diff options
Diffstat (limited to 'ghc/includes')
40 files changed, 3384 insertions, 3465 deletions
diff --git a/ghc/includes/Block.h b/ghc/includes/Block.h index ac30e8cd36..d7599c5931 100644 --- a/ghc/includes/Block.h +++ b/ghc/includes/Block.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Block.h,v 1.16 2003/11/26 12:14:26 simonmar Exp $ + * $Id: Block.h,v 1.17 2004/08/13 13:09:09 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -47,12 +47,13 @@ * on a 32-bit machine. */ -typedef struct _bdescr { +#ifndef CMINUSMINUS +typedef struct bdescr_ { StgPtr start; /* start addr of memory */ StgPtr free; /* first free byte of memory */ - struct _bdescr *link; /* used for chaining blocks together */ + struct bdescr_ *link; /* used for chaining blocks together */ union { - struct _bdescr *back; /* used (occasionally) for doubly-linked lists*/ + struct bdescr_ *back; /* used (occasionally) for doubly-linked lists*/ StgWord *bitmap; } u; unsigned int gen_no; /* generation */ @@ -65,6 +66,7 @@ typedef struct _bdescr { StgWord32 _padding[0]; #endif } bdescr; +#endif #if SIZEOF_VOID_P == 8 #define BDESCR_SIZE 0x40 @@ -76,17 +78,25 @@ typedef struct _bdescr { #define BDESCR_SHIFT 5 #endif -// Block contains objects evacuated during this GC +/* Block contains objects evacuated during this GC */ #define BF_EVACUATED 1 -// Block is a large object +/* Block is a large object */ #define BF_LARGE 2 -// Block is pinned +/* Block is pinned */ #define BF_PINNED 4 -// Block is part of a compacted generation +/* Block is part of a compacted generation */ #define BF_COMPACTED 8 /* Finding the block descriptor for a given block -------------------------- */ +#ifdef CMINUSMINUS + +#define Bdescr(p) \ + ((((p) & MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) \ + | ((p) & ~MBLOCK_MASK)) + +#else + INLINE_HEADER bdescr *Bdescr(StgPtr p) { return (bdescr *) @@ -95,6 +105,8 @@ INLINE_HEADER bdescr *Bdescr(StgPtr p) ); } +#endif + /* Useful Macros ------------------------------------------------------------ */ /* Offset of first real data block in a megablock */ @@ -129,4 +141,20 @@ INLINE_HEADER bdescr *Bdescr(StgPtr p) #define BLOCKS_TO_MBLOCKS(n) \ (1 + (W_)MBLOCK_ROUND_UP((n-BLOCKS_PER_MBLOCK) * BLOCK_SIZE) / MBLOCK_SIZE) + +/* Double-linked block lists: --------------------------------------------- */ + +#ifndef CMINUSMINUS +INLINE_HEADER void +dbl_link_onto(bdescr *bd, bdescr **list) +{ + bd->link = *list; + bd->u.back = NULL; + if (*list) { + (*list)->u.back = bd; /* double-link the list */ + } + *list = bd; +} +#endif + #endif /* BLOCK_H */ diff --git a/ghc/includes/CCall.h b/ghc/includes/CCall.h deleted file mode 100644 index 3040c17491..0000000000 --- a/ghc/includes/CCall.h +++ /dev/null @@ -1,141 +0,0 @@ -/* ----------------------------------------------------------------------------- - * $Id: CCall.h,v 1.4 2000/01/13 14:34:00 hwloidl Exp $ - * - * (c) The GHC Team, 1998-1999 - * - * Macros for performing C calls from the STG world. - * - * -------------------------------------------------------------------------- */ - -#ifndef CCALL_H -#define CCALL_H - -/* - * Most C-Calls made from STG land are of the 'unsafe' variety. - * An unsafe C-Call is one where we trust the C function not to do - * anything nefarious while it has control. - * - * Nefarious actions include doing allocation on the Haskell heap, - * garbage collecting, creating/deleting threads, re-entering the - * scheduler, and messing with runtime system data structures. - * - * For these calls, the code generator will kindly provide CALLER_SAVE - * and CALLER_RESTORE macros for any registers that are live across the - * call. These macros may expand into saves of the relevant registers - * if those registers are designated caller-saves by the C calling - * convention, otherwise they will expand to nothing. - */ - -/* Unsafe C-Calls have no macros: we just use a straightforward call. - */ - -/* - * An STGCALL<n> is used when we want the relevant registers to be - * saved automatically. An STGCALL doesn't return a result, there's - * an alternative set of RET_STGCALL<n> macros for that (and we hope - * that the restoring of the caller-saves registers doesn't clobber - * the result!) - */ - -#define STGCALL0(f) \ - CALLER_SAVE_ALL (void) f(); CALLER_RESTORE_ALL - -#define STGCALL1(f,a) \ - CALLER_SAVE_ALL (void) f(a); CALLER_RESTORE_ALL - -#define STGCALL2(f,a,b) \ - CALLER_SAVE_ALL (void) f(a,b); CALLER_RESTORE_ALL - -#define STGCALL3(f,a,b,c) \ - CALLER_SAVE_ALL (void) f(a,b,c); CALLER_RESTORE_ALL - -#define STGCALL4(f,a,b,c,d) \ - CALLER_SAVE_ALL (void) f(a,b,c,d); CALLER_RESTORE_ALL - -#define STGCALL5(f,a,b,c,d,e) \ - CALLER_SAVE_ALL (void) f(a,b,c,d,e); CALLER_RESTORE_ALL - -#define STGCALL6(f,a,b,c,d,e,z) \ - CALLER_SAVE_ALL (void) f(a,b,c,d,e,z); CALLER_RESTORE_ALL - - -#define RET_STGCALL0(t,f) \ - ({ t _r; CALLER_SAVE_ALL _r = f(); CALLER_RESTORE_ALL; _r; }) - -#define RET_STGCALL1(t,f,a) \ - ({ t _r; CALLER_SAVE_ALL _r = f(a); CALLER_RESTORE_ALL; _r; }) - -#define RET_STGCALL2(t,f,a,b) \ - ({ t _r; CALLER_SAVE_ALL _r = f(a,b); CALLER_RESTORE_ALL; _r; }) - -#define RET_STGCALL3(t,f,a,b,c) \ - ({ t _r; CALLER_SAVE_ALL _r = f(a,b,c); CALLER_RESTORE_ALL; _r; }) - -#define RET_STGCALL4(t,f,a,b,c,d) \ - ({ t _r; CALLER_SAVE_ALL _r = f(a,b,c,d); CALLER_RESTORE_ALL; _r; }) - -#define RET_STGCALL5(t,f,a,b,c,d,e) \ - ({ t _r; CALLER_SAVE_ALL _r = f(a,b,c,d,e); CALLER_RESTORE_ALL; _r; }) - -#define RET_STGCALL6(t,f,a,b,c,d,e,z) \ - ({ t _r; CALLER_SAVE_ALL _r = f(a,b,c,d,e,z); CALLER_RESTORE_ALL; _r; }) - - -/* - * A PRIM_STGCALL is used when we have arranged to save the R<n>, - * F<n>, and D<n> registers already, we only need the "system" - * registers saved for us. These are used in PrimOps, where the - * compiler has a good idea of what registers are live, and so doesn't - * need to save all of them. - */ - -#define PRIM_STGCALL0(f) \ - CALLER_SAVE_SYSTEM (void) f(); CALLER_RESTORE_SYSTEM - -#define PRIM_STGCALL1(f,a) \ - CALLER_SAVE_SYSTEM (void) f(a); CALLER_RESTORE_SYSTEM - -#define PRIM_STGCALL2(f,a,b) \ - CALLER_SAVE_SYSTEM (void) f(a,b); CALLER_RESTORE_SYSTEM - -#define PRIM_STGCALL3(f,a,b,c) \ - CALLER_SAVE_SYSTEM (void) f(a,b,c); CALLER_RESTORE_SYSTEM - -#define PRIM_STGCALL4(f,a,b,c,d) \ - CALLER_SAVE_SYSTEM (void) f(a,b,c,d); CALLER_RESTORE_SYSTEM - -#define PRIM_STGCALL5(f,a,b,c,d,e) \ - CALLER_SAVE_SYSTEM (void) f(a,b,c,d,e); CALLER_RESTORE_SYSTEM - -#define PRIM_STGCALL6(f,a,b,c,d,e,z) \ - CALLER_SAVE_SYSTEM (void) f(a,b,c,d,e,z); CALLER_RESTORE_SYSTEM - - -#define RET_PRIM_STGCALL0(t,f) \ - ({ t _r; CALLER_SAVE_SYSTEM _r = f(); CALLER_RESTORE_SYSTEM; _r; }) - -#define RET_PRIM_STGCALL1(t,f,a) \ - ({ t _r; CALLER_SAVE_SYSTEM _r = f(a); CALLER_RESTORE_SYSTEM; _r; }) - -#define RET_PRIM_STGCALL2(t,f,a,b) \ - ({ t _r; CALLER_SAVE_SYSTEM _r = f(a,b); CALLER_RESTORE_SYSTEM; _r; }) - -#define RET_PRIM_STGCALL3(t,f,a,b,c) \ - ({ t _r; CALLER_SAVE_SYSTEM _r = f(a,b,c); CALLER_RESTORE_SYSTEM; _r; }) - -#define RET_PRIM_STGCALL4(t,f,a,b,c,d) \ - ({ t _r; CALLER_SAVE_SYSTEM _r = f(a,b,c,d); CALLER_RESTORE_SYSTEM; _r; }) - -#define RET_PRIM_STGCALL5(t,f,a,b,c,d,e) \ - ({ t _r; CALLER_SAVE_SYSTEM _r = f(a,b,c,d,e); CALLER_RESTORE_SYSTEM; _r; }) - -#define RET_PRIM_STGCALL6(t,f,a,b,c,d,e,z) \ - ({ t _r; CALLER_SAVE_SYSTEM _r = f(a,b,c,d,e,z); CALLER_RESTORE_SYSTEM; _r; }) - -/* ToDo: ccalls that might garbage collect - do we need to return to - * the scheduler to perform these? Similarly, ccalls that might want - * to call Haskell right back, or start a new thread or something. - */ - -#endif /* CCALL_H */ - diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h index b9778518a6..e2519bb503 100644 --- a/ghc/includes/ClosureMacros.h +++ b/ghc/includes/ClosureMacros.h @@ -1,7 +1,6 @@ /* ---------------------------------------------------------------------------- - * $Id: ClosureMacros.h,v 1.38 2003/11/12 17:27:00 sof Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * * Macros for building and manipulating closures * @@ -52,7 +51,6 @@ -------------------------------------------------------------------------- */ -#define INIT_INFO(i) info : (StgInfoTable *)&(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))) @@ -62,30 +60,21 @@ #define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info)) #define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info)) +#define GET_TAG(con) (get_itbl(con)->srt_bitmap) #ifdef TABLES_NEXT_TO_CODE -#define INIT_ENTRY(e) -#define ENTRY_CODE(info) (info) #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1) #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1) #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1) #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1) -INLINE_HEADER StgFunPtr get_entry(const StgInfoTable *itbl) { - return (StgFunPtr)(itbl+1); -} #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) #else -#define INIT_ENTRY(e) entry : (F_)(e) -#define ENTRY_CODE(info) (((StgInfoTable *)info)->entry) #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info) #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info) #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info) #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info) -INLINE_HEADER StgFunPtr get_entry(const StgInfoTable *itbl) { - return itbl->entry; -} #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i)) #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i)) #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i)) @@ -104,7 +93,6 @@ INLINE_HEADER StgFunPtr get_entry(const StgInfoTable *itbl) { Note: change those functions building Haskell objects from C datatypes, i.e., all rts_mk???() functions in RtsAPI.c, as well. */ -extern StgWord flip; #define SET_PROF_HDR(c,ccs_) \ ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip)) #else @@ -125,10 +113,10 @@ extern StgWord flip; */ #define SET_PROF_HDR(c,ccs_) \ ((c)->header.prof.ccs = ccs_, \ - LDV_recordCreate((c))) + LDV_RECORD_CREATE((c))) #endif // DEBUG_RETAINER #define SET_STATIC_PROF_HDR(ccs_) \ - prof : { ccs : ccs_, hp : { rs : NULL } }, + prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } }, #else #define SET_PROF_HDR(c,ccs) #define SET_STATIC_PROF_HDR(ccs) @@ -158,9 +146,9 @@ extern StgWord flip; #define SET_STATIC_TICKY_HDR(stuff) #endif -#define SET_HDR(c,info,ccs) \ +#define SET_HDR(c,_info,ccs) \ { \ - SET_INFO(c,info); \ + (c)->header.info = _info; \ SET_GRAN_HDR((StgClosure *)(c),ThisPE); \ SET_PAR_HDR((StgClosure *)(c),LOCAL_GA); \ SET_PROF_HDR((StgClosure *)(c),ccs); \ @@ -172,34 +160,13 @@ extern StgWord flip; (c)->words = n_words; /* ----------------------------------------------------------------------------- - Static closures are defined as follows: - - - SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,closure_class,info_class); - - The info argument must have type 'StgInfoTable' or - 'StgSRTInfoTable', since we use '&' to get its address in the macro. + 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 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) \ - } - -/* 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) \ (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \ info->layout.payload.nptrs]))) @@ -230,17 +197,4 @@ extern StgWord flip; #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE]) #define INTLIKE_CLOSURE(n) ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE]) -/* ----------------------------------------------------------------------------- - Closure Tables (for enumerated data types) - -------------------------------------------------------------------------- */ - -#define CLOSURE_TBL(lbl) const StgClosure *lbl[] = { - -/* ----------------------------------------------------------------------------- - CONSTRs. - -------------------------------------------------------------------------- */ - -/* constructors don't have SRTs */ -#define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_bitmap) - #endif /* CLOSUREMACROS_H */ diff --git a/ghc/includes/Closures.h b/ghc/includes/Closures.h index 1b4fb0a66a..d5467928ed 100644 --- a/ghc/includes/Closures.h +++ b/ghc/includes/Closures.h @@ -1,7 +1,6 @@ /* ---------------------------------------------------------------------------- - * $Id: Closures.h,v 1.35 2003/11/14 14:28:07 stolz Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * * Closures * @@ -52,8 +51,6 @@ typedef struct { #endif } StgHeader; -#define FIXED_HS (sizeof(StgHeader)) - /* ----------------------------------------------------------------------------- Closure Types @@ -233,11 +230,53 @@ typedef struct { #define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \ / BITS_IN(StgWord)) -/* Dynamic stack frames - these have a liveness mask in the object - * itself, rather than in the info table. Useful for generic heap - * check code. See StgMacros.h, HEAP_CHK_GEN(). - */ - +/* ----------------------------------------------------------------------------- + Dynamic stack frames for generic heap checks. + + These generic heap checks are slow, but have the advantage of being + usable in a variety of situations. + + The one restriction is that any relevant SRTs must already be pointed + to from the stack. The return address doesn't need to have an info + table attached: hence it can be any old code pointer. + + The liveness mask contains a 1 at bit n, if register Rn contains a + non-pointer. The contents of all 8 vanilla registers are always saved + on the stack; the liveness mask tells the GC which ones contain + pointers. + + Good places to use a generic heap check: + + - case alternatives (the return address with an SRT is already + on the stack). + + - primitives (no SRT required). + + The stack frame layout for a RET_DYN is like this: + + some pointers |-- RET_DYN_PTRS(liveness) words + some nonpointers |-- RET_DYN_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). + + See Liveness.h for the macros (RET_DYN_PTRS() etc.). + + 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. + -------------------------------------------------------------------------- */ + typedef struct { const struct _StgInfoTable* info; StgWord liveness; diff --git a/ghc/includes/Cmm.h b/ghc/includes/Cmm.h new file mode 100644 index 0000000000..608e97dfbd --- /dev/null +++ b/ghc/includes/Cmm.h @@ -0,0 +1,465 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2004 + * + * This file is included at the top of all .cmm source files (and + * *only* .cmm files). It defines a collection of useful macros for + * making .cmm code a bit less error-prone to write, and a bit easier + * on the eye for the reader. + * + * For the syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y. + * + * If you're used to the old HC file syntax, here's a quick cheat sheet + * for converting HC code: + * + * - Remove FB_/FE_ + * - Remove all type casts + * - Remove '&' + * - STGFUN(foo) { ... } ==> foo { ... } + * - FN_(foo) { ... } ==> foo { ... } + * - JMP_(e) ==> jump e; + * - Remove EXTFUN(foo) + * - Sp[n] ==> Sp(n) + * - Hp[n] ==> Hp(n) + * - Sp += n ==> Sp_adj(n) + * - Hp += n ==> Hp_adj(n) + * - R1.i ==> R1 (similarly for R1.w, R1.cl etc.) + * - You need to explicitly dereference variables; eg. + * context_switch ==> CInt[context_switch] + * - convert all word offsets into byte offsets: + * - e ==> WDS(e) + * - sizeofW(StgFoo) ==> SIZEOF_StgFoo + * - ENTRY_CODE(e) ==> %ENTRY_CODE(e) + * - get_itbl(c) ==> %GET_STD_INFO(c) + * - Change liveness masks in STK_CHK_GEN, HP_CHK_GEN: + * R1_PTR | R2_PTR ==> R1_PTR & R2_PTR + * (NOTE: | becomes &) + * - Declarations like 'StgPtr p;' become just 'W_ p;' + * - e->payload[n] ==> PAYLOAD(e,n) + * - Be very careful with comparisons: the infix versions (>, >=, etc.) + * are unsigned, so use %lt(a,b) to get signed less-than for example. + * + * Accessing fields of structures defined in the RTS header files is + * done via automatically-generated macros in DerivedConstants.h. For + * example, where previously we used + * + * CurrentTSO->what_next = x + * + * in C-- we now use + * + * StgTSO_what_next(CurrentTSO) = x + * + * where the StgTSO_what_next() macro is automatically generated by + * mkDerivedConstnants.c. If you need to access a field that doesn't + * already have a macro, edit that file (it's pretty self-explanatory). + * + * -------------------------------------------------------------------------- */ + +#ifndef CMM_H +#define CMM_H + +// In files that are included into both C and C-- (and perhaps +// Haskell) sources, we sometimes need to conditionally compile bits +// depending on the language. CMINUSMINUS==1 in .cmm sources: +#define CMINUSMINUS 1 + +#include "ghcconfig.h" +#include "RtsConfig.h" + +/* ----------------------------------------------------------------------------- + Types + + The following synonyms for C-- types are declared here: + + I8, I16, I32, I64 MachRep-style names for convenience + + W_ is shorthand for the word type (== StgWord) + F_ shorthand for float (F_ == StgFloat == C's float) + D_ shorthand for double (D_ == StgDouble == C's double) + + CInt has the same size as an int in C on this platform + CLong has the same size as a long in C on this platform + + --------------------------------------------------------------------------- */ + +#define I8 bits8 +#define I16 bits16 +#define I32 bits32 +#define I64 bits64 + +#if SIZEOF_VOID_P == 4 +#define W_ bits32 +#elif SIZEOF_VOID_P == 8 +#define W_ bits64 +#else +#error Unknown word size +#endif + +#if SIZEOF_INT == 4 +#define CInt bits32 +#elif SIZEOF_INT = 8 +#define CInt bits64 +#else +#error Unknown int size +#endif + +#if SIZEOF_LONG == 4 +#define CLong bits32 +#elif SIZEOF_LONG = 8 +#define CLong bits64 +#else +#error Unknown long size +#endif + +#define F_ float32 +#define D_ float64 +#define L_ bits64 + +#define SIZEOF_StgDouble 8 +#define SIZEOF_StgWord64 8 + +/* ----------------------------------------------------------------------------- + Misc useful stuff + -------------------------------------------------------------------------- */ + +#define NULL (0::W_) + +#define STRING(name,str) \ + section "rodata" { \ + name : bits8[] str; \ + } \ + +/* ----------------------------------------------------------------------------- + Byte/word macros + + Everything in C-- is in byte offsets (well, most things). We use + some macros to allow us to express offsets in words and to try to + avoid byte/word confusion. + -------------------------------------------------------------------------- */ + +#define SIZEOF_W SIZEOF_VOID_P +#define W_MASK (SIZEOF_W-1) + +#if SIZEOF_W == 4 +#define W_SHIFT 2 +#elif SIZEOF_W == 8 +#define W_SHIFT 4 +#endif + +// Converting quantities of words to bytes +#define WDS(n) ((n)*SIZEOF_W) + +// Converting quantities of bytes to words +// NB. these work on *unsigned* values only +#define BYTES_TO_WDS(n) ((n) / SIZEOF_W) +#define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W) + +// TO_W_(n) converts n to W_ type from a smaller type +#if SIZEOF_W == 4 +#define TO_W_(x) %sx32(x) +#define HALF_W_(x) %lobits16(x) +#elif SIZEOF_W == 8 +#define TO_W_(x) %sx64(x) +#define HALF_W_(x) %lobits32(x) +#endif + +/* ----------------------------------------------------------------------------- + Heap/stack access, and adjusting the heap/stack pointers. + -------------------------------------------------------------------------- */ + +#define Sp(n) W_[Sp + WDS(n)] +#define Hp(n) W_[Hp + WDS(n)] + +#define Sp_adj(n) Sp = Sp + WDS(n) +#define Hp_adj(n) Hp = Hp + WDS(n) + +/* ----------------------------------------------------------------------------- + Assertions and Debuggery + -------------------------------------------------------------------------- */ + +#ifdef DEBUG +#define ASSERT(predicate) \ + if (predicate) { \ + /*null*/; \ + } else { \ + foreign "C" _stgAssert(NULL, __LINE__); \ + } +#else +#define ASSERT(p) /* nothing */ +#endif + +#ifdef DEBUG +#define DEBUG_ONLY(s) s +#else +#define DEBUG_ONLY(s) /* nothing */ +#endif + +// +// The IF_DEBUG macro is useful for debug messages that depend on one +// of the RTS debug options. For example: +// +// IF_DEBUG(RtsFlags_DebugFlags_apply, +// foreign "C" fprintf(stderr, stg_ap_0_ret_str)); +// +// Note the syntax is slightly different to the C version of this macro. +// +#ifdef DEBUG +#define IF_DEBUG(c,s) if (RtsFlags_DebugFlags_##c(RtsFlags)) { s; } +#else +#define IF_DEBUG(c,s) /* nothing */ +#endif + +/* ----------------------------------------------------------------------------- + Entering + + 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. + + ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES, + but switch doesn't allow us to use exprs there yet. + -------------------------------------------------------------------------- */ + +#define ENTER() \ + again: \ + switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \ + (TO_W_( %INFO_TYPE(%GET_STD_INFO(R1)) )) { \ + case \ + IND, \ + IND_OLDGEN, \ + IND_PERM, \ + IND_OLDGEN_PERM, \ + IND_STATIC: \ + { \ + R1 = StgInd_indirectee(R1); \ + goto again; \ + } \ + case \ + BCO, \ + FUN, \ + FUN_1_0, \ + FUN_0_1, \ + FUN_2_0, \ + FUN_1_1, \ + FUN_0_2, \ + FUN_STATIC, \ + PAP: \ + { \ + jump %ENTRY_CODE(Sp(0)); \ + } \ + default: \ + { \ + jump %GET_ENTRY(R1); \ + } \ + } + +/* ----------------------------------------------------------------------------- + Constants. + -------------------------------------------------------------------------- */ + +#include "Constants.h" +#include "DerivedConstants.h" +#include "ClosureTypes.h" +#include "StgFun.h" + +// +// Need MachRegs, because some of the RTS code is conditionally +// compiled based on REG_R1, REG_R2, etc. +// +#define STOLEN_X86_REGS 4 +#include "MachRegs.h" + +#include "Liveness.h" +#include "StgLdvProf.h" + +#undef BLOCK_SIZE +#undef MBLOCK_SIZE +#include "Block.h" // For Bdescr() + + +// Can't think of a better place to put this. +#if SIZEOF_mp_limb_t != SIZEOF_VOID_P +#error mp_limb_t != StgWord: assumptions in PrimOps.cmm are now false +#endif + +/* ------------------------------------------------------------------------- + Allocation and garbage collection + ------------------------------------------------------------------------- */ + +// ALLOC_PRIM is for allocating memory on the heap for a primitive +// object. It is used all over PrimOps.cmm. +// +// We make the simplifying assumption that the "admin" part of a +// primitive closure is just the header when calculating sizes for +// ticky-ticky. It's not clear whether eg. the size field of an array +// should be counted as "admin", or the various fields of a BCO. +// +#define ALLOC_PRIM(bytes,liveness,reentry) \ + HP_CHK_GEN_TICKY(bytes,liveness,reentry); \ + TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \ + CCCS_ALLOC(bytes); + +// CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words +#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), W_[CCCS]) + +#define HP_CHK_GEN_TICKY(alloc,liveness,reentry) \ + HP_CHK_GEN(alloc,liveness,reentry); \ + TICK_ALLOC_HEAP_NOCTR(alloc); + +#define MAYBE_GC(liveness,reentry) \ + if (CInt[alloc_blocks] >= CInt[alloc_blocks_lim]) { \ + R9 = liveness; \ + R10 = reentry; \ + jump stg_gc_gen_hp; \ + } + +/* ----------------------------------------------------------------------------- + Closures + -------------------------------------------------------------------------- */ + +// The offset of the payload of an array +#define BYTE_ARR_CTS(arr) ((arr) + SIZEOF_StgArrWords) + +// Getting/setting the info pointer of a closure +#define SET_INFO(p,info) StgHeader_info(p) = info +#define GET_INFO(p) StgHeader_info(p) + +// Determine the size of an ordinary closure from its info table +#define sizeW_fromITBL(itbl) \ + SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl)) + +// NB. duplicated from InfoTables.h! +#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK) +#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT) + +// Debugging macros +#define LOOKS_LIKE_INFO_PTR(p) \ + ((p) != NULL && \ + (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \ + (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES)) + +#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(p))) + +// +// The layout of the StgFunInfoExtra part of an info table changes +// depending on TABLES_NEXT_TO_CODE. So we define field access +// macros which use the appropriate version here: +// +#ifdef TABLES_NEXT_TO_CODE +#define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraRev_slow_apply(i) +#define StgFunInfoExtra_fun_type(i) StgFunInfoExtraRev_fun_type(i) +#define StgFunInfoExtra_arity(i) StgFunInfoExtraRev_arity(i) +#define StgFunInfoExtra_bitmap(i) StgFunInfoExtraRev_bitmap(i) +#else +#define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i) +#define StgFunInfoExtra_fun_type(i) StgFunInfoExtraFwd_fun_type(i) +#define StgFunInfoExtra_arity(i) StgFunInfoExtraFwd_arity(i) +#define StgFunInfoExtra_bitmap(i) StgFunInfoExtraFwd_bitmap(i) +#endif + +/* ----------------------------------------------------------------------------- + Voluntary Yields/Blocks + + We only have a generic version of this at the moment - if it turns + out to be slowing us down we can make specialised ones. + -------------------------------------------------------------------------- */ + +#define YIELD(liveness,reentry) \ + R9 = liveness; \ + R10 = reentry; \ + jump stg_gen_yield; + +#define BLOCK(liveness,reentry) \ + R9 = liveness; \ + R10 = reentry; \ + jump stg_gen_block; + +/* ----------------------------------------------------------------------------- + Ticky macros + -------------------------------------------------------------------------- */ + +#ifdef TICKY_TICKY +#define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n +#else +#define TICK_BUMP_BY(ctr,n) /* nothing */ +#endif + +#define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) + +#define TICK_ENT_DYN_IND() TICK_BUMP(ENT_DYN_IND_ctr) +#define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +#define TICK_ENT_VIA_NODE() TICK_BUMP(ENT_VIA_NODE_ctr) +#define TICK_ENT_STATIC_IND() TICK_BUMP(ENT_STATIC_IND_ctr) +#define TICK_ENT_PERM_IND() TICK_BUMP(ENT_PERM_IND_ctr) +#define TICK_ENT_PAP() TICK_BUMP(ENT_PAP_ctr) +#define TICK_ENT_AP() TICK_BUMP(ENT_AP_ctr) +#define TICK_ENT_AP_STACK() TICK_BUMP(ENT_AP_STACK_ctr) +#define TICK_ENT_BH() TICK_BUMP(ENT_BH_ctr) +#define TICK_UNKNOWN_CALL() TICK_BUMP(UNKNOWN_CALL_ctr) +#define TICK_UPDF_PUSHED() TICK_BUMP(UPDF_PUSHED_ctr) +#define TICK_CATCHF_PUSHED() TICK_BUMP(CATCHF_PUSHED_ctr) +#define TICK_UPDF_OMITTED() TICK_BUMP(UPDF_OMITTED_ctr) +#define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr) +#define TICK_UPD_NEW_PERM_IND() TICK_BUMP(UPD_NEW_PERM_IND_ctr) +#define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr) +#define TICK_UPD_OLD_PERM_IND() TICK_BUMP(UPD_OLD_PERM_IND_ctr) + +#define TICK_SLOW_CALL_FUN_TOO_FEW() TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr) +#define TICK_SLOW_CALL_FUN_CORRECT() TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr) +#define TICK_SLOW_CALL_FUN_TOO_MANY() TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr) +#define TICK_SLOW_CALL_PAP_TOO_FEW() TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr) +#define TICK_SLOW_CALL_PAP_CORRECT() TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr) +#define TICK_SLOW_CALL_PAP_TOO_MANY() TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr) + +#define TICK_SLOW_CALL_v() TICK_BUMP(SLOW_CALL_v_ctr) +#define TICK_SLOW_CALL_p() TICK_BUMP(SLOW_CALL_p_ctr) +#define TICK_SLOW_CALL_pv() TICK_BUMP(SLOW_CALL_pv_ctr) +#define TICK_SLOW_CALL_pp() TICK_BUMP(SLOW_CALL_pp_ctr) +#define TICK_SLOW_CALL_ppp() TICK_BUMP(SLOW_CALL_ppp_ctr) +#define TICK_SLOW_CALL_pppp() TICK_BUMP(SLOW_CALL_pppp_ctr) +#define TICK_SLOW_CALL_ppppp() TICK_BUMP(SLOW_CALL_ppppp_ctr) +#define TICK_SLOW_CALL_pppppp() TICK_BUMP(SLOW_CALL_pppppp_ctr) + +#ifdef TICKY_TICKY +#define TICK_HISTO_BY(histo,n,i) \ + W_ __idx; \ + __idx = (n); \ + if (__idx > 8) { \ + __idx = 8; \ + } \ + CLong[histo##_hst + _idx*SIZEOF_LONG] \ + = histo##_hst + __idx*SIZEOF_LONG] + i; +#else +#define TICK_HISTO_BY(histo,n,i) /* nothing */ +#endif + +#define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1) + +// An unboxed tuple with n components. +#define TICK_RET_UNBOXED_TUP(n) \ + TICK_BUMP(RET_UNBOXED_TUP_ctr++); \ + TICK_HISTO(RET_UNBOXED_TUP,n) + +// A slow call with n arguments. In the unevald case, this call has +// already been counted once, so don't count it again. +#define TICK_SLOW_CALL(n) \ + TICK_BUMP(SLOW_CALL_ctr); \ + TICK_HISTO(SLOW_CALL,n) + +// This slow call was found to be to an unevaluated function; undo the +// ticks we did in TICK_SLOW_CALL. +#define TICK_SLOW_CALL_UNEVALD(n) \ + TICK_BUMP(SLOW_CALL_UNEVALD_ctr); \ + TICK_BUMP_BY(SLOW_CALL_ctr,-1); \ + TICK_HISTO_BY(SLOW_CALL,n,-1); + +// Updating a closure with a new CON +#define TICK_UPD_CON_IN_NEW(n) \ + TICK_BUMP(UPD_CON_IN_NEW_ctr); \ + TICK_HISTO(UPD_CON_IN_NEW,n) + +#define TICK_ALLOC_HEAP_NOCTR(n) \ + TICK_BUMP(ALLOC_HEAP_ctr); \ + TICK_BUMP_BY(ALLOC_HEAP_tot,n) + +#endif // CMM_H diff --git a/ghc/includes/Constants.h b/ghc/includes/Constants.h index 8974052821..2d99ae9b6a 100644 --- a/ghc/includes/Constants.h +++ b/ghc/includes/Constants.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: Constants.h,v 1.25 2003/04/28 09:55:20 simonmar Exp $ + * $Id: Constants.h,v 1.26 2004/08/13 13:09:13 simonmar Exp $ * * (c) The GHC Team, 1998-2002 * @@ -62,8 +62,7 @@ * space. */ -#define MAX_SPEC_AP_SIZE 8 -/* ToDo: make it 8 again */ +#define MAX_SPEC_AP_SIZE 7 /* Specialised FUN/THUNK/CONSTR closure types */ @@ -71,6 +70,17 @@ #define MAX_SPEC_FUN_SIZE 2 #define MAX_SPEC_CONSTR_SIZE 2 +/* Range of built-in table of static small int-like and char-like closures. + * + * NB. This corresponds with the number of actual INTLIKE/CHARLIKE + * closures defined in rts/StgMiscClosures.cmm. + */ +#define MAX_INTLIKE 16 +#define MIN_INTLIKE (-16) + +#define MAX_CHARLIKE 255 +#define MIN_CHARLIKE 0 + /* ----------------------------------------------------------------------------- STG Registers. @@ -81,24 +91,18 @@ #define MAX_VANILLA_REG 8 #define MAX_FLOAT_REG 4 #define MAX_DOUBLE_REG 2 -/* register is only used for returning (unboxed) 64-bit vals */ #define MAX_LONG_REG 1 -/*---- Maximum number of constructors in a data type for direct-returns. */ +/* ----------------------------------------------------------------------------- + * Maximum number of constructors in a data type for direct-returns. + * + * NB. There are various places that assume the value of this + * constant, such as the polymorphic return frames for updates + * (stg_upd_frame_info) and catch frames (stg_catch_frame_info). + * -------------------------------------------------------------------------- */ #define MAX_VECTORED_RTN 8 -/*---- Range of built-in table of static small int-like and char-like closures. */ - -#define MAX_INTLIKE 16 -#define MIN_INTLIKE (-16) - -#define MAX_CHARLIKE 255 -#define MIN_CHARLIKE 0 - -/* You can change these constants (I hope) but be sure to modify - rts/StgMiscClosures.hs accordingly. */ - /* ----------------------------------------------------------------------------- Semi-Tagging constants @@ -170,4 +174,96 @@ #error unknown SIZEOF_VOID_P #endif +/* ----------------------------------------------------------------------------- + Lag/Drag/Void constants + -------------------------------------------------------------------------- */ + +/* + An LDV word is divided into 3 parts: state bits (LDV_STATE_MASK), creation + time bits (LDV_CREATE_MASK), and last use time bits (LDV_LAST_MASK). + */ +#if SIZEOF_VOID_P == 8 +#define LDV_SHIFT 30 +#define LDV_STATE_MASK 0x1000000000000000 +#define LDV_CREATE_MASK 0x0FFFFFFFC0000000 +#define LDV_LAST_MASK 0x000000003FFFFFFF +#define LDV_STATE_CREATE 0x0000000000000000 +#define LDV_STATE_USE 0x1000000000000000 +#else +#define LDV_SHIFT 15 +#define LDV_STATE_MASK 0x40000000 +#define LDV_CREATE_MASK 0x3FFF8000 +#define LDV_LAST_MASK 0x00007FFF +#define LDV_STATE_CREATE 0x00000000 +#define LDV_STATE_USE 0x40000000 +#endif // SIZEOF_VOID_P + +/* ----------------------------------------------------------------------------- + TSO related constants + -------------------------------------------------------------------------- */ + +/* + * Constants for the what_next field of a TSO, which indicates how it + * is to be run. + */ +#define ThreadRunGHC 1 /* return to address on top of stack */ +#define ThreadInterpret 2 /* interpret this thread */ +#define ThreadKilled 3 /* thread has died, don't run it */ +#define ThreadRelocated 4 /* thread has moved, link points to new locn */ +#define ThreadComplete 5 /* thread has finished */ + +/* + * Constants for the why_blocked field of a TSO + */ +#define NotBlocked 0 +#define BlockedOnMVar 1 +#define BlockedOnBlackHole 2 +#define BlockedOnException 3 +#define BlockedOnRead 4 +#define BlockedOnWrite 5 +#define BlockedOnDelay 6 + +/* Win32 only: */ +#define BlockedOnDoProc 7 + +/* Only relevant for PAR: */ + /* blocked on a remote closure represented by a Global Address: */ +#define BlockedOnGA 8 + /* same as above but without sending a Fetch message */ +#define BlockedOnGA_NoSend 9 +/* Only relevant for RTS_SUPPORTS_THREADS: */ +#define BlockedOnCCall 10 +#define BlockedOnCCall_NoUnblockExc 11 + /* same as above but don't unblock async exceptions in resumeThread() */ + +/* + * These constants are returned to the scheduler by a thread that has + * stopped for one reason or another. See typedef StgThreadReturnCode + * in TSO.h. + */ +#define HeapOverflow 1 /* might also be StackOverflow */ +#define StackOverflow 2 +#define ThreadYielding 3 +#define ThreadBlocked 4 +#define ThreadFinished 5 + +/* ----------------------------------------------------------------------------- + RET_DYN stack frames + -------------------------------------------------------------------------- */ + +/* 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 + +/* 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 + #endif /* CONSTANTS_H */ diff --git a/ghc/includes/Derived.h b/ghc/includes/Derived.h deleted file mode 100644 index f65cfc8e93..0000000000 --- a/ghc/includes/Derived.h +++ /dev/null @@ -1,32 +0,0 @@ -/* ----------------------------------------------------------------------------- - * $Id: Derived.h,v 1.2 2001/08/04 06:09:24 ken Exp $ - * - * (c) The GHC Team, 1998-2001 - * - * Configuration information derived from config.h. - * - * NOTE: assumes #include "config.h" - * - * NB: THIS FILE IS INCLUDED IN NON-C CODE AND DATA! #defines only please. - * ---------------------------------------------------------------------------*/ - -#ifndef DERIVED_H -#define DERIVED_H - -/* - * SUPPORT_LONG_LONGS controls whether we need to support long longs on a - * particular platform. On 64-bit platforms, we don't need to support - * long longs since regular machine words will do just fine. - */ -#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8 -#define SUPPORT_LONG_LONGS 1 -#endif - -/* - * Whether the runtime system will use libbfd for debugging purposes. - */ -#if defined(DEBUG) && defined(HAVE_BFD_H) && !defined(_WIN32) && !defined(PAR) && !defined(GRAN) -#define USING_LIBBFD 1 -#endif - -#endif /* DERIVED_H */ diff --git a/ghc/includes/DietHEP.h b/ghc/includes/DietHEP.h deleted file mode 100644 index 28b3c05d40..0000000000 --- a/ghc/includes/DietHEP.h +++ /dev/null @@ -1,13 +0,0 @@ - -typedef enum { dh_stdcall, dh_ccall } DH_CALLCONV; -typedef int DH_MODULE; -typedef char* DH_LPCSTR; - -extern __attribute__((__stdcall__)) - DH_MODULE DH_LoadLibrary ( DH_LPCSTR modname ); -extern __attribute__((__stdcall__)) - void* DH_GetProcAddress ( DH_CALLCONV cconv, - DH_MODULE hModule, - DH_LPCSTR lpProcName ); - - diff --git a/ghc/includes/HsFFI.h b/ghc/includes/HsFFI.h index fc029bb21f..a96cb95c91 100644 --- a/ghc/includes/HsFFI.h +++ b/ghc/includes/HsFFI.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: HsFFI.h,v 1.19 2004/04/12 16:26:40 panne Exp $ + * $Id: HsFFI.h,v 1.20 2004/08/13 13:09:13 simonmar Exp $ * * (c) The GHC Team, 2000 * @@ -18,7 +18,8 @@ extern "C" { #endif /* get types from GHC's runtime system */ -#include "config.h" +#include "ghcconfig.h" +#include "RtsConfig.h" #include "StgTypes.h" /* get limits for integral types */ diff --git a/ghc/includes/InfoMacros.h b/ghc/includes/InfoMacros.h deleted file mode 100644 index 5aa4835eaf..0000000000 --- a/ghc/includes/InfoMacros.h +++ /dev/null @@ -1,692 +0,0 @@ -/* ---------------------------------------------------------------------------- - * $Id: InfoMacros.h,v 1.22 2003/05/14 09:14:01 simonmar Exp $ - * - * (c) The GHC Team, 1998-2002 - * - * Macros for building and deconstructing info tables. - * - * -------------------------------------------------------------------------- */ - -#ifndef INFOMACROS_H -#define INFOMACROS_H - -#define STD_INFO(srt_bitmap_, type_) \ - srt_bitmap : srt_bitmap_, \ - type : type_ - -#define THUNK_INFO(srt_, srt_off_) \ - srt : (StgSRT *)((StgClosure **)srt_+srt_off_) - -#define FUN_GEN_INFO(srt_, srt_off_, fun_type_, arity_, bitmap_, slow_apply_) \ - -#define RET_INFO(srt_, srt_off_) \ - srt : (StgSRT *)((StgClosure **)srt_+srt_off_) - -#ifdef PROFILING -#define PROF_INFO(type_str, desc_str) \ - prof: { \ - closure_type: type_str, \ - closure_desc: desc_str, \ - }, -#else -#define PROF_INFO(type_str, desc_str) -#endif - -/* - On the GranSim/GUM specific parts of the InfoTables (GRAN/PAR): - - In both GranSim and GUM we use revertible black holes (RBH) when putting - an updatable closure into a packet for communication. The entry code for - an RBH performs standard blocking (as with any kind of BH). The info - table for the RBH resides just before the one for the std info - table. (NB: there is one RBH ITBL for every ITBL of an updatable - closure.) The @rbh_infoptr@ field in the ITBL points from the std ITBL to - the RBH ITBL and vice versa. This is used by the RBH_INFOPTR and - REVERT_INFOPTR macros to turn an updatable node into an RBH and vice - versa. Note, that the only case where we have to revert the RBH in its - original form is when a packet is sent back because of garbage collection - on another PE. In the RTS for GdH we will use this reversion mechanism in - order to deal with faults in the system. - ToDo: Check that RBHs are needed for all the info tables below. From a quick - check of the macros generated in the libs it seems that all of them are used - for generating THUNKs. - Possible optimisation: Note that any RBH ITBL is a fixed distance away from - the actual ITBL. We could inline this offset as a constant into the RTS and - avoid the rbh_infoptr fields altogether (Jim did that in the old RTS). - -- HWL -*/ - - -/* function/thunk info tables --------------------------------------------- */ - -#if defined(GRAN) || defined(PAR) - -#define \ -INFO_TABLE_THUNK(info, /* info-table label */ \ - entry, /* entry code label */ \ - ptrs, nptrs, /* closure layout info */\ - srt_, srt_off_, srt_bitmap_, /* SRT info */ \ - type, /* closure type */ \ - info_class, entry_class, /* C storage classes */ \ - prof_descr, prof_type) /* profiling info */ \ - entry_class(stg_RBH_##entry); \ - entry_class(entry); \ - ED_RO_ StgInfoTable info; \ - info_class const StgInfoTable stg_RBH_##info = { \ - layout : { payload : {ptrs,nptrs} }, \ - PROF_INFO(prof_type, prof_descr) \ - SRT_INFO(RBH,srt_,srt_off_,srt_bitmap_), \ - INCLUDE_RBH_INFO(info), \ - INIT_ENTRY(stg_RBH_##entry) \ - } ; \ - StgFunPtr stg_RBH_##entry (void) { \ - FB_ \ - JMP_(stg_RBH_entry); \ - FE_ \ - } ; \ - info_class const StgInfoTable info = { \ - layout : { payload : {ptrs,nptrs} }, \ - PROF_INFO(prof_type, prof_descr) \ - SRT_INFO(type,srt_,srt_off_,srt_bitmap_), \ - INCLUDE_RBH_INFO(stg_RBH_##info), \ - INIT_ENTRY(entry) \ - } - -#else - -#define \ -INFO_TABLE_THUNK(info, /* info-table label */ \ - entry, /* entry code label */ \ - ptrs, nptrs, /* closure layout info */\ - srt_, srt_off_, srt_bitmap_, /* SRT info */ \ - type_, /* closure type */ \ - info_class, entry_class, /* C storage classes */ \ - prof_descr, prof_type) /* profiling info */ \ - entry_class(entry); \ - info_class const StgThunkInfoTable info = { \ - i : { \ - layout : { payload : {ptrs,nptrs} }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(srt_bitmap_, type_), \ - INIT_ENTRY(entry) \ - }, \ - THUNK_INFO(srt_,srt_off_), \ - } - -#endif - -/* direct-return address info tables --------------------------------------*/ - -#if defined(GRAN) || defined(PAR) - -#define \ -INFO_TABLE_RET(info, entry, bitmap_, srt_, srt_off_, srt_bitmap_, \ - type, info_class, entry_class, \ - prof_descr, prof_type) \ - entry_class(stg_RBH_##entry); \ - entry_class(entry); \ - ED_RO_ StgInfoTable info; \ - info_class const StgInfoTable stg_RBH_##info = { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - PROF_INFO(prof_type, prof_descr) \ - SRT_INFO(RBH,srt_,srt_off_,srt_bitmap_), \ - INCLUDE_RBH_INFO(info), \ - INIT_ENTRY(stg_RBH_##entry) \ - }; \ - StgFunPtr stg_RBH_##entry (void) { \ - FB_ \ - JMP_(stg_RBH_entry); \ - FE_ \ - } ; \ - info_class const StgInfoTable info = { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - PROF_INFO(prof_type, prof_descr) \ - SRT_INFO(type,srt_,srt_off_,srt_bitmap_), \ - INCLUDE_RBH_INFO(stg_RBH_##info), \ - INIT_ENTRY(entry) \ - } - -#else - -#define \ -INFO_TABLE_RET(info, entry, bitmap_, srt_, srt_off_, srt_bitmap_, \ - type_, info_class, entry_class, \ - prof_descr, prof_type) \ - entry_class(entry); \ - info_class const StgRetInfoTable info = { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(srt_bitmap_,type_), \ - INIT_ENTRY(entry) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } -#endif - -/* info-table without an SRT -----------------------------------------------*/ - -#if defined(GRAN) || defined(PAR) - -#define \ -INFO_TABLE(info, entry, ptrs, nptrs, type, info_class, \ - entry_class, prof_descr, prof_type) \ - entry_class(stg_RBH_##entry); \ - entry_class(entry); \ - ED_ StgInfoTable info; \ - info_class const StgInfoTable stg_RBH_##info = { \ - layout : { payload : {ptrs,nptrs} }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(RBH), \ - INCLUDE_RBH_INFO(info), \ - INIT_ENTRY(stg_RBH_##entry) \ - } ; \ - StgFunPtr stg_RBH_##entry (void) { \ - FB_ \ - JMP_(stg_RBH_entry); \ - FE_ \ - } ; \ - info_class const StgInfoTable info = { \ - layout : { payload : {ptrs,nptrs} }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(type), \ - INCLUDE_RBH_INFO(stg_RBH_##info), \ - INIT_ENTRY(entry) \ - } - -#else - -#define \ -INFO_TABLE(info, entry, ptrs, nptrs, type, info_class, \ - entry_class, prof_descr, prof_type) \ - entry_class(entry); \ - info_class const StgInfoTable info = { \ - layout : { payload : {ptrs,nptrs} }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(0, type), \ - INIT_ENTRY(entry) \ - } - -#endif - -/* special selector-thunk info table ---------------------------------------*/ - -#if defined(GRAN) || defined(PAR) - -#define \ -INFO_TABLE_SELECTOR(info, entry, offset, info_class, \ - entry_class, prof_descr, prof_type) \ - entry_class(stg_RBH_##entry); \ - entry_class(entry); \ - ED_RO_ StgInfoTable info; \ - info_class const StgInfoTable stg_RBH_##info = { \ - layout : { selector_offset : offset }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(RBH), \ - INCLUDE_RBH_INFO(info), \ - INIT_ENTRY(stg_RBH_##entry) \ - }; \ - StgFunPtr stg_RBH_##entry (void) { \ - FB_ \ - JMP_(stg_RBH_entry); \ - FE_ \ - } ; \ - info_class const StgInfoTable info = { \ - layout : { selector_offset : offset }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(THUNK_SELECTOR), \ - INCLUDE_RBH_INFO(stg_RBH_##info), \ - INIT_ENTRY(entry) \ - } - -#else - -#define \ -INFO_TABLE_SELECTOR(info, entry, offset, info_class, \ - entry_class, prof_descr, prof_type) \ - entry_class(entry); \ - info_class const StgInfoTable info = { \ - layout : { selector_offset : offset }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(0,THUNK_SELECTOR), \ - INIT_ENTRY(entry) \ - } - -#endif - -/* constructor info table --------------------------------------------------*/ - -#define \ -INFO_TABLE_CONSTR(info, entry, ptrs, nptrs, tag_,type_,info_class, \ - entry_class, prof_descr, prof_type) \ - entry_class(entry); \ - info_class const StgInfoTable info = { \ - layout : { payload : {ptrs,nptrs} }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(tag_, type_), \ - INIT_ENTRY(entry) \ - } - -#define constrTag(con) (get_itbl(con)->srt_bitmap) - -/* function info table -----------------------------------------------------*/ - -#define \ -INFO_TABLE_FUN_GEN(info, /* info-table label */ \ - entry, /* entry code label */ \ - ptrs, nptrs, /* closure layout info */\ - srt_, srt_off_, srt_bitmap_, /* SRT info */ \ - fun_type_, arity_, bitmap_, slow_apply_, \ - /* Function info */ \ - type_, /* closure type */ \ - info_class, entry_class, /* C storage classes */ \ - prof_descr, prof_type) /* profiling info */ \ - entry_class(entry); \ - info_class const StgFunInfoTable info = { \ - i : { \ - layout : { payload : {ptrs,nptrs} }, \ - PROF_INFO(prof_type, prof_descr) \ - STD_INFO(srt_bitmap_,type_), \ - INIT_ENTRY(entry) \ - }, \ - srt : (StgSRT *)((StgClosure **)srt_+srt_off_), \ - arity : arity_, \ - fun_type : fun_type_, \ - bitmap : (W_)bitmap_, \ - slow_apply : slow_apply_ \ - } - -/* return-vectors ----------------------------------------------------------*/ - -/* vectored-return info tables have the vector slammed up against the - * start of the info table. - * - * A vectored-return address always has an SRT and a bitmap-style - * layout field, so we only need one macro for these. - */ - -#ifdef TABLES_NEXT_TO_CODE - -typedef struct { - StgFunPtr vec[2]; - StgRetInfoTable i; -} vec_info_2; - -typedef struct { - StgFunPtr vec[3]; - StgRetInfoTable i; -} vec_info_3; - -typedef struct { - StgFunPtr vec[4]; - StgRetInfoTable i; -} vec_info_4; - -typedef struct { - StgFunPtr vec[5]; - StgRetInfoTable i; -} vec_info_5; - -typedef struct { - StgFunPtr vec[6]; - StgRetInfoTable i; -} vec_info_6; - -typedef struct { - StgFunPtr vec[7]; - StgRetInfoTable i; -} vec_info_7; - -typedef struct { - StgFunPtr vec[8]; - StgRetInfoTable i; -} vec_info_8; - -#define VEC_INFO_2(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2) \ - info_class const vec_info_2 info = { \ - { alt_2, alt_1 }, \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - -#define VEC_INFO_3(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3 \ - ) \ - info_class const vec_info_3 info = { \ - { alt_3, alt_2, alt_1 }, \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - -#define VEC_INFO_4(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4 \ - ) \ - info_class const vec_info_4 info = { \ - { alt_4, alt_3, alt_2, alt_1 }, \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - -#define VEC_INFO_5(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4, \ - alt_5 \ - ) \ - info_class const vec_info_5 info = { \ - { alt_5, alt_4, alt_3, alt_2, \ - alt_1 }, \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - -#define VEC_INFO_6(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6 \ - ) \ - info_class const vec_info_6 info = { \ - { alt_6, alt_5, alt_4, alt_3, \ - alt_2, alt_1 }, \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - -#define VEC_INFO_7(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6, alt_7 \ - ) \ - info_class const vec_info_7 info = { \ - { alt_7, alt_6, alt_5, alt_4, \ - alt_3, alt_2, alt_1 }, \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - -#define VEC_INFO_8(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6, alt_7, alt_8 \ - ) \ - info_class const vec_info_8 info = { \ - { alt_8, alt_7, alt_6, alt_5, \ - alt_4, alt_3, alt_2, alt_1 }, \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - - -#else - -/* We have to define these structure to work around a bug in gcc: if we - * try to initialise the vector directly (it's defined as a zero-length - * array tacked on the end of the info table structor), then gcc silently - * throws away our vector table sometimes. - */ - -typedef struct { - StgRetInfoTable i; - StgFunPtr vec[2]; -} vec_info_2; - -typedef struct { - StgRetInfoTable i; - StgFunPtr vec[3]; -} vec_info_3; - -typedef struct { - StgRetInfoTable i; - StgFunPtr vec[4]; -} vec_info_4; - -typedef struct { - StgRetInfoTable i; - StgFunPtr vec[5]; -} vec_info_5; - -typedef struct { - StgRetInfoTable i; - StgFunPtr vec[6]; -} vec_info_6; - -typedef struct { - StgRetInfoTable i; - StgFunPtr vec[7]; -} vec_info_7; - -typedef struct { - StgRetInfoTable i; - StgFunPtr vec[8]; -} vec_info_8; - -#define VEC_INFO_2(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2) \ - info_class const vec_info_2 info = { \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - -#define VEC_INFO_3(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3 \ - ) \ - info_class const vec_info_3 info = { \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - }, \ - vec : { alt_1, alt_2, alt_3 } \ - } - -#define VEC_INFO_4(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4 \ - ) \ - info_class const vec_info_4 info = { \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - }, \ - vec : { alt_1, alt_2, alt_3, alt_4 } \ - } - -#define VEC_INFO_5(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4, \ - alt_5 \ - ) \ - info_class const vec_info_5 info = { \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - }, \ - vec : { alt_1, alt_2, alt_3, alt_4, \ - alt_5 } \ - } - -#define VEC_INFO_6(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6 \ - ) \ - info_class const vec_info_6 info = { \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - }, \ - vec : { alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6 } \ - } - -#define VEC_INFO_7(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6, alt_7 \ - ) \ - info_class const vec_info_7 info = { \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - }, \ - vec : { alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6, alt_7 } \ - } - -#define VEC_INFO_8(info,bitmap_,srt_,srt_off_,srt_bitmap_, \ - type_, info_class, \ - alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6, alt_7, alt_8 \ - ) \ - info_class const vec_info_8 info = { \ - i : { \ - i : { \ - layout : { bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_,type_) \ - }, \ - RET_INFO(srt_,srt_off_) \ - }, \ - vec : { alt_1, alt_2, alt_3, alt_4, \ - alt_5, alt_6, alt_7, alt_8 } \ - } - -#endif /* TABLES_NEXT_TO_CODE */ - -/* For polymorphic activation records, we need both a direct return - * address and a return vector: - */ - -typedef vec_info_8 StgPolyInfoTable; - -#ifndef TABLES_NEXT_TO_CODE - -#define VEC_POLY_INFO_TABLE(nm, bitmap_, \ - srt_, srt_off_, srt_bitmap_, \ - type_, info_class, entry_class \ - ) \ - info_class const vec_info_8 nm##_info = { \ - i : { \ - i : { \ - layout : { \ - bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_, type_), \ - INIT_ENTRY(nm##_ret) \ - }, \ - RET_INFO(srt_,srt_off_) \ - }, \ - vec : { \ - (F_) nm##_0_ret, \ - (F_) nm##_1_ret, \ - (F_) nm##_2_ret, \ - (F_) nm##_3_ret, \ - (F_) nm##_4_ret, \ - (F_) nm##_5_ret, \ - (F_) nm##_6_ret, \ - (F_) nm##_7_ret \ - } \ - } -#else - -#define VEC_POLY_INFO_TABLE(nm, bitmap_, \ - srt_, srt_off_, srt_bitmap_, \ - type_, info_class, entry_class \ - ) \ - info_class const vec_info_8 nm##_info = { \ - { \ - (F_) nm##_7_ret, \ - (F_) nm##_6_ret, \ - (F_) nm##_5_ret, \ - (F_) nm##_4_ret, \ - (F_) nm##_3_ret, \ - (F_) nm##_2_ret, \ - (F_) nm##_1_ret, \ - (F_) nm##_0_ret \ - }, \ - i : { \ - i : { \ - layout : { \ - bitmap : (StgWord)bitmap_ }, \ - STD_INFO(srt_bitmap_, type_), \ - INIT_ENTRY(nm##_ret) \ - }, \ - RET_INFO(srt_,srt_off_) \ - } \ - } - -#endif - -#define SRT(lbl) \ - static const StgSRT lbl = { - -/* DLL_SRT_ENTRY is used on the Win32 side when filling initialising - an entry in an SRT table with a reference to a closure that's - living in a DLL. See elsewhere for reasons as to why we need - to distinguish these kinds of references. - (ToDo: fill in a more precise href.) -*/ -#ifdef ENABLE_WIN32_DLL_SUPPORT /* mingw DietHEP doesn't seem to care either way */ -#define DLL_SRT_ENTRY(x) ((StgClosure*)(((char*)&DLL_IMPORT_DATA_VAR(x)) + 1)) -#else -#define DLL_SRT_ENTRY(x) no-can-do -#endif - -#endif /* INFOMACROS_H */ diff --git a/ghc/includes/InfoTables.h b/ghc/includes/InfoTables.h index 5284932c1a..a605ba2c17 100644 --- a/ghc/includes/InfoTables.h +++ b/ghc/includes/InfoTables.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: InfoTables.h,v 1.32 2003/11/14 14:28:08 stolz Exp $ + * $Id: InfoTables.h,v 1.33 2004/08/13 13:09:17 simonmar Exp $ * * (c) The GHC Team, 1998-2002 * @@ -169,6 +169,8 @@ extern StgWord16 closure_flags[]; (usually on the stack) to the garbage collector. The two primary uses are for stack frames, and functions (where we need to describe the layout of a PAP to the GC). + + In these bitmaps: 0 == ptr, 1 == non-ptr. -------------------------------------------------------------------------- */ // @@ -285,21 +287,29 @@ typedef struct _StgInfoTable { bitmap fields have also been omitted. -------------------------------------------------------------------------- */ -typedef struct _StgFunInfoTable { -#if defined(TABLES_NEXT_TO_CODE) +typedef struct _StgFunInfoExtraRev { StgFun *slow_apply; // apply to args on the stack StgWord bitmap; // arg ptr/nonptr bitmap StgSRT *srt; // pointer to the SRT table StgHalfWord fun_type; // function type StgHalfWord arity; // function arity - StgInfoTable i; -#else - StgInfoTable i; +} StgFunInfoExtraRev; + +typedef struct _StgFunInfoExtraFwd { StgHalfWord fun_type; // function type StgHalfWord arity; // function arity StgSRT *srt; // pointer to the SRT table StgWord bitmap; // arg ptr/nonptr bitmap StgFun *slow_apply; // apply to args on the stack +} StgFunInfoExtraFwd; + +typedef struct { +#if defined(TABLES_NEXT_TO_CODE) + StgFunInfoExtraRev f; + StgInfoTable i; +#else + StgInfoTable i; + StgFunInfoExtraFwd f; #endif } StgFunInfoTable; @@ -310,15 +320,13 @@ typedef struct _StgFunInfoTable { // When info tables are laid out backwards, we can omit the SRT // pointer iff srt_bitmap is zero. -typedef struct _StgRetInfoTable { -#if !defined(TABLES_NEXT_TO_CODE) - StgInfoTable i; -#endif - StgSRT *srt; // pointer to the SRT table +typedef struct { #if defined(TABLES_NEXT_TO_CODE) + StgSRT *srt; // pointer to the SRT table StgInfoTable i; -#endif -#if !defined(TABLES_NEXT_TO_CODE) +#else + StgInfoTable i; + StgSRT *srt; // pointer to the SRT table StgFunPtr vector[FLEXIBLE_ARRAY]; #endif } StgRetInfoTable; diff --git a/ghc/includes/Liveness.h b/ghc/includes/Liveness.h new file mode 100644 index 0000000000..cc93cae34f --- /dev/null +++ b/ghc/includes/Liveness.h @@ -0,0 +1,34 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2004 + * + * Building liveness masks for RET_DYN stack frames. + * A few macros that are used in both .cmm and .c sources. + * + * A liveness mask is constructed like so: + * + * R1_PTR & R2_PTR & R3_PTR + * + * -------------------------------------------------------------------------- */ + +#ifndef LIVENESS_H +#define LIVENESS_H + +#define NO_PTRS 0xff +#define R1_PTR (NO_PTRS ^ (1<<0)) +#define R2_PTR (NO_PTRS ^ (1<<1)) +#define R3_PTR (NO_PTRS ^ (1<<2)) +#define R4_PTR (NO_PTRS ^ (1<<3)) +#define R5_PTR (NO_PTRS ^ (1<<4)) +#define R6_PTR (NO_PTRS ^ (1<<5)) +#define R7_PTR (NO_PTRS ^ (1<<6)) +#define R8_PTR (NO_PTRS ^ (1<<7)) + +#define N_NONPTRS(n) ((n)<<16) +#define N_PTRS(n) ((n)<<24) + +#define RET_DYN_NONPTRS(l) ((l)>>16 & 0xff) +#define RET_DYN_PTRS(l) ((l)>>24 & 0xff) +#define RET_DYN_LIVENESS(l) ((l) & 0xffff) + +#endif /* LIVENESS_H */ diff --git a/ghc/includes/MachDeps.h b/ghc/includes/MachDeps.h index 77fa21b62c..39ce757917 100644 --- a/ghc/includes/MachDeps.h +++ b/ghc/includes/MachDeps.h @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: MachDeps.h,v 1.8 2002/12/11 15:36:37 simonmar Exp $ * * (c) The University of Glasgow 2002 * @@ -14,7 +13,7 @@ #define MACHDEPS_H /* Sizes of C types come from here... */ -#include "config.h" +#include "ghcconfig.h" /* Sizes of Haskell types follow. These sizes correspond to: * - the number of bytes in the primitive type (eg. Int#) diff --git a/ghc/includes/MachRegs.h b/ghc/includes/MachRegs.h index c54de67e98..8297023dfd 100644 --- a/ghc/includes/MachRegs.h +++ b/ghc/includes/MachRegs.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: MachRegs.h,v 1.15 2003/12/10 11:35:25 wolfgang Exp $ + * $Id: MachRegs.h,v 1.16 2004/08/13 13:09:18 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -437,11 +437,7 @@ #define REG_Hp r25 #define REG_HpLim r26 -#define NCG_SpillTmp_I1 r27 -#define NCG_SpillTmp_I2 r28 - -#define NCG_SpillTmp_D1 f20 -#define NCG_SpillTmp_D2 f21 +#define REG_Base r27 #endif /* powerpc */ diff --git a/ghc/includes/Makefile b/ghc/includes/Makefile index 11e4e1b827..2d6a27a7c2 100644 --- a/ghc/includes/Makefile +++ b/ghc/includes/Makefile @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Makefile,v 1.22 2003/09/04 09:56:16 simonmar Exp $ +# $Id: Makefile,v 1.23 2004/08/13 13:09:18 simonmar Exp $ # TOP = .. @@ -20,11 +20,11 @@ endif # # Header file built from the configure script's findings # -H_CONFIG = config.h +H_CONFIG = ghcconfig.h boot :: gmp.h -all :: $(H_CONFIG) NativeDefs.h +all :: $(H_CONFIG) # gmp.h is copied from the GMP directory gmp.h : $(FPTOOLS_TOP)/ghc/rts/gmp/gmp.h @@ -39,8 +39,8 @@ $(H_CONFIG) : $(FPTOOLS_TOP)/mk/config.h $(FPTOOLS_TOP)/mk/config.mk $(H_CONFIG) : @echo "Creating $@..." @$(RM) $@ - @echo "#ifndef __FPTOOLS_CONFIG_H__" >$@ - @echo "#define __FPTOOLS_CONFIG_H__" >>$@ + @echo "#ifndef __GHCCONFIG_H__" >$@ + @echo "#define __GHCCONFIG_H__" >>$@ @echo >> $@ @echo "#define HostPlatform_TYPE $(HostPlatform_CPP)" >> $@ @echo "#define TargetPlatform_TYPE $(TargetPlatform_CPP)" >> $@ @@ -72,8 +72,8 @@ endif @echo "#define $(HostVendor_CPP)_HOST_VENDOR 1" >> $@ @echo "#define $(TargetVendor_CPP)_TARGET_VENDOR 1" >> $@ @echo "#define $(BuildVendor_CPP)_BUILD_VENDOR 1" >> $@ - @cat $(FPTOOLS_TOP)/mk/$@ >> $@ - @echo "#endif /* __FPTOOLS_CONFIG_H__ */" >> $@ + @cat $(FPTOOLS_TOP)/mk/config.h >> $@ + @echo "#endif /* __GHCCONFIG_H__ */" >> $@ @echo "Done." # --------------------------------------------------------------------------- @@ -87,24 +87,27 @@ mkDerivedConstantsHdr : mkDerivedConstants.o $(CC) -o $@ $(CC_OPTS) $(LD_OPTS) mkDerivedConstants.o DerivedConstants.h : mkDerivedConstantsHdr - ./mkDerivedConstantsHdr >DerivedConstants.h + ./mkDerivedConstantsHdr >$@ CLEAN_FILES += mkDerivedConstantsHdr$(exeext) DerivedConstants.h -# --------------------------------------------------------------------------- -# Make NativeDefs.h for the NCG +# ----------------------------------------------------------------------------- +# -all :: NativeDefs.h +all :: GHCConstants.h -mkNativeHdr.o : DerivedConstants.h +mkGHCConstants.c : $(H_CONFIG) -mkNativeHdr : mkNativeHdr.o - $(CC) -o $@ $(CC_OPTS) $(LD_OPTS) mkNativeHdr.o +mkGHCConstants : mkGHCConstants.o + $(CC) -o $@ $(CC_OPTS) $(LD_OPTS) mkGHCConstants.o -NativeDefs.h : mkNativeHdr - ./mkNativeHdr >NativeDefs.h +mkGHCConstants.o : mkDerivedConstants.c + $(CC) -o $@ -c $< -DGEN_HASKELL -CLEAN_FILES += mkNativeHdr$(exeext) NativeDefs.h +GHCConstants.h : mkGHCConstants + ./mkGHCConstants >$@ + +CLEAN_FILES += mkDerivedConstantsHdr$(exeext) DerivedConstants.h # --------------------------------------------------------------------------- # boot setup: diff --git a/ghc/includes/PosixSource.h b/ghc/includes/PosixSource.h deleted file mode 100644 index 37966b4907..0000000000 --- a/ghc/includes/PosixSource.h +++ /dev/null @@ -1,19 +0,0 @@ -/* ----------------------------------------------------------------------------- - * $Id: PosixSource.h,v 1.2 2002/04/23 17:16:01 ken Exp $ - * - * (c) The GHC Team, 1998-2001 - * - * Include this file into sources which should not need any non-Posix services. - * That includes most RTS C sources. - * ---------------------------------------------------------------------------*/ - -#ifndef POSIXSOURCE_H -#define POSIXSOURCE_H - -#define _POSIX_SOURCE 1 -#define _POSIX_C_SOURCE 199506L -#define _ISOC9X_SOURCE - -/* Let's be ISO C9X too... */ - -#endif diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h deleted file mode 100644 index e7d5ff5cb5..0000000000 --- a/ghc/includes/PrimOps.h +++ /dev/null @@ -1,421 +0,0 @@ -/* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.107 2003/11/12 17:27:01 sof Exp $ - * - * (c) The GHC Team, 1998-2000 - * - * Macros for primitive operations in STG-ish C code. - * - * ---------------------------------------------------------------------------*/ - -/* As of 5 Dec 01, this file no longer implements the primops, since they are - translated into standard C in compiler/absCSyn/AbsCUtils during the absC - flattening pass. Only {add,sub,mul}IntCzh remain untranslated. Most of - what is here is now EXTFUN_RTS declarations for the out-of-line primop - implementations which live in compiler/rts/PrimOps.hc. -*/ - -#ifndef PRIMOPS_H -#define PRIMOPS_H - -#include "MachDeps.h" - -#if WORD_SIZE_IN_BITS < 32 -#error GHC C backend requires 32+-bit words -#endif - - -/* ----------------------------------------------------------------------------- - * Int operations with carry. - * -------------------------------------------------------------------------- */ - -/* Multiply with overflow checking. - * - * This is tricky - the usual sign rules for add/subtract don't apply. - * - * On 32-bit machines we use gcc's 'long long' types, finding - * overflow with some careful bit-twiddling. - * - * On 64-bit machines where gcc's 'long long' type is also 64-bits, - * we use a crude approximation, testing whether either operand is - * larger than 32-bits; if neither is, then we go ahead with the - * multiplication. - * - * Return non-zero if there is any possibility that the signed multiply - * of a and b might overflow. Return zero only if you are absolutely sure - * that it won't overflow. If in doubt, return non-zero. - */ - -#if SIZEOF_VOID_P == 4 - -#ifdef WORDS_BIGENDIAN -#define RTS_CARRY_IDX__ 0 -#define RTS_REM_IDX__ 1 -#else -#define RTS_CARRY_IDX__ 1 -#define RTS_REM_IDX__ 0 -#endif - -typedef union { - StgInt64 l; - StgInt32 i[2]; -} long_long_u ; - -#define mulIntMayOflo(a,b) \ -({ \ - StgInt32 r, c; \ - long_long_u z; \ - z.l = (StgInt64)a * (StgInt64)b; \ - r = z.i[RTS_REM_IDX__]; \ - c = z.i[RTS_CARRY_IDX__]; \ - if (c == 0 || c == -1) { \ - c = ((StgWord)((a^b) ^ r)) \ - >> (BITS_IN (I_) - 1); \ - } \ - c; \ -}) - -/* Careful: the carry calculation above is extremely delicate. Make sure - * you test it thoroughly after changing it. - */ - -#else - -#define HALF_INT (((I_)1) << (BITS_IN (I_) / 2)) - -#define stg_abs(a) (((I_)(a)) < 0 ? -((I_)(a)) : ((I_)(a))) - -#define mulIntMayOflo(a,b) \ -({ \ - I_ c; \ - if (stg_abs(a) >= HALF_INT || \ - stg_abs(b) >= HALF_INT) { \ - c = 1; \ - } else { \ - c = 0; \ - } \ - c; \ -}) -#endif - - -/* ----------------------------------------------------------------------------- - Integer PrimOps. - -------------------------------------------------------------------------- */ - -/* NOTE: gcdIntzh and gcdIntegerIntzh work only for positive inputs! */ - -/* Some of these are out-of-line: -------- */ - -/* Integer arithmetic */ -EXTFUN_RTS(plusIntegerzh_fast); -EXTFUN_RTS(minusIntegerzh_fast); -EXTFUN_RTS(timesIntegerzh_fast); -EXTFUN_RTS(gcdIntegerzh_fast); -EXTFUN_RTS(quotRemIntegerzh_fast); -EXTFUN_RTS(quotIntegerzh_fast); -EXTFUN_RTS(remIntegerzh_fast); -EXTFUN_RTS(divExactIntegerzh_fast); -EXTFUN_RTS(divModIntegerzh_fast); - -EXTFUN_RTS(cmpIntegerIntzh_fast); -EXTFUN_RTS(cmpIntegerzh_fast); -EXTFUN_RTS(integer2Intzh_fast); -EXTFUN_RTS(integer2Wordzh_fast); -EXTFUN_RTS(gcdIntegerIntzh_fast); -EXTFUN_RTS(gcdIntzh_fast); - -/* Conversions */ -EXTFUN_RTS(int2Integerzh_fast); -EXTFUN_RTS(word2Integerzh_fast); - -/* Floating-point decodings */ -EXTFUN_RTS(decodeFloatzh_fast); -EXTFUN_RTS(decodeDoublezh_fast); - -/* Bit operations */ -EXTFUN_RTS(andIntegerzh_fast); -EXTFUN_RTS(orIntegerzh_fast); -EXTFUN_RTS(xorIntegerzh_fast); -EXTFUN_RTS(complementIntegerzh_fast); - - -/* ----------------------------------------------------------------------------- - Word64 PrimOps. - -------------------------------------------------------------------------- */ - -#ifdef SUPPORT_LONG_LONGS - -/* Conversions */ -EXTFUN_RTS(int64ToIntegerzh_fast); -EXTFUN_RTS(word64ToIntegerzh_fast); - -#endif - -/* ----------------------------------------------------------------------------- - Array PrimOps. - -------------------------------------------------------------------------- */ - -/* We cast to void* instead of StgChar* because this avoids a warning - * about increasing the alignment requirements. - */ -#define REAL_BYTE_ARR_CTS(a) ((void *) (((StgArrWords *)(a))->payload)) -#define REAL_PTRS_ARR_CTS(a) ((P_) (((StgMutArrPtrs *)(a))->payload)) - -#ifdef DEBUG -#define BYTE_ARR_CTS(a) \ - ({ ASSERT(GET_INFO((StgArrWords *)(a)) == &stg_ARR_WORDS_info); \ - REAL_BYTE_ARR_CTS(a); }) -#define PTRS_ARR_CTS(a) \ - ({ ASSERT((GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_FROZEN_info) \ - || (GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_info)); \ - REAL_PTRS_ARR_CTS(a); }) -#else -#define BYTE_ARR_CTS(a) REAL_BYTE_ARR_CTS(a) -#define PTRS_ARR_CTS(a) REAL_PTRS_ARR_CTS(a) -#endif - - -extern I_ genSymZh(void); -extern I_ resetGenSymZh(void); - -/*--- Almost everything in line. */ - -EXTFUN_RTS(unsafeThawArrayzh_fast); -EXTFUN_RTS(newByteArrayzh_fast); -EXTFUN_RTS(newPinnedByteArrayzh_fast); -EXTFUN_RTS(newArrayzh_fast); - -/* The decode operations are out-of-line because they need to allocate - * a byte array. - */ - -/* We only support IEEE floating point formats. */ -#include "ieee-flpt.h" -EXTFUN_RTS(decodeFloatzh_fast); -EXTFUN_RTS(decodeDoublezh_fast); - -/* grimy low-level support functions defined in StgPrimFloat.c */ -extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e); -extern StgDouble __int_encodeDouble (I_ j, I_ e); -extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e); -extern StgFloat __int_encodeFloat (I_ j, I_ e); -extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl); -extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt); -extern StgInt isDoubleNaN(StgDouble d); -extern StgInt isDoubleInfinite(StgDouble d); -extern StgInt isDoubleDenormalized(StgDouble d); -extern StgInt isDoubleNegativeZero(StgDouble d); -extern StgInt isFloatNaN(StgFloat f); -extern StgInt isFloatInfinite(StgFloat f); -extern StgInt isFloatDenormalized(StgFloat f); -extern StgInt isFloatNegativeZero(StgFloat f); - - -/* ----------------------------------------------------------------------------- - Mutable variables - - newMutVar is out of line. - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(newMutVarzh_fast); -EXTFUN_RTS(atomicModifyMutVarzh_fast); - -/* ----------------------------------------------------------------------------- - MVar PrimOps. - - All out of line, because they either allocate or may block. - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(isEmptyMVarzh_fast); -EXTFUN_RTS(newMVarzh_fast); -EXTFUN_RTS(takeMVarzh_fast); -EXTFUN_RTS(putMVarzh_fast); -EXTFUN_RTS(tryTakeMVarzh_fast); -EXTFUN_RTS(tryPutMVarzh_fast); - - -/* ----------------------------------------------------------------------------- - Delay/Wait PrimOps - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(waitReadzh_fast); -EXTFUN_RTS(waitWritezh_fast); -EXTFUN_RTS(delayzh_fast); -#ifdef mingw32_TARGET_OS -EXTFUN_RTS(asyncReadzh_fast); -EXTFUN_RTS(asyncWritezh_fast); -EXTFUN_RTS(asyncDoProczh_fast); -#endif - - -/* ----------------------------------------------------------------------------- - Primitive I/O, error-handling PrimOps - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(catchzh_fast); -EXTFUN_RTS(raisezh_fast); -EXTFUN_RTS(raiseIOzh_fast); - -extern void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__); - -/* ----------------------------------------------------------------------------- - Stable Name / Stable Pointer PrimOps - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(makeStableNamezh_fast); -EXTFUN_RTS(makeStablePtrzh_fast); -EXTFUN_RTS(deRefStablePtrzh_fast); - - -/* ----------------------------------------------------------------------------- - Concurrency/Exception PrimOps. - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(forkzh_fast); -EXTFUN_RTS(yieldzh_fast); -EXTFUN_RTS(killThreadzh_fast); -EXTFUN_RTS(seqzh_fast); -EXTFUN_RTS(blockAsyncExceptionszh_fast); -EXTFUN_RTS(unblockAsyncExceptionszh_fast); -EXTFUN_RTS(myThreadIdzh_fast); -EXTFUN_RTS(labelThreadzh_fast); -EXTFUN_RTS(isCurrentThreadBoundzh_fast); - -extern int cmp_thread(StgPtr tso1, StgPtr tso2); -extern int rts_getThreadId(StgPtr tso); -extern int forkOS_createThread ( HsStablePtr entry ); - -/* ----------------------------------------------------------------------------- - Weak Pointer PrimOps. - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(mkWeakzh_fast); -EXTFUN_RTS(finalizzeWeakzh_fast); -EXTFUN_RTS(deRefWeakzh_fast); - - -/* ----------------------------------------------------------------------------- - Foreign Object PrimOps. - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(mkForeignObjzh_fast); - - -/* ----------------------------------------------------------------------------- - Constructor tags - -------------------------------------------------------------------------- */ - -/* - * This macro is only used when compiling unregisterised code (see - * AbsCUtils.dsCOpStmt for motivation & the Story). - */ -#ifndef TABLES_NEXT_TO_CODE -# define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info)) -#endif - -/* ----------------------------------------------------------------------------- - BCOs and BCO linkery - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(newBCOzh_fast); -EXTFUN_RTS(mkApUpd0zh_fast); - -/* ------------------------------------------------------------------------ - Parallel PrimOps - - A par in the Haskell code is ultimately translated to a parzh macro - (with a case wrapped around it to guarantee that the macro is actually - executed; see compiler/prelude/PrimOps.lhs) - In GUM and SMP we only add a pointer to the spark pool. - In GranSim we call an RTS fct, forwarding additional parameters which - supply info on granularity of the computation, size of the result value - and the degree of parallelism in the sparked expression. - ---------------------------------------------------------------------- */ - -#if defined(GRAN) -//@cindex _par_ -#define parzh(r,node) parAny(r,node,1,0,0,0,0,0) - -//@cindex _parAt_ -#define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \ - parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,1) - -//@cindex _parAtAbs_ -#define parAtAbszh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \ - parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,2) - -//@cindex _parAtRel_ -#define parAtRelzh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \ - parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,3) - -//@cindex _parAtForNow_ -#define parAtForNowzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \ - parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0) - -#define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \ -{ \ - if (closure_SHOULD_SPARK((StgClosure*)node)) { \ - rtsSparkQ result; \ - PEs p; \ - \ - STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \ - switch (local) { \ - case 2: p = where; /* parAtAbs means absolute PE no. expected */ \ - break; \ - case 3: p = CurrentProc+where; /* parAtRel means rel PE no. expected */\ - break; \ - default: p = where_is(where); /* parAt means closure expected */ \ - break; \ - } \ - /* update GranSim state according to this spark */ \ - STGCALL3(GranSimSparkAtAbs, result, (I_)p, identifier); \ - } \ -} - -//@cindex _parLocal_ -#define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \ - parAny(r,node,rest,identifier,gran_info,size_info,par_info,1) - -//@cindex _parGlobal_ -#define parGlobalzh(r,node,identifier,gran_info,size_info,par_info,rest) \ - parAny(r,node,rest,identifier,gran_info,size_info,par_info,0) - -#define parAny(r,node,rest,identifier,gran_info,size_info,par_info,local) \ -{ \ - if (closure_SHOULD_SPARK((StgClosure*)node)) { \ - rtsSpark *result; \ - result = RET_STGCALL6(rtsSpark*, newSpark, \ - node,identifier,gran_info,size_info,par_info,local);\ - STGCALL1(add_to_spark_queue,result); \ - STGCALL2(GranSimSpark, local,(P_)node); \ - } \ -} - -#define copyablezh(r,node) \ - /* copyable not yet implemented!! */ - -#define noFollowzh(r,node) \ - /* noFollow not yet implemented!! */ - -#elif defined(SMP) || defined(PAR) - -#define parzh(r,node) \ -{ \ - extern unsigned int context_switch; \ - if (closure_SHOULD_SPARK((StgClosure *)node) && \ - SparkTl < SparkLim) { \ - *SparkTl++ = (StgClosure *)(node); \ - } \ - r = context_switch = 1; \ -} -#else /* !GRAN && !SMP && !PAR */ -#define parzh(r,node) r = 1 -#endif - -/* ----------------------------------------------------------------------------- - ForeignObj - the C backend still needs this. - -------------------------------------------------------------------------- */ -#define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data) - - -#endif /* PRIMOPS_H */ diff --git a/ghc/includes/README b/ghc/includes/README new file mode 100644 index 0000000000..ec10ca17c9 --- /dev/null +++ b/ghc/includes/README @@ -0,0 +1,114 @@ +----------------------------------------------------------------------------- +The External API to the GHC Runtime System. +----------------------------------------------------------------------------- + +The header files in this directory form the external API for the +runtime. The header files are used in the following scenarios: + + 1. Included into the RTS source code itself. + In this case we include "Rts.h", which includes everything + else in the appropriate order. + + Pretty much everything falls into this category. + + 2. Included into a .hc file generated by the compiler. + In this case we include Stg.h, which includes a + subset of the headers, in the appropriate order and + with the appropriate settings (e.g. global register variables + turned on). + + Includes everything below Stg.h in the hierarchy (see below). + + 3. Included into external C source code. + The following headers are designed to be included into + external C code (i.e. C code compiled using a GHC installation, + not part of GHC itself or the RTS): + + HsFFI.h + RtsAPI.h + SchedAPI.h + RtsFlags.h + Linker.h + + These interfaces are intended to be relatively stable. + + Also Rts.h can be included to get hold of everything else, including + definitions of heap objects, info tables, the storage manager interface + and so on. But be warned: none of this is guaranteed to remain stable + from one GHC release to the next. + + 4. Included into non-C source code, including Haskell (GHC itself) + and C-- code in the RTS. + + The following headers are #included into non-C source, so + cannot contain any C code or declarations: + config.h + RtsConfig.h + Constants.h + DerivedConstants.h + ClosureTypes.h + StgFun.h + MachRegs.h + Liveness.h + StgLdvProf.h + +Here is a rough hierarchy of the header files by dependency. + +Rts.h + Stg.h + config.h // configuration info derived by the configure script. + RtsConfig.h // settings for Rts things (eg. eager vs. lazy BH) + MachDeps.h // sizes of various basic types + StgTypes.h // basic types specific to the virtual machine + TailCalls.h // tail calls in .hc code + StgDLL.h // stuff related to Windows DLLs + MachRegs.h // global register assignments for this arch + Regs.h // "registers" in the virtual machine + StgProf.h // profiling gubbins + StgMiscClosures.h // decls for closures & info tables in the RTS + RtsExternal.h // decls for RTS things required by .hc code + (RtsAPI.h) + (HsFFI.h) + + RtsTypes.h // types used in the RTS + + Constants.h // build-time constants + StgLdvProf.h + StgFun.h + Closures.h + Liveness.h // macros for constructing RET_DYN liveness masks + ClosureMacros.h + ClosureTypes.h + InfoTables.h + TSO.h + Updates.h // macros for performing updates + GranSim.h + Parallel.h + SMP.h + Block.h + StgTicky.h + Stable.h + Hooks.h + Signals.h + DNInvoke.h + Dotnet.h + +Cmm.h // included into .cmm source only + DerivedConstants.h // generated by mkDerivedConstants.c from other + // .h files. + (Constants.h) + (ClosureTypes.h) + (StgFun.h) + (MachRegs.h) + (Liveness.h) + (Block.h) + +Bytecodes.h // Bytecode definitions for the interpreter +Linker.h // External API to the linker +RtsFlags.h // External API to the RTS runtime flags +SchedAPI.h // External API to the RTS scheduler +ieee-flpt.h // ToDo: needed? + +RtsAPI.h // The top-level interface to the RTS (rts_evalIO(), etc.) +HsFFI.h // The external FFI api + diff --git a/ghc/includes/Regs.h b/ghc/includes/Regs.h index 8afc6c9817..cd5ff95971 100644 --- a/ghc/includes/Regs.h +++ b/ghc/includes/Regs.h @@ -1,20 +1,27 @@ /* ----------------------------------------------------------------------------- - * $Id: Regs.h,v 1.14 2003/11/14 14:28:08 stolz Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * - * Registers used in STG code. Might or might not correspond to - * actual machine registers. + * Registers in the STG machine. + * + * The STG machine has a collection of "registers", each one of which + * may or may not correspond to an actual machine register when + * running code. + * + * The register set is backed by a table in memory (struct + * StgRegTable). If a particular STG register is not mapped to a + * machine register, then the apprpriate slot in this table is used + * instead. + * + * This table is itself pointed to by another register, BaseReg. If + * BaseReg is not in a machine register, then the register table is + * used from an absolute location (MainCapability). * * ---------------------------------------------------------------------------*/ #ifndef REGS_H #define REGS_H -/* - * This file should do the right thing if we have no machine-registers - * defined, i.e. everything lives in the RegTable. - */ /* * This is the table that holds shadow-locations for all the STG @@ -37,6 +44,25 @@ typedef struct { StgFunPtr stgGCFun; } StgFunTable; +/* + * Vanilla registers are given this union type, which is purely so + * that we can cast the vanilla reg to a variety of types with the + * minimum of syntax. eg. R1.w instead of (StgWord)R1. + */ +typedef union { + StgWord w; + StgAddr a; + StgChar c; + StgInt8 i8; + StgFloat f; + StgInt i; + StgPtr p; + StgClosurePtr cl; + StgStackOffset offset; /* unused? */ + StgByteArray b; + StgTSOPtr t; +} StgUnion; + typedef struct StgRegTable_ { StgUnion rR1; StgUnion rR2; @@ -59,10 +85,10 @@ typedef struct StgRegTable_ { StgPtr rSpLim; StgPtr rHp; StgPtr rHpLim; - StgTSO *rCurrentTSO; - struct _bdescr *rNursery; - struct _bdescr *rCurrentNursery; - StgWord rHpAlloc; // number of words being allocated in heap + struct StgTSO_ *rCurrentTSO; + struct bdescr_ *rNursery; + struct bdescr_ *rCurrentNursery; + StgWord rHpAlloc; // number of *bytes* being allocated in heap #if defined(SMP) || defined(PAR) StgSparkPool rSparks; // per-task spark pool #endif @@ -82,12 +108,16 @@ typedef struct Capability_ { #endif } Capability; -/* No such thing as a MainRegTable under SMP - each thread must - * have its own MainRegTable. +/* No such thing as a MainCapability under SMP - each thread must have + * its own Capability. */ #ifndef SMP +#if IN_STG_CODE +extern W_ MainCapability[]; +#else extern DLL_IMPORT_RTS Capability MainCapability; #endif +#endif #if IN_STG_CODE @@ -291,7 +321,7 @@ GLOBAL_REG_DECL(StgRegTable *,BaseReg,REG_Base) #ifdef SMP #error BaseReg must be in a register for SMP #endif -#define BaseReg (&MainCapability.r) +#define BaseReg (&((Capability *)MainCapability)[0].r) #endif #ifdef REG_Sp @@ -319,7 +349,7 @@ GLOBAL_REG_DECL(P_,HpLim,REG_HpLim) #endif #ifdef REG_CurrentTSO -GLOBAL_REG_DECL(StgTSO *,CurrentTSO,REG_CurrentTSO) +GLOBAL_REG_DECL(struct _StgTSO *,CurrentTSO,REG_CurrentTSO) #else #define CurrentTSO (BaseReg->rCurrentTSO) #endif @@ -712,7 +742,6 @@ GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim) #define CALLER_RESTORE_SYSTEM /* nothing */ #endif /* IN_STG_CODE */ - #define CALLER_SAVE_ALL \ CALLER_SAVE_SYSTEM \ CALLER_SAVE_USER @@ -722,4 +751,3 @@ GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim) CALLER_RESTORE_USER #endif /* REGS_H */ - diff --git a/ghc/includes/Rts.h b/ghc/includes/Rts.h index b0ad6ead6d..8d42730abf 100644 --- a/ghc/includes/Rts.h +++ b/ghc/includes/Rts.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Rts.h,v 1.23 2003/11/12 17:27:03 sof Exp $ + * $Id: Rts.h,v 1.24 2004/08/13 13:09:27 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -19,6 +19,171 @@ extern "C" { #endif #include "Stg.h" +#include "RtsTypes.h" + +#if __GNUC__ >= 3 +/* Assume that a flexible array member at the end of a struct + * can be defined thus: T arr[]; */ +#define FLEXIBLE_ARRAY +#else +/* Assume that it must be defined thus: T arr[0]; */ +#define FLEXIBLE_ARRAY 0 +#endif + +#if defined(SMP) || defined(THREADED_RTS) +#define RTS_SUPPORTS_THREADS 1 +#endif + +/* Fix for mingw stat problem (done here so it's early enough) */ +#ifdef mingw32_TARGET_OS +#define __MSVCRT__ 1 +#endif + +#if defined(__GNUC__) +#define GNU_ATTRIBUTE(at) __attribute__((at)) +#else +#define GNU_ATTRIBUTE(at) +#endif + +#if __GNUC__ >= 3 +#define GNUC3_ATTRIBUTE(at) __attribute__((at)) +#else +#define GNUC3_ATTRIBUTE(at) +#endif + +/* + * Empty structures isn't supported by all, so to define + * empty structures, please protect the defn with an + * #if SUPPORTS_EMPTY_STRUCTS. Similarly for use, + * employ the macro MAYBE_EMPTY_STRUCT(): + * + * MAYBE_EMPTY_STRUCT(structFoo, fieldName); + */ +#if SUPPORTS_EMPTY_STRUCTS +# define MAYBE_EMPTY_STRUCT(a,b) a b; +#else +# define MAYBE_EMPTY_STRUCT(a,b) /* empty */ +#endif + +/* + * We often want to know the size of something in units of an + * StgWord... (rounded up, of course!) + */ +#define sizeofW(t) ((sizeof(t)+sizeof(W_)-1)/sizeof(W_)) + +/* + * It's nice to be able to grep for casts + */ +#define stgCast(ty,e) ((ty)(e)) + +/* ----------------------------------------------------------------------------- + Assertions and Debuggery + -------------------------------------------------------------------------- */ + +#ifndef DEBUG +#define ASSERT(predicate) /* nothing */ +#else + +void _stgAssert (char *, unsigned int); + +#define ASSERT(predicate) \ + if (predicate) \ + /*null*/; \ + else \ + _stgAssert(__FILE__, __LINE__) +#endif /* DEBUG */ + +/* + * Use this on the RHS of macros which expand to nothing + * to make sure that the macro can be used in a context which + * demands a non-empty statement. + */ + +#define doNothing() do { } while (0) + +/* ----------------------------------------------------------------------------- + Include everything STG-ish + -------------------------------------------------------------------------- */ + +/* System headers: stdlib.h is eeded so that we can use NULL. It must + * come after MachRegs.h, because stdlib.h might define some inline + * functions which may only be defined after register variables have + * been declared. + */ +#include <stdlib.h> + +/* Global constaints */ +#include "Constants.h" + +/* Profiling information */ +#include "StgProf.h" +#include "StgLdvProf.h" + +/* Storage format definitions */ +#include "StgFun.h" +#include "Closures.h" +#include "Liveness.h" +#include "ClosureTypes.h" +#include "InfoTables.h" +#include "TSO.h" + +/* Info tables, closures & code fragments defined in the RTS */ +#include "StgMiscClosures.h" + +/* Simulated-parallel information */ +#include "GranSim.h" + +/* Parallel information */ +#include "Parallel.h" + +/* STG/Optimised-C related stuff */ +#include "SMP.h" +#include "Block.h" + +#ifdef SMP +#include <pthread.h> +#endif + +/* GNU mp library */ +#include "gmp.h" + +/* Macros for STG/C code */ +#include "ClosureMacros.h" +#include "StgTicky.h" +#include "Stable.h" + +/* Runtime-system hooks */ +#include "Hooks.h" + +#include "ieee-flpt.h" + +#include "Signals.h" + +/* Misc stuff without a home */ +DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */ +DLL_IMPORT_RTS extern int prog_argc; +DLL_IMPORT_RTS extern char *prog_name; + +extern void stackOverflow(void); + +extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl); +extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt); + +#if defined(WANT_DOTNET_SUPPORT) +#include "DNInvoke.h" +#endif + +/* Creating and destroying an adjustor thunk and initialising the whole + adjustor thunk machinery. I cannot make myself create a separate .h file + for these three (sof.) + +*/ +extern void* createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr); +extern void freeHaskellFunctionPtr(void* ptr); +extern rtsBool initAdjustor(void); + +extern void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__); + /* ----------------------------------------------------------------------------- RTS Exit codes -------------------------------------------------------------------------- */ diff --git a/ghc/includes/RtsAPI.h b/ghc/includes/RtsAPI.h index d8e772fe9a..f554b96061 100644 --- a/ghc/includes/RtsAPI.h +++ b/ghc/includes/RtsAPI.h @@ -1,7 +1,6 @@ /* ---------------------------------------------------------------------------- - * $Id: RtsAPI.h,v 1.36 2003/09/21 22:20:52 wolfgang Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * * API for invoking Haskell functions via the RTS * @@ -131,10 +130,10 @@ rts_checkSchedStatus ( char* site, SchedulerStatus rc); These are used by foreign export and foreign import "wrapper" stubs. ----------------------------------------------------------------------- */ -extern StgClosure GHCziTopHandler_runIO_closure; -extern StgClosure GHCziTopHandler_runNonIO_closure; -#define runIO_closure (&GHCziTopHandler_runIO_closure) -#define runNonIO_closure (&GHCziTopHandler_runNonIO_closure) +extern StgWord GHCziTopHandler_runIO_closure[]; +extern StgWord GHCziTopHandler_runNonIO_closure[]; +#define runIO_closure GHCziTopHandler_runIO_closure +#define runNonIO_closure GHCziTopHandler_runNonIO_closure /* ------------------------------------------------------------------------ */ diff --git a/ghc/includes/RtsConfig.h b/ghc/includes/RtsConfig.h new file mode 100644 index 0000000000..1af4517705 --- /dev/null +++ b/ghc/includes/RtsConfig.h @@ -0,0 +1,84 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Rts settings. + * + * NOTE: assumes #include "ghcconfig.h" + * + * NB: THIS FILE IS INCLUDED IN NON-C CODE AND DATA! #defines only please. + * ---------------------------------------------------------------------------*/ + +#ifndef RTSCONFIG_H +#define RTSCONFIG_H + +/* + * SUPPORT_LONG_LONGS controls whether we need to support long longs on a + * particular platform. On 64-bit platforms, we don't need to support + * long longs since regular machine words will do just fine. + */ +#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8 +#define SUPPORT_LONG_LONGS 1 +#endif + +/* + * Whether the runtime system will use libbfd for debugging purposes. + */ +#if defined(DEBUG) && defined(HAVE_BFD_H) && !defined(_WIN32) && !defined(PAR) && !defined(GRAN) +#define USING_LIBBFD 1 +#endif + +/* Turn lazy blackholing and eager blackholing on/off. + * + * Using eager blackholing makes things easier to debug because + * the blackholes are more predictable - but it's slower and less sexy. + * + * For now, do lazy and not eager. + */ + +/* TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of + * single-entry thunks. + * + * SMP needs EAGER_BLACKHOLING because it has to lock thunks + * synchronously, in case another thread is trying to evaluate the + * same thunk simultaneously. + */ +#if defined(SMP) || defined(TICKY_TICKY) +# define EAGER_BLACKHOLING +#else +# define LAZY_BLACKHOLING +#endif + +/* TABLES_NEXT_TO_CODE says whether to assume that info tables are + * assumed to reside just before the code for a function. + * + * UNDEFINING THIS WON'T WORK ON ITS OWN. You have been warned. + */ +#if !defined(USE_MINIINTERPRETER) && !defined(ia64_TARGET_ARCH) +#define TABLES_NEXT_TO_CODE +#endif + +/* ----------------------------------------------------------------------------- + Labels - entry labels & info labels point to the same place in + TABLES_NEXT_TO_CODE, so we only generate the _info label. Jumps + must therefore be directed to foo_info rather than foo_entry when + TABLES_NEXT_TO_CODE is on. + + This isn't a good place for these macros, but they need to be + available to .cmm sources as well as C and we don't have a better + place. + -------------------------------------------------------------------------- */ + +#ifdef TABLES_NEXT_TO_CODE +#define ENTRY_LBL(f) f##_info +#else +#define ENTRY_LBL(f) f##_entry +#endif + +#ifdef TABLES_NEXT_TO_CODE +#define RET_LBL(f) f##_info +#else +#define RET_LBL(f) f##_ret +#endif + +#endif /* RTSCONFIG_H */ diff --git a/ghc/includes/RtsExternal.h b/ghc/includes/RtsExternal.h new file mode 100644 index 0000000000..da4f02e102 --- /dev/null +++ b/ghc/includes/RtsExternal.h @@ -0,0 +1,67 @@ +/* ----------------------------------------------------------------------------- + * $Id: RtsExternal.h,v 1.2 2004/08/13 13:09:29 simonmar Exp $ + * + * (c) The GHC Team, 1998-2004 + * + * Things visible externally to the RTS + * + * -------------------------------------------------------------------------- */ + +#ifndef RTSEXTERNAL_H +#define RTSEXTERNAL_H + +/* The RTS public interface. */ +#include "RtsAPI.h" + +/* The standard FFI interface */ +#include "HsFFI.h" + +/* ----------------------------------------------------------------------------- + Functions exported by the RTS for use in Stg code + -------------------------------------------------------------------------- */ + +#if IN_STG_CODE +extern void newCAF(void*); +#else +extern void newCAF(StgClosure*); +#endif + +/* ToDo: remove? */ +extern I_ genSymZh(void); +extern I_ resetGenSymZh(void); + +/* Concurrency/Exception PrimOps. */ +extern int cmp_thread(StgPtr tso1, StgPtr tso2); +extern int rts_getThreadId(StgPtr tso); +extern int forkOS_createThread ( HsStablePtr entry ); + +/* grimy low-level support functions defined in StgPrimFloat.c */ +extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e); +extern StgDouble __int_encodeDouble (I_ j, I_ e); +extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e); +extern StgFloat __int_encodeFloat (I_ j, I_ e); +extern StgInt isDoubleNaN(StgDouble d); +extern StgInt isDoubleInfinite(StgDouble d); +extern StgInt isDoubleDenormalized(StgDouble d); +extern StgInt isDoubleNegativeZero(StgDouble d); +extern StgInt isFloatNaN(StgFloat f); +extern StgInt isFloatInfinite(StgFloat f); +extern StgInt isFloatDenormalized(StgFloat f); +extern StgInt isFloatNegativeZero(StgFloat f); + +/* Suspending/resuming threads around foreign calls */ +extern StgInt suspendThread ( StgRegTable * ); +extern StgRegTable * resumeThread ( StgInt ); + +/* ----------------------------------------------------------------------------- + Storage manager stuff exported + -------------------------------------------------------------------------- */ + +/* Prototype for an evacuate-like function */ +typedef void (*evac_fn)(StgClosure **); + +extern void performGC(void); +extern void performMajorGC(void); +extern void performGCWithRoots(void (*get_roots)(evac_fn)); + +#endif /* RTSEXTERNAL_H */ diff --git a/ghc/includes/RtsFlags.h b/ghc/includes/RtsFlags.h index 01f631d5ce..1d4574894f 100644 --- a/ghc/includes/RtsFlags.h +++ b/ghc/includes/RtsFlags.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsFlags.h,v 1.45 2003/01/23 12:13:10 simonmar Exp $ + * $Id: RtsFlags.h,v 1.46 2004/08/13 13:09:29 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -73,15 +73,8 @@ struct COST_CENTRE_FLAGS { int msecsPerTick; /* derived */ }; -#ifdef PROFILING struct PROFILING_FLAGS { unsigned int doHeapProfile; - - nat profileInterval; /* delta between samples (in ms) */ - nat profileIntervalTicks; /* delta between samples (in 'ticks') */ - rtsBool includeTSOs; - - # define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */ # define HEAP_BY_CCS 1 # define HEAP_BY_MOD 2 @@ -90,6 +83,14 @@ struct PROFILING_FLAGS { # define HEAP_BY_RETAINER 6 # define HEAP_BY_LDV 7 +# define HEAP_BY_INFOPTR 1 /* DEBUG only */ +# define HEAP_BY_CLOSURE_TYPE 2 /* DEBUG only */ + + nat profileInterval; /* delta between samples (in ms) */ + nat profileIntervalTicks; /* delta between samples (in 'ticks') */ + rtsBool includeTSOs; + + rtsBool showCCSOnException; nat maxRetainerSetSize; @@ -103,15 +104,6 @@ struct PROFILING_FLAGS { char* bioSelector; }; -#elif defined(DEBUG) -# define NO_HEAP_PROFILING 0 -# define HEAP_BY_INFOPTR 1 -# define HEAP_BY_CLOSURE_TYPE 2 -struct PROFILING_FLAGS { - unsigned int doHeapProfile; /* heap profile using symbol table */ - -}; -#endif /* DEBUG || PROFILING */ struct CONCURRENT_FLAGS { int ctxtSwitchTime; /* in milliseconds */ @@ -288,44 +280,38 @@ struct GRAN_FLAGS { }; #endif /* GRAN */ -#ifdef TICKY_TICKY struct TICKY_FLAGS { rtsBool showTickyStats; FILE *tickyFile; }; -#endif /* TICKY_TICKY */ /* Put them together: */ -struct RTS_FLAGS { - struct GC_FLAGS GcFlags; - struct CONCURRENT_FLAGS ConcFlags; - -#ifdef DEBUG - struct DEBUG_FLAGS DebugFlags; -#endif -#if defined(PROFILING) || defined(PAR) +typedef struct _RTS_FLAGS { + // The first portion of RTS_FLAGS is invariant. + struct GC_FLAGS GcFlags; + struct CONCURRENT_FLAGS ConcFlags; + struct DEBUG_FLAGS DebugFlags; struct COST_CENTRE_FLAGS CcFlags; -#endif -#if defined(PROFILING) || defined(DEBUG) - struct PROFILING_FLAGS ProfFlags; -#endif + struct PROFILING_FLAGS ProfFlags; + struct TICKY_FLAGS TickyFlags; + #if defined(SMP) || defined(PAR) struct PAR_FLAGS ParFlags; #endif #ifdef GRAN struct GRAN_FLAGS GranFlags; #endif -#ifdef TICKY_TICKY - struct TICKY_FLAGS TickyFlags; -#endif -}; +} RTS_FLAGS; #ifdef COMPILING_RTS_MAIN -extern DLLIMPORT struct RTS_FLAGS RtsFlags; +extern DLLIMPORT RTS_FLAGS RtsFlags; +#elif IN_STG_CODE +// Hack because the C code generator can't generate '&label'. +extern RTS_FLAGS RtsFlags[]; #else -extern struct RTS_FLAGS RtsFlags; +extern RTS_FLAGS RtsFlags; #endif /* Routines that operate-on/to-do-with RTS flags: */ diff --git a/ghc/includes/Stable.h b/ghc/includes/Stable.h index fefdba9665..ca2e72118a 100644 --- a/ghc/includes/Stable.h +++ b/ghc/includes/Stable.h @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Stable.h,v 1.15 2003/11/12 17:27:03 sof Exp $ * - * (c) The GHC Team, 1998-2000 + * (c) The GHC Team, 1998-2004 * * Stable Pointers: A stable pointer is represented as an index into * the stable pointer table in the low BITS_PER_WORD-8 bits with a @@ -55,4 +54,13 @@ StgPtr deRefStablePtr(StgStablePtr sp) extern StgPtr deRefStablePtr(StgStablePtr sp); #endif +extern void initStablePtrTable ( void ); +extern void enlargeStablePtrTable ( void ); +extern StgWord lookupStableName ( StgPtr p ); + +extern void markStablePtrTable ( evac_fn evac ); +extern void threadStablePtrTable ( evac_fn evac ); +extern void gcStablePtrTable ( void ); +extern void updateStablePtrTable ( rtsBool full ); + #endif diff --git a/ghc/includes/Stg.h b/ghc/includes/Stg.h index dd41d37f2c..12051e0551 100644 --- a/ghc/includes/Stg.h +++ b/ghc/includes/Stg.h @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: Stg.h,v 1.62 2004/03/23 10:03:18 simonmar Exp $ + * $Id: Stg.h,v 1.63 2004/08/13 13:09:30 simonmar Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * * Top-level include file for everything STG-ish. * @@ -12,6 +12,13 @@ * functions are defined (some system headers have been known to * define the odd inline function). * + * We generally try to keep as little visible as possible when + * compiling .hc files. So for example the definitions of the + * InfoTable structs, closure structs and other RTS types are not + * visible here. The compiler knows enough about the representations + * of these types to generate code which manipulates them directly + * with pointer arithmetic. + * * ---------------------------------------------------------------------------*/ #ifndef STG_H @@ -34,82 +41,35 @@ #endif /* Configuration */ -#include "config.h" - -/* This needs to be up near the top as the register line on alpha needs - * to be before all procedures */ -#include "TailCalls.h" - -#if __GNUC__ >= 3 -/* Assume that a flexible array member at the end of a struct - * can be defined thus: T arr[]; */ -#define FLEXIBLE_ARRAY -#else -/* Assume that it must be defined thus: T arr[0]; */ -#define FLEXIBLE_ARRAY 0 -#endif - -#if defined(SMP) || defined(THREADED_RTS) -#define RTS_SUPPORTS_THREADS 1 -#endif - -/* Some macros to handle DLLing (Win32 only at the moment). */ -#include "StgDLL.h" +#include "ghcconfig.h" +#include "RtsConfig.h" -/* Fix for mingw stat problem (done here so it's early enough) */ -#ifdef mingw32_TARGET_OS -#define __MSVCRT__ 1 -#endif - -/* Turn lazy blackholing and eager blackholing on/off. - * - * Using eager blackholing makes things easier to debug because - * the blackholes are more predictable - but it's slower and less sexy. - * - * For now, do lazy and not eager. - */ +/* ----------------------------------------------------------------------------- + Useful definitions + -------------------------------------------------------------------------- */ -/* TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of - * single-entry thunks. - * - * SMP needs EAGER_BLACKHOLING because it has to lock thunks - * synchronously, in case another thread is trying to evaluate the - * same thunk simultaneously. +/* + * The C backend like to refer to labels by just mentioning their + * names. Howevver, when a symbol is declared as a variable in C, the + * C compiler will implicitly dereference it when it occurs in source. + * So we must subvert this behaviour for .hc files by declaring + * variables as arrays, which eliminates the implicit dereference. */ -#if defined(SMP) || defined(TICKY_TICKY) -# define EAGER_BLACKHOLING +#if IN_STG_CODE +#define RTS_VAR(x) (x)[] +#define RTS_DEREF(x) (*(x)) #else -# define LAZY_BLACKHOLING +#define RTS_VAR(x) x +#define RTS_DEREF(x) x #endif -#if defined(__GNUC__) -#define GNU_ATTRIBUTE(at) __attribute__((at)) -#else -#define GNU_ATTRIBUTE(at) -#endif - -#if __GNUC__ >= 3 -#define GNUC3_ATTRIBUTE(at) __attribute__((at)) -#else -#define GNUC3_ATTRIBUTE(at) -#endif - -/* - * Empty structures isn't supported by all, so to define - * empty structures, please protect the defn with an - * #if SUPPORTS_EMPTY_STRUCTS. Similarly for use, - * employ the macro MAYBE_EMPTY_STRUCT(): - * - * MAYBE_EMPTY_STRUCT(structFoo, fieldName); +/* bit macros */ -#if SUPPORTS_EMPTY_STRUCTS -# define MAYBE_EMPTY_STRUCT(a,b) a b; -#else -# define MAYBE_EMPTY_STRUCT(a,b) /* empty */ -#endif +#define BITS_PER_BYTE 8 +#define BITS_IN(x) (BITS_PER_BYTE * sizeof(x)) /* - * 'Portable' + * 'Portable' inlining */ #if defined(__GNUC__) || defined( __INTEL_COMPILER) # define INLINE_HEADER static inline @@ -123,51 +83,12 @@ # error "Don't know how to inline functions with your C compiler." #endif -/* TABLES_NEXT_TO_CODE says whether to assume that info tables are - * assumed to reside just before the code for a function. - * - * UNDEFINING THIS WON'T WORK ON ITS OWN. You have been warned. - */ -#if !defined(USE_MINIINTERPRETER) && !defined(ia64_TARGET_ARCH) -#define TABLES_NEXT_TO_CODE -#endif - -/* bit macros - */ -#define BITS_PER_BYTE 8 -#define BITS_IN(x) (BITS_PER_BYTE * sizeof(x)) - -/* ----------------------------------------------------------------------------- - Assertions and Debuggery - -------------------------------------------------------------------------- */ - -#ifndef DEBUG -#define ASSERT(predicate) /* nothing */ -#else - -void _stgAssert (char *, unsigned int); - -#define ASSERT(predicate) \ - if (predicate) \ - /*null*/; \ - else \ - _stgAssert(__FILE__, __LINE__) -#endif /* DEBUG */ - -/* - * Use this on the RHS of macros which expand to nothing - * to make sure that the macro can be used in a context which - * demands a non-empty statement. - */ - -#define doNothing() do { } while (0) - /* ----------------------------------------------------------------------------- Global type definitions -------------------------------------------------------------------------- */ +#include "MachDeps.h" #include "StgTypes.h" -#include "RtsTypes.h" /* ----------------------------------------------------------------------------- Shorthand forms @@ -187,107 +108,321 @@ typedef StgClosurePtr L_; typedef StgInt64 LI_; typedef StgWord64 LW_; -/* - * We often want to know the size of something in units of an - * StgWord... (rounded up, of course!) - */ +#define IF_(f) static F_ f(void) +#define FN_(f) F_ f(void) +#define EF_(f) extern F_ f(void) -#define sizeofW(t) ((sizeof(t)+sizeof(W_)-1)/sizeof(W_)) +typedef StgWord StgWordArray[]; +#define EI_ extern StgWordArray +#define II_ static StgWordArray -/* - * It's nice to be able to grep for casts - */ +/* ----------------------------------------------------------------------------- + Tail calls + + This needs to be up near the top as the register line on alpha needs + to be before all procedures (inline & out-of-line). + -------------------------------------------------------------------------- */ -#define stgCast(ty,e) ((ty)(e)) +#include "TailCalls.h" /* ----------------------------------------------------------------------------- - Include everything STG-ish + 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(void *)). + + PK_FLT is for pulling a float out of memory. The memory is + guaranteed to be StgWord aligned. -------------------------------------------------------------------------- */ -/* Global constaints */ -#include "Constants.h" +INLINE_HEADER void ASSIGN_FLT (W_ [], StgFloat); +INLINE_HEADER StgFloat PK_FLT (W_ []); -/* Profiling information */ -#include "StgProf.h" -#include "StgLdvProf.h" +#if ALIGNMENT_FLOAT <= ALIGNMENT_LONG -/* Storage format definitions */ -#include "StgFun.h" -#include "Closures.h" -#include "ClosureTypes.h" -#include "InfoTables.h" -#include "TSO.h" +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; } -/* Simulated-parallel information */ -#include "GranSim.h" +#else /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */ -/* Parallel information */ -#include "Parallel.h" +INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src) +{ + float_thing y; + y.f = src; + *p_dest = y.fu; +} -/* STG/Optimised-C related stuff */ -#include "SMP.h" -#include "MachRegs.h" -#include "Regs.h" -#include "Block.h" +INLINE_HEADER StgFloat PK_FLT(W_ p_src[]) +{ + float_thing y; + y.fu = *p_src; + return(y.f); +} + +#endif /* ALIGNMENT_FLOAT > ALIGNMENT_LONG */ + +#if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG + +INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); +INLINE_HEADER StgDouble PK_DBL (W_ []); -/* RTS public interface */ -#include "RtsAPI.h" +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; } -/* System headers: stdlib.h is eeded so that we can use NULL. It must - * come after MachRegs.h, because stdlib.h might define some inline - * functions which may only be defined after register variables have - * been declared. +#else /* ALIGNMENT_DOUBLE > ALIGNMENT_LONG */ + +/* Sparc uses two floating point registers to hold a double. We can + * write ASSIGN_DBL and PK_DBL by directly accessing the registers + * independently - unfortunately this code isn't writable in C, we + * have to use inline assembler. */ -#include <stdlib.h> +#if sparc_TARGET_ARCH + +#define ASSIGN_DBL(dst0,src) \ + { StgPtr dst = (StgPtr)(dst0); \ + __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \ + "=m" (((P_)(dst))[1]) : "f" (src)); \ + } + +#define PK_DBL(src0) \ + ( { StgPtr src = (StgPtr)(src0); \ + register double d; \ + __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \ + "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \ + } ) + +#else /* ! sparc_TARGET_ARCH */ + +INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); +INLINE_HEADER StgDouble PK_DBL (W_ []); + +typedef struct + { StgWord dhi; + StgWord dlo; + } unpacked_double; + +typedef union + { StgDouble d; + unpacked_double du; + } double_thing; + +INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src) +{ + double_thing y; + y.d = src; + p_dest[0] = y.du.dhi; + p_dest[1] = y.du.dlo; +} + +/* GCC also works with this version, but it generates + the same code as the previous one, and is not ANSI + +#define ASSIGN_DBL( p_dest, src ) \ + *p_dest = ((double_thing) src).du.dhi; \ + *(p_dest+1) = ((double_thing) src).du.dlo \ +*/ -#ifdef SMP -#include <pthread.h> -#endif +INLINE_HEADER StgDouble PK_DBL(W_ p_src[]) +{ + double_thing y; + y.du.dhi = p_src[0]; + y.du.dlo = p_src[1]; + return(y.d); +} -/* GNU mp library */ -#include "gmp.h" +#endif /* ! sparc_TARGET_ARCH */ -/* Storage Manager */ -#include "StgStorage.h" +#endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */ -/* Macros for STG/C code */ -#include "ClosureMacros.h" -#include "InfoMacros.h" -#include "StgMacros.h" -#include "PrimOps.h" -#include "Updates.h" -#include "StgTicky.h" -#include "CCall.h" -#include "Stable.h" -/* Built-in entry points */ +/* ----------------------------------------------------------------------------- + Moving 64-bit quantities around + + ASSIGN_Word64 assign an StgWord64/StgInt64 to a memory location + PK_Word64 load an StgWord64/StgInt64 from a amemory location + + In both cases the memory location might not be 64-bit aligned. + -------------------------------------------------------------------------- */ + +#ifdef SUPPORT_LONG_LONGS + +typedef struct + { StgWord dhi; + StgWord dlo; + } unpacked_double_word; + +typedef union + { StgInt64 i; + unpacked_double_word iu; + } int64_thing; + +typedef union + { StgWord64 w; + unpacked_double_word wu; + } word64_thing; + +INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + word64_thing y; + y.w = src; + p_dest[0] = y.wu.dhi; + p_dest[1] = y.wu.dlo; +} + +INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) +{ + word64_thing y; + y.wu.dhi = p_src[0]; + y.wu.dlo = p_src[1]; + return(y.w); +} + +INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + int64_thing y; + y.i = src; + p_dest[0] = y.iu.dhi; + p_dest[1] = y.iu.dlo; +} + +INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) +{ + int64_thing y; + y.iu.dhi = p_src[0]; + y.iu.dlo = p_src[1]; + return(y.i); +} + +#elif SIZEOF_VOID_P == 8 + +INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + p_dest[0] = src; +} + +INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) +{ + return p_src[0]; +} + +INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + p_dest[0] = src; +} + +INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) +{ + return p_src[0]; +} + +#endif + +/* ----------------------------------------------------------------------------- + Other Stg stuff... + -------------------------------------------------------------------------- */ + +#include "StgDLL.h" +#include "MachRegs.h" +#include "Regs.h" +#include "StgProf.h" /* ToDo: separate out RTS-only stuff from here */ + +#if IN_STG_CODE +/* + * This is included later for RTS sources, after definitions of + * StgInfoTable, StgClosure and so on. + */ #include "StgMiscClosures.h" +#endif -/* Runtime-system hooks */ -#include "Hooks.h" +/* RTS external interface */ +#include "RtsExternal.h" -#include "Signals.h" +/* ----------------------------------------------------------------------------- + Split markers + -------------------------------------------------------------------------- */ -#include "HsFFI.h" +#if defined(USE_SPLIT_MARKERS) +#if defined(LEADING_UNDERSCORE) +#define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:"); +#else +#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:"); +#endif +#else +#define __STG_SPLIT_MARKER /* nothing */ +#endif + +/* ----------------------------------------------------------------------------- + Integer multiply with overflow + -------------------------------------------------------------------------- */ -/* Misc stuff without a home */ -DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */ -DLL_IMPORT_RTS extern int prog_argc; -DLL_IMPORT_RTS extern char *prog_name; +/* Multiply with overflow checking. + * + * This is tricky - the usual sign rules for add/subtract don't apply. + * + * On 32-bit machines we use gcc's 'long long' types, finding + * overflow with some careful bit-twiddling. + * + * On 64-bit machines where gcc's 'long long' type is also 64-bits, + * we use a crude approximation, testing whether either operand is + * larger than 32-bits; if neither is, then we go ahead with the + * multiplication. + * + * Return non-zero if there is any possibility that the signed multiply + * of a and b might overflow. Return zero only if you are absolutely sure + * that it won't overflow. If in doubt, return non-zero. + */ -extern void stackOverflow(void); +#if SIZEOF_VOID_P == 4 -#if defined(WANT_DOTNET_SUPPORT) -#include "DNInvoke.h" +#ifdef WORDS_BIGENDIAN +#define RTS_CARRY_IDX__ 0 +#define RTS_REM_IDX__ 1 +#else +#define RTS_CARRY_IDX__ 1 +#define RTS_REM_IDX__ 0 #endif -/* Creating and destroying an adjustor thunk and initialising the whole - adjustor thunk machinery. I cannot make myself create a separate .h file - for these three (sof.) - -*/ -extern void* createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr); -extern void freeHaskellFunctionPtr(void* ptr); -extern rtsBool initAdjustor(void); +typedef union { + StgInt64 l; + StgInt32 i[2]; +} long_long_u ; + +#define mulIntMayOflo(a,b) \ +({ \ + StgInt32 r, c; \ + long_long_u z; \ + z.l = (StgInt64)a * (StgInt64)b; \ + r = z.i[RTS_REM_IDX__]; \ + c = z.i[RTS_CARRY_IDX__]; \ + if (c == 0 || c == -1) { \ + c = ((StgWord)((a^b) ^ r)) \ + >> (BITS_IN (I_) - 1); \ + } \ + c; \ +}) + +/* Careful: the carry calculation above is extremely delicate. Make sure + * you test it thoroughly after changing it. + */ + +#else + +#define HALF_INT (((I_)1) << (BITS_IN (I_) / 2)) + +#define stg_abs(a) (((I_)(a)) < 0 ? -((I_)(a)) : ((I_)(a))) + +#define mulIntMayOflo(a,b) \ +({ \ + I_ c; \ + if (stg_abs(a) >= HALF_INT || \ + stg_abs(b) >= HALF_INT) { \ + c = 1; \ + } else { \ + c = 0; \ + } \ + c; \ +}) +#endif #endif /* STG_H */ diff --git a/ghc/includes/StgFun.h b/ghc/includes/StgFun.h index b89cd984e5..a1a4712985 100644 --- a/ghc/includes/StgFun.h +++ b/ghc/includes/StgFun.h @@ -19,6 +19,9 @@ /* specialised function types: bitmaps and calling sequences * for these functions are pre-generated (see ghc/utils/genapply), and * the generated code in ghc/rts/AutoApply.hc. + * + * NOTE: this ordering/numbering is hard-coded into the tables + * generated by GenApply.hs which end up in AutoApply.cmm. */ #define ARG_N 3 #define ARG_P 4 @@ -29,21 +32,18 @@ #define ARG_NP 9 #define ARG_PN 10 #define ARG_PP 11 -#define ARG_FF 12 -#define ARG_DD 13 -#define ARG_LL 14 -#define ARG_NNN 15 -#define ARG_NNP 16 -#define ARG_NPN 17 -#define ARG_NPP 18 -#define ARG_PNN 19 -#define ARG_PNP 20 -#define ARG_PPN 21 -#define ARG_PPP 22 -#define ARG_PPPP 23 -#define ARG_PPPPP 24 -#define ARG_PPPPPP 25 -#define ARG_PPPPPPP 26 -#define ARG_PPPPPPPP 27 +#define ARG_NNN 12 +#define ARG_NNP 13 +#define ARG_NPN 14 +#define ARG_NPP 15 +#define ARG_PNN 16 +#define ARG_PNP 17 +#define ARG_PPN 18 +#define ARG_PPP 19 +#define ARG_PPPP 20 +#define ARG_PPPPP 21 +#define ARG_PPPPPP 22 +#define ARG_PPPPPPP 23 +#define ARG_PPPPPPPP 24 #endif // STGFUN_H diff --git a/ghc/includes/StgLdvProf.h b/ghc/includes/StgLdvProf.h index dceefd7140..f5f7ae22d8 100644 --- a/ghc/includes/StgLdvProf.h +++ b/ghc/includes/StgLdvProf.h @@ -1,8 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: StgLdvProf.h,v 1.2 2001/11/26 16:54:22 simonmar Exp $ * - * (c) The GHC Team, 2001 - * Author: Sungwoo Park + * (c) The University of Glasgow, 2004 * * Lag/Drag/Void profiling. * @@ -11,63 +9,37 @@ #ifndef STGLDVPROF_H #define STGLDVPROF_H -/* - An LDV word is divided into 3 parts: state bits (LDV_STATE_MASK), creation - time bits (LDV_CREATE_MASK), and last use time bits (LDV_LAST_MASK). - */ -#if SIZEOF_VOID_P == 8 -#define LDV_SHIFT 30 -#define LDV_STATE_MASK 0x1000000000000000 -#define LDV_CREATE_MASK 0x0FFFFFFFC0000000 -#define LDV_LAST_MASK 0x000000003FFFFFFF -#define LDV_STATE_CREATE 0x0000000000000000 -#define LDV_STATE_USE 0x1000000000000000 -#else -#define LDV_SHIFT 15 -#define LDV_STATE_MASK 0x40000000 -#define LDV_CREATE_MASK 0x3FFF8000 -#define LDV_LAST_MASK 0x00007FFF -#define LDV_STATE_CREATE 0x00000000 -#define LDV_STATE_USE 0x40000000 -#endif // SIZEOF_VOID_P - #ifdef PROFILING -extern nat era; - -// retrieves the LDV word from closure c +/* retrieves the LDV word from closure c */ #define LDVW(c) (((StgClosure *)(c))->header.prof.hp.ldvw) -// Stores the creation time for closure c. -// This macro is called at the very moment of closure creation. -// -// NOTE: this initializes LDVW(c) to zero, which ensures that there -// is no conflict between retainer profiling and LDV profiling, -// because retainer profiling also expects LDVW(c) to be initialised -// to zero. -#define LDV_recordCreate(c) \ - LDVW((c)) = (era << LDV_SHIFT) | LDV_STATE_CREATE - -// Stores the last use time for closure c. -// This macro *must* be called whenever a closure is used, that is, it is -// entered. -#define LDV_recordUse(c) \ - { \ - if (era > 0) \ - LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) | \ - era | \ - LDV_STATE_USE; \ - } - -// Macros called when a closure is entered. -// The closure is not an 'inherently used' one. -// The closure is not IND or IND_OLDGEN because neither is considered for LDV -// profiling. -#define LDV_ENTER(c) LDV_recordUse((c)) +/* + * Stores the creation time for closure c. + * This macro is called at the very moment of closure creation. + * + * NOTE: this initializes LDVW(c) to zero, which ensures that there + * is no conflict between retainer profiling and LDV profiling, + * because retainer profiling also expects LDVW(c) to be initialised + * to zero. + */ +#ifndef CMINUSMINUS +#define LDV_RECORD_CREATE(c) \ + LDVW((c)) = (RTS_DEREF(era) << LDV_SHIFT) | LDV_STATE_CREATE +#endif + +#ifdef CMINUSMINUS +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) \ + foreign "C" LDV_recordDead_FILL_SLOP_DYNAMIC(c "ptr") +#else +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) \ + LDV_recordDead_FILL_SLOP_DYNAMIC(c) +#endif -#else // !PROFILING +#else /* !PROFILING */ -#define LDV_ENTER(c) +#define LDV_RECORD_CREATE(c) /* nothing */ +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) /* nothing */ -#endif // PROFILING -#endif // STGLDVPROF_H +#endif /* PROFILING */ +#endif /* STGLDVPROF_H */ diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h deleted file mode 100644 index bb1fcf69d0..0000000000 --- a/ghc/includes/StgMacros.h +++ /dev/null @@ -1,851 +0,0 @@ -/* ----------------------------------------------------------------------------- - * $Id: StgMacros.h,v 1.57 2003/11/12 17:27:04 sof Exp $ - * - * (c) The GHC Team, 1998-1999 - * - * Macros used for writing STG-ish C code. - * - * ---------------------------------------------------------------------------*/ - -#ifndef STGMACROS_H -#define STGMACROS_H - -/* ----------------------------------------------------------------------------- - The following macros create function headers. - - Each basic block is represented by a C function with no arguments. - We therefore always begin with either - - extern F_ f(void) - - or - - static F_ f(void) - - The macros can be used either to define the function itself, or to provide - prototypes (by following with a ';'). - - Note: the various I*_ shorthands in the second block below are used to - declare forward references to local symbols. These shorthands *have* to - use the 'extern' type specifier and not 'static'. The reason for this is - that 'static' declares a reference as being a static/local variable, - and *not* as a forward reference to a static variable. - - This might seem obvious, but it had me stumped as to why my info tables - were suddenly all filled with 0s. - - -- sof 1/99 - - --------------------------------------------------------------------------- */ - -#define STGFUN(f) StgFunPtr f(void) -#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 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 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 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 ECP_(x) extern const StgClosure *(x)[] -#define EDCP_(x) extern DLLIMPORT StgClosure *(x)[] -#define ICP_(x) static const StgClosure *(x)[] - -/* ----------------------------------------------------------------------------- - Entering - - 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 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. - - When failing a check, we save a return address on the stack and - jump to a pre-compiled code fragment that saves the live registers - and returns to the scheduler. - - The return address in most cases will be the beginning of the basic - block in which the check resides, since we need to perform the check - again on re-entry because someone else might have stolen the resource - in the meantime. - ------------------------------------------------------------------------- */ - -#define STK_CHK_FUN(headroom,assts) \ - if (Sp - headroom < SpLim) { \ - assts \ - JMP_(stg_gc_fun); \ - } - -#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 - on the stack and covered by a liveness mask already, and there is - even a return address with an SRT info table there as well. - - Just push R1 and return to the scheduler saying 'EnterGHC' - - {STK,HP,HP_STK}_CHK_NP are the various checking macros for - bog-standard case alternatives, thunks, and non-top-level - functions. In all these cases, node points to a closure that we - can just enter to restart the heap check (the NP stands for 'node points'). - - In the NP case GranSim absolutely has to check whether the current node - resides on the current processor. Otherwise a FETCH event has to be - scheduled. All that is done in GranSimFetch. -- HWL - - HpLim points to the LAST WORD of valid allocation space. - -------------------------------------------------------------------------- */ - -#define STK_CHK_NP(headroom,tag_assts) \ - if ((Sp - (headroom)) < SpLim) { \ - tag_assts \ - JMP_(stg_gc_enter_1); \ - } - -#define HP_CHK_NP(headroom,tag_assts) \ - DO_GRAN_ALLOCATE(headroom) \ - if ((Hp += (headroom)) > HpLim) { \ - HpAlloc = (headroom); \ - tag_assts \ - JMP_(stg_gc_enter_1); \ - } - -// 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 ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \ - HpAlloc = (hp_headroom); \ - tag_assts \ - JMP_(stg_gc_enter_1); \ - } - - -/* Heap checks for branches of a primitive case / unboxed tuple return */ - -#define GEN_HP_CHK_ALT(headroom,lbl,tag_assts) \ - DO_GRAN_ALLOCATE(headroom) \ - if ((Hp += (headroom)) > HpLim) { \ - HpAlloc = (headroom); \ - tag_assts \ - JMP_(lbl); \ - } - -#define HP_CHK_NOREGS(headroom,tag_assts) \ - GEN_HP_CHK_ALT(headroom,stg_gc_noregs,tag_assts); -#define HP_CHK_UNPT_R1(headroom,tag_assts) \ - GEN_HP_CHK_ALT(headroom,stg_gc_unpt_r1,tag_assts); -#define HP_CHK_UNBX_R1(headroom,tag_assts) \ - GEN_HP_CHK_ALT(headroom,stg_gc_unbx_r1,tag_assts); -#define HP_CHK_F1(headroom,tag_assts) \ - 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); - -/* ----------------------------------------------------------------------------- - Generic Heap checks. - - These are slow, but have the advantage of being usable in a variety - of situations. - - The one restriction is that any relevant SRTs must already be pointed - to from the stack. The return address doesn't need to have an info - table attached: hence it can be any old code pointer. - - The liveness mask is a logical 'XOR' of NO_PTRS and zero or more - Rn_PTR constants defined below. All registers will be saved, but - the garbage collector needs to know which ones contain pointers. - - Good places to use a generic heap check: - - - case alternatives (the return address with an SRT is already - on the stack). - - - primitives (no SRT required). - - 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, 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 R3_PTR 1<<2 -#define R4_PTR 1<<3 -#define R5_PTR 1<<4 -#define R6_PTR 1<<5 -#define R7_PTR 1<<6 -#define R8_PTR 1<<7 - -#define HP_CHK_UNBX_TUPLE(headroom,liveness,code) \ - if ((Hp += (headroom)) > HpLim ) { \ - HpAlloc = (headroom); \ - code \ - R9.w = (W_)LIVENESS_MASK(liveness); \ - JMP_(stg_gc_ut); \ - } - -#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) \ - if ((Sp - (headroom)) < SpLim) { \ - R9.w = (W_)LIVENESS_MASK(liveness); \ - R10.w = (W_)reentry; \ - JMP_(stg_gc_gen); \ - } - -#define MAYBE_GC(liveness,reentry) \ - if (doYouWantToGC()) { \ - R9.w = (W_)LIVENESS_MASK(liveness); \ - R10.w = (W_)reentry; \ - JMP_(stg_gc_gen_hp); \ - } - -/* ----------------------------------------------------------------------------- - Voluntary Yields/Blocks - - We only have a generic version of this at the moment - if it turns - out to be slowing us down we can make specialised ones. - -------------------------------------------------------------------------- */ - -EXTFUN_RTS(stg_gen_yield); -EXTFUN_RTS(stg_gen_block); - -#define YIELD(liveness,reentry) \ - { \ - R9.w = (W_)LIVENESS_MASK(liveness); \ - R10.w = (W_)reentry; \ - JMP_(stg_gen_yield); \ - } - -#define BLOCK(liveness,reentry) \ - { \ - R9.w = (W_)LIVENESS_MASK(liveness); \ - R10.w = (W_)reentry; \ - JMP_(stg_gen_block); \ - } - -#define BLOCK_NP(ptrs) \ - { \ - EXTFUN_RTS(stg_block_##ptrs); \ - JMP_(stg_block_##ptrs); \ - } - -#if defined(PAR) -/* - Similar to BLOCK_NP but separates the saving of the thread state from the - actual jump via an StgReturn -*/ - -#define SAVE_THREAD_STATE(ptrs) \ - ASSERT(ptrs==1); \ - Sp -= 1; \ - Sp[0] = R1.w; \ - SaveThreadState(); - -#define THREAD_RETURN(ptrs) \ - ASSERT(ptrs==1); \ - CurrentTSO->what_next = ThreadEnterGHC; \ - R1.i = ThreadBlocked; \ - JMP_(StgReturn); -#endif - -/* ----------------------------------------------------------------------------- - CCall_GC needs to push a dummy stack frame containing the contents - of volatile registers and variables. - - We use a RET_DYN frame the same as for a dynamic heap check. - ------------------------------------------------------------------------- */ - -/* ----------------------------------------------------------------------------- - Vectored Returns - - RETVEC(p,t) where 'p' is a pointer to the info table for a - vectored return address, returns the address of the return code for - tag 't'. - - 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(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(StgRetInfoTable) - t - 1)) -#else -#define RET_VEC(p,t) (((StgRetInfoTable *)p)->vector[t]) -#endif - -/* ----------------------------------------------------------------------------- - Misc - -------------------------------------------------------------------------- */ - - -/* set the tag register (if we have one) */ -#define SET_TAG(t) /* nothing */ - -#ifdef EAGER_BLACKHOLING -# ifdef SMP -# define UPD_BH_UPDATABLE(info) \ - TICK_UPD_BH_UPDATABLE(); \ - { \ - bdescr *bd = Bdescr(R1.p); \ - if (bd->u.back != (bdescr *)BaseReg) { \ - if (bd->gen_no >= 1 || bd->step->no >= 1) { \ - LOCK_THUNK(info); \ - } else { \ - EXTFUN_RTS(stg_gc_enter_1_hponly); \ - JMP_(stg_gc_enter_1_hponly); \ - } \ - } \ - } \ - SET_INFO(R1.cl,&stg_BLACKHOLE_info) -# define UPD_BH_SINGLE_ENTRY(info) \ - TICK_UPD_BH_SINGLE_ENTRY(); \ - { \ - bdescr *bd = Bdescr(R1.p); \ - if (bd->u.back != (bdescr *)BaseReg) { \ - if (bd->gen_no >= 1 || bd->step->no >= 1) { \ - LOCK_THUNK(info); \ - } else { \ - EXTFUN_RTS(stg_gc_enter_1_hponly); \ - JMP_(stg_gc_enter_1_hponly); \ - } \ - } \ - } \ - SET_INFO(R1.cl,&stg_BLACKHOLE_info) -# else -# ifndef PROFILING -# define UPD_BH_UPDATABLE(info) \ - TICK_UPD_BH_UPDATABLE(); \ - SET_INFO(R1.cl,&stg_BLACKHOLE_info) -# define UPD_BH_SINGLE_ENTRY(info) \ - TICK_UPD_BH_SINGLE_ENTRY(); \ - SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info) -# 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) \ - TICK_UPD_BH_UPDATABLE(); \ - LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl); \ - SET_INFO(R1.cl,&stg_BLACKHOLE_info); \ - LDV_recordCreate(R1.cl) -# define UPD_BH_SINGLE_ENTRY(info) \ - TICK_UPD_BH_SINGLE_ENTRY(); \ - LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl); \ - SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info) \ - LDV_recordCreate(R1.cl) -# endif /* PROFILING */ -# endif -#else /* !EAGER_BLACKHOLING */ -# define UPD_BH_UPDATABLE(thunk) /* nothing */ -# define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */ -#endif /* EAGER_BLACKHOLING */ - -/* ----------------------------------------------------------------------------- - 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(void *)). - - PK_FLT is for pulling a float out of memory. The memory is - guaranteed to be StgWord aligned. - -------------------------------------------------------------------------- */ - -INLINE_HEADER void ASSIGN_FLT (W_ [], StgFloat); -INLINE_HEADER StgFloat PK_FLT (W_ []); - -#if ALIGNMENT_FLOAT <= ALIGNMENT_LONG - -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 */ - -INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src) -{ - float_thing y; - y.f = src; - *p_dest = y.fu; -} - -INLINE_HEADER StgFloat PK_FLT(W_ p_src[]) -{ - float_thing y; - y.fu = *p_src; - return(y.f); -} - -#endif /* ALIGNMENT_FLOAT > ALIGNMENT_LONG */ - -#if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG - -INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); -INLINE_HEADER StgDouble PK_DBL (W_ []); - -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 */ - -/* Sparc uses two floating point registers to hold a double. We can - * write ASSIGN_DBL and PK_DBL by directly accessing the registers - * independently - unfortunately this code isn't writable in C, we - * have to use inline assembler. - */ -#if sparc_TARGET_ARCH - -#define ASSIGN_DBL(dst0,src) \ - { StgPtr dst = (StgPtr)(dst0); \ - __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \ - "=m" (((P_)(dst))[1]) : "f" (src)); \ - } - -#define PK_DBL(src0) \ - ( { StgPtr src = (StgPtr)(src0); \ - register double d; \ - __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \ - "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \ - } ) - -#else /* ! sparc_TARGET_ARCH */ - -INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); -INLINE_HEADER StgDouble PK_DBL (W_ []); - -typedef struct - { StgWord dhi; - StgWord dlo; - } unpacked_double; - -typedef union - { StgDouble d; - unpacked_double du; - } double_thing; - -INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src) -{ - double_thing y; - y.d = src; - p_dest[0] = y.du.dhi; - p_dest[1] = y.du.dlo; -} - -/* GCC also works with this version, but it generates - the same code as the previous one, and is not ANSI - -#define ASSIGN_DBL( p_dest, src ) \ - *p_dest = ((double_thing) src).du.dhi; \ - *(p_dest+1) = ((double_thing) src).du.dlo \ -*/ - -INLINE_HEADER StgDouble PK_DBL(W_ p_src[]) -{ - double_thing y; - y.du.dhi = p_src[0]; - y.du.dlo = p_src[1]; - return(y.d); -} - -#endif /* ! sparc_TARGET_ARCH */ - -#endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */ - -#ifdef SUPPORT_LONG_LONGS - -typedef struct - { StgWord dhi; - StgWord dlo; - } unpacked_double_word; - -typedef union - { StgInt64 i; - unpacked_double_word iu; - } int64_thing; - -typedef union - { StgWord64 w; - unpacked_double_word wu; - } word64_thing; - -INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) -{ - word64_thing y; - y.w = src; - p_dest[0] = y.wu.dhi; - p_dest[1] = y.wu.dlo; -} - -INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) -{ - word64_thing y; - y.wu.dhi = p_src[0]; - y.wu.dlo = p_src[1]; - return(y.w); -} - -INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) -{ - int64_thing y; - y.i = src; - p_dest[0] = y.iu.dhi; - p_dest[1] = y.iu.dlo; -} - -INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) -{ - int64_thing y; - y.iu.dhi = p_src[0]; - y.iu.dlo = p_src[1]; - return(y.i); -} - -#elif SIZEOF_VOID_P == 8 - -INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) -{ - p_dest[0] = src; -} - -INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) -{ - return p_src[0]; -} - -INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) -{ - p_dest[0] = src; -} - -INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) -{ - return p_src[0]; -} - -#endif - -/* ----------------------------------------------------------------------------- - Catch frames - -------------------------------------------------------------------------- */ - -extern DLL_IMPORT_RTS const StgPolyInfoTable stg_catch_frame_info; - -/* ----------------------------------------------------------------------------- - Split markers - -------------------------------------------------------------------------- */ - -#if defined(USE_SPLIT_MARKERS) -#if defined(LEADING_UNDERSCORE) -#define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:"); -#else -#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:"); -#endif -#else -#define __STG_SPLIT_MARKER /* nothing */ -#endif - -/* ----------------------------------------------------------------------------- - Closure and Info Macros with casting. - - We don't want to mess around with casts in the generated C code, so - we use this casting versions of the closure macro. - - This version of SET_HDR also includes CCS_ALLOC for profiling - the - reason we don't use two separate macros is that the cost centre - field is sometimes a non-simple expression and we want to share its - value between SET_HDR and CCS_ALLOC. - -------------------------------------------------------------------------- */ - -#define SET_HDR_(c,info,ccs,size) \ - { \ - CostCentreStack *tmp = (ccs); \ - SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),tmp); \ - CCS_ALLOC(tmp,size); \ - } - -/* ----------------------------------------------------------------------------- - Saving context for exit from the STG world, and loading up context - on entry to STG code. - - We save all the STG registers (that is, the ones that are mapped to - machine registers) in their places in the TSO. - - The stack registers go into the current stack object, and the - current nursery is updated from the heap pointer. - - These functions assume that BaseReg is loaded appropriately (if - we have one). - -------------------------------------------------------------------------- */ - -#if IN_STG_CODE - -INLINE_HEADER void -SaveThreadState(void) -{ - StgTSO *tso; - - /* Don't need to save REG_Base, it won't have changed. */ - - tso = CurrentTSO; - tso->sp = Sp; - CloseNursery(Hp); - -#ifdef REG_CurrentTSO - SAVE_CurrentTSO = tso; -#endif -#ifdef REG_CurrentNursery - SAVE_CurrentNursery = CurrentNursery; -#endif -#if defined(PROFILING) - CurrentTSO->prof.CCCS = CCCS; -#endif -} - -INLINE_HEADER void -LoadThreadState (void) -{ - StgTSO *tso; - -#ifdef REG_CurrentTSO - CurrentTSO = SAVE_CurrentTSO; -#endif - - tso = CurrentTSO; - Sp = tso->sp; - SpLim = (P_)&(tso->stack) + RESERVED_STACK_WORDS; - OpenNursery(Hp,HpLim); - -#ifdef REG_CurrentNursery - CurrentNursery = SAVE_CurrentNursery; -#endif -# if defined(PROFILING) - CCCS = CurrentTSO->prof.CCCS; -# endif -} - -#endif - -/* ----------------------------------------------------------------------------- - Module initialisation - - The module initialisation code looks like this, roughly: - - FN(__stginit_Foo) { - JMP_(__stginit_Foo_1_p) - } - - FN(__stginit_Foo_1_p) { - ... - } - - We have one version of the init code with a module version and the - 'way' attached to it. The version number helps to catch cases - where modules are not compiled in dependency order before being - linked: if a module has been compiled since any modules which depend on - it, then the latter modules will refer to a different version in their - init blocks and a link error will ensue. - - The 'way' suffix helps to catch cases where modules compiled in different - ways are linked together (eg. profiled and non-profiled). - - We provide a plain, unadorned, version of the module init code - which just jumps to the version with the label and way attached. The - reason for this is that when using foreign exports, the caller of - startupHaskell() must supply the name of the init function for the "top" - module in the program, and we don't want to require that this name - has the version and way info appended to it. - -------------------------------------------------------------------------- */ - -#define PUSH_INIT_STACK(reg_function) \ - *(Sp++) = (W_)reg_function - -#define POP_INIT_STACK() \ - *(--Sp) - -#define MOD_INIT_WRAPPER(label,real_init) \ - - -#define START_MOD_INIT(plain_lbl, real_lbl) \ - static int _module_registered = 0; \ - EF_(real_lbl); \ - FN_(plain_lbl) { \ - FB_ \ - JMP_(real_lbl); \ - FE_ \ - } \ - FN_(real_lbl) { \ - FB_; \ - if (! _module_registered) { \ - _module_registered = 1; \ - { - /* extern decls go here, followed by init code */ - -#define REGISTER_FOREIGN_EXPORT(reg_fe_binder) \ - STGCALL1(getStablePtr,reg_fe_binder) - -#define REGISTER_IMPORT(reg_mod_name) \ - PUSH_INIT_STACK(reg_mod_name) - -#define END_MOD_INIT() \ - }}; \ - JMP_(POP_INIT_STACK()); \ - FE_ } - -/* ----------------------------------------------------------------------------- - Support for _ccall_GC_ and _casm_GC. - -------------------------------------------------------------------------- */ - -/* - * Suspending/resuming threads for doing external C-calls (_ccall_GC). - * These functions are defined in rts/Schedule.c. - */ -StgInt suspendThread ( StgRegTable *, rtsBool); -StgRegTable * resumeThread ( StgInt, rtsBool ); - -#define SUSPEND_THREAD(token,threaded) \ - SaveThreadState(); \ - token = suspendThread(BaseReg,threaded); - -#ifdef SMP -#define RESUME_THREAD(token,threaded) \ - BaseReg = resumeThread(token,threaded); \ - LoadThreadState(); -#else -#define RESUME_THREAD(token,threaded) \ - (void)resumeThread(token,threaded); \ - LoadThreadState(); -#endif - -#endif /* STGMACROS_H */ - diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h index 6cc9173510..ef39a8ef70 100644 --- a/ghc/includes/StgMiscClosures.h +++ b/ghc/includes/StgMiscClosures.h @@ -1,296 +1,546 @@ -/* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.h,v 1.47 2003/03/27 13:54:31 simonmar Exp $ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 * - * (c) The GHC Team, 1998-2002 + * Declarations for various symbols exported by the RTS. * - * Entry code for various built-in closure types. + * ToDo: many of the symbols in here don't need to be exported, but + * our Cmm code generator doesn't know how to generate local symbols + * for the RTS bits (it assumes all RTS symbols are external). * - * ---------------------------------------------------------------------------*/ + * --------------------------------------------------------------------------*/ + +#ifndef STGMISCCLOSURES_H +#define STGMISCCLOSURES_H + +#if IN_STG_CODE +# define RTS_RET_INFO(i) extern W_(i)[] +# define RTS_FUN_INFO(i) extern W_(i)[] +# define RTS_THUNK_INFO(i) extern W_(i)[] +# define RTS_INFO(i) extern W_(i)[] +# define RTS_CLOSURE(i) extern W_(i)[] +# define RTS_FUN(f) extern DLL_IMPORT_RTS StgFunPtr f(void) +#else +# define RTS_RET_INFO(i) extern DLL_IMPORT_RTS const StgRetInfoTable i +# define RTS_FUN_INFO(i) extern DLL_IMPORT_RTS const StgFunInfoTable i +# define RTS_THUNK_INFO(i) extern DLL_IMPORT_RTS const StgThunkInfoTable i +# define RTS_INFO(i) extern DLL_IMPORT_RTS const StgInfoTable i +# define RTS_CLOSURE(i) extern DLL_IMPORT_RTS StgClosure i +# define RTS_FUN(f) extern DLL_IMPORT_RTS StgFunPtr f(void) +#endif -/* The naming scheme here follows the naming scheme for closure types - * defined in InfoTables.h. The actual info tables and entry code for - * these objects can be found in StgMiscClosures.hc. - */ +#ifdef TABLES_NEXT_TO_CODE +# define RTS_ENTRY(f) /* nothing */ +#else +# define RTS_ENTRY(f) RTS_FUN(f) +#endif -/* Various entry points */ -STGFUN(stg_PAP_entry); -STGFUN(stg_BCO_entry); +/* Stack frames */ +RTS_RET_INFO(stg_upd_frame_info); +RTS_RET_INFO(stg_noupd_frame_info); +RTS_RET_INFO(stg_seq_frame_info); +RTS_RET_INFO(stg_catch_frame_info); + +RTS_ENTRY(stg_upd_frame_ret); +RTS_ENTRY(stg_seq_frame_ret); /* Entry code for constructors created by the bytecode interpreter */ -STGFUN(stg_interp_constr_entry); -STGFUN(stg_interp_constr1_entry); -STGFUN(stg_interp_constr2_entry); -STGFUN(stg_interp_constr3_entry); -STGFUN(stg_interp_constr4_entry); -STGFUN(stg_interp_constr5_entry); -STGFUN(stg_interp_constr6_entry); -STGFUN(stg_interp_constr7_entry); -STGFUN(stg_interp_constr8_entry); +RTS_ENTRY(stg_interp_constr_entry); +RTS_ENTRY(stg_interp_constr1_entry); +RTS_ENTRY(stg_interp_constr2_entry); +RTS_ENTRY(stg_interp_constr3_entry); +RTS_ENTRY(stg_interp_constr4_entry); +RTS_ENTRY(stg_interp_constr5_entry); +RTS_ENTRY(stg_interp_constr6_entry); +RTS_ENTRY(stg_interp_constr7_entry); +RTS_ENTRY(stg_interp_constr8_entry); /* Magic glue code for when compiled code returns a value in R1/F1/D1 or a VoidRep to the interpreter. */ -extern DLL_IMPORT_RTS const StgPolyInfoTable stg_ctoi_ret_R1p_info; -extern DLL_IMPORT_RTS const StgRetInfoTable stg_ctoi_ret_R1unpt_info; -extern DLL_IMPORT_RTS const StgRetInfoTable stg_ctoi_ret_R1n_info; -extern DLL_IMPORT_RTS const StgRetInfoTable stg_ctoi_ret_F1_info; -extern DLL_IMPORT_RTS const StgRetInfoTable stg_ctoi_ret_D1_info; -extern DLL_IMPORT_RTS const StgRetInfoTable stg_ctoi_ret_L1_info; -extern DLL_IMPORT_RTS const StgRetInfoTable stg_ctoi_ret_V_info; - -extern DLL_IMPORT_RTS const StgRetInfoTable stg_apply_interp_info; - -/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */ -#define END_TSO_QUEUE ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure) -/* this is the NIL ptr for a list CAFs */ -#define END_ECAF_LIST ((StgCAF *)(void*)&stg_END_TSO_QUEUE_closure) +RTS_RET_INFO(stg_ctoi_R1p_info); +RTS_RET_INFO(stg_ctoi_R1unpt_info); +RTS_RET_INFO(stg_ctoi_R1n_info); +RTS_RET_INFO(stg_ctoi_F1_info); +RTS_RET_INFO(stg_ctoi_D1_info); +RTS_RET_INFO(stg_ctoi_L1_info); +RTS_RET_INFO(stg_ctoi_V_info); + +RTS_ENTRY(stg_ctoi_R1p_ret); +RTS_ENTRY(stg_ctoi_R1unpt_ret); +RTS_ENTRY(stg_ctoi_R1n_ret); +RTS_ENTRY(stg_ctoi_F1_ret); +RTS_ENTRY(stg_ctoi_D1_ret); +RTS_ENTRY(stg_ctoi_L1_ret); +RTS_ENTRY(stg_ctoi_V_ret); + +RTS_RET_INFO(stg_apply_interp_info); +RTS_ENTRY(stg_apply_interp_ret); + +RTS_INFO(stg_IND_info); +RTS_INFO(stg_IND_direct_info); +RTS_INFO(stg_IND_0_info); +RTS_INFO(stg_IND_1_info); +RTS_INFO(stg_IND_2_info); +RTS_INFO(stg_IND_3_info); +RTS_INFO(stg_IND_4_info); +RTS_INFO(stg_IND_5_info); +RTS_INFO(stg_IND_6_info); +RTS_INFO(stg_IND_7_info); +RTS_INFO(stg_IND_STATIC_info); +RTS_INFO(stg_IND_PERM_info); +RTS_INFO(stg_IND_OLDGEN_info); +RTS_INFO(stg_IND_OLDGEN_PERM_info); +RTS_INFO(stg_CAF_UNENTERED_info); +RTS_INFO(stg_CAF_ENTERED_info); +RTS_INFO(stg_BLACKHOLE_info); +RTS_INFO(stg_CAF_BLACKHOLE_info); +RTS_INFO(stg_BLACKHOLE_BQ_info); +#ifdef TICKY_TICKY +RTS_INFO(stg_SE_BLACKHOLE_info); +RTS_INFO(stg_SE_CAF_BLACKHOLE_info); +#endif + #if defined(PAR) || defined(GRAN) -/* this is the NIL ptr for a blocking queue */ -# define END_BQ_QUEUE ((StgBlockingQueueElement *)(void*)&stg_END_TSO_QUEUE_closure) -/* this is the NIL ptr for a blocked fetch queue (as in PendingFetches in GUM) */ -# define END_BF_QUEUE ((StgBlockedFetch *)(void*)&stg_END_TSO_QUEUE_closure) +RTS_INFO(stg_RBH_info); #endif -/* ToDo?: different name for end of sleeping queue ? -- HWL */ - -/* info tables */ - -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_direct_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_0_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_1_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_2_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_3_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_4_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_5_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_6_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_7_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_STATIC_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_PERM_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_OLDGEN_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_IND_OLDGEN_PERM_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_UNENTERED_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_ENTERED_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_BLACKHOLE_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_BLACKHOLE_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_BLACKHOLE_BQ_info; -#ifdef SMP -extern DLL_IMPORT_RTS const StgInfoTable stg_WHITEHOLE_info; +#if defined(PAR) +RTS_INFO(stg_FETCH_ME_BQ_info); #endif +RTS_FUN_INFO(stg_BCO_info); +RTS_INFO(stg_EVACUATED_info); +RTS_INFO(stg_FOREIGN_info); +RTS_INFO(stg_WEAK_info); +RTS_INFO(stg_DEAD_WEAK_info); +RTS_INFO(stg_STABLE_NAME_info); +RTS_INFO(stg_FULL_MVAR_info); +RTS_INFO(stg_EMPTY_MVAR_info); +RTS_INFO(stg_TSO_info); +RTS_INFO(stg_ARR_WORDS_info); +RTS_INFO(stg_MUT_ARR_WORDS_info); +RTS_INFO(stg_MUT_ARR_PTRS_info); +RTS_INFO(stg_MUT_ARR_PTRS_FROZEN_info); +RTS_INFO(stg_MUT_VAR_info); +RTS_INFO(stg_END_TSO_QUEUE_info); +RTS_INFO(stg_MUT_CONS_info); +RTS_INFO(stg_END_MUT_LIST_info); +RTS_INFO(stg_catch_info); +RTS_INFO(stg_PAP_info); +RTS_INFO(stg_AP_info); +RTS_INFO(stg_AP_STACK_info); +RTS_INFO(stg_dummy_ret_info); +RTS_INFO(stg_raise_info); + +RTS_ENTRY(stg_IND_entry); +RTS_ENTRY(stg_IND_direct_entry); +RTS_ENTRY(stg_IND_0_entry); +RTS_ENTRY(stg_IND_1_entry); +RTS_ENTRY(stg_IND_2_entry); +RTS_ENTRY(stg_IND_3_entry); +RTS_ENTRY(stg_IND_4_entry); +RTS_ENTRY(stg_IND_5_entry); +RTS_ENTRY(stg_IND_6_entry); +RTS_ENTRY(stg_IND_7_entry); +RTS_ENTRY(stg_IND_STATIC_entry); +RTS_ENTRY(stg_IND_PERM_entry); +RTS_ENTRY(stg_IND_OLDGEN_entry); +RTS_ENTRY(stg_IND_OLDGEN_PERM_entry); +RTS_ENTRY(stg_CAF_UNENTERED_entry); +RTS_ENTRY(stg_CAF_ENTERED_entry); +RTS_ENTRY(stg_BLACKHOLE_entry); +RTS_ENTRY(stg_CAF_BLACKHOLE_entry); +RTS_ENTRY(stg_BLACKHOLE_BQ_entry); #ifdef TICKY_TICKY -extern DLL_IMPORT_RTS const StgInfoTable stg_SE_BLACKHOLE_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_SE_CAF_BLACKHOLE_info; +RTS_ENTRY(stg_SE_BLACKHOLE_entry); +RTS_ENTRY(stg_SE_CAF_BLACKHOLE_entry); #endif #if defined(PAR) || defined(GRAN) -extern DLL_IMPORT_RTS const StgInfoTable stg_RBH_info; +RTS_ENTRY(stg_RBH_entry); #endif #if defined(PAR) -extern DLL_IMPORT_RTS const StgInfoTable stg_FETCH_ME_BQ_info; +RTS_ENTRY(stg_FETCH_ME_BQ_entry); #endif -extern DLL_IMPORT_RTS const StgFunInfoTable stg_BCO_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_EVACUATED_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_FOREIGN_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_WEAK_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_DEAD_WEAK_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_STABLE_NAME_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_FULL_MVAR_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_EMPTY_MVAR_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_TSO_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_ARR_WORDS_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_MUT_ARR_WORDS_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_MUT_ARR_PTRS_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_MUT_ARR_PTRS_FROZEN_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_MUT_VAR_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_END_TSO_QUEUE_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_MUT_CONS_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_END_MUT_LIST_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_catch_info; -extern DLL_IMPORT_RTS const StgPolyInfoTable stg_seq_frame_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_PAP_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_AP_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_AP_STACK_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_dummy_ret_info; -extern DLL_IMPORT_RTS const StgInfoTable stg_raise_info; -extern DLL_IMPORT_RTS const StgRetInfoTable stg_forceIO_info; -extern DLL_IMPORT_RTS const StgRetInfoTable stg_noforceIO_info; +RTS_ENTRY(stg_BCO_entry); +RTS_ENTRY(stg_EVACUATED_entry); +RTS_ENTRY(stg_FOREIGN_entry); +RTS_ENTRY(stg_WEAK_entry); +RTS_ENTRY(stg_DEAD_WEAK_entry); +RTS_ENTRY(stg_STABLE_NAME_entry); +RTS_ENTRY(stg_FULL_MVAR_entry); +RTS_ENTRY(stg_EMPTY_MVAR_entry); +RTS_ENTRY(stg_TSO_entry); +RTS_ENTRY(stg_ARR_WORDS_entry); +RTS_ENTRY(stg_MUT_ARR_WORDS_entry); +RTS_ENTRY(stg_MUT_ARR_PTRS_entry); +RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN_entry); +RTS_ENTRY(stg_MUT_VAR_entry); +RTS_ENTRY(stg_END_TSO_QUEUE_entry); +RTS_ENTRY(stg_MUT_CONS_entry); +RTS_ENTRY(stg_END_MUT_LIST_entry); +RTS_ENTRY(stg_catch_entry); +RTS_ENTRY(stg_PAP_entry); +RTS_ENTRY(stg_AP_entry); +RTS_ENTRY(stg_AP_STACK_entry); +RTS_ENTRY(stg_dummy_ret_entry); +RTS_ENTRY(stg_raise_entry); + + +RTS_ENTRY(stg_unblockAsyncExceptionszh_ret_ret); +RTS_ENTRY(stg_blockAsyncExceptionszh_ret_ret); +RTS_ENTRY(stg_catch_frame_ret); +RTS_ENTRY(stg_catch_entry); +RTS_ENTRY(stg_raise_entry); + /* closures */ -extern DLL_IMPORT_RTS StgClosure stg_END_TSO_QUEUE_closure; -extern DLL_IMPORT_RTS StgClosure stg_END_MUT_LIST_closure; -extern DLL_IMPORT_RTS StgClosure stg_NO_FINALIZER_closure; -extern DLL_IMPORT_RTS StgClosure stg_dummy_ret_closure; -extern DLL_IMPORT_RTS StgClosure stg_forceIO_closure; +RTS_CLOSURE(stg_END_TSO_QUEUE_closure); +RTS_CLOSURE(stg_END_MUT_LIST_closure); +RTS_CLOSURE(stg_NO_FINALIZER_closure); +RTS_CLOSURE(stg_dummy_ret_closure); +RTS_CLOSURE(stg_forceIO_closure); + +RTS_ENTRY(stg_NO_FINALIZER_entry); +RTS_ENTRY(stg_END_EXCEPTION_LIST_entry); +RTS_ENTRY(stg_EXCEPTION_CONS_entry); +#if IN_STG_CODE +extern DLL_IMPORT_RTS StgWordArray stg_CHARLIKE_closure; +extern DLL_IMPORT_RTS StgWordArray stg_INTLIKE_closure; +#else extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_CHARLIKE_closure[]; extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_INTLIKE_closure[]; +#endif + +/* StgStartup */ + +RTS_RET_INFO(stg_forceIO_info); +RTS_ENTRY(stg_forceIO_ret); +RTS_RET_INFO(stg_noforceIO_info); +RTS_ENTRY(stg_noforceIO_ret); /* standard entry points */ /* standard selector thunks */ -EXTINFO_RTS stg_sel_0_upd_info; -EXTINFO_RTS stg_sel_1_upd_info; -EXTINFO_RTS stg_sel_2_upd_info; -EXTINFO_RTS stg_sel_3_upd_info; -EXTINFO_RTS stg_sel_4_upd_info; -EXTINFO_RTS stg_sel_5_upd_info; -EXTINFO_RTS stg_sel_6_upd_info; -EXTINFO_RTS stg_sel_7_upd_info; -EXTINFO_RTS stg_sel_8_upd_info; -EXTINFO_RTS stg_sel_8_upd_info; -EXTINFO_RTS stg_sel_9_upd_info; -EXTINFO_RTS stg_sel_10_upd_info; -EXTINFO_RTS stg_sel_11_upd_info; -EXTINFO_RTS stg_sel_12_upd_info; -EXTINFO_RTS stg_sel_13_upd_info; -EXTINFO_RTS stg_sel_14_upd_info; -EXTINFO_RTS stg_sel_15_upd_info; - -EXTINFO_RTS stg_sel_0_noupd_info; -EXTINFO_RTS stg_sel_1_noupd_info; -EXTINFO_RTS stg_sel_2_noupd_info; -EXTINFO_RTS stg_sel_3_noupd_info; -EXTINFO_RTS stg_sel_4_noupd_info; -EXTINFO_RTS stg_sel_5_noupd_info; -EXTINFO_RTS stg_sel_6_noupd_info; -EXTINFO_RTS stg_sel_7_noupd_info; -EXTINFO_RTS stg_sel_8_noupd_info; -EXTINFO_RTS stg_sel_9_noupd_info; -EXTINFO_RTS stg_sel_10_noupd_info; -EXTINFO_RTS stg_sel_11_noupd_info; -EXTINFO_RTS stg_sel_12_noupd_info; -EXTINFO_RTS stg_sel_13_noupd_info; -EXTINFO_RTS stg_sel_14_noupd_info; -EXTINFO_RTS stg_sel_15_noupd_info; - - /* and their standard entry points -- KSW 1998-12 */ - -EXTFUN_RTS(stg_sel_0_upd_entry); -EXTFUN_RTS(stg_sel_1_upd_entry); -EXTFUN_RTS(stg_sel_2_upd_entry); -EXTFUN_RTS(stg_sel_3_upd_entry); -EXTFUN_RTS(stg_sel_4_upd_entry); -EXTFUN_RTS(stg_sel_5_upd_entry); -EXTFUN_RTS(stg_sel_6_upd_entry); -EXTFUN_RTS(stg_sel_7_upd_entry); -EXTFUN_RTS(stg_sel_8_upd_entry); -EXTFUN_RTS(stg_sel_8_upd_entry); -EXTFUN_RTS(stg_sel_9_upd_entry); -EXTFUN_RTS(stg_sel_10_upd_entry); -EXTFUN_RTS(stg_sel_11_upd_entry); -EXTFUN_RTS(stg_sel_12_upd_entry); -EXTFUN_RTS(stg_sel_13_upd_entry); -EXTFUN_RTS(stg_sel_14_upd_entry); -EXTFUN_RTS(stg_sel_15_upd_entry); - -EXTFUN_RTS(stg_sel_0_noupd_entry); -EXTFUN_RTS(stg_sel_1_noupd_entry); -EXTFUN_RTS(stg_sel_2_noupd_entry); -EXTFUN_RTS(stg_sel_3_noupd_entry); -EXTFUN_RTS(stg_sel_4_noupd_entry); -EXTFUN_RTS(stg_sel_5_noupd_entry); -EXTFUN_RTS(stg_sel_6_noupd_entry); -EXTFUN_RTS(stg_sel_7_noupd_entry); -EXTFUN_RTS(stg_sel_8_noupd_entry); -EXTFUN_RTS(stg_sel_9_noupd_entry); -EXTFUN_RTS(stg_sel_10_noupd_entry); -EXTFUN_RTS(stg_sel_11_noupd_entry); -EXTFUN_RTS(stg_sel_12_noupd_entry); -EXTFUN_RTS(stg_sel_13_noupd_entry); -EXTFUN_RTS(stg_sel_14_noupd_entry); -EXTFUN_RTS(stg_sel_15_noupd_entry); - -// standard ap thunks - -ETI_RTS stg_ap_1_upd_info; -ETI_RTS stg_ap_2_upd_info; -ETI_RTS stg_ap_3_upd_info; -ETI_RTS stg_ap_4_upd_info; -ETI_RTS stg_ap_5_upd_info; -ETI_RTS stg_ap_6_upd_info; -ETI_RTS stg_ap_7_upd_info; -ETI_RTS stg_ap_8_upd_info; - -// standard application routines (see also rts/gen_apply.py, -// and compiler/codeGen/CgStackery.lhs). - -extern DLL_IMPORT_RTS const StgPolyInfoTable stg_ap_0_info; -ERI_(stg_ap_v_info); -ERI_(stg_ap_f_info); -ERI_(stg_ap_d_info); -ERI_(stg_ap_l_info); -ERI_(stg_ap_n_info); -ERI_(stg_ap_p_info); -ERI_(stg_ap_pv_info); -ERI_(stg_ap_pp_info); -ERI_(stg_ap_ppv_info); -ERI_(stg_ap_ppp_info); -ERI_(stg_ap_pppp_info); -ERI_(stg_ap_ppppp_info); -ERI_(stg_ap_pppppp_info); -ERI_(stg_ap_ppppppp_info); - -EXTFUN(stg_ap_0_ret); -EXTFUN(stg_ap_v_ret); -EXTFUN(stg_ap_f_ret); -EXTFUN(stg_ap_d_ret); -EXTFUN(stg_ap_l_ret); -EXTFUN(stg_ap_n_ret); -EXTFUN(stg_ap_p_ret); -EXTFUN(stg_ap_pv_ret); -EXTFUN(stg_ap_pp_ret); -EXTFUN(stg_ap_ppv_ret); -EXTFUN(stg_ap_ppp_ret); -EXTFUN(stg_ap_pppp_ret); -EXTFUN(stg_ap_ppppp_ret); -EXTFUN(stg_ap_pppppp_ret); -EXTFUN(stg_ap_ppppppp_ret); +RTS_ENTRY(stg_sel_ret_0_upd_ret); +RTS_ENTRY(stg_sel_ret_1_upd_ret); +RTS_ENTRY(stg_sel_ret_2_upd_ret); +RTS_ENTRY(stg_sel_ret_3_upd_ret); +RTS_ENTRY(stg_sel_ret_4_upd_ret); +RTS_ENTRY(stg_sel_ret_5_upd_ret); +RTS_ENTRY(stg_sel_ret_6_upd_ret); +RTS_ENTRY(stg_sel_ret_7_upd_ret); +RTS_ENTRY(stg_sel_ret_8_upd_ret); +RTS_ENTRY(stg_sel_ret_8_upd_ret); +RTS_ENTRY(stg_sel_ret_9_upd_ret); +RTS_ENTRY(stg_sel_ret_10_upd_ret); +RTS_ENTRY(stg_sel_ret_11_upd_ret); +RTS_ENTRY(stg_sel_ret_12_upd_ret); +RTS_ENTRY(stg_sel_ret_13_upd_ret); +RTS_ENTRY(stg_sel_ret_14_upd_ret); +RTS_ENTRY(stg_sel_ret_15_upd_ret); + +RTS_INFO(stg_sel_0_upd_info); +RTS_INFO(stg_sel_1_upd_info); +RTS_INFO(stg_sel_2_upd_info); +RTS_INFO(stg_sel_3_upd_info); +RTS_INFO(stg_sel_4_upd_info); +RTS_INFO(stg_sel_5_upd_info); +RTS_INFO(stg_sel_6_upd_info); +RTS_INFO(stg_sel_7_upd_info); +RTS_INFO(stg_sel_8_upd_info); +RTS_INFO(stg_sel_8_upd_info); +RTS_INFO(stg_sel_9_upd_info); +RTS_INFO(stg_sel_10_upd_info); +RTS_INFO(stg_sel_11_upd_info); +RTS_INFO(stg_sel_12_upd_info); +RTS_INFO(stg_sel_13_upd_info); +RTS_INFO(stg_sel_14_upd_info); +RTS_INFO(stg_sel_15_upd_info); + +RTS_ENTRY(stg_sel_0_upd_entry); +RTS_ENTRY(stg_sel_1_upd_entry); +RTS_ENTRY(stg_sel_2_upd_entry); +RTS_ENTRY(stg_sel_3_upd_entry); +RTS_ENTRY(stg_sel_4_upd_entry); +RTS_ENTRY(stg_sel_5_upd_entry); +RTS_ENTRY(stg_sel_6_upd_entry); +RTS_ENTRY(stg_sel_7_upd_entry); +RTS_ENTRY(stg_sel_8_upd_entry); +RTS_ENTRY(stg_sel_8_upd_entry); +RTS_ENTRY(stg_sel_9_upd_entry); +RTS_ENTRY(stg_sel_10_upd_entry); +RTS_ENTRY(stg_sel_11_upd_entry); +RTS_ENTRY(stg_sel_12_upd_entry); +RTS_ENTRY(stg_sel_13_upd_entry); +RTS_ENTRY(stg_sel_14_upd_entry); +RTS_ENTRY(stg_sel_15_upd_entry); + +RTS_ENTRY(stg_sel_ret_0_noupd_ret); +RTS_ENTRY(stg_sel_ret_1_noupd_ret); +RTS_ENTRY(stg_sel_ret_2_noupd_ret); +RTS_ENTRY(stg_sel_ret_3_noupd_ret); +RTS_ENTRY(stg_sel_ret_4_noupd_ret); +RTS_ENTRY(stg_sel_ret_5_noupd_ret); +RTS_ENTRY(stg_sel_ret_6_noupd_ret); +RTS_ENTRY(stg_sel_ret_7_noupd_ret); +RTS_ENTRY(stg_sel_ret_8_noupd_ret); +RTS_ENTRY(stg_sel_ret_8_noupd_ret); +RTS_ENTRY(stg_sel_ret_9_noupd_ret); +RTS_ENTRY(stg_sel_ret_10_noupd_ret); +RTS_ENTRY(stg_sel_ret_11_noupd_ret); +RTS_ENTRY(stg_sel_ret_12_noupd_ret); +RTS_ENTRY(stg_sel_ret_13_noupd_ret); +RTS_ENTRY(stg_sel_ret_14_noupd_ret); +RTS_ENTRY(stg_sel_ret_15_noupd_ret); + +RTS_INFO(stg_sel_0_noupd_info); +RTS_INFO(stg_sel_1_noupd_info); +RTS_INFO(stg_sel_2_noupd_info); +RTS_INFO(stg_sel_3_noupd_info); +RTS_INFO(stg_sel_4_noupd_info); +RTS_INFO(stg_sel_5_noupd_info); +RTS_INFO(stg_sel_6_noupd_info); +RTS_INFO(stg_sel_7_noupd_info); +RTS_INFO(stg_sel_8_noupd_info); +RTS_INFO(stg_sel_9_noupd_info); +RTS_INFO(stg_sel_10_noupd_info); +RTS_INFO(stg_sel_11_noupd_info); +RTS_INFO(stg_sel_12_noupd_info); +RTS_INFO(stg_sel_13_noupd_info); +RTS_INFO(stg_sel_14_noupd_info); +RTS_INFO(stg_sel_15_noupd_info); + +RTS_ENTRY(stg_sel_0_noupd_entry); +RTS_ENTRY(stg_sel_1_noupd_entry); +RTS_ENTRY(stg_sel_2_noupd_entry); +RTS_ENTRY(stg_sel_3_noupd_entry); +RTS_ENTRY(stg_sel_4_noupd_entry); +RTS_ENTRY(stg_sel_5_noupd_entry); +RTS_ENTRY(stg_sel_6_noupd_entry); +RTS_ENTRY(stg_sel_7_noupd_entry); +RTS_ENTRY(stg_sel_8_noupd_entry); +RTS_ENTRY(stg_sel_9_noupd_entry); +RTS_ENTRY(stg_sel_10_noupd_entry); +RTS_ENTRY(stg_sel_11_noupd_entry); +RTS_ENTRY(stg_sel_12_noupd_entry); +RTS_ENTRY(stg_sel_13_noupd_entry); +RTS_ENTRY(stg_sel_14_noupd_entry); +RTS_ENTRY(stg_sel_15_noupd_entry); + +/* standard ap thunks */ + +RTS_THUNK_INFO(stg_ap_1_upd_info); +RTS_THUNK_INFO(stg_ap_2_upd_info); +RTS_THUNK_INFO(stg_ap_3_upd_info); +RTS_THUNK_INFO(stg_ap_4_upd_info); +RTS_THUNK_INFO(stg_ap_5_upd_info); +RTS_THUNK_INFO(stg_ap_6_upd_info); +RTS_THUNK_INFO(stg_ap_7_upd_info); + +RTS_ENTRY(stg_ap_1_upd_entry); +RTS_ENTRY(stg_ap_2_upd_entry); +RTS_ENTRY(stg_ap_3_upd_entry); +RTS_ENTRY(stg_ap_4_upd_entry); +RTS_ENTRY(stg_ap_5_upd_entry); +RTS_ENTRY(stg_ap_6_upd_entry); +RTS_ENTRY(stg_ap_7_upd_entry); + +/* standard application routines (see also rts/gen_apply.py, + * and compiler/codeGen/CgStackery.lhs). + */ +RTS_RET_INFO(stg_ap_0_info); +RTS_RET_INFO(stg_ap_v_info); +RTS_RET_INFO(stg_ap_f_info); +RTS_RET_INFO(stg_ap_d_info); +RTS_RET_INFO(stg_ap_l_info); +RTS_RET_INFO(stg_ap_n_info); +RTS_RET_INFO(stg_ap_p_info); +RTS_RET_INFO(stg_ap_pv_info); +RTS_RET_INFO(stg_ap_pp_info); +RTS_RET_INFO(stg_ap_ppv_info); +RTS_RET_INFO(stg_ap_ppp_info); +RTS_RET_INFO(stg_ap_pppv_info); +RTS_RET_INFO(stg_ap_pppp_info); +RTS_RET_INFO(stg_ap_ppppp_info); +RTS_RET_INFO(stg_ap_pppppp_info); + +RTS_ENTRY(stg_ap_0_ret); +RTS_ENTRY(stg_ap_v_ret); +RTS_ENTRY(stg_ap_f_ret); +RTS_ENTRY(stg_ap_d_ret); +RTS_ENTRY(stg_ap_l_ret); +RTS_ENTRY(stg_ap_n_ret); +RTS_ENTRY(stg_ap_p_ret); +RTS_ENTRY(stg_ap_pv_ret); +RTS_ENTRY(stg_ap_pp_ret); +RTS_ENTRY(stg_ap_ppv_ret); +RTS_ENTRY(stg_ap_ppp_ret); +RTS_ENTRY(stg_ap_pppv_ret); +RTS_ENTRY(stg_ap_pppp_ret); +RTS_ENTRY(stg_ap_ppppp_ret); +RTS_ENTRY(stg_ap_pppppp_ret); /* standard GC & stack check entry points, all defined in HeapStackCheck.hc */ -ERI_(stg_enter_info); -EF_(stg_enter_ret); +RTS_RET_INFO(stg_enter_info); +RTS_ENTRY(stg_enter_ret); + +RTS_RET_INFO(stg_gc_void_info); +RTS_ENTRY(stg_gc_void_ret); + +RTS_FUN(__stg_gc_enter_1); + +RTS_FUN(stg_gc_noregs); -ERI_(stg_gc_void_info); +RTS_RET_INFO(stg_gc_unpt_r1_info); +RTS_ENTRY(stg_gc_unpt_r1_ret); +RTS_FUN(stg_gc_unpt_r1); -EF_(__stg_gc_enter_1); +RTS_RET_INFO(stg_gc_unbx_r1_info); +RTS_ENTRY(stg_gc_unbx_r1_ret); +RTS_FUN(stg_gc_unbx_r1); -EF_(stg_gc_noregs); +RTS_RET_INFO(stg_gc_f1_info); +RTS_ENTRY(stg_gc_f1_ret); +RTS_FUN(stg_gc_f1); -ERI_(stg_gc_unpt_r1_info); -EF_(stg_gc_unpt_r1); +RTS_RET_INFO(stg_gc_d1_info); +RTS_ENTRY(stg_gc_d1_ret); +RTS_FUN(stg_gc_d1); -ERI_(stg_gc_unbx_r1_info); -EF_(stg_gc_unbx_r1); +RTS_RET_INFO(stg_gc_l1_info); +RTS_ENTRY(stg_gc_l1_ret); +RTS_FUN(stg_gc_l1); -ERI_(stg_gc_f1_info); -EF_(stg_gc_f1); +RTS_FUN(__stg_gc_fun); +RTS_RET_INFO(stg_gc_fun_info); +RTS_ENTRY(stg_gc_fun_ret); -ERI_(stg_gc_d1_info); -EF_(stg_gc_d1); +RTS_RET_INFO(stg_gc_gen_info); +RTS_ENTRY(stg_gc_gen_ret); +RTS_FUN(stg_gc_gen); -ERI_(stg_gc_l1_info); -EF_(stg_gc_l1); +RTS_ENTRY(stg_ut_1_0_unreg_ret); +RTS_RET_INFO(stg_ut_1_0_unreg_info); -EF_(__stg_gc_fun); -ERI_(stg_gc_fun_info); -EF_(stg_gc_fun_ret); +RTS_FUN(stg_gc_gen_hp); +RTS_FUN(stg_gc_ut); +RTS_FUN(stg_gen_yield); +RTS_FUN(stg_yield_noregs); +RTS_FUN(stg_yield_to_interpreter); +RTS_FUN(stg_gen_block); +RTS_FUN(stg_block_noregs); +RTS_FUN(stg_block_1); +RTS_FUN(stg_block_takemvar); +RTS_ENTRY(stg_block_takemvar_ret); +RTS_FUN(stg_block_putmvar); +RTS_ENTRY(stg_block_putmvar_ret); +#ifdef mingw32_TARGET_OS +RTS_FUN(stg_block_async); +#endif + +/* Entry/exit points from StgStartup.cmm */ + +RTS_RET_INFO(stg_stop_thread_info); +RTS_ENTRY(stg_stop_thread_ret); + +RTS_FUN(stg_returnToStackTop); +RTS_FUN(stg_enterStackTop); + +RTS_FUN(stg_init_finish); +RTS_FUN(stg_init); + +/* ----------------------------------------------------------------------------- + PrimOps + -------------------------------------------------------------------------- */ + +RTS_FUN(plusIntegerzh_fast); +RTS_FUN(minusIntegerzh_fast); +RTS_FUN(timesIntegerzh_fast); +RTS_FUN(gcdIntegerzh_fast); +RTS_FUN(quotRemIntegerzh_fast); +RTS_FUN(quotIntegerzh_fast); +RTS_FUN(remIntegerzh_fast); +RTS_FUN(divExactIntegerzh_fast); +RTS_FUN(divModIntegerzh_fast); + +RTS_FUN(cmpIntegerIntzh_fast); +RTS_FUN(cmpIntegerzh_fast); +RTS_FUN(integer2Intzh_fast); +RTS_FUN(integer2Wordzh_fast); +RTS_FUN(gcdIntegerIntzh_fast); +RTS_FUN(gcdIntzh_fast); + +RTS_FUN(int2Integerzh_fast); +RTS_FUN(word2Integerzh_fast); + +RTS_FUN(decodeFloatzh_fast); +RTS_FUN(decodeDoublezh_fast); + +RTS_FUN(andIntegerzh_fast); +RTS_FUN(orIntegerzh_fast); +RTS_FUN(xorIntegerzh_fast); +RTS_FUN(complementIntegerzh_fast); + +#ifdef SUPPORT_LONG_LONGS + +RTS_FUN(int64ToIntegerzh_fast); +RTS_FUN(word64ToIntegerzh_fast); + +#endif -EF_(stg_gc_gen); -ERI_(stg_gc_gen_info); +RTS_FUN(unsafeThawArrayzh_fast); +RTS_FUN(newByteArrayzh_fast); +RTS_FUN(newPinnedByteArrayzh_fast); +RTS_FUN(newArrayzh_fast); -EF_(stg_ut_1_0_unreg_ret); -ERI_(stg_ut_1_0_unreg_info); +RTS_FUN(decodeFloatzh_fast); +RTS_FUN(decodeDoublezh_fast); -EF_(stg_gc_gen_hp); -EF_(stg_gc_ut); -EF_(stg_gen_yield); -EF_(stg_yield_noregs); -EF_(stg_yield_to_interpreter); -EF_(stg_gen_block); -EF_(stg_block_noregs); -EF_(stg_block_1); -EF_(stg_block_takemvar); -EF_(stg_block_putmvar); +RTS_FUN(newMutVarzh_fast); +RTS_FUN(atomicModifyMutVarzh_fast); + +RTS_FUN(isEmptyMVarzh_fast); +RTS_FUN(newMVarzh_fast); +RTS_FUN(takeMVarzh_fast); +RTS_FUN(putMVarzh_fast); +RTS_FUN(tryTakeMVarzh_fast); +RTS_FUN(tryPutMVarzh_fast); + +RTS_FUN(waitReadzh_fast); +RTS_FUN(waitWritezh_fast); +RTS_FUN(delayzh_fast); #ifdef mingw32_TARGET_OS -EF_(stg_block_async); +RTS_FUN(asyncReadzh_fast); +RTS_FUN(asyncWritezh_fast); +RTS_FUN(asyncDoProczh_fast); #endif + +RTS_FUN(catchzh_fast); +RTS_FUN(raisezh_fast); +RTS_FUN(raiseIOzh_fast); + +RTS_FUN(makeStableNamezh_fast); +RTS_FUN(makeStablePtrzh_fast); +RTS_FUN(deRefStablePtrzh_fast); + +RTS_FUN(forkzh_fast); +RTS_FUN(yieldzh_fast); +RTS_FUN(killThreadzh_fast); +RTS_FUN(blockAsyncExceptionszh_fast); +RTS_FUN(unblockAsyncExceptionszh_fast); +RTS_FUN(myThreadIdzh_fast); +RTS_FUN(labelThreadzh_fast); +RTS_FUN(isCurrentThreadBoundzh_fast); + +RTS_FUN(mkWeakzh_fast); +RTS_FUN(finalizzeWeakzh_fast); +RTS_FUN(deRefWeakzh_fast); + +RTS_FUN(mkForeignObjzh_fast); + +RTS_FUN(newBCOzh_fast); +RTS_FUN(mkApUpd0zh_fast); + +#endif /* STGMISCCLOSURES_H */ diff --git a/ghc/includes/StgProf.h b/ghc/includes/StgProf.h index 165475d811..26ee622e67 100644 --- a/ghc/includes/StgProf.h +++ b/ghc/includes/StgProf.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgProf.h,v 1.17 2003/11/12 17:27:04 sof Exp $ + * $Id: StgProf.h,v 1.18 2004/08/13 13:09:37 simonmar Exp $ * * (c) The GHC Team, 1998 * @@ -13,38 +13,34 @@ * Data Structures * ---------------------------------------------------------------------------*/ typedef struct _CostCentre { - int ccID; + StgInt ccID; - char *label; - char *module; + char * label; + char * module; /* used for accumulating costs at the end of the run... */ - unsigned long time_ticks; - ullong mem_alloc; + StgWord time_ticks; + StgWord64 mem_alloc; - char is_caf; + StgInt is_caf; struct _CostCentre *link; } CostCentre; typedef struct _CostCentreStack { - int ccsID; + StgInt ccsID; CostCentre *cc; struct _CostCentreStack *prevStack; struct _IndexTable *indexTable; - unsigned int selected; - - ullong scc_count; - - unsigned long time_ticks; - - ullong mem_alloc; - - unsigned long inherited_ticks; - ullong inherited_alloc; + StgWord selected; + StgWord64 scc_count; + StgWord time_ticks; + StgWord64 mem_alloc; + StgWord inherited_ticks; + StgWord64 inherited_alloc; CostCentre *root; } CostCentreStack; @@ -85,8 +81,30 @@ typedef struct _IndexTable { Pre-defined cost centres and cost centre stacks -------------------------------------------------------------------------- */ -extern CostCentreStack *CCCS; /* current CCS */ +extern CostCentreStack * RTS_VAR(CCCS); /* current CCS */ +#if IN_STG_CODE + +extern StgWord CC_MAIN[]; +extern StgWord CCS_MAIN[]; /* Top CCS */ + +extern StgWord CC_SYSTEM[]; +extern StgWord CCS_SYSTEM[]; /* RTS costs */ + +extern StgWord CC_GC[]; +extern StgWord CCS_GC[]; /* Garbage collector costs */ + +extern StgWord CC_SUBSUMED[]; +extern StgWord CCS_SUBSUMED[]; /* Costs are subsumed by caller */ + +extern StgWord CC_OVERHEAD[]; +extern StgWord CCS_OVERHEAD[]; /* Profiling overhead */ + +extern StgWord CC_DONT_CARE[]; +extern StgWord CCS_DONT_CARE[]; /* shouldn't ever get set */ + +#else + extern CostCentre CC_MAIN[]; extern CostCentreStack CCS_MAIN[]; /* Top CCS */ @@ -105,19 +123,23 @@ extern CostCentreStack CCS_OVERHEAD[]; /* Profiling overhead */ extern CostCentre CC_DONT_CARE[]; extern CostCentreStack CCS_DONT_CARE[]; /* shouldn't ever get set */ -extern unsigned int CC_ID; /* global ids */ -extern unsigned int CCS_ID; -extern unsigned int HP_ID; +#endif // IN_STG_CODE + +extern unsigned int RTS_VAR(CC_ID); /* global ids */ +extern unsigned int RTS_VAR(CCS_ID); +extern unsigned int RTS_VAR(HP_ID); + +extern unsigned int RTS_VAR(era); /* ----------------------------------------------------------------------------- * Functions * ---------------------------------------------------------------------------*/ -CostCentreStack *EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn ); +void EnterFunCCS ( CostCentreStack *ccsfn ); CostCentreStack *PushCostCentre ( CostCentreStack *, CostCentre * ); CostCentreStack *AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ); -extern unsigned int entering_PAP; +extern unsigned int RTS_VAR(entering_PAP); /* ----------------------------------------------------------------------------- * Registering CCs @@ -142,8 +164,8 @@ extern unsigned int entering_PAP; -------------------------------------------------------------------------- */ -extern CostCentre *CC_LIST; /* registered CC list */ -extern CostCentreStack *CCS_LIST; /* registered CCS list */ +extern CostCentre * RTS_VAR(CC_LIST); /* registered CC list */ +extern CostCentreStack * RTS_VAR(CCS_LIST); /* registered CCS list */ #define REGISTER_CC(cc) \ do { \ @@ -208,7 +230,7 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ /* Restore the CCCS from a stack frame. * (addr should always be Sp->header.prof.ccs) */ -#define RESTORE_CCCS(addr) (CCCS = (CostCentreStack *)(addr)) +#define RESTORE_CCCS(addr) (*CCCS = (CostCentreStack *)(addr)) /* ----------------------------------------------------------------------------- * Pushing a new cost centre (i.e. for scc annotations) @@ -291,7 +313,7 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ #define ENTER_CCS_T(ccs) \ do { \ - CCCS = (CostCentreStack *)(ccs); \ + *CCCS = (CostCentreStack *)(ccs); \ CCCS_DETAIL_COUNT(CCCS->thunk_count); \ } while(0) @@ -305,12 +327,7 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ * (b) The CCS is CAF-ish. * -------------------------------------------------------------------------- */ -#define ENTER_CCS_F(stack) \ - do { \ - CostCentreStack *ccs = (CostCentreStack *) (stack); \ - CCCS_DETAIL_COUNT(CCCS->function_count); \ - CCCS = EnterFunCCS(CCCS,ccs); \ - } while(0) +#define ENTER_CCS_F(stack) EnterFunCCS(stack) #define ENTER_CCS_FCL(closure) ENTER_CCS_F(CCS_HDR(closure)) @@ -343,7 +360,7 @@ extern CostCentreStack *CCS_LIST; /* registered CCS list */ #define ENTER_CCS_PAP(stack) \ do { \ ENTER_CCS_F(stack); \ - entering_PAP = rtsTrue; \ + *entering_PAP = rtsTrue; \ } while(0) #define ENTER_CCS_PAP_CL(closure) \ diff --git a/ghc/includes/StgStorage.h b/ghc/includes/StgStorage.h deleted file mode 100644 index 5c0ca12a51..0000000000 --- a/ghc/includes/StgStorage.h +++ /dev/null @@ -1,121 +0,0 @@ -/* ----------------------------------------------------------------------------- - * $Id: StgStorage.h,v 1.12 2003/03/26 17:40:58 sof Exp $ - * - * (c) The GHC Team, 1998-1999 - * - * STG Storage Manager Interface - * - * ---------------------------------------------------------------------------*/ - -#ifndef STGSTORAGE_H -#define STGSTORAGE_H - -/* GENERATION GC NOTES - * - * We support an arbitrary number of generations, with an arbitrary number - * of steps per generation. Notes (in no particular order): - * - * - all generations except the oldest should have two steps. This gives - * objects a decent chance to age before being promoted, and in - * particular will ensure that we don't end up with too many - * thunks being updated in older generations. - * - * - the oldest generation has one step. There's no point in aging - * objects in the oldest generation. - * - * - generation 0, step 0 (G0S0) is the allocation area. It is given - * a fixed set of blocks during initialisation, and these blocks - * are never freed. - * - * - during garbage collection, each step which is an evacuation - * destination (i.e. all steps except G0S0) is allocated a to-space. - * evacuated objects are allocated into the step's to-space until - * GC is finished, when the original step's contents may be freed - * and replaced by the to-space. - * - * - the mutable-list is per-generation (not per-step). G0 doesn't - * have one (since every garbage collection collects at least G0). - * - * - block descriptors contain pointers to both the step and the - * generation that the block belongs to, for convenience. - * - * - static objects are stored in per-generation lists. See GC.c for - * details of how we collect CAFs in the generational scheme. - * - * - large objects are per-step, and are promoted in the same way - * as small objects, except that we may allocate large objects into - * generation 1 initially. - */ - -typedef struct _step { - unsigned int no; /* step number */ - bdescr * blocks; /* blocks in this step */ - unsigned int n_blocks; /* number of blocks */ - struct _step * to; /* destination step for live objects */ - struct _generation * gen; /* generation this step belongs to */ - unsigned int gen_no; /* generation number (cached) */ - bdescr * large_objects; /* large objects (doubly linked) */ - unsigned int n_large_blocks; /* no. of blocks used by large objs */ - int is_compacted; /* compact this step? (old gen only) */ - - /* temporary use during GC: */ - StgPtr hp; /* next free locn in to-space */ - StgPtr hpLim; /* end of current to-space block */ - bdescr * hp_bd; /* bdescr of current to-space block */ - bdescr * to_blocks; /* bdescr of first to-space block */ - unsigned int n_to_blocks; /* number of blocks in to-space */ - bdescr * scan_bd; /* block currently being scanned */ - StgPtr scan; /* scan pointer in current block */ - bdescr * new_large_objects; /* large objects collected so far */ - bdescr * scavenged_large_objects; /* live large objs after GC (d-link) */ - unsigned int n_scavenged_large_blocks;/* size of above */ - bdescr * bitmap; /* bitmap for compacting collection */ -} step; - -typedef struct _generation { - unsigned int no; /* generation number */ - step * steps; /* steps */ - unsigned int n_steps; /* number of steps */ - unsigned int max_blocks; /* max blocks in step 0 */ - StgMutClosure *mut_list; /* mut objects in this gen (not G0)*/ - StgMutClosure *mut_once_list; /* objects that point to younger gens */ - - /* temporary use during GC: */ - StgMutClosure * saved_mut_list; - - /* stats information */ - unsigned int collections; - unsigned int failed_promotions; -} generation; - -/* ----------------------------------------------------------------------------- - Allocation area for compiled code - - OpenNursery(hp,hplim) Opens the allocation area, and sets hp - and hplim appropriately. - - CloseNursery(hp) Closes the allocation area. - - -------------------------------------------------------------------------- */ - -#define OpenNursery(hp,hplim) \ - (hp = CurrentNursery->free-1, \ - hplim = CurrentNursery->start + CurrentNursery->blocks*BLOCK_SIZE_W - 1) - -#define CloseNursery(hp) (CurrentNursery->free = (P_)(hp)+1) - -/* ----------------------------------------------------------------------------- - Prototype for an evacuate-like function - -------------------------------------------------------------------------- */ - -typedef void (*evac_fn)(StgClosure **); - -/* ----------------------------------------------------------------------------- - Trigger a GC from Haskell land. - -------------------------------------------------------------------------- */ - -extern void performGC(void); -extern void performMajorGC(void); -extern void performGCWithRoots(void (*get_roots)(evac_fn)); - -#endif /* STGSTORAGE_H */ diff --git a/ghc/includes/StgTicky.h b/ghc/includes/StgTicky.h index 22e26060be..c39c0ce477 100644 --- a/ghc/includes/StgTicky.h +++ b/ghc/includes/StgTicky.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: StgTicky.h,v 1.15 2003/07/28 15:59:09 simonmar Exp $ + * $Id: StgTicky.h,v 1.16 2004/08/13 13:09:38 simonmar Exp $ * * (c) The AQUA project, Glasgow University, 1994-1997 * (c) The GHC Team, 1998-1999 @@ -11,6 +11,23 @@ #ifndef TICKY_H #define TICKY_H +/* ----------------------------------------------------------------------------- + The StgEntCounter type - needed regardless of TICKY_TICKY + -------------------------------------------------------------------------- */ + +typedef struct _StgEntCounter { + StgWord16 registeredp; /* 0 == no, 1 == yes */ + StgWord16 arity; /* arity (static info) */ + StgWord16 stk_args; /* # of args off stack */ + /* (rest of args are in registers) */ + char *str; /* name of the thing */ + char *arg_kinds; /* info about the args types */ + StgInt entry_count; /* Trips to fast entry code */ + StgInt allocs; /* number of allocations by this fun */ + struct _StgEntCounter *link;/* link to chain them all together */ +} StgEntCounter; + + #ifdef TICKY_TICKY /* ----------------------------------------------------------------------------- @@ -77,6 +94,8 @@ ALLOC_BH_gds += (g); ALLOC_BH_slp += (s); \ TICK_ALLOC_HISTO(BH,_HS,g,s) +// admin size doesn't take into account the FUN, that is accounted for +// in the "goods". #define TICK_ALLOC_PAP(g,s) \ ALLOC_PAP_ctr++; ALLOC_PAP_adm += sizeofW(StgPAP)-1; \ ALLOC_PAP_gds += (g); ALLOC_PAP_slp += (s); \ @@ -138,18 +157,6 @@ #define TICK_ENT_STATIC_THK() ENT_STATIC_THK_ctr++ #define TICK_ENT_DYN_THK() ENT_DYN_THK_ctr++ -typedef struct _StgEntCounter { - unsigned registeredp:16, /* 0 == no, 1 == yes */ - arity:16, /* arity (static info) */ - stk_args:16; /* # of args off stack */ - /* (rest of args are in registers) */ - char *str; /* name of the thing */ - char *arg_kinds; /* info about the args types */ - I_ entry_count; /* Trips to fast entry code */ - I_ allocs; /* number of allocations by this fun */ - struct _StgEntCounter *link;/* link to chain them all together */ -} StgEntCounter; - #define TICK_CTR(f_ct, str, arity, args, arg_kinds) \ static StgEntCounter f_ct \ = { 0, arity, args, \ @@ -196,16 +203,65 @@ extern StgEntCounter *ticky_entry_ctrs; SLOW_CALL_hst[((__idx > 8) ? 8 : __idx)] += 1; \ } -// A slow call with n arguments -#define TICK_SLOW_CALL(n) SLOW_CALL_ctr++; \ - TICK_SLOW_HISTO(n) - -// A slow call to a FUN found insufficient arguments, and built a PAP -#define TICK_SLOW_CALL_BUILT_PAP() SLOW_CALL_BUILT_PAP_ctr++ +#define UNDO_TICK_SLOW_HISTO(n) \ + { unsigned __idx; \ + __idx = (n); \ + SLOW_CALL_hst[((__idx > 8) ? 8 : __idx)] -= 1; \ + } -// A slow call to a PAP found insufficient arguments, and build a new PAP -#define TICK_SLOW_CALL_NEW_PAP() SLOW_CALL_NEW_PAP_ctr++ +// A slow call with n arguments. In the unevald case, this call has +// already been counted once, so don't count it again. +#define TICK_SLOW_CALL(n) \ + SLOW_CALL_ctr++; \ + TICK_SLOW_HISTO(n) + +// This slow call was found to be to an unevaluated function; undo the +// ticks we did in TICK_SLOW_CALL. +#define TICK_SLOW_CALL_UNEVALD(n) \ + SLOW_CALL_UNEVALD_ctr++; \ + SLOW_CALL_ctr--; \ + UNDO_TICK_SLOW_HISTO(n) + +#define TICK_MULTI_CHUNK_SLOW_CALL(pattern, chunks) \ + fprintf(stderr, "Multi-chunk slow call: %s\n", pattern); \ + MULTI_CHUNK_SLOW_CALL_ctr++; \ + MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr += chunks; + +// A completely unknown tail-call +#define TICK_UNKNOWN_CALL() UNKNOWN_CALL_ctr++ + +// slow call patterns (includes "extra" args to known calls, +// so the total of these will be greater than UNKNOWN_CALL_ctr). +#define TICK_SLOW_CALL_v() SLOW_CALL_v_ctr++ +#define TICK_SLOW_CALL_f() SLOW_CALL_f_ctr++ +#define TICK_SLOW_CALL_d() SLOW_CALL_d_ctr++ +#define TICK_SLOW_CALL_l() SLOW_CALL_l_ctr++ +#define TICK_SLOW_CALL_n() SLOW_CALL_n_ctr++ +#define TICK_SLOW_CALL_p() SLOW_CALL_p_ctr++ +#define TICK_SLOW_CALL_pv() SLOW_CALL_pv_ctr++ +#define TICK_SLOW_CALL_pp() SLOW_CALL_pp_ctr++ +#define TICK_SLOW_CALL_ppv() SLOW_CALL_ppv_ctr++ +#define TICK_SLOW_CALL_ppp() SLOW_CALL_ppp_ctr++ +#define TICK_SLOW_CALL_pppv() SLOW_CALL_pppv_ctr++ +#define TICK_SLOW_CALL_pppp() SLOW_CALL_pppp_ctr++ +#define TICK_SLOW_CALL_ppppp() SLOW_CALL_ppppp_ctr++ +#define TICK_SLOW_CALL_pppppp() SLOW_CALL_pppppp_ctr++ +#define TICK_SLOW_CALL_OTHER(pattern) \ + fprintf(stderr,"slow call: %s\n", pattern); \ + SLOW_CALL_OTHER_ctr++ + +#define TICK_KNOWN_CALL() KNOWN_CALL_ctr++ +#define TICK_KNOWN_CALL_TOO_FEW_ARGS() KNOWN_CALL_TOO_FEW_ARGS_ctr++ +#define TICK_KNOWN_CALL_EXTRA_ARGS() KNOWN_CALL_EXTRA_ARGS_ctr++ +// A slow call to a FUN found insufficient arguments, and built a PAP +#define TICK_SLOW_CALL_FUN_TOO_FEW() SLOW_CALL_FUN_TOO_FEW_ctr++ +#define TICK_SLOW_CALL_FUN_CORRECT() SLOW_CALL_FUN_CORRECT_ctr++ +#define TICK_SLOW_CALL_FUN_TOO_MANY() SLOW_CALL_FUN_TOO_MANY_ctr++ +#define TICK_SLOW_CALL_PAP_TOO_FEW() SLOW_CALL_PAP_TOO_FEW_ctr++ +#define TICK_SLOW_CALL_PAP_CORRECT() SLOW_CALL_PAP_CORRECT_ctr++ +#define TICK_SLOW_CALL_PAP_TOO_MANY() SLOW_CALL_PAP_TOO_MANY_ctr++ + /* ----------------------------------------------------------------------------- Returns -------------------------------------------------------------------------- */ @@ -475,9 +531,38 @@ EXTERN unsigned long ENT_AP_ctr INIT(0); EXTERN unsigned long ENT_AP_STACK_ctr INIT(0); EXTERN unsigned long ENT_BH_ctr INIT(0); +EXTERN unsigned long UNKNOWN_CALL_ctr INIT(0); + +EXTERN unsigned long SLOW_CALL_v_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_f_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_d_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_l_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_n_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_p_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pv_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_ppv_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_ppp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pppv_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pppp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_ppppp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pppppp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_OTHER_ctr INIT(0); + +EXTERN unsigned long ticky_slow_call_unevald INIT(0); EXTERN unsigned long SLOW_CALL_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_BUILT_PAP_ctr INIT(0); -EXTERN unsigned long SLOW_CALL_NEW_PAP_ctr INIT(0); +EXTERN unsigned long MULTI_CHUNK_SLOW_CALL_ctr INIT(0); +EXTERN unsigned long MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr INIT(0); +EXTERN unsigned long KNOWN_CALL_ctr INIT(0); +EXTERN unsigned long KNOWN_CALL_TOO_FEW_ARGS_ctr INIT(0); +EXTERN unsigned long KNOWN_CALL_EXTRA_ARGS_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_FUN_TOO_FEW_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_FUN_CORRECT_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_FUN_TOO_MANY_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_PAP_TOO_FEW_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_PAP_CORRECT_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_PAP_TOO_MANY_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_UNEVALD_ctr INIT(0); EXTERN unsigned long SLOW_CALL_hst[8] #ifdef TICKY_C @@ -608,8 +693,34 @@ EXTERN unsigned long GC_WORDS_COPIED_ctr INIT(0); #define TICK_ENT_BH() #define TICK_SLOW_CALL(n) -#define TICK_SLOW_CALL_BUILT_PAP() -#define TICK_SLOW_CALL_NEW_PAP() +#define TICK_SLOW_CALL_UNEVALD(n) +#define TICK_SLOW_CALL_FUN_TOO_FEW() +#define TICK_SLOW_CALL_FUN_CORRECT() +#define TICK_SLOW_CALL_FUN_TOO_MANY() +#define TICK_SLOW_CALL_PAP_TOO_FEW() +#define TICK_SLOW_CALL_PAP_CORRECT() +#define TICK_SLOW_CALL_PAP_TOO_MANY() + +#define TICK_SLOW_CALL_v() +#define TICK_SLOW_CALL_f() +#define TICK_SLOW_CALL_d() +#define TICK_SLOW_CALL_l() +#define TICK_SLOW_CALL_n() +#define TICK_SLOW_CALL_p() +#define TICK_SLOW_CALL_pv() +#define TICK_SLOW_CALL_pp() +#define TICK_SLOW_CALL_ppv() +#define TICK_SLOW_CALL_ppp() +#define TICK_SLOW_CALL_pppv() +#define TICK_SLOW_CALL_pppp() +#define TICK_SLOW_CALL_ppppp() +#define TICK_SLOW_CALL_pppppp() +#define TICK_SLOW_CALL_OTHER(pattern) + +#define TICK_KNOWN_CALL() +#define TICK_KNOWN_CALL_TOO_FEW_ARGS() +#define TICK_KNOWN_CALL_EXTRA_ARGS() +#define TICK_UNKNOWN_CALL() #define TICK_RET_NEW(n) #define TICK_RET_OLD(n) diff --git a/ghc/includes/StgTypes.h b/ghc/includes/StgTypes.h index 2492046324..ae9eec5334 100644 --- a/ghc/includes/StgTypes.h +++ b/ghc/includes/StgTypes.h @@ -1,10 +1,9 @@ /* ----------------------------------------------------------------------------- - * $Id: StgTypes.h,v 1.20 2003/11/12 17:27:05 sof Exp $ * - * (c) The GHC Team, 1998-2000 + * (c) The GHC Team, 1998-2004 * * Various C datatypes used in the run-time system. This is the - * lowest-level include file, after config.h and Derived.h. + * lowest-level include file, after ghcconfig.h and RtsConfig.h. * * This module should define types *only*, all beginning with "Stg". * @@ -27,7 +26,7 @@ * WARNING: Keep this file, MachDeps.h, and HsFFI.h in synch! * - * NOTE: assumes #include "config.h" + * NOTE: assumes #include "ghcconfig.h" * * Works with or without _POSIX_SOURCE. * @@ -36,8 +35,6 @@ #ifndef STGTYPES_H #define STGTYPES_H -#include "Derived.h" - /* * First, platform-dependent definitions of size-specific integers. * Assume for now that the int type is 32 bits. @@ -150,18 +147,4 @@ typedef void* StgStablePtr; typedef void *(*(*StgFunPtr)(void))(void); typedef StgFunPtr StgFun(void); -typedef union { - StgWord w; - StgAddr a; - StgChar c; - StgInt8 i8; - StgFloat f; - StgInt i; - StgPtr p; - StgClosurePtr cl; - StgStackOffset offset; /* unused? */ - StgByteArray b; - StgTSOPtr t; -} StgUnion; - #endif /* STGTYPES_H */ diff --git a/ghc/includes/Storage.h b/ghc/includes/Storage.h new file mode 100644 index 0000000000..861cbeb434 --- /dev/null +++ b/ghc/includes/Storage.h @@ -0,0 +1,411 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * External Storage Manger Interface + * + * ---------------------------------------------------------------------------*/ + +#ifndef STORAGE_H +#define STORAGE_H + +#include <stddef.h> + +/* ----------------------------------------------------------------------------- + * Generational GC + * + * We support an arbitrary number of generations, with an arbitrary number + * of steps per generation. Notes (in no particular order): + * + * - all generations except the oldest should have two steps. This gives + * objects a decent chance to age before being promoted, and in + * particular will ensure that we don't end up with too many + * thunks being updated in older generations. + * + * - the oldest generation has one step. There's no point in aging + * objects in the oldest generation. + * + * - generation 0, step 0 (G0S0) is the allocation area. It is given + * a fixed set of blocks during initialisation, and these blocks + * are never freed. + * + * - during garbage collection, each step which is an evacuation + * destination (i.e. all steps except G0S0) is allocated a to-space. + * evacuated objects are allocated into the step's to-space until + * GC is finished, when the original step's contents may be freed + * and replaced by the to-space. + * + * - the mutable-list is per-generation (not per-step). G0 doesn't + * have one (since every garbage collection collects at least G0). + * + * - block descriptors contain pointers to both the step and the + * generation that the block belongs to, for convenience. + * + * - static objects are stored in per-generation lists. See GC.c for + * details of how we collect CAFs in the generational scheme. + * + * - large objects are per-step, and are promoted in the same way + * as small objects, except that we may allocate large objects into + * generation 1 initially. + * + * ------------------------------------------------------------------------- */ + +typedef struct _step { + unsigned int no; /* step number */ + bdescr * blocks; /* blocks in this step */ + unsigned int n_blocks; /* number of blocks */ + struct _step * to; /* destination step for live objects */ + struct _generation * gen; /* generation this step belongs to */ + unsigned int gen_no; /* generation number (cached) */ + bdescr * large_objects; /* large objects (doubly linked) */ + unsigned int n_large_blocks; /* no. of blocks used by large objs */ + int is_compacted; /* compact this step? (old gen only) */ + + /* temporary use during GC: */ + StgPtr hp; /* next free locn in to-space */ + StgPtr hpLim; /* end of current to-space block */ + bdescr * hp_bd; /* bdescr of current to-space block */ + bdescr * to_blocks; /* bdescr of first to-space block */ + unsigned int n_to_blocks; /* number of blocks in to-space */ + bdescr * scan_bd; /* block currently being scanned */ + StgPtr scan; /* scan pointer in current block */ + bdescr * new_large_objects; /* large objects collected so far */ + bdescr * scavenged_large_objects; /* live large objs after GC (d-link) */ + unsigned int n_scavenged_large_blocks;/* size of above */ + bdescr * bitmap; /* bitmap for compacting collection */ +} step; + +typedef struct _generation { + unsigned int no; /* generation number */ + step * steps; /* steps */ + unsigned int n_steps; /* number of steps */ + unsigned int max_blocks; /* max blocks in step 0 */ + StgMutClosure *mut_list; /* mut objects in this gen (not G0)*/ + StgMutClosure *mut_once_list; /* objects that point to younger gens */ + + /* temporary use during GC: */ + StgMutClosure * saved_mut_list; + + /* stats information */ + unsigned int collections; + unsigned int failed_promotions; +} generation; + +extern generation * RTS_VAR(generations); + +extern generation * RTS_VAR(g0); +extern step * RTS_VAR(g0s0); +extern generation * RTS_VAR(oldest_gen); + +/* ----------------------------------------------------------------------------- + Initialisation / De-initialisation + -------------------------------------------------------------------------- */ + +extern void initStorage(void); +extern void exitStorage(void); + +/* ----------------------------------------------------------------------------- + Generic allocation + + StgPtr allocate(nat n) Allocates a chunk of contiguous store + n words long, returning a pointer to + the first word. Always succeeds. + + StgPtr allocatePinned(nat n) Allocates a chunk of contiguous store + n words long, which is at a fixed + address (won't be moved by GC). + Returns a pointer to the first word. + Always succeeds. + + NOTE: the GC can't in general handle + pinned objects, so allocatePinned() + can only be used for ByteArrays at the + moment. + + Don't forget to TICK_ALLOC_XXX(...) + after calling allocate or + allocatePinned, for the + benefit of the ticky-ticky profiler. + + rtsBool doYouWantToGC(void) Returns True if the storage manager is + ready to perform a GC, False otherwise. + + lnat allocated_bytes(void) Returns the number of bytes allocated + via allocate() since the last GC. + Used in the reporting of statistics. + + SMP: allocate and doYouWantToGC can be used from STG code, they are + surrounded by a mutex. + -------------------------------------------------------------------------- */ + +extern StgPtr allocate ( nat n ); +extern StgPtr allocatePinned ( nat n ); +extern lnat allocated_bytes ( void ); + +extern bdescr * RTS_VAR(small_alloc_list); +extern bdescr * RTS_VAR(large_alloc_list); +extern bdescr * RTS_VAR(pinned_object_block); + +extern StgPtr RTS_VAR(alloc_Hp); +extern StgPtr RTS_VAR(alloc_HpLim); + +extern nat RTS_VAR(alloc_blocks); +extern nat RTS_VAR(alloc_blocks_lim); + +INLINE_HEADER rtsBool +doYouWantToGC( void ) +{ + return (alloc_blocks >= alloc_blocks_lim); +} + +/* ----------------------------------------------------------------------------- + Performing Garbage Collection + + GarbageCollect(get_roots) Performs a garbage collection. + 'get_roots' is called to find all the + roots that the system knows about. + + StgClosure Called by get_roots on each root. + MarkRoot(StgClosure *p) Returns the new location of the root. + -------------------------------------------------------------------------- */ + +extern void GarbageCollect(void (*get_roots)(evac_fn),rtsBool force_major_gc); + +/* ----------------------------------------------------------------------------- + Generational garbage collection support + + recordMutable(StgPtr p) Informs the garbage collector that a + previously immutable object has + become (permanently) mutable. Used + by thawArray and similar. + + updateWithIndirection(p1,p2) Updates the object at p1 with an + indirection pointing to p2. This is + normally called for objects in an old + generation (>0) when they are updated. + + updateWithPermIndirection(p1,p2) As above but uses a permanent indir. + + -------------------------------------------------------------------------- */ + +/* + * Storage manager mutex + */ +#if defined(SMP) +extern Mutex sm_mutex; +#define ACQUIRE_SM_LOCK ACQUIRE_LOCK(&sm_mutex) +#define RELEASE_SM_LOCK RELEASE_LOCK(&sm_mutex) +#else +#define ACQUIRE_SM_LOCK +#define RELEASE_SM_LOCK +#endif + +/* ToDo: shouldn't recordMutable and recordOldToNewPtrs acquire some + * kind of lock in the SMP case? + */ +INLINE_HEADER void +recordMutable(StgMutClosure *p) +{ + bdescr *bd; + +#ifdef SMP + ASSERT(p->header.info == &stg_WHITEHOLE_info || closure_MUTABLE(p)); +#else + ASSERT(closure_MUTABLE(p)); +#endif + + bd = Bdescr((P_)p); + if (bd->gen_no > 0) { + p->mut_link = RTS_DEREF(generations)[bd->gen_no].mut_list; + RTS_DEREF(generations)[bd->gen_no].mut_list = p; + } +} + +INLINE_HEADER void +recordOldToNewPtrs(StgMutClosure *p) +{ + bdescr *bd; + + bd = Bdescr((P_)p); + if (bd->gen_no > 0) { + p->mut_link = RTS_DEREF(generations)[bd->gen_no].mut_once_list; + RTS_DEREF(generations)[bd->gen_no].mut_once_list = p; + } +} + +/* ----------------------------------------------------------------------------- + The CAF table - used to let us revert CAFs in GHCi + -------------------------------------------------------------------------- */ + +void revertCAFs( void ); + +/* ----------------------------------------------------------------------------- + DEBUGGING predicates for pointers + + LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr + LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr + + These macros are complete but not sound. That is, they might + return false positives. Do not rely on them to distinguish info + pointers from closure pointers, for example. + + We don't use address-space predicates these days, for portability + reasons, and the fact that code/data can be scattered about the + address space in a dynamically-linked environment. Our best option + is to look at the alleged info table and see whether it seems to + make sense... + -------------------------------------------------------------------------- */ + +#define LOOKS_LIKE_INFO_PTR(p) \ + (p && ((StgInfoTable *)(INFO_PTR_TO_STRUCT(p)))->type != INVALID_OBJECT && \ + ((StgInfoTable *)(INFO_PTR_TO_STRUCT(p)))->type < N_CLOSURE_TYPES) + +#define LOOKS_LIKE_CLOSURE_PTR(p) \ + (LOOKS_LIKE_INFO_PTR(((StgClosure *)(p))->header.info)) + +/* ----------------------------------------------------------------------------- + Macros for calculating how big a closure will be (used during allocation) + -------------------------------------------------------------------------- */ + +INLINE_HEADER StgOffset PAP_sizeW ( nat n_args ) +{ return sizeofW(StgPAP) + n_args; } + +INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size ) +{ return sizeofW(StgAP_STACK) + size; } + +INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np ) +{ return sizeofW(StgHeader) + p + np; } + +INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void ) +{ return sizeofW(StgHeader) + MIN_UPD_SIZE; } + +INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void ) +{ return sizeofW(StgHeader) + MIN_UPD_SIZE; } + +/* -------------------------------------------------------------------------- + Sizes of closures + ------------------------------------------------------------------------*/ + +INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) +{ return sizeofW(StgClosure) + + sizeofW(StgPtr) * itbl->layout.payload.ptrs + + sizeofW(StgWord) * itbl->layout.payload.nptrs; } + +INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x ) +{ return AP_STACK_sizeW(x->size); } + +INLINE_HEADER StgOffset pap_sizeW( StgPAP* x ) +{ return PAP_sizeW(x->n_args); } + +INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x ) +{ return sizeofW(StgArrWords) + x->words; } + +INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x ) +{ return sizeofW(StgMutArrPtrs) + x->ptrs; } + +INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso ) +{ return TSO_STRUCT_SIZEW + tso->stack_size; } + +INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco ) +{ return bco->size; } + +/* ----------------------------------------------------------------------------- + Sizes of stack frames + -------------------------------------------------------------------------- */ + +INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame ) +{ + StgRetInfoTable *info; + + info = get_ret_itbl(frame); + switch (info->i.type) { + + case RET_DYN: + { + StgRetDyn *dyn = (StgRetDyn *)frame; + return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + + RET_DYN_NONPTR_REGS_SIZE + + RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness); + } + + case RET_FUN: + return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size; + + case RET_BIG: + case RET_VEC_BIG: + return 1 + info->i.layout.large_bitmap->size; + + case RET_BCO: + return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]); + + default: + return 1 + BITMAP_SIZE(info->i.layout.bitmap); + } +} + +/* ----------------------------------------------------------------------------- + Nursery manipulation + -------------------------------------------------------------------------- */ + +extern void allocNurseries ( void ); +extern void resetNurseries ( void ); +extern bdescr * allocNursery ( bdescr *last_bd, nat blocks ); +extern void resizeNursery ( nat blocks ); +extern void tidyAllocateLists ( void ); + +/* ----------------------------------------------------------------------------- + MUTABLE LISTS + A mutable list is ended with END_MUT_LIST, so that we can use NULL + as an indication that an object is not on a mutable list. + ------------------------------------------------------------------------- */ + +#define END_MUT_LIST ((StgMutClosure *)(void *)&stg_END_MUT_LIST_closure) + +/* ----------------------------------------------------------------------------- + Functions from GC.c + -------------------------------------------------------------------------- */ + +extern void threadPaused ( StgTSO * ); +extern StgClosure * isAlive ( StgClosure *p ); +extern void markCAFs ( evac_fn evac ); + +/* ----------------------------------------------------------------------------- + Stats 'n' DEBUG stuff + -------------------------------------------------------------------------- */ + +extern lnat RTS_VAR(total_allocated); + +extern lnat calcAllocated ( void ); +extern lnat calcLive ( void ); +extern lnat calcNeeded ( void ); + +#if defined(DEBUG) +extern void memInventory(void); +extern void checkSanity(void); +extern nat countBlocks(bdescr *); +#endif + +#if defined(DEBUG) +void printMutOnceList(generation *gen); +void printMutableList(generation *gen); +#endif + +/* ---------------------------------------------------------------------------- + Storage manager internal APIs and globals + ------------------------------------------------------------------------- */ + +#define END_OF_STATIC_LIST stgCast(StgClosure*,1) + +extern void newDynCAF(StgClosure *); + +extern void move_TSO(StgTSO *src, StgTSO *dest); +extern StgTSO *relocate_stack(StgTSO *dest, ptrdiff_t diff); + +extern StgClosure * RTS_VAR(static_objects); +extern StgClosure * RTS_VAR(scavenged_static_objects); +extern StgWeak * RTS_VAR(old_weak_ptr_list); +extern StgWeak * RTS_VAR(weak_ptr_list); +extern StgClosure * RTS_VAR(caf_list); +extern StgTSO * RTS_VAR(resurrected_threads); + +#endif // STORAGE_H diff --git a/ghc/includes/TSO.h b/ghc/includes/TSO.h index 22f3e530a8..87ea876792 100644 --- a/ghc/includes/TSO.h +++ b/ghc/includes/TSO.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: TSO.h,v 1.34 2004/03/01 14:18:35 simonmar Exp $ + * $Id: TSO.h,v 1.35 2004/08/13 13:09:40 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -36,79 +36,64 @@ typedef struct { } StgTSOStatBuf; #endif -#if defined(PROFILING) +/* + * PROFILING info in a TSO + */ typedef struct { CostCentreStack *CCCS; /* thread's current CCS */ } StgTSOProfInfo; -#else /* !PROFILING */ -# if defined(SUPPORTS_EMPTY_STRUCTS) -typedef struct { - /* empty */ -} StgTSOProfInfo; -# endif -#endif /* PROFILING */ -#if defined(PAR) +/* + * PAR info in a TSO + */ +#ifdef PAR typedef StgTSOStatBuf StgTSOParInfo; -#else /* !PAR */ -# if defined(SUPPORTS_EMPTY_STRUCTS) +#else +#ifdef SUPPORTS_EMPTY_STRUCTS typedef struct { - /* empty */ + /* empty */ } StgTSOParInfo; -# endif -#endif /* PAR */ +#endif +#endif -#if defined(DIST) +/* + * DIST info in a TSO + */ +#ifdef DIST typedef struct { StgThreadPriority priority; StgInt revalTid; /* ToDo: merge both into 1 word */ StgInt revalSlot; } StgTSODistInfo; -#else /* !DIST */ -# if defined(SUPPORTS_EMPTY_STRUCTS) +#else +#ifdef SUPPORTS_EMPTY_STRUCTS typedef struct { - /* empty */ + /* empty */ } StgTSODistInfo; -# endif -#endif /* DIST */ +#endif +#endif -#if defined(GRAN) +/* + * GRAN info in a TSO + */ +#ifdef GRAN typedef StgTSOStatBuf StgTSOGranInfo; -#else /* !GRAN */ -# if defined(SUPPORTS_EMPTY_STRUCTS) +#else +#ifdef SUPPORTS_EMPTY_STRUCTS typedef struct { - /* empty */ + /* empty */ } StgTSOGranInfo; -# endif -#endif /* GRAN */ - +#endif +#endif -#if defined(TICKY) -typedef struct { -} StgTSOTickyInfo; -#else /* !TICKY_TICKY */ -# if defined(SUPPORTS_EMPTY_STRUCTS) +/* + * TICKY_TICKY info in a TSO + */ +#ifdef SUPPORTS_EMPTY_STRUCTS typedef struct { /* empty */ } StgTSOTickyInfo; -# endif -#endif /* TICKY_TICKY */ - -typedef enum { - tso_state_runnable, - tso_state_stopped -} StgTSOState; - -/* - * The what_next field of a TSO indicates how the thread is to be run. - */ -typedef enum { - ThreadRunGHC, /* return to address on top of stack */ - ThreadInterpret, /* interpret this thread */ - ThreadKilled, /* thread has died, don't run it */ - ThreadRelocated, /* thread has moved, link points to new locn */ - ThreadComplete /* thread has finished */ -} StgTSOWhatNext; +#endif /* * Thread IDs are 32 bits. @@ -116,17 +101,11 @@ typedef enum { typedef StgWord32 StgThreadID; /* - * This type is returned to the scheduler by a thread that has - * stopped for one reason or another. + * Type returned after running a thread. Values of this type + * include HeapOverflow, StackOverflow etc. See Constants.h for the + * full list. */ - -typedef enum { - HeapOverflow, /* might also be StackOverflow */ - StackOverflow, - ThreadYielding, - ThreadBlocked, - ThreadFinished -} StgThreadReturnCode; +typedef unsigned int StgThreadReturnCode; /* * We distinguish between the various classes of threads in the system. @@ -138,34 +117,6 @@ typedef enum { RevalPriority } StgThreadPriority; -/* - * Threads may be blocked for several reasons. A blocked thread will - * have the reason in the why_blocked field of the TSO, and some - * further info (such as the closure the thread is blocked on, or the - * file descriptor if the thread is waiting on I/O) in the block_info - * field. - */ - -typedef enum { - NotBlocked, - BlockedOnMVar, - BlockedOnBlackHole, - BlockedOnException, - BlockedOnRead, - BlockedOnWrite, - BlockedOnDelay -#if defined(mingw32_TARGET_OS) - , BlockedOnDoProc -#endif -#if defined(PAR) - , BlockedOnGA // blocked on a remote closure represented by a Global Address - , BlockedOnGA_NoSend // same as above but without sending a Fetch message -#endif - , BlockedOnCCall - , BlockedOnCCall_NoUnblockExc // same as above but don't unblock - // async exceptions in resumeThread() -} StgTSOBlockReason; - #if defined(mingw32_TARGET_OS) /* results from an async I/O request + it's ID. */ typedef struct { @@ -192,30 +143,42 @@ typedef union { */ /* + * Threads may be blocked for several reasons. A blocked thread will + * have the reason in the why_blocked field of the TSO, and some + * further info (such as the closure the thread is blocked on, or the + * file descriptor if the thread is waiting on I/O) in the block_info + * field. + */ + +/* * ToDo: make this structure sensible on a non-32-bit arch. */ typedef struct StgTSO_ { StgHeader header; - struct StgTSO_* link; /* Links threads onto blocking queues */ - StgMutClosure * mut_link; /* TSO's are mutable of course! */ - struct StgTSO_* global_link; /* Links all threads together */ + struct StgTSO_* link; // Links threads onto blocking queues */ + StgMutClosure * mut_link; // TSO's are mutable of course! */ + struct StgTSO_* global_link; // Links all threads together */ - StgTSOWhatNext what_next : 16; - StgTSOBlockReason why_blocked : 16; - StgTSOBlockInfo block_info; - struct StgTSO_* blocked_exceptions; - StgThreadID id; - int saved_errno; - struct StgMainThread_* main; + StgWord16 what_next; // Values defined in Constants.h + StgWord16 why_blocked; // Values defined in Constants.h + StgTSOBlockInfo block_info; + struct StgTSO_* blocked_exceptions; + StgThreadID id; + int saved_errno; +#ifdef TICKY_TICKY MAYBE_EMPTY_STRUCT(StgTSOTickyInfo,ticky) - MAYBE_EMPTY_STRUCT(StgTSOProfInfo,prof) - MAYBE_EMPTY_STRUCT(StgTSOParInfo,par) - MAYBE_EMPTY_STRUCT(StgTSOGranInfo,gran) - MAYBE_EMPTY_STRUCT(StgTSODistInfo,dist) - +#endif +#ifdef PROFILING + StgTSOProfInfo prof; +#endif + + MAYBE_EMPTY_STRUCT(StgTSOParInfo,par); + MAYBE_EMPTY_STRUCT(StgTSOGranInfo,gran); + MAYBE_EMPTY_STRUCT(StgTSODistInfo,dist); + /* The thread stack... */ StgWord stack_size; /* stack size in *words* */ StgWord max_stack_size; /* maximum stack size in *words* */ @@ -300,4 +263,16 @@ extern StgTSO dummy_tso; #define TSO_STRUCT_SIZEW (TSO_STRUCT_SIZE / sizeof(W_)) + +/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */ +#define END_TSO_QUEUE ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure) + +#if defined(PAR) || defined(GRAN) +/* this is the NIL ptr for a blocking queue */ +# define END_BQ_QUEUE ((StgBlockingQueueElement *)(void*)&stg_END_TSO_QUEUE_closure) +/* this is the NIL ptr for a blocked fetch queue (as in PendingFetches in GUM) */ +# define END_BF_QUEUE ((StgBlockedFetch *)(void*)&stg_END_TSO_QUEUE_closure) +#endif +/* ToDo?: different name for end of sleeping queue ? -- HWL */ + #endif /* TSO_H */ diff --git a/ghc/includes/TailCalls.h b/ghc/includes/TailCalls.h index bdcc400309..a61695e758 100644 --- a/ghc/includes/TailCalls.h +++ b/ghc/includes/TailCalls.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: TailCalls.h,v 1.15 2003/10/12 13:24:52 igloo Exp $ + * $Id: TailCalls.h,v 1.16 2004/08/13 13:09:41 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -16,7 +16,7 @@ #ifdef USE_MINIINTERPRETER -#define JMP_(cont) return(stgCast(StgFunPtr,cont)) +#define JMP_(cont) return((StgFunPtr)(cont)) #define FB_ #define FE_ diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h index ebc2e7301d..208c9f00d1 100644 --- a/ghc/includes/Updates.h +++ b/ghc/includes/Updates.h @@ -1,9 +1,8 @@ /* ----------------------------------------------------------------------------- - * $Id: Updates.h,v 1.34 2003/11/12 17:27:06 sof Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * - * Definitions related to updates. + * Performing updates. * * ---------------------------------------------------------------------------*/ @@ -11,20 +10,18 @@ #define UPDATES_H /* ----------------------------------------------------------------------------- - Update a closure with an indirection. This may also involve waking - up a queue of blocked threads waiting on the result of this - computation. - -------------------------------------------------------------------------- */ + Updates -/* ToDo: overwrite slop words with something safe in case sanity checking - * is turned on. - * (I think the fancy version of the GC is supposed to do this too.) - */ + We have two layers of update macros. The top layer, UPD_IND() and + friends perform all the work of an update. In detail: -/* This expands to a fair chunk of code, what with waking up threads - * and checking whether we're updating something in a old generation. - * preferably don't use this macro inline in compiled code. - */ + - if the closure being updated is a blocking queue, then all the + threads waiting on the blocking queue are updated. + + - then the lower level updateWithIndirection() macro is invoked + to actually replace the closure with an indirection (see below). + + -------------------------------------------------------------------------- */ #ifdef TICKY_TICKY # define UPD_IND(updclosure, heapptr) \ @@ -34,96 +31,68 @@ #else # define SEMI ; # define UPD_IND(updclosure, heapptr) \ - UPD_REAL_IND(updclosure,&stg_IND_info,heapptr,SEMI) + UPD_REAL_IND(updclosure,INFO_PTR(stg_IND_info),heapptr,SEMI) # define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \ UPD_REAL_IND(updclosure,ind_info,heapptr,and_then) #endif +/* These macros have to work in both C and C--, so here's the + * impedence matching: + */ +#ifdef CMINUSMINUS +#define DECLARE_IPTR(info) W_ info +#define FCALL foreign "C" +#define INFO_PTR(info) info +#define ARG_PTR "ptr" +#else +#define DECLARE_IPTR(info) const StgInfoTable *(info) +#define FCALL /* nothing */ +#define INFO_PTR(info) &info +#define StgBlockingQueue_blocking_queue(closure) \ + (((StgBlockingQueue *)closure)->blocking_queue) +#define ARG_PTR /* nothing */ +#endif + /* UPD_IND actually does a PERM_IND if TICKY_TICKY is on; if you *really* need an IND use UPD_REAL_IND */ -#ifdef SMP #define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then) \ - { \ - const StgInfoTable *info; \ - if (Bdescr((P_)updclosure)->u.back != (bdescr *)BaseReg) { \ - info = LOCK_CLOSURE(updclosure); \ - } else { \ - info = updclosure->header.info; \ - } \ + DECLARE_IPTR(info); \ + info = GET_INFO(updclosure); \ AWAKEN_BQ(info,updclosure); \ - updateWithIndirection(info, ind_info, \ - (StgClosure *)updclosure, \ - (StgClosure *)heapptr, \ - and_then); \ - } -#else -#define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then) \ - { \ - const StgInfoTable *info; \ - info = ((StgClosure *)updclosure)->header.info; \ - AWAKEN_BQ(info,updclosure); \ - updateWithIndirection(((StgClosure *)updclosure)->header.info, ind_info, \ - (StgClosure *)updclosure, \ - (StgClosure *)heapptr, \ - and_then); \ - } -#endif - -#define UPD_STATIC_IND(updclosure, heapptr) \ - { \ - const StgInfoTable *info; \ - info = ((StgClosure *)updclosure)->header.info; \ - AWAKEN_STATIC_BQ(info,updclosure); \ - updateWithStaticIndirection(info, \ - (StgClosure *)updclosure, \ - (StgClosure *)heapptr); \ - } + updateWithIndirection(GET_INFO(updclosure), ind_info, \ + updclosure, \ + heapptr, \ + and_then); #if defined(PROFILING) || defined(TICKY_TICKY) -#define UPD_PERM_IND(updclosure, heapptr) \ - { \ - const StgInfoTable *info; \ - info = ((StgClosure *)updclosure)->header.info; \ - AWAKEN_BQ(info,updclosure); \ - updateWithPermIndirection(info, \ - (StgClosure *)updclosure, \ - (StgClosure *)heapptr); \ - } +#define UPD_PERM_IND(updclosure, heapptr) \ + DECLARE_IPTR(info); \ + info = GET_INFO(updclosure); \ + AWAKEN_BQ(info,updclosure); \ + updateWithPermIndirection(info, \ + updclosure, \ + heapptr); #endif -#ifdef SMP -#define UPD_IND_NOLOCK(updclosure, heapptr) \ - { \ - const StgInfoTable *info; \ - info = updclosure->header.info; \ - AWAKEN_BQ(info,updclosure); \ - updateWithIndirection(info,&stg_IND_info, \ - (StgClosure *)updclosure, \ - (StgClosure *)heapptr,); \ - } -#elif defined(RTS_SUPPORTS_THREADS) +#if defined(RTS_SUPPORTS_THREADS) # ifdef TICKY_TICKY -# define UPD_IND_NOLOCK(updclosure, heapptr) \ - { \ - const StgInfoTable *info; \ - info = ((StgClosure *)updclosure)->header.info; \ - AWAKEN_BQ_NOLOCK(info,updclosure); \ - updateWithPermIndirection(info, \ - (StgClosure *)updclosure, \ - (StgClosure *)heapptr); \ - } +# define UPD_IND_NOLOCK(updclosure, heapptr) \ + DECLARE_IPTR(info); \ + info = GET_INFO(updclosure); \ + AWAKEN_BQ_NOLOCK(info,updclosure); \ + updateWithPermIndirection(info, \ + updclosure, \ + heapptr) # else # define UPD_IND_NOLOCK(updclosure, heapptr) \ - { \ - const StgInfoTable *info; \ - info = ((StgClosure *)updclosure)->header.info; \ + DECLARE_IPTR(info); \ + info = GET_INFO(updclosure); \ AWAKEN_BQ_NOLOCK(info,updclosure); \ - updateWithIndirection(info,&stg_IND_info, \ - (StgClosure *)updclosure, \ - (StgClosure *)heapptr,); \ - } + updateWithIndirection(info,stg_IND_info, \ + updclosure, \ + heapptr,); # endif #else @@ -131,7 +100,7 @@ #endif /* ----------------------------------------------------------------------------- - Awaken any threads waiting on this computation + Awaken any threads waiting on a blocking queue (BLACKHOLE_BQ). -------------------------------------------------------------------------- */ #if defined(PAR) @@ -189,99 +158,209 @@ extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); #else /* !GRAN && !PAR */ -extern void awakenBlockedQueue(StgTSO *q); #define DO_AWAKEN_BQ(closure) \ - STGCALL1(awakenBlockedQueue, \ - ((StgBlockingQueue *)closure)->blocking_queue); + FCALL awakenBlockedQueue(StgBlockingQueue_blocking_queue(closure) ARG_PTR); #define AWAKEN_BQ(info,closure) \ - if (info == &stg_BLACKHOLE_BQ_info) { \ + if (info == INFO_PTR(stg_BLACKHOLE_BQ_info)) { \ DO_AWAKEN_BQ(closure); \ } #define AWAKEN_STATIC_BQ(info,closure) \ - if (info == &stg_BLACKHOLE_BQ_STATIC_info) { \ + if (info == INFO_PTR(stg_BLACKHOLE_BQ_STATIC_info)) { \ DO_AWAKEN_BQ(closure); \ } #ifdef RTS_SUPPORTS_THREADS -extern void awakenBlockedQueueNoLock(StgTSO *q); -#define DO_AWAKEN_BQ_NOLOCK(closure) \ - STGCALL1(awakenBlockedQueueNoLock, \ - ((StgBlockingQueue *)closure)->blocking_queue); +#define DO_AWAKEN_BQ_NOLOCK(closure) \ + FCALL awakenBlockedQueueNoLock(StgBlockingQueue_blocking_queue(closure) ARG_PTR); #define AWAKEN_BQ_NOLOCK(info,closure) \ - if (info == &stg_BLACKHOLE_BQ_info) { \ + if (info == INFO_PTR(stg_BLACKHOLE_BQ_info)) { \ DO_AWAKEN_BQ_NOLOCK(closure); \ } #endif #endif /* GRAN || PAR */ -/* ------------------------------------------------------------------------- - Push an update frame on the stack. - ------------------------------------------------------------------------- */ - -#if defined(PROFILING) -// frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0) is unnecessary -// because it is not used anyhow. -#define PUSH_STD_CCCS(frame) (frame->header.prof.ccs = CCCS) -#else -#define PUSH_STD_CCCS(frame) -#endif +/* ----------------------------------------------------------------------------- + Updates: lower-level macros which update a closure with an + indirection to another closure. -extern DLL_IMPORT_RTS const StgPolyInfoTable stg_upd_frame_info; -extern DLL_IMPORT_RTS const StgPolyInfoTable stg_noupd_frame_info; - -#define PUSH_UPD_FRAME(target, Sp_offset) \ - { \ - StgUpdateFrame *__frame; \ - TICK_UPDF_PUSHED(target, GET_INFO((StgClosure*)target)); \ - __frame = (StgUpdateFrame *)(Sp + (Sp_offset)) - 1; \ - SET_INFO(__frame, (StgInfoTable *)&stg_upd_frame_info); \ - __frame->updatee = (StgClosure *)(target); \ - PUSH_STD_CCCS(__frame); \ - } + There are several variants of this code. -/* ----------------------------------------------------------------------------- - Entering CAFs + PROFILING: + -------------------------------------------------------------------------- */ - When a CAF is first entered, it creates a black hole in the heap, - and updates itself with an indirection to this new black hole. +/* LDV profiling: + * We call LDV_recordDead_FILL_SLOP_DYNAMIC(p1) regardless of the generation in + * which p1 resides. + * + * Note: + * After all, we do *NOT* need to call LDV_RECORD_CREATE() for both IND and + * IND_OLDGEN closures because they are inherently used. But, it corrupts + * the invariants that every closure keeps its creation time in the profiling + * field. So, we call LDV_RECORD_CREATE(). + */ - We update the CAF with an indirection to a newly-allocated black - hole in the heap. We also set the blocking queue on the newly - allocated black hole to be empty. +/* In the DEBUG case, we also zero out the slop of the old closure, + * so that the sanity checker can tell where the next closure is. + * + * Two important invariants: we should never try to update a closure + * to point to itself, and the closure being updated should not + * already have been updated (the mutable list will get messed up + * otherwise). + */ +#if !defined(DEBUG) + +#define DEBUG_FILL_SLOP(p) /* nothing */ + +#else /* DEBUG */ + +#ifdef CMINUSMINUS + +#define DEBUG_FILL_SLOP(p) \ + W_ inf; \ + W_ np; \ + W_ nw; \ + W_ i; \ + inf = %GET_STD_INFO(p); \ + np = TO_W_(%INFO_PTRS(inf)); \ + nw = TO_W_(%INFO_NPTRS(inf)); \ + if (%INFO_TYPE(inf) != THUNK_SELECTOR::I16) { \ + i = 0; \ + for: \ + if (i < np + nw) { \ + StgClosure_payload(p,i) = 0; \ + i = i + 1; \ + goto for; \ + } \ + } - Why do we make a black hole in the heap when we enter a CAF? - - - for a generational garbage collector, which needs a fast - test for whether an updatee is in an old generation or not - - for the parallel system, which can implement updates more - easily if the updatee is always in the heap. (allegedly). +#else /* !CMINUSMINUS */ - When debugging, we maintain a separate CAF list so we can tell when - a CAF has been garbage collected. - -------------------------------------------------------------------------- */ - -/* ToDo: only call newCAF when debugging. */ +INLINE_HEADER void +DEBUG_FILL_SLOP(StgClosure *p) +{ + StgInfoTable *inf = get_itbl(p); + nat np = inf->layout.payload.ptrs, + nw = inf->layout.payload.nptrs, i; + if (inf->type != THUNK_SELECTOR) { + for (i = 0; i < np + nw; i++) { + ((StgClosure *)p)->payload[i] = 0; + } + } +} -extern void newCAF(StgClosure*); +#endif /* CMINUSMINUS */ +#endif /* DEBUG */ -/* newCAF must be called before the itbl ptr is overwritten, since - newCAF records the old itbl ptr in order to do CAF reverting - (which Hugs needs to do in order that combined mode works right.) -*/ -#define UPD_CAF(cafptr, bhptr) \ +/* We have two versions of this macro (sadly), one for use in C-- code, + * and the other for C. + * + * The and_then argument is a performance hack so that we can paste in + * the continuation code directly. It helps shave a couple of + * instructions off the common case in the update code, which is + * worthwhile (the update code is often part of the inner loop). + * (except that gcc now appears to common up this code again and + * invert the optimisation. Grrrr --SDM). + */ +#ifdef CMINUSMINUS +#define generation(n) (W_[generations] + n*SIZEOF_generation) +#define updateWithIndirection(info, ind_info, p1, p2, and_then) \ + W_ bd; \ + \ +/* ASSERT( p1 != p2 && !closure_IND(p1) ); \ + */ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); \ + bd = Bdescr(p1); \ + if (bdescr_gen_no(bd) == 0) { \ + StgInd_indirectee(p1) = p2; \ + SET_INFO(p1, ind_info); \ + LDV_RECORD_CREATE(p1); \ + TICK_UPD_NEW_IND(); \ + and_then; \ + } else { \ + if (info != stg_BLACKHOLE_BQ_info) { \ + DEBUG_FILL_SLOP(p1); \ + W_ __mut_once_list; \ + __mut_once_list = generation(bdescr_gen_no(bd)) + \ + OFFSET_generation_mut_once_list; \ + StgMutClosure_mut_link(p1) = W_[__mut_once_list]; \ + W_[__mut_once_list] = p1; \ + } \ + StgInd_indirectee(p1) = p2; \ + SET_INFO(p1, stg_IND_OLDGEN_info); \ + LDV_RECORD_CREATE(p1); \ + TICK_UPD_OLD_IND(); \ + and_then; \ + } +#else +#define updateWithIndirection(_info, ind_info, p1, p2, and_then) \ { \ - LOCK_CLOSURE(cafptr); \ - STGCALL1(newCAF,(StgClosure *)cafptr); \ - ((StgInd *)cafptr)->indirectee = (StgClosure *)(bhptr); \ - SET_INFO((StgInd *)cafptr,(const StgInfoTable*)&stg_IND_STATIC_info);\ + bdescr *bd; \ + \ + ASSERT( (P_)p1 != (P_)p2 && !closure_IND(p1) ); \ + LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); \ + bd = Bdescr((P_)p1); \ + if (bd->gen_no == 0) { \ + ((StgInd *)p1)->indirectee = p2; \ + SET_INFO(p1, ind_info); \ + LDV_RECORD_CREATE(p1); \ + TICK_UPD_NEW_IND(); \ + and_then; \ + } else { \ + if (_info != &stg_BLACKHOLE_BQ_info) { \ + DEBUG_FILL_SLOP(p1); \ + ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \ + generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; \ + } \ + ((StgIndOldGen *)p1)->indirectee = p2; \ + SET_INFO(p1, &stg_IND_OLDGEN_info); \ + TICK_UPD_OLD_IND(); \ + and_then; \ + } \ } +#endif -/* ----------------------------------------------------------------------------- - Update-related prototypes - -------------------------------------------------------------------------- */ +/* The permanent indirection version isn't performance critical. We + * therefore use an inline C function instead of the C-- macro. + */ +#ifndef CMINUSMINUS +INLINE_HEADER void +updateWithPermIndirection(const StgInfoTable *info, + StgClosure *p1, + StgClosure *p2) +{ + bdescr *bd; + + ASSERT( p1 != p2 && !closure_IND(p1) ); + + // @LDV profiling + // Destroy the old closure. + // Nb: LDV_* stuff cannot mix with ticky-ticky + LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); + + bd = Bdescr((P_)p1); + if (bd->gen_no == 0) { + ((StgInd *)p1)->indirectee = p2; + SET_INFO(p1, &stg_IND_PERM_info); + // @LDV profiling + // We have just created a new closure. + LDV_RECORD_CREATE(p1); + TICK_UPD_NEW_PERM_IND(p1); + } else { + if (info != &stg_BLACKHOLE_BQ_info) { + ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; + generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; + } + ((StgIndOldGen *)p1)->indirectee = p2; + SET_INFO(p1, &stg_IND_OLDGEN_PERM_info); + // @LDV profiling + // We have just created a new closure. + LDV_RECORD_CREATE(p1); + TICK_UPD_OLD_PERM_IND(); + } +} +#endif #endif /* UPDATES_H */ diff --git a/ghc/includes/mkDerivedConstants.c b/ghc/includes/mkDerivedConstants.c index 8c7591ac2c..1baacdb5b5 100644 --- a/ghc/includes/mkDerivedConstants.c +++ b/ghc/includes/mkDerivedConstants.c @@ -1,53 +1,372 @@ /* -------------------------------------------------------------------------- - * $Id: mkDerivedConstants.c,v 1.5 2004/03/08 10:31:00 stolz Exp $ * - * (c) The GHC Team, 1992-1998 + * (c) The GHC Team, 1992-2004 * - * Generate a header for the native code generator + * mkDerivedConstants.c + * + * Basically this is a C program that extracts information from the C + * declarations in the header files (primarily struct field offsets) + * and generates a header file that can be #included into non-C source + * containing this information. * * ------------------------------------------------------------------------*/ #include <stdio.h> #define IN_STG_CODE 0 -#include "Stg.h" + +// We need offsets of profiled things... better be careful that this +// doesn't affect the offsets of anything else. +#define PROFILING + +#include "Rts.h" +#include "RtsFlags.h" +#include "Storage.h" + +#define str(a,b) #a "_" #b #define OFFSET(s_type, field) ((unsigned int)&(((s_type*)0)->field)) +#if defined(GEN_HASKELL) +#define def_offset(str, offset) \ + printf("oFFSET_" str " = %d::Int\n", offset); +#else +#define def_offset(str, offset) \ + printf("#define OFFSET_" str " %d\n", offset); +#endif + +#if defined(GEN_HASKELL) +#define ctype(type) /* nothing */ +#else +#define ctype(type) \ + printf("#define SIZEOF_" #type " %d\n", sizeof(type)); +#endif + +#if defined(GEN_HASKELL) +#define field_type_(str, s_type, field) /* nothing */ +#else +#define field_type_(str, s_type, field) \ + printf("#define REP_" str " I"); \ + printf("%d\n", sizeof (__typeof__(((((s_type*)0)->field)))) * 8); +#endif + +#define field_type(s_type, field) \ + field_type_(str(s_type,field),s_type,field); + +#define field_offset_(str, s_type, field) \ + def_offset(str, OFFSET(s_type,field)); + +#define field_offset(s_type, field) \ + field_offset_(str(s_type,field),s_type,field); + +// An access macro for use in C-- sources. +#define struct_field_macro(str) \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+OFFSET_" str "]\n"); + +// Outputs the byte offset and MachRep for a field +#define struct_field(s_type, field) \ + field_offset(s_type, field); \ + field_type(s_type, field); \ + struct_field_macro(str(s_type,field)) + +#define struct_field_(str, s_type, field) \ + field_offset_(str, s_type, field); \ + field_type_(str, s_type, field); \ + struct_field_macro(str) + +#if defined(GEN_HASKELL) +#define def_size(str, size) \ + printf("sIZEOF_" str " = %d::Int\n", size); +#else +#define def_size(str, size) \ + printf("#define SIZEOF_" str " %d\n", size); +#endif + +#if defined(GEN_HASKELL) +#define def_closure_size(str, size) /* nothing */ +#else +#define def_closure_size(str, size) \ + printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%d)\n", size); +#endif + +#define struct_size(s_type) \ + def_size(#s_type, sizeof(s_type)); + +// Size of a closure type, minus the header, named SIZEOF_<type>_NoHdr +// Also, we #define SIZEOF_<type> to be the size of the whole closure for .cmm. +#define closure_size(s_type) \ + def_size(#s_type "_NoHdr", sizeof(s_type) - sizeof(StgHeader)); \ + def_closure_size(#s_type, sizeof(s_type) - sizeof(StgHeader)); + +// An access macro for use in C-- sources. +#define closure_field_macro(str) \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n"); + +#define closure_field_offset_(str, s_type,field) \ + def_offset(str, OFFSET(s_type,field) - sizeof(StgHeader)); + +#define closure_field_offset(s_type,field) \ + closure_field_offset_(str(s_type,field),s_type,field); + +#define closure_payload_macro(str) \ + printf("#define " str "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n"); + +#define closure_payload(s_type,field) \ + closure_field_offset_(str(s_type,field),s_type,field); \ + closure_payload_macro(str(s_type,field)); + +// Byte offset and MachRep for a closure field, minus the header +#define closure_field(s_type, field) \ + closure_field_offset(s_type,field) \ + field_type(s_type, field); \ + closure_field_macro(str(s_type,field)) + +// Byte offset and MachRep for a closure field, minus the header +#define closure_field_(str, s_type, field) \ + closure_field_offset_(str,s_type,field) \ + field_type_(str, s_type, field); \ + closure_field_macro(str) + +// Byte offset and MachRep for a TSO field, minus the header and +// variable prof bit. +#define tso_offset(s_type, field) \ + def_offset(str(s_type,field), OFFSET(s_type,field) - sizeof(StgHeader) - sizeof(StgTSOProfInfo)); + +#define tso_field_macro(str) \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+SIZEOF_OPT_StgTSOTickyInfo+SIZEOF_OPT_StgTSOParInfo+SIZEOF_OPT_StgTSOGranInfo+SIZEOF_OPT_StgTSODistInfo+OFFSET_" str "]\n"); + +#define tso_field(s_type, field) \ + tso_offset(s_type, field); \ + field_type(s_type, field); \ + tso_field_macro(str(s_type,field)) + +#define opt_struct_size(s_type, option) \ + printf("#ifdef " #option "\n"); \ + printf("#define SIZEOF_OPT_" #s_type " SIZEOF_" #s_type "\n"); \ + printf("#else\n"); \ + printf("#define SIZEOF_OPT_" #s_type " 0\n"); \ + printf("#endif\n\n"); + +#define FUN_OFFSET(sym) (OFFSET(Capability,f.sym) - OFFSET(Capability,r)) + + int main(int argc, char *argv[]) { - printf("-- This file is created automatically. Do not edit by hand.\n\n"); +#ifndef GEN_HASKELL + printf("/* This file is created automatically. Do not edit by hand.*/\n\n"); - printf("#define STD_HDR_SIZE %d\n", sizeofW(StgHeader)); + printf("#define STD_HDR_SIZE %d\n", sizeofW(StgHeader) - sizeofW(StgProfHeader)); + // grrr.. PROFILING is on so we need to subtract sizeofW(StgProfHeader) printf("#define PROF_HDR_SIZE %d\n", sizeofW(StgProfHeader)); printf("#define GRAN_HDR_SIZE %d\n", sizeofW(StgGranHeader)); - printf("#define ARR_WORDS_HDR_SIZE %d\n", - sizeofW(StgArrWords) - sizeofW(StgHeader)); - - printf("#define ARR_PTRS_HDR_SIZE %d\n", - sizeofW(StgMutArrPtrs) - sizeofW(StgHeader)); - printf("#define STD_ITBL_SIZE %d\n", sizeofW(StgInfoTable)); printf("#define RET_ITBL_SIZE %d\n", sizeofW(StgRetInfoTable) - sizeofW(StgInfoTable)); printf("#define PROF_ITBL_SIZE %d\n", sizeofW(StgProfInfo)); printf("#define GRAN_ITBL_SIZE %d\n", 0); printf("#define TICKY_ITBL_SIZE %d\n", sizeofW(StgTickyInfo)); - printf("#define STD_UF_SIZE %d\n", sizeofW(StgUpdateFrame)); - printf("#define GRAN_UF_SIZE %d\n", - sizeofW(StgUpdateFrame) + sizeofW(StgGranHeader)); - printf("#define PROF_UF_SIZE %d\n", - sizeofW(StgUpdateFrame) + sizeofW(StgProfHeader)); + printf("#define BLOCK_SIZE %d\n", BLOCK_SIZE); + printf("#define MBLOCK_SIZE %d\n", MBLOCK_SIZE); - printf("#define UF_RET %d\n", - OFFSET(StgUpdateFrame,header.info)); + printf("\n\n"); +#endif - printf("#define UF_UPDATEE %d\n", - OFFSET(StgUpdateFrame,updatee) / sizeof(W_)); + field_offset(StgRegTable, rR1); + field_offset(StgRegTable, rR2); + field_offset(StgRegTable, rR3); + field_offset(StgRegTable, rR4); + field_offset(StgRegTable, rR5); + field_offset(StgRegTable, rR6); + field_offset(StgRegTable, rR7); + field_offset(StgRegTable, rR8); + field_offset(StgRegTable, rR9); + field_offset(StgRegTable, rR10); + field_offset(StgRegTable, rF1); + field_offset(StgRegTable, rF2); + field_offset(StgRegTable, rF3); + field_offset(StgRegTable, rF4); + field_offset(StgRegTable, rD1); + field_offset(StgRegTable, rD2); +#ifdef SUPPORT_LONG_LONGS + field_offset(StgRegTable, rL1); +#endif + field_offset(StgRegTable, rSp); + field_offset(StgRegTable, rSpLim); + field_offset(StgRegTable, rHp); + field_offset(StgRegTable, rHpLim); + field_offset(StgRegTable, rCurrentTSO); + field_offset(StgRegTable, rCurrentNursery); + field_offset(StgRegTable, rHpAlloc); - printf("#define BLOCK_SIZE %d\n", BLOCK_SIZE); - printf("#define MBLOCK_SIZE %d\n", MBLOCK_SIZE); + def_offset("stgGCEnter1", FUN_OFFSET(stgGCEnter1)); + def_offset("stgGCFun", FUN_OFFSET(stgGCFun)); + + field_offset(Capability, r); + + struct_field(bdescr, start); + struct_field(bdescr, free); + struct_field(bdescr, blocks); + struct_field(bdescr, gen_no); + struct_field(bdescr, link); + + struct_size(generation); + struct_field(generation, mut_once_list); + + struct_field(CostCentreStack, ccsID); + struct_field(CostCentreStack, mem_alloc); + struct_field(CostCentreStack, scc_count); + struct_field(CostCentreStack, prevStack); + + struct_field(CostCentre, ccID); + struct_field(CostCentre, link); + + struct_field(StgHeader, info); + struct_field_("StgHeader_ccs", StgHeader, prof.ccs); + struct_field_("StgHeader_ldvw", StgHeader, prof.hp.ldvw); + + closure_payload(StgClosure,payload); + + struct_field(StgEntCounter, allocs); + struct_field(StgEntCounter, registeredp); + struct_field(StgEntCounter, link); + + closure_size(StgUpdateFrame); + closure_size(StgCatchFrame); + closure_size(StgStopFrame); + + closure_size(StgMutArrPtrs); + closure_field(StgMutArrPtrs, ptrs); + + closure_size(StgArrWords); + closure_field(StgArrWords, words); + closure_payload(StgArrWords, payload); + + closure_field(StgTSO, link); + closure_field(StgTSO, mut_link); + closure_field(StgTSO, global_link); + closure_field(StgTSO, what_next); + closure_field(StgTSO, why_blocked); + closure_field(StgTSO, block_info); + closure_field(StgTSO, blocked_exceptions); + closure_field(StgTSO, id); + closure_field(StgTSO, saved_errno); + closure_field_("StgTSO_CCCS", StgTSO, prof.CCCS); + tso_field(StgTSO, sp); + tso_offset(StgTSO, stack); + tso_field(StgTSO, stack_size); + + struct_size(StgTSOProfInfo); + struct_size(StgTSOTickyInfo); + struct_size(StgTSOParInfo); + struct_size(StgTSOGranInfo); + struct_size(StgTSODistInfo); + + opt_struct_size(StgTSOProfInfo,PROFILING); + opt_struct_size(StgTSOTickyInfo,TICKY_TICKY); + opt_struct_size(StgTSOParInfo,PAR); + opt_struct_size(StgTSOGranInfo,GRAN); + opt_struct_size(StgTSODistInfo,DIST); + + closure_size(StgBlockingQueue); + closure_field(StgBlockingQueue, blocking_queue); + + closure_field(StgUpdateFrame, updatee); + + closure_field(StgCatchFrame, handler); + closure_field(StgCatchFrame, exceptions_blocked); + + closure_size(StgPAP); + closure_field(StgPAP, n_args); + closure_field(StgPAP, fun); + closure_field(StgPAP, arity); + closure_payload(StgPAP, payload); + + closure_size(StgAP); + closure_field(StgAP, n_args); + closure_field(StgAP, fun); + closure_payload(StgAP, payload); + + closure_size(StgAP_STACK); + closure_field(StgAP_STACK, size); + closure_field(StgAP_STACK, fun); + closure_payload(StgAP_STACK, payload); + + closure_field(StgInd, indirectee); + closure_field(StgMutClosure, mut_link); + + closure_size(StgMutVar); + closure_field(StgMutVar, var); + + closure_size(StgForeignObj); + closure_field(StgForeignObj,data); + + closure_size(StgWeak); + closure_field(StgWeak,link); + closure_field(StgWeak,key); + closure_field(StgWeak,value); + closure_field(StgWeak,finalizer); + + closure_size(StgMVar); + closure_field(StgMVar,head); + closure_field(StgMVar,tail); + closure_field(StgMVar,value); + + closure_size(StgBCO); + closure_field(StgBCO, instrs); + closure_field(StgBCO, literals); + closure_field(StgBCO, ptrs); + closure_field(StgBCO, itbls); + closure_field(StgBCO, arity); + closure_field(StgBCO, size); + closure_payload(StgBCO, bitmap); + + closure_size(StgStableName); + closure_field(StgStableName,sn); + + struct_field_("RtsFlags_ProfFlags_showCCSOnException", + RTS_FLAGS, ProfFlags.showCCSOnException); + struct_field_("RtsFlags_DebugFlags_apply", + RTS_FLAGS, DebugFlags.apply); + struct_field_("RtsFlags_DebugFlags_sanity", + RTS_FLAGS, DebugFlags.sanity); + struct_field_("RtsFlags_DebugFlags_weak", + RTS_FLAGS, DebugFlags.weak); + struct_field_("RtsFlags_GcFlags_initialStkSize", + RTS_FLAGS, GcFlags.initialStkSize); + + struct_size(StgFunInfoExtraFwd); + struct_field(StgFunInfoExtraFwd, slow_apply); + struct_field(StgFunInfoExtraFwd, fun_type); + struct_field(StgFunInfoExtraFwd, arity); + struct_field(StgFunInfoExtraFwd, bitmap); + + struct_size(StgFunInfoExtraRev); + struct_field(StgFunInfoExtraRev, slow_apply); + struct_field(StgFunInfoExtraRev, fun_type); + struct_field(StgFunInfoExtraRev, arity); + struct_field(StgFunInfoExtraRev, bitmap); + + struct_field(StgLargeBitmap, size); + field_offset(StgLargeBitmap, bitmap); + + struct_size(snEntry); + struct_field(snEntry,sn_obj); + struct_field(snEntry,addr); + +#ifdef mingw32_TARGET_OS + struct_size(StgAsyncIOResult); + struct_field(StgAsyncIOResult, reqID); + struct_field(StgAsyncIOResult, len); + struct_field(StgAsyncIOResult, errCode); +#endif + + struct_size(MP_INT); + struct_field(MP_INT,_mp_alloc); + struct_field(MP_INT,_mp_size); + struct_field(MP_INT,_mp_d); + + ctype(mp_limb_t); return 0; } diff --git a/ghc/includes/mkNativeHdr.c b/ghc/includes/mkNativeHdr.c deleted file mode 100644 index d078055bf5..0000000000 --- a/ghc/includes/mkNativeHdr.c +++ /dev/null @@ -1,117 +0,0 @@ -/* -------------------------------------------------------------------------- - * $Id: mkNativeHdr.c,v 1.12 2003/03/21 15:48:06 sof Exp $ - * - * (c) The GHC Team, 1992-1998 - * - * Generate a header for the native code generator - * - * ------------------------------------------------------------------------*/ - -#include "Stg.h" - -#include <stdio.h> - -#define OFFSET(table, x) ((StgUnion *) &(x) - (StgUnion *) (&table)) - -#define OFFSET_R1 OFFSET(RegTable, RegTable.rR1) -#define OFFSET_R2 OFFSET(RegTable, RegTable.rR2) -#define OFFSET_R3 OFFSET(RegTable, RegTable.rR3) -#define OFFSET_R4 OFFSET(RegTable, RegTable.rR4) -#define OFFSET_R5 OFFSET(RegTable, RegTable.rR5) -#define OFFSET_R6 OFFSET(RegTable, RegTable.rR6) -#define OFFSET_R7 OFFSET(RegTable, RegTable.rR7) -#define OFFSET_R8 OFFSET(RegTable, RegTable.rR8) -#define OFFSET_R9 OFFSET(RegTable, RegTable.rR9) -#define OFFSET_R10 OFFSET(RegTable, RegTable.rR10) -#define OFFSET_F1 OFFSET(RegTable, RegTable.rF1) -#define OFFSET_F2 OFFSET(RegTable, RegTable.rF2) -#define OFFSET_F3 OFFSET(RegTable, RegTable.rF3) -#define OFFSET_F4 OFFSET(RegTable, RegTable.rF4) -#define OFFSET_D1 OFFSET(RegTable, RegTable.rD1) -#define OFFSET_D2 OFFSET(RegTable, RegTable.rD2) -#define OFFSET_L1 OFFSET(RegTable, RegTable.rL1) -#define OFFSET_Sp OFFSET(RegTable, RegTable.rSp) -#define OFFSET_SpLim OFFSET(RegTable, RegTable.rSpLim) -#define OFFSET_Hp OFFSET(RegTable, RegTable.rHp) -#define OFFSET_HpLim OFFSET(RegTable, RegTable.rHpLim) -#define OFFSET_CurrentTSO OFFSET(RegTable, RegTable.rCurrentTSO) -#define OFFSET_CurrentNursery OFFSET(RegTable, RegTable.rCurrentNursery) -#define OFFSET_HpAlloc OFFSET(RegTable, RegTable.rHpAlloc) - -#define FUN_OFFSET(sym) ((StgPtr)&cap.f.sym - (StgPtr)&cap.r) - -#define OFFSET_stgGCEnter1 FUN_OFFSET(stgGCEnter1) -#define OFFSET_stgGCFun FUN_OFFSET(stgGCFun) - -#define OFFW_Capability_r OFFSET(cap, cap.r) - -#define TSO_SP OFFSET(tso, tso.sp) -#define TSO_STACK OFFSET(tso, tso.stack) - -#define BDESCR_START OFFSET(bd, bd.start) -#define BDESCR_FREE OFFSET(bd, bd.free) -#define BDESCR_BLOCKS OFFSET(bd, bd.blocks) - -StgRegTable RegTable; - -Capability cap; - -StgTSO tso; -bdescr bd; - -int -main() -{ - printf("-- This file is created automatically. Do not edit by hand.\n\n"); - - printf("\n-- Base table offsets for the Native Code Generator\n"); - - printf("#define OFFSET_R1 %d\n", OFFSET_R1); - printf("#define OFFSET_R2 %d\n", OFFSET_R2); - printf("#define OFFSET_R3 %d\n", OFFSET_R3); - printf("#define OFFSET_R4 %d\n", OFFSET_R4); - printf("#define OFFSET_R5 %d\n", OFFSET_R5); - printf("#define OFFSET_R6 %d\n", OFFSET_R6); - printf("#define OFFSET_R7 %d\n", OFFSET_R7); - printf("#define OFFSET_R8 %d\n", OFFSET_R8); - printf("#define OFFSET_R9 %d\n", OFFSET_R9); - printf("#define OFFSET_R10 %d\n", OFFSET_R10); - printf("#define OFFSET_F1 %d\n", OFFSET_F1); - printf("#define OFFSET_F2 %d\n", OFFSET_F2); - printf("#define OFFSET_F3 %d\n", OFFSET_F3); - printf("#define OFFSET_F4 %d\n", OFFSET_F4); - printf("#define OFFSET_D1 %d\n", OFFSET_D1); - printf("#define OFFSET_D2 %d\n", OFFSET_D2); -#ifdef SUPPORT_LONG_LONGS - printf("#define OFFSET_L1 %d\n", OFFSET_L1); -#endif - printf("#define OFFSET_Sp %d\n", OFFSET_Sp); - printf("#define OFFSET_SpLim %d\n", OFFSET_SpLim); - printf("#define OFFSET_Hp %d\n", OFFSET_Hp); - printf("#define OFFSET_HpLim %d\n", OFFSET_HpLim); - printf("#define OFFSET_CurrentTSO %d\n", OFFSET_CurrentTSO); - printf("#define OFFSET_CurrentNursery %d\n", OFFSET_CurrentNursery); - printf("#define OFFSET_HpAlloc %d\n", OFFSET_HpAlloc); - - printf("#define OFFSET_stgGCEnter1 (%d)\n", OFFSET_stgGCEnter1); - printf("#define OFFSET_stgGCFun (%d)\n", OFFSET_stgGCFun); - - printf("\n-- Offset of the .r (StgRegTable) field in a Capability\n"); - - printf("#define OFFW_Capability_r (%d)\n", OFFW_Capability_r); - - printf("\n-- Storage Manager offsets for the Native Code Generator\n"); - - printf("\n-- TSO offsets for the Native Code Generator\n"); - - printf("#define TSO_SP %d\n", TSO_SP); - printf("#define TSO_STACK %d\n", TSO_STACK); - - printf("\n-- Block descriptor offsets for the Native Code Generator\n"); - - printf("#define BDESCR_START %d\n", BDESCR_START); - printf("#define BDESCR_FREE %d\n", BDESCR_FREE); - printf("#define BDESCR_BLOCKS %d\n", BDESCR_BLOCKS); - - exit(0); -} |