X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=includes%2FCmm.h;h=59081e2466f952b838c3224dab6fa9cb61f8a440;hp=d95002c5afb3389162076c0b7de9cb3ee1cae713;hb=5270423a6afe69f1dc57e5e5a474812182718d40;hpb=fb684b4309f0d9b3eb823961c93271a406cd1bf6 diff --git a/includes/Cmm.h b/includes/Cmm.h index d95002c..59081e2 100644 --- a/includes/Cmm.h +++ b/includes/Cmm.h @@ -25,7 +25,7 @@ * - 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] + * alloc_blocks ==> CInt[alloc_blocks] * - convert all word offsets into byte offsets: * - e ==> WDS(e) * - sizeofW(StgFoo) ==> SIZEOF_StgFoo @@ -66,7 +66,6 @@ #define CMINUSMINUS 1 #include "ghcconfig.h" -#include "RtsConfig.h" /* ----------------------------------------------------------------------------- Types @@ -88,15 +87,28 @@ #define I16 bits16 #define I32 bits32 #define I64 bits64 +#define P_ gcptr #if SIZEOF_VOID_P == 4 #define W_ bits32 +/* Maybe it's better to include MachDeps.h */ +#define TAG_BITS 2 #elif SIZEOF_VOID_P == 8 #define W_ bits64 +/* Maybe it's better to include MachDeps.h */ +#define TAG_BITS 3 #else #error Unknown word size #endif +/* + * The RTS must sometimes UNTAG a pointer before dereferencing it. + * See the wiki page Commentary/Rts/HaskellExecution/PointerTagging + */ +#define TAG_MASK ((1 << TAG_BITS) - 1) +#define UNTAG(p) (p & ~TAG_MASK) +#define GETTAG(p) (p & TAG_MASK) + #if SIZEOF_INT == 4 #define CInt bits32 #elif SIZEOF_INT == 8 @@ -131,6 +143,18 @@ name : bits8[] str; \ } \ +#ifdef TABLES_NEXT_TO_CODE +#define RET_LBL(f) f##_info +#else +#define RET_LBL(f) f##_ret +#endif + +#ifdef TABLES_NEXT_TO_CODE +#define ENTRY_LBL(f) f##_info +#else +#define ENTRY_LBL(f) f##_entry +#endif + /* ----------------------------------------------------------------------------- Byte/word macros @@ -228,12 +252,45 @@ ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES, but switch doesn't allow us to use exprs there yet. + + If R1 points to a tagged object it points either to + * A constructor. + * A function with arity <= TAG_MASK. + In both cases the right thing to do is to return. + Note: it is rather lucky that we can use the tag bits to do this + for both objects. Maybe it points to a brittle design? + + Indirections can contain tagged pointers, so their tag is checked. -------------------------------------------------------------------------- */ +#ifdef PROFILING + +// When profiling, we cannot shortcut ENTER() by checking the tag, +// because LDV profiling relies on entering closures to mark them as +// "used". + +#define LOAD_INFO \ + info = %INFO_PTR(UNTAG(P1)); + +#define UNTAG_R1 \ + P1 = UNTAG(P1); + +#else + +#define LOAD_INFO \ + if (GETTAG(P1) != 0) { \ + jump %ENTRY_CODE(Sp(0)); \ + } \ + info = %INFO_PTR(P1); + +#define UNTAG_R1 /* nothing */ + +#endif + #define ENTER() \ again: \ W_ info; \ - info = %INFO_PTR(R1); \ + LOAD_INFO \ switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \ (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \ case \ @@ -243,56 +300,58 @@ IND_OLDGEN_PERM, \ IND_STATIC: \ { \ - R1 = StgInd_indirectee(R1); \ + P1 = StgInd_indirectee(P1); \ goto again; \ } \ case \ - BCO, \ FUN, \ FUN_1_0, \ FUN_0_1, \ FUN_2_0, \ FUN_1_1, \ FUN_0_2, \ - FUN_STATIC, \ + FUN_STATIC, \ + BCO, \ PAP: \ { \ jump %ENTRY_CODE(Sp(0)); \ } \ default: \ { \ + UNTAG_R1 \ jump %ENTRY_CODE(info); \ } \ } +// The FUN cases almost never happen: a pointer to a non-static FUN +// should always be tagged. This unfortunately isn't true for the +// interpreter right now, which leaves untagged FUNs on the stack. + /* ----------------------------------------------------------------------------- Constants. -------------------------------------------------------------------------- */ -#include "Constants.h" +#include "rts/Constants.h" #include "DerivedConstants.h" -#include "ClosureTypes.h" -#include "StgFun.h" +#include "rts/storage/ClosureTypes.h" +#include "rts/storage/FunTypes.h" +#include "rts/storage/SMPClosureOps.h" +#include "rts/OSThreads.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 "stg/MachRegs.h" -#include "Liveness.h" -#include "StgLdvProf.h" +#include "rts/storage/Liveness.h" +#include "rts/prof/LDV.h" #undef BLOCK_SIZE #undef MBLOCK_SIZE -#include "Block.h" /* For Bdescr() */ - +#include "rts/storage/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 #define MyCapability() (BaseReg - OFFSET_Capability_r) @@ -321,13 +380,15 @@ HP_CHK_GEN(alloc,liveness,reentry); \ TICK_ALLOC_HEAP_NOCTR(alloc); -// allocateLocal() allocates from the nursery, so we check to see +// allocate() allocates from the nursery, so we check to see // whether the nursery is nearly empty in any function that uses -// allocateLocal() - this includes many of the primops. +// allocate() - this includes many of the primops. #define MAYBE_GC(liveness,reentry) \ - if (bdescr_link(CurrentNursery) == NULL || CInt[alloc_blocks] >= CInt[alloc_blocks_lim]) { \ + if (bdescr_link(CurrentNursery) == NULL || \ + step_n_large_blocks(StgRegTable_rNursery(BaseReg)) >= CInt[alloc_blocks_lim]) { \ R9 = liveness; \ R10 = reentry; \ + HpAlloc = 0; \ jump stg_gc_gen_hp; \ } @@ -367,12 +428,15 @@ #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) && \ +#define LOOKS_LIKE_INFO_PTR(p) \ + ((p) != NULL && \ + LOOKS_LIKE_INFO_PTR_NOT_NULL(p)) + +#define LOOKS_LIKE_INFO_PTR_NOT_NULL(p) \ + ( (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))) +#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(UNTAG(p)))) /* * The layout of the StgFunInfoExtra part of an info table changes @@ -462,18 +526,13 @@ #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 +/* NOTE: TICK_HISTO_BY and TICK_HISTO + currently have no effect. + The old code for it didn't typecheck and I + just commented it out to get ticky to work. + - krc 1/2007 */ + #define TICK_HISTO_BY(histo,n,i) /* nothing */ -#endif #define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1) @@ -512,6 +571,34 @@ Misc junk -------------------------------------------------------------------------- */ -#define TICK_MILLISECS (1000/TICK_FREQUENCY) /* ms per tick */ +#define NO_TREC stg_NO_TREC_closure +#define END_TSO_QUEUE stg_END_TSO_QUEUE_closure +#define END_INVARIANT_CHECK_QUEUE stg_END_INVARIANT_CHECK_QUEUE_closure + +#define recordMutableCap(p, gen, regs) \ + W_ __bd; \ + W_ mut_list; \ + mut_list = Capability_mut_lists(MyCapability()) + WDS(gen); \ + __bd = W_[mut_list]; \ + if (bdescr_free(__bd) >= bdescr_start(__bd) + BLOCK_SIZE) { \ + W_ __new_bd; \ + ("ptr" __new_bd) = foreign "C" allocBlock_lock() [regs]; \ + bdescr_link(__new_bd) = __bd; \ + __bd = __new_bd; \ + W_[mut_list] = __bd; \ + } \ + W_ free; \ + free = bdescr_free(__bd); \ + W_[free] = p; \ + bdescr_free(__bd) = free + WDS(1); + +#define recordMutable(p, regs) \ + P_ __p; \ + W_ __bd; \ + W_ __gen; \ + __p = p; \ + __bd = Bdescr(__p); \ + __gen = TO_W_(bdescr_gen_no(__bd)); \ + if (__gen > 0) { recordMutableCap(__p, __gen, regs); } #endif /* CMM_H */