diff options
author | John Ericson <John.Ericson@Obsidian.Systems> | 2021-07-22 07:26:47 +0000 |
---|---|---|
committer | John Ericson <John.Ericson@Obsidian.Systems> | 2021-08-03 17:33:08 +0000 |
commit | 562991def56ea199865e0404365c41314c66c646 (patch) | |
tree | 0476cae915656f05f874e9af85e489c7b1cceeac /rts/include/Cmm.h | |
parent | 7a5636a18c821f6bfe3f4400d1fb368d110dead3 (diff) | |
download | haskell-wip/organize-headers.tar.gz |
Move `/includes` to `/rts/include`, sort per package betterwip/organize-headers
In order to make the packages in this repo "reinstallable", we need to
associate source code with a specific packages. Having a top level
`/includes` dir that mixes concerns (which packages' includes?) gets in
the way of this.
To start, I have moved everything to `rts/`, which is mostly correct.
There are a few things however that really don't belong in the rts (like
the generated constants haskell type, `CodeGen.Platform.h`). Those
needed to be manually adjusted.
Things of note:
- No symlinking for sake of windows, so we hard-link at configure time.
- `CodeGen.Platform.h` no longer as `.hs` extension (in addition to
being moved to `compiler/`) so as not to confuse anyone, since it is
next to Haskell files.
- Blanket `-Iincludes` is gone in both build systems, include paths now
more strictly respect per-package dependencies.
- `deriveConstants` has been taught to not require a `--target-os` flag
when generating the platform-agnostic Haskell type. Make takes
advantage of this, but Hadrian has yet to.
Diffstat (limited to 'rts/include/Cmm.h')
-rw-r--r-- | rts/include/Cmm.h | 924 |
1 files changed, 924 insertions, 0 deletions
diff --git a/rts/include/Cmm.h b/rts/include/Cmm.h new file mode 100644 index 0000000000..9b17e9f400 --- /dev/null +++ b/rts/include/Cmm.h @@ -0,0 +1,924 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2004-2013 + * + * 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/GHC/Cmm/Parser.y. + * + * 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 + * utils/deriveConstants. If you need to access a field that doesn't + * already have a macro, edit that program (it's pretty self-explanatory). + * + * -------------------------------------------------------------------------- */ + +#pragma once + +/* + * 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" + +/* ----------------------------------------------------------------------------- + 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 + CBool has the same size as a bool in C on this platform + + --------------------------------------------------------------------------- */ + +#define I8 bits8 +#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/haskell-execution/pointer-tagging + */ +#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 +#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 CBool bits8 + +#define F_ float32 +#define D_ float64 +#define L_ bits64 +#define V16_ bits128 +#define V32_ bits256 +#define V64_ bits512 + +#define SIZEOF_StgDouble 8 +#define SIZEOF_StgWord64 8 + +/* ----------------------------------------------------------------------------- + Misc useful stuff + -------------------------------------------------------------------------- */ + +#define ccall foreign "C" + +#define NULL (0::W_) + +#define STRING(name,str) \ + section "rodata" { \ + name : bits8[] str; \ + } \ + +#if defined(TABLES_NEXT_TO_CODE) +#define RET_LBL(f) f##_info +#else +#define RET_LBL(f) f##_ret +#endif + +#if defined(TABLES_NEXT_TO_CODE) +#define ENTRY_LBL(f) f##_info +#else +#define ENTRY_LBL(f) f##_entry +#endif + +/* ----------------------------------------------------------------------------- + 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 3 +#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) and TO_ZXW_(n) convert n to W_ type from a smaller type, + * with and without sign extension respectively + */ +#if SIZEOF_W == 4 +#define TO_I64(x) %sx64(x) +#define TO_W_(x) %sx32(x) +#define TO_ZXW_(x) %zx32(x) +#define HALF_W_(x) %lobits16(x) +#elif SIZEOF_W == 8 +#define TO_I64(x) (x) +#define TO_W_(x) %sx64(x) +#define TO_ZXW_(x) %zx64(x) +#define HALF_W_(x) %lobits32(x) +#endif + +#if SIZEOF_INT == 4 && SIZEOF_W == 8 +#define W_TO_INT(x) %lobits32(x) +#elif SIZEOF_INT == SIZEOF_W +#define W_TO_INT(x) (x) +#endif + +#if SIZEOF_LONG == 4 && SIZEOF_W == 8 +#define W_TO_LONG(x) %lobits32(x) +#elif SIZEOF_LONG == SIZEOF_W +#define W_TO_LONG(x) (x) +#endif + +/* ----------------------------------------------------------------------------- + Atomic memory operations. + -------------------------------------------------------------------------- */ + +#if SIZEOF_W == 4 +#define cmpxchgW cmpxchg32 +#elif SIZEOF_W == 8 +#define cmpxchgW cmpxchg64 +#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) /* pronounced "spadge" */ +#define Hp_adj(n) Hp = Hp + WDS(n) + +/* ----------------------------------------------------------------------------- + Assertions and Debuggery + -------------------------------------------------------------------------- */ + +#if defined(DEBUG) || defined(USE_ASSERTS_ALL_WAYS) +#define ASSERTS_ENABLED 1 +#else +#undef ASSERTS_ENABLED +#endif + +#if ASSERTS_ENABLED +#define ASSERT(predicate) \ + if (predicate) { \ + /*null*/; \ + } else { \ + foreign "C" _assertFail(__FILE__, __LINE__) never returns; \ + } +#else +#define ASSERT(p) /* nothing */ +#endif + +#if defined(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. + */ +#if defined(DEBUG) +#define IF_DEBUG(c,s) if (RtsFlags_DebugFlags_##c(RtsFlags) != 0::CBool) { 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. + + 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. + -------------------------------------------------------------------------- */ + +#if defined(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(ret,x) \ + info = %INFO_PTR(UNTAG(x)); + +#define UNTAG_IF_PROF(x) UNTAG(x) + +#else + +#define LOAD_INFO(ret,x) \ + if (GETTAG(x) != 0) { \ + ret(x); \ + } \ + info = %INFO_PTR(x); + +#define UNTAG_IF_PROF(x) (x) /* already untagged */ + +#endif + +// We need two versions of ENTER(): +// - ENTER(x) takes the closure as an argument and uses return(), +// for use in civilized code where the stack is handled by GHC +// +// - ENTER_NOSTACK() where the closure is in R1, and returns are +// explicit jumps, for use when we are doing the stack management +// ourselves. + +#if defined(PROFILING) +// See Note [Evaluating functions with profiling] in rts/Apply.cmm +#define ENTER(x) jump stg_ap_0_fast(x); +#else +#define ENTER(x) ENTER_(return,x) +#endif + +#define ENTER_R1() ENTER_(RET_R1,R1) + +#define RET_R1(x) jump %ENTRY_CODE(Sp(0)) [R1] + +#define ENTER_(ret,x) \ + again: \ + W_ info; \ + LOAD_INFO(ret,x) \ + /* See Note [Heap memory barriers] in SMP.h */ \ + prim_read_barrier; \ + switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \ + (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \ + case \ + IND, \ + IND_STATIC: \ + { \ + x = StgInd_indirectee(x); \ + goto again; \ + } \ + case \ + FUN, \ + FUN_1_0, \ + FUN_0_1, \ + FUN_2_0, \ + FUN_1_1, \ + FUN_0_2, \ + FUN_STATIC, \ + BCO, \ + PAP: \ + { \ + ret(x); \ + } \ + default: \ + { \ + x = UNTAG_IF_PROF(x); \ + jump %ENTRY_CODE(info) (x); \ + } \ + } + +// 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 "rts/Constants.h" +#include "DerivedConstants.h" +#include "rts/storage/ClosureTypes.h" +#include "rts/storage/FunTypes.h" +#include "rts/OSThreads.h" + +/* + * Need MachRegs, because some of the RTS code is conditionally + * compiled based on REG_R1, REG_R2, etc. + */ +#include "stg/MachRegsForHost.h" + +#include "rts/prof/LDV.h" + +#undef BLOCK_SIZE +#undef MBLOCK_SIZE +#include "rts/storage/Block.h" /* For Bdescr() */ + + +#define MyCapability() (BaseReg - OFFSET_Capability_r) + +/* ------------------------------------------------------------------------- + Info tables + ------------------------------------------------------------------------- */ + +#if defined(PROFILING) +#define PROF_HDR_FIELDS(w_,hdr1,hdr2) \ + w_ hdr1, \ + w_ hdr2, +#else +#define PROF_HDR_FIELDS(w_,hdr1,hdr2) /* nothing */ +#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) \ + HP_CHK_GEN_TICKY(bytes); \ + TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \ + CCCS_ALLOC(bytes); + +#define HEAP_CHECK(bytes,failure) \ + TICK_BUMP(HEAP_CHK_ctr); \ + Hp = Hp + (bytes); \ + if (Hp > HpLim) { HpAlloc = (bytes); failure; } \ + TICK_ALLOC_HEAP_NOCTR(bytes); + +#define ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,failure) \ + HEAP_CHECK(bytes,failure) \ + TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \ + CCCS_ALLOC(bytes); + +#define ALLOC_PRIM_(bytes,fun) \ + ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM(fun)); + +#define ALLOC_PRIM_P(bytes,fun,arg) \ + ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_P(fun,arg)); + +#define ALLOC_PRIM_N(bytes,fun,arg) \ + ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_N(fun,arg)); + +/* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */ +#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), CCCS) + +#define HP_CHK_GEN_TICKY(bytes) \ + HP_CHK_GEN(bytes); \ + TICK_ALLOC_HEAP_NOCTR(bytes); + +#define HP_CHK_P(bytes, fun, arg) \ + HEAP_CHECK(bytes, GC_PRIM_P(fun,arg)) + +// TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed? +// -NSF March 2013 +#define ALLOC_P_TICKY(bytes, fun, arg) \ + HP_CHK_P(bytes); \ + TICK_ALLOC_HEAP_NOCTR(bytes); + +#define CHECK_GC() \ + (bdescr_link(CurrentNursery) == NULL || \ + generation_n_new_large_words(W_[g0]) >= TO_W_(CLong[large_alloc_lim])) + +// allocate() allocates from the nursery, so we check to see +// whether the nursery is nearly empty in any function that uses +// allocate() - this includes many of the primops. +// +// HACK alert: the __L__ stuff is here to coax the common-block +// eliminator into commoning up the call stg_gc_noregs() with the same +// code that gets generated by a STK_CHK_GEN() in the same proc. We +// also need an if (0) { goto __L__; } so that the __L__ label isn't +// optimised away by the control-flow optimiser prior to common-block +// elimination (it will be optimised away later). +// +// This saves some code in gmp-wrappers.cmm where we have lots of +// MAYBE_GC() in the same proc as STK_CHK_GEN(). +// +#define MAYBE_GC(retry) \ + if (CHECK_GC()) { \ + HpAlloc = 0; \ + goto __L__; \ + __L__: \ + call stg_gc_noregs(); \ + goto retry; \ + } \ + if (0) { goto __L__; } + +#define GC_PRIM(fun) \ + jump stg_gc_prim(fun); + +// Version of GC_PRIM for use in low-level Cmm. We can call +// stg_gc_prim, because it takes one argument and therefore has a +// platform-independent calling convention (Note [Syntax of .cmm +// files] in GHC.Cmm.Parser). +#define GC_PRIM_LL(fun) \ + R1 = fun; \ + jump stg_gc_prim [R1]; + +// We pass the fun as the second argument, because the arg is +// usually already in the first argument position (R1), so this +// avoids moving it to a different register / stack slot. +#define GC_PRIM_N(fun,arg) \ + jump stg_gc_prim_n(arg,fun); + +#define GC_PRIM_P(fun,arg) \ + jump stg_gc_prim_p(arg,fun); + +#define GC_PRIM_P_LL(fun,arg) \ + R1 = arg; \ + R2 = fun; \ + jump stg_gc_prim_p_ll [R1,R2]; + +#define GC_PRIM_PP(fun,arg1,arg2) \ + jump stg_gc_prim_pp(arg1,arg2,fun); + +#define MAYBE_GC_(fun) \ + if (CHECK_GC()) { \ + HpAlloc = 0; \ + GC_PRIM(fun) \ + } + +#define MAYBE_GC_N(fun,arg) \ + if (CHECK_GC()) { \ + HpAlloc = 0; \ + GC_PRIM_N(fun,arg) \ + } + +#define MAYBE_GC_P(fun,arg) \ + if (CHECK_GC()) { \ + HpAlloc = 0; \ + GC_PRIM_P(fun,arg) \ + } + +#define MAYBE_GC_PP(fun,arg1,arg2) \ + if (CHECK_GC()) { \ + HpAlloc = 0; \ + GC_PRIM_PP(fun,arg1,arg2) \ + } + +#define STK_CHK_LL(n, fun) \ + TICK_BUMP(STK_CHK_ctr); \ + if (Sp - (n) < SpLim) { \ + GC_PRIM_LL(fun) \ + } + +#define STK_CHK_P_LL(n, fun, arg) \ + TICK_BUMP(STK_CHK_ctr); \ + if (Sp - (n) < SpLim) { \ + GC_PRIM_P_LL(fun,arg) \ + } + +#define STK_CHK_PP(n, fun, arg1, arg2) \ + TICK_BUMP(STK_CHK_ctr); \ + if (Sp - (n) < SpLim) { \ + GC_PRIM_PP(fun,arg1,arg2) \ + } + +#define STK_CHK_ENTER(n, closure) \ + TICK_BUMP(STK_CHK_ctr); \ + if (Sp - (n) < SpLim) { \ + jump __stg_gc_enter_1(closure); \ + } + +// A funky heap check used by AutoApply.cmm + +#define HP_CHK_NP_ASSIGN_SP0(size,f) \ + HEAP_CHECK(size, Sp(0) = f; jump __stg_gc_enter_1 [R1];) + +/* ----------------------------------------------------------------------------- + Closure headers + -------------------------------------------------------------------------- */ + +/* + * This is really ugly, since we don't do the rest of StgHeader this + * way. The problem is that values from DerivedConstants.h cannot be + * dependent on the way (SMP, PROF etc.). For SIZEOF_StgHeader we get + * the value from GHC, but it seems like too much trouble to do that + * for StgThunkHeader. + */ +#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader + +#define StgThunk_payload(__ptr__,__ix__) \ + W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)] + +/* ----------------------------------------------------------------------------- + Closures + -------------------------------------------------------------------------- */ + +/* The offset of the payload of an array */ +#define BYTE_ARR_CTS(arr) ((arr) + SIZEOF_StgArrBytes) + +/* The number of words allocated in an array payload */ +#define BYTE_ARR_WDS(arr) ROUNDUP_BYTES_TO_WDS(StgArrBytes_bytes(arr)) + +/* 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 && \ + 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(UNTAG(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: + */ +#if defined(TABLES_NEXT_TO_CODE) +/* + * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset + * instead of the normal pointer. + */ + +#define StgFunInfoExtra_slow_apply(fun_info) \ + (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info)) \ + + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable) + +#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 + +#define mutArrCardMask ((1 << MUT_ARR_PTRS_CARD_BITS) - 1) +#define mutArrPtrCardDown(i) ((i) >> MUT_ARR_PTRS_CARD_BITS) +#define mutArrPtrCardUp(i) (((i) + mutArrCardMask) >> MUT_ARR_PTRS_CARD_BITS) +#define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n)) + +#if defined(PROFILING) || defined(DEBUG) +#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size) +#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr") +#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" overwritingMutableClosureOfs(c "ptr", off) +#else +#define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ +#define OVERWRITING_CLOSURE(c) /* nothing */ +/* This is used to zero slop after shrunk arrays. It is important that we do + * this whenever profiling is enabled as described in Note [slop on the heap] + * in Storage.c. */ +#define OVERWRITING_CLOSURE_MUTABLE(c, off) \ + if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } +#endif + +// Memory barriers. +// For discussion of how these are used to fence heap object +// accesses see Note [Heap memory barriers] in SMP.h. +#if defined(THREADED_RTS) +#define prim_read_barrier prim %read_barrier() +#else +#define prim_read_barrier /* nothing */ +#endif +#if defined(THREADED_RTS) +#define prim_write_barrier prim %write_barrier() +#else +#define prim_write_barrier /* nothing */ +#endif + +/* ----------------------------------------------------------------------------- + Ticky macros + -------------------------------------------------------------------------- */ + +#if defined(TICKY_TICKY) +#define TICK_BUMP_BY(ctr,n) W_[ctr] = W_[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) +// ENT_DYN_THK_ctr doesn't exist anymore. Could be ENT_DYN_THK_SINGLE_ctr or +// ENT_DYN_THK_MANY_ctr +// #define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +#define TICK_ENT_DYN_THK() + +#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_ENT_LNE() TICK_BUMP(ENT_LNE_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_fast_v16() TICK_BUMP(SLOW_CALL_fast_v16_ctr) +#define TICK_SLOW_CALL_fast_v() TICK_BUMP(SLOW_CALL_fast_v_ctr) +#define TICK_SLOW_CALL_fast_p() TICK_BUMP(SLOW_CALL_fast_p_ctr) +#define TICK_SLOW_CALL_fast_pv() TICK_BUMP(SLOW_CALL_fast_pv_ctr) +#define TICK_SLOW_CALL_fast_pp() TICK_BUMP(SLOW_CALL_fast_pp_ctr) +#define TICK_SLOW_CALL_fast_ppv() TICK_BUMP(SLOW_CALL_fast_ppv_ctr) +#define TICK_SLOW_CALL_fast_ppp() TICK_BUMP(SLOW_CALL_fast_ppp_ctr) +#define TICK_SLOW_CALL_fast_pppv() TICK_BUMP(SLOW_CALL_fast_pppv_ctr) +#define TICK_SLOW_CALL_fast_pppp() TICK_BUMP(SLOW_CALL_fast_pppp_ctr) +#define TICK_SLOW_CALL_fast_ppppp() TICK_BUMP(SLOW_CALL_fast_ppppp_ctr) +#define TICK_SLOW_CALL_fast_pppppp() TICK_BUMP(SLOW_CALL_fast_pppppp_ctr) +#define TICK_VERY_SLOW_CALL() TICK_BUMP(VERY_SLOW_CALL_ctr) + +/* 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 */ + +#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(bytes) \ + TICK_BUMP(ALLOC_RTS_ctr); \ + TICK_BUMP_BY(ALLOC_RTS_tot,bytes) + +/* ----------------------------------------------------------------------------- + Misc junk + -------------------------------------------------------------------------- */ + +#define NO_TREC stg_NO_TREC_closure +#define END_TSO_QUEUE stg_END_TSO_QUEUE_closure +#define STM_AWOKEN stg_STM_AWOKEN_closure + +#define recordMutableCap(p, gen) \ + 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(); \ + 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) \ + P_ __p; \ + W_ __bd; \ + W_ __gen; \ + __p = p; \ + __bd = Bdescr(__p); \ + __gen = TO_W_(bdescr_gen_no(__bd)); \ + if (__gen > 0) { recordMutableCap(__p, __gen); } + +/* ----------------------------------------------------------------------------- + Update remembered set write barrier + -------------------------------------------------------------------------- */ + +/* ----------------------------------------------------------------------------- + Arrays + -------------------------------------------------------------------------- */ + +/* Complete function body for the clone family of (mutable) array ops. + Defined as a macro to avoid function call overhead or code + duplication. */ +#define cloneArray(info, src, offset, n) \ + W_ words, size; \ + gcptr dst, dst_p, src_p; \ + \ + again: MAYBE_GC(again); \ + \ + size = n + mutArrPtrsCardWords(n); \ + words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size; \ + ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \ + TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0); \ + \ + SET_HDR(dst, info, CCCS); \ + StgMutArrPtrs_ptrs(dst) = n; \ + StgMutArrPtrs_size(dst) = size; \ + \ + dst_p = dst + SIZEOF_StgMutArrPtrs; \ + src_p = src + SIZEOF_StgMutArrPtrs + WDS(offset); \ + prim %memcpy(dst_p, src_p, n * SIZEOF_W, SIZEOF_W); \ + \ + return (dst); + +#define copyArray(src, src_off, dst, dst_off, n) \ + W_ dst_elems_p, dst_p, src_p, bytes; \ + \ + if ((n) != 0) { \ + SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); \ + \ + dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs; \ + dst_p = dst_elems_p + WDS(dst_off); \ + src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off); \ + bytes = WDS(n); \ + \ + prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); \ + \ + setCards(dst, dst_off, n); \ + } \ + \ + return (); + +#define copyMutableArray(src, src_off, dst, dst_off, n) \ + W_ dst_elems_p, dst_p, src_p, bytes; \ + \ + if ((n) != 0) { \ + SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS); \ + \ + dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs; \ + dst_p = dst_elems_p + WDS(dst_off); \ + src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off); \ + bytes = WDS(n); \ + \ + if ((src) == (dst)) { \ + prim %memmove(dst_p, src_p, bytes, SIZEOF_W); \ + } else { \ + prim %memcpy(dst_p, src_p, bytes, SIZEOF_W); \ + } \ + \ + setCards(dst, dst_off, n); \ + } \ + \ + return (); + +/* + * Set the cards in the array pointed to by arr for an + * update to n elements, starting at element dst_off. + */ +#define setCards(arr, dst_off, n) \ + setCardsValue(arr, dst_off, n, 1) + +/* + * Set the cards in the array pointed to by arr for an + * update to n elements, starting at element dst_off to value (0 to indicate + * clean, 1 to indicate dirty). + */ +#define setCardsValue(arr, dst_off, n, value) \ + W_ __start_card, __end_card, __cards, __dst_cards_p; \ + __dst_cards_p = (arr) + SIZEOF_StgMutArrPtrs + WDS(StgMutArrPtrs_ptrs(arr)); \ + __start_card = mutArrPtrCardDown(dst_off); \ + __end_card = mutArrPtrCardDown((dst_off) + (n) - 1); \ + __cards = __end_card - __start_card + 1; \ + prim %memset(__dst_cards_p + __start_card, (value), __cards, 1) + +/* Complete function body for the clone family of small (mutable) + array ops. Defined as a macro to avoid function call overhead or + code duplication. */ +#define cloneSmallArray(info, src, offset, n) \ + W_ words, size; \ + gcptr dst, dst_p, src_p; \ + \ + again: MAYBE_GC(again); \ + \ + words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + n; \ + ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \ + TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0); \ + \ + SET_HDR(dst, info, CCCS); \ + StgSmallMutArrPtrs_ptrs(dst) = n; \ + \ + dst_p = dst + SIZEOF_StgSmallMutArrPtrs; \ + src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(offset); \ + prim %memcpy(dst_p, src_p, n * SIZEOF_W, SIZEOF_W); \ + \ + return (dst); + + +// +// Nonmoving write barrier helpers +// +// See Note [Update remembered set] in NonMovingMark.c. + +#if defined(THREADED_RTS) +#define IF_NONMOVING_WRITE_BARRIER_ENABLED \ + if (W_[nonmoving_write_barrier_enabled] != 0) (likely: False) +#else +// A similar measure is also taken in rts/NonMoving.h, but that isn't visible from C-- +#define IF_NONMOVING_WRITE_BARRIER_ENABLED \ + if (0) +#define nonmoving_write_barrier_enabled 0 +#endif + +// A useful helper for pushing a pointer to the update remembered set. +#define updateRemembSetPushPtr(p) \ + IF_NONMOVING_WRITE_BARRIER_ENABLED { \ + ccall updateRemembSetPushClosure_(BaseReg "ptr", p "ptr"); \ + } |