packages feed

ghc-lib-parser 8.8.0.20190723 → 8.8.1

raw patch · 58 files changed

+58/−7686 lines, 58 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- ByteCodeTypes: CgBreakInfo :: [(Id, Word16)] -> Type -> CgBreakInfo
+ ByteCodeTypes: CgBreakInfo :: [Maybe (Id, Word16)] -> Type -> CgBreakInfo
- ByteCodeTypes: [cgb_vars] :: CgBreakInfo -> [(Id, Word16)]
+ ByteCodeTypes: [cgb_vars] :: CgBreakInfo -> [Maybe (Id, Word16)]

Files

compiler/coreSyn/CoreArity.hs view
@@ -1057,10 +1057,17 @@   where     empty_subst = mkEmptyTCvSubst in_scope +    go :: Arity              -- Number of value args to expand to+       -> TCvSubst -> Type   -- We are really looking at subst(ty)+       -> [EtaInfo]          -- Accumulating parameter+       -> (InScopeSet, [EtaInfo])     go n subst ty eis       -- See Note [exprArity invariant]++       ----------- Done!  No more expansion needed        | n == 0        = (getTCvInScope subst, reverse eis) +       ----------- Forall types  (forall a. ty)        | Just (tcv,ty') <- splitForAllTy_maybe ty        , let (subst', tcv') = Type.substVarBndr subst tcv        = let ((n_subst, n_tcv), n_n)@@ -1071,10 +1078,11 @@                --   lambda \co:ty. e co. In this case we generate a new variable                --   of the coercion type, update the scope, and reduce n by 1.                | isTyVar tcv = ((subst', tcv'), n)-               | otherwise  = (freshEtaId n subst' (varType tcv'), n-1)+               | otherwise   = (freshEtaId n subst' (varType tcv'), n-1)            -- Avoid free vars of the original expression          in go n_n n_subst ty' (EtaVar n_tcv : eis) +       ----------- Function types  (t1 -> t2)        | Just (arg_ty, res_ty) <- splitFunTy_maybe ty        , not (isTypeLevPoly arg_ty)           -- See Note [Levity polymorphism invariants] in CoreSyn@@ -1084,14 +1092,19 @@            -- Avoid free vars of the original expression        = go (n-1) subst' res_ty (EtaVar eta_id' : eis) +       ----------- Newtypes+       -- Given this:+       --      newtype T = MkT ([T] -> Int)+       -- Consider eta-expanding this+       --      eta_expand 1 e T+       -- We want to get+       --      coerce T (\x::[T] -> (coerce ([T]->Int) e) x)        | Just (co, ty') <- topNormaliseNewType_maybe ty-       =        -- Given this:-                --      newtype T = MkT ([T] -> Int)-                -- Consider eta-expanding this-                --      eta_expand 1 e T-                -- We want to get-                --      coerce T (\x::[T] -> (coerce ([T]->Int) e) x)-         go n subst ty' (pushCoercion co eis)+       , let co' = Coercion.substCo subst co+             -- Remember to apply the substitution to co (#16979)+             -- (or we could have applied to ty, but then+             --  we'd have had to zap it for the recursive call)+       = go n subst ty' (pushCoercion co' eis)         | otherwise       -- We have an expression of arity > 0,                          -- but its type isn't a function, or a binder
compiler/coreSyn/CoreSyn.hs view
@@ -608,6 +608,8 @@      same number of arguments, counting both types and values; we call this the      "join arity" (to distinguish from regular arity, which only counts values). +     See Note [Join points are less general than the paper]+   2. For join arity n, the right-hand side must begin with at least n lambdas.      No ticks, no casts, just lambdas!  C.f. CoreUtils.joinRhsArity. @@ -656,6 +658,26 @@ Core Lint will check these invariants, anticipating that any binder whose OccInfo is marked AlwaysTailCalled will become a join point as soon as the simplifier (or simpleOptPgm) runs.++Note [Join points are less general than the paper]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In the paper "Compiling without continuations", this expression is+perfectly valid:++    join { j = \_ -> e }+    in (case blah of       )+       (  True  -> j void# ) arg+       (  False -> blah    )++assuming 'j' has arity 1.   Here the call to 'j' does not look like a+tail call, but actually everything is fine. See Section 3, "Managing \Delta"+in the paper.++In GHC, however, we adopt a slightly more restrictive subset, in which+join point calls must be tail calls.  I think we /could/ loosen it up, but+in fact the simplifier ensures that we always get tail calls, and it makes+the back end a bit easier I think.  Generally, just less to think about;+nothing deeper than that.  Note [The type of a join point] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
compiler/ghci/ByteCodeTypes.hs view
@@ -35,6 +35,7 @@ import Data.ByteString (ByteString) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap+import Data.Maybe (catMaybes) import GHC.Exts.Heap import GHC.Stack.CCS @@ -110,14 +111,15 @@ -- | Information about a breakpoint that we know at code-generation time data CgBreakInfo    = CgBreakInfo-   { cgb_vars   :: [(Id,Word16)]+   { cgb_vars   :: [Maybe (Id,Word16)]    , cgb_resty  :: Type    }+-- See Note [Syncing breakpoint info] in compiler/main/InteractiveEval.hs  -- Not a real NFData instance because we can't rnf Id or Type seqCgBreakInfo :: CgBreakInfo -> () seqCgBreakInfo CgBreakInfo{..} =-  rnf (map snd cgb_vars) `seq`+  rnf (map snd (catMaybes (cgb_vars))) `seq`   seqType cgb_resty  instance Outputable UnlinkedBCO where
ghc-lib-parser.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-parser-version: 8.8.0.20190723+version: 8.8.1 license: BSD3 license-file: LICENSE category: Development@@ -44,11 +44,9 @@     ghc-lib/stage1/compiler/build/Config.hs     ghc-lib/stage0/compiler/build/Parser.hs     ghc-lib/stage0/compiler/build/Lexer.hs-    includes/*.h+    includes/ghcconfig.h+    includes/MachDeps.h     includes/CodeGen.Platform.hs-    includes/rts/*.h-    includes/rts/storage/*.h-    includes/rts/prof/*.h     compiler/nativeGen/*.h     compiler/utils/*.h     compiler/*.h@@ -61,6 +59,7 @@     default-language:   Haskell2010     default-extensions: NoImplicitPrelude     include-dirs:+        includes         ghc-lib/generated         ghc-lib/stage0/compiler/build         ghc-lib/stage1/compiler/build
ghc-lib/generated/ghcversion.h view
@@ -5,8 +5,7 @@ # define __GLASGOW_HASKELL__ 808 #endif -#define __GLASGOW_HASKELL_PATCHLEVEL1__ 0-#define __GLASGOW_HASKELL_PATCHLEVEL2__ 20190721+#define __GLASGOW_HASKELL_PATCHLEVEL1__ 1  #define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\    ((ma)*100+(mi)) <  __GLASGOW_HASKELL__ || \
ghc-lib/stage0/compiler/build/Parser.hs view
@@ -12532,7 +12532,7 @@   {-# LINE 19 "<built-in>" #-}-{-# LINE 1 "/var/folders/f_/bb4zyb7d2_z9bqm3hrqrjgp40000gn/T/ghc33323_0/ghc_2.h" #-}+{-# LINE 1 "/var/folders/f_/bb4zyb7d2_z9bqm3hrqrjgp40000gn/T/ghc99894_0/ghc_2.h" #-}   
ghc-lib/stage1/compiler/build/Config.hs view
@@ -19,17 +19,17 @@ cProjectName          :: String cProjectName          = "The Glorious Glasgow Haskell Compilation System" cProjectGitCommitId   :: String-cProjectGitCommitId   = "3e139dba8b8fcc15c201803a0ae27255ada43c14"+cProjectGitCommitId   = "9c787d4d24f2b515934c8503ee2bbd7cfac4da20" cProjectVersion       :: String-cProjectVersion       = "8.8.0.20190721"+cProjectVersion       = "8.8.1" cProjectVersionInt    :: String cProjectVersionInt    = "808" cProjectPatchLevel    :: String-cProjectPatchLevel    = "020190721"+cProjectPatchLevel    = "1" cProjectPatchLevel1   :: String-cProjectPatchLevel1   = "0"+cProjectPatchLevel1   = "1" cProjectPatchLevel2   :: String-cProjectPatchLevel2   = "20190721"+cProjectPatchLevel2   = "" cBooterVersion        :: String cBooterVersion        = "8.4.3" cStage                :: String
− includes/Cmm.h
@@ -1,941 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (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/cmm/CmmParse.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- * mkDerivedConstants.c.  If you need to access a field that doesn't- * already have a macro, edit that file (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/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-#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) converts n to W_ type from a smaller type */-#if SIZEOF_W == 4-#define TO_I64(x) %sx64(x)-#define TO_W_(x) %sx32(x)-#define HALF_W_(x) %lobits16(x)-#elif SIZEOF_W == 8-#define TO_I64(x) (x)-#define TO_W_(x) %sx64(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)-#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/RtsMachRegs.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 CmmParse.y).-#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(THREADED_RTS) && 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_OFS(c,n) foreign "C" overwritingClosureOfs(c "ptr", n)-#else-#define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */-#define OVERWRITING_CLOSURE(c) /* nothing */-#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */-#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) 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_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)--/* ------------------------------------------------------------------------------   Saving and restoring STG registers--   STG registers must be saved around a C call, just in case the STG-   register is mapped to a caller-saves machine register.  Normally we-   don't need to worry about this the code generator has already-   loaded any live STG registers into variables for us, but in-   hand-written low-level Cmm code where we don't know which registers-   are live, we might have to save them all.-   -------------------------------------------------------------------------- */--#define SAVE_STGREGS                            \-    W_ r1, r2, r3,  r4,  r5,  r6,  r7,  r8;     \-    F_ f1, f2, f3, f4, f5, f6;                  \-    D_ d1, d2, d3, d4, d5, d6;                  \-    L_ l1;                                      \-                                                \-    r1 = R1;                                    \-    r2 = R2;                                    \-    r3 = R3;                                    \-    r4 = R4;                                    \-    r5 = R5;                                    \-    r6 = R6;                                    \-    r7 = R7;                                    \-    r8 = R8;                                    \-                                                \-    f1 = F1;                                    \-    f2 = F2;                                    \-    f3 = F3;                                    \-    f4 = F4;                                    \-    f5 = F5;                                    \-    f6 = F6;                                    \-                                                \-    d1 = D1;                                    \-    d2 = D2;                                    \-    d3 = D3;                                    \-    d4 = D4;                                    \-    d5 = D5;                                    \-    d6 = D6;                                    \-                                                \-    l1 = L1;---#define RESTORE_STGREGS                         \-    R1 = r1;                                    \-    R2 = r2;                                    \-    R3 = r3;                                    \-    R4 = r4;                                    \-    R5 = r5;                                    \-    R6 = r6;                                    \-    R7 = r7;                                    \-    R8 = r8;                                    \-                                                \-    F1 = f1;                                    \-    F2 = f2;                                    \-    F3 = f3;                                    \-    F4 = f4;                                    \-    F5 = f5;                                    \-    F6 = f6;                                    \-                                                \-    D1 = d1;                                    \-    D2 = d2;                                    \-    D3 = d3;                                    \-    D4 = d4;                                    \-    D5 = d5;                                    \-    D6 = d6;                                    \-                                                \-    L1 = l1;--/* ------------------------------------------------------------------------------   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); }--/* ------------------------------------------------------------------------------   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, dst_cards_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);              \-                                                                  \-        dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \-        setCards(dst_cards_p, dst_off, n);                        \-    }                                                             \-                                                                  \-    return ();--#define copyMutableArray(src, src_off, dst, dst_off, n)           \-  W_ dst_elems_p, dst_p, src_p, dst_cards_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);          \-        }                                                         \-                                                                  \-        dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \-        setCards(dst_cards_p, dst_off, n);                        \-    }                                                             \-                                                                  \-    return ();--/*- * Set the cards in the cards table pointed to by dst_cards_p for an- * update to n elements, starting at element dst_off.- */-#define setCards(dst_cards_p, dst_off, n)                      \-    W_ __start_card, __end_card, __cards;                      \-    __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, 1, __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);
− includes/HsFFI.h
@@ -1,141 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2000- *- * A mapping for Haskell types to C types, including the corresponding bounds.- * Intended to be used in conjuction with the FFI.- *- * WARNING: Keep this file and StgTypes.h in synch!- *- * ---------------------------------------------------------------------------*/--#pragma once--#if defined(__cplusplus)-extern "C" {-#endif--/* get types from GHC's runtime system */-#include "ghcconfig.h"-#include "stg/Types.h"--/* get limits for floating point types */-#include <float.h>--typedef StgChar                 HsChar;-typedef StgInt                  HsInt;-typedef StgInt8                 HsInt8;-typedef StgInt16                HsInt16;-typedef StgInt32                HsInt32;-typedef StgInt64                HsInt64;-typedef StgWord                 HsWord;-typedef StgWord8                HsWord8;-typedef StgWord16               HsWord16;-typedef StgWord32               HsWord32;-typedef StgWord64               HsWord64;-typedef StgFloat                HsFloat;-typedef StgDouble               HsDouble;-typedef StgInt                  HsBool;-typedef void*                   HsPtr;          /* this should better match StgAddr */-typedef void                    (*HsFunPtr)(void); /* this should better match StgAddr */-typedef void*                   HsStablePtr;--/* this should correspond to the type of StgChar in StgTypes.h */-#define HS_CHAR_MIN             0-#define HS_CHAR_MAX             0x10FFFF--/* is it true or not?  */-#define HS_BOOL_FALSE           0-#define HS_BOOL_TRUE            1--#define HS_BOOL_MIN             HS_BOOL_FALSE-#define HS_BOOL_MAX             HS_BOOL_TRUE---#define HS_INT_MIN              STG_INT_MIN-#define HS_INT_MAX              STG_INT_MAX-#define HS_WORD_MAX             STG_WORD_MAX--#define HS_INT8_MIN             STG_INT8_MIN-#define HS_INT8_MAX             STG_INT8_MAX-#define HS_INT16_MIN            STG_INT16_MIN-#define HS_INT16_MAX            STG_INT16_MAX-#define HS_INT32_MIN            STG_INT32_MIN-#define HS_INT32_MAX            STG_INT32_MAX-#define HS_INT64_MIN            STG_INT64_MIN-#define HS_INT64_MAX            STG_INT64_MAX-#define HS_WORD8_MAX            STG_WORD8_MAX-#define HS_WORD16_MAX           STG_WORD16_MAX-#define HS_WORD32_MAX           STG_WORD32_MAX-#define HS_WORD64_MAX           STG_WORD64_MAX--#define HS_FLOAT_RADIX          FLT_RADIX-#define HS_FLOAT_ROUNDS         FLT_ROUNDS-#define HS_FLOAT_EPSILON        FLT_EPSILON-#define HS_FLOAT_DIG            FLT_DIG-#define HS_FLOAT_MANT_DIG       FLT_MANT_DIG-#define HS_FLOAT_MIN            FLT_MIN-#define HS_FLOAT_MIN_EXP        FLT_MIN_EXP-#define HS_FLOAT_MIN_10_EXP     FLT_MIN_10_EXP-#define HS_FLOAT_MAX            FLT_MAX-#define HS_FLOAT_MAX_EXP        FLT_MAX_EXP-#define HS_FLOAT_MAX_10_EXP     FLT_MAX_10_EXP--#define HS_DOUBLE_RADIX         DBL_RADIX-#define HS_DOUBLE_ROUNDS        DBL_ROUNDS-#define HS_DOUBLE_EPSILON       DBL_EPSILON-#define HS_DOUBLE_DIG           DBL_DIG-#define HS_DOUBLE_MANT_DIG      DBL_MANT_DIG-#define HS_DOUBLE_MIN           DBL_MIN-#define HS_DOUBLE_MIN_EXP       DBL_MIN_EXP-#define HS_DOUBLE_MIN_10_EXP    DBL_MIN_10_EXP-#define HS_DOUBLE_MAX           DBL_MAX-#define HS_DOUBLE_MAX_EXP       DBL_MAX_EXP-#define HS_DOUBLE_MAX_10_EXP    DBL_MAX_10_EXP--extern void hs_init     (int *argc, char **argv[]);-extern void hs_exit     (void);-extern void hs_exit_nowait(void);-extern void hs_set_argv (int argc, char *argv[]);-extern void hs_thread_done (void);--extern void hs_perform_gc (void);--// Lock the stable pointer table. The table must be unlocked-// again before calling any Haskell functions, even if those-// functions do not manipulate stable pointers. The Haskell-// garbage collector will not be able to run until this lock-// is released! It is also forbidden to call hs_free_fun_ptr-// or any stable pointer-related FFI functions other than-// hs_free_stable_ptr_unsafe while the table is locked.-extern void hs_lock_stable_ptr_table (void);--// A deprecated synonym.-extern void hs_lock_stable_tables (void);--// Unlock the stable pointer table.-extern void hs_unlock_stable_ptr_table (void);--// A deprecated synonym.-extern void hs_unlock_stable_tables (void);--// Free a stable pointer assuming that the stable pointer-// table is already locked.-extern void hs_free_stable_ptr_unsafe (HsStablePtr sp);--extern void hs_free_stable_ptr (HsStablePtr sp);-extern void hs_free_fun_ptr    (HsFunPtr fp);--extern StgPtr hs_spt_lookup(StgWord64 key1, StgWord64 key2);-extern int hs_spt_keys(StgPtr keys[], int szKeys);-extern int hs_spt_key_count (void);--extern void hs_try_putmvar (int capability, HsStablePtr sp);--/* -------------------------------------------------------------------------- */----#if defined(__cplusplus)-}-#endif
− includes/Rts.h
@@ -1,311 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * RTS external APIs.  This file declares everything that the GHC RTS- * exposes externally.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#if defined(__cplusplus)-extern "C" {-#endif--/* We include windows.h very early, as on Win64 the CONTEXT type has-   fields "R8", "R9" and "R10", which goes bad if we've already-   #define'd those names for our own purposes (in stg/Regs.h) */-#if defined(HAVE_WINDOWS_H)-#include <windows.h>-#endif--#if !defined(IN_STG_CODE)-#define IN_STG_CODE 0-#endif-#include "Stg.h"--#include "HsFFI.h"-#include "RtsAPI.h"--// Turn off inlining when debugging - it obfuscates things-#if defined(DEBUG)-# undef  STATIC_INLINE-# define STATIC_INLINE static-#endif--#include "rts/Types.h"-#include "rts/Time.h"--#if __GNUC__ >= 3-#define ATTRIBUTE_ALIGNED(n) __attribute__((aligned(n)))-#else-#define ATTRIBUTE_ALIGNED(n) /*nothing*/-#endif--// Symbols that are extern, but private to the RTS, are declared-// with visibility "hidden" to hide them outside the RTS shared-// library.-#if defined(HAS_VISIBILITY_HIDDEN)-#define RTS_PRIVATE  GNUC3_ATTRIBUTE(visibility("hidden"))-#else-#define RTS_PRIVATE  /* disabled: RTS_PRIVATE */-#endif--#if __GNUC__ >= 4-#define RTS_UNLIKELY(p) __builtin_expect((p),0)-#else-#define RTS_UNLIKELY(p) p-#endif--/* __builtin_unreachable is supported since GNU C 4.5 */-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5)-#define RTS_UNREACHABLE __builtin_unreachable()-#else-#define RTS_UNREACHABLE abort()-#endif--/* Fix for mingw stat problem (done here so it's early enough) */-#if defined(mingw32_HOST_OS)-#define __MSVCRT__ 1-#endif--/* Needed to get the macro version of errno on some OSs, and also to-   get prototypes for the _r versions of C library functions. */-#if !defined(_REENTRANT)-#define _REENTRANT 1-#endif--/*- * We often want to know the size of something in units of an- * StgWord... (rounded up, of course!)- */-#define ROUNDUP_BYTES_TO_WDS(n) (((n) + sizeof(W_) - 1) / sizeof(W_))--#define sizeofW(t) ROUNDUP_BYTES_TO_WDS(sizeof(t))--/* ------------------------------------------------------------------------------   Assertions and Debuggery--   CHECK(p)   evaluates p and terminates with an error if p is false-   ASSERT(p)  like CHECK(p) if DEBUG is on, otherwise a no-op-   -------------------------------------------------------------------------- */--void _assertFail(const char *filename, unsigned int linenum)-   GNUC3_ATTRIBUTE(__noreturn__);--#define CHECK(predicate)                        \-        if (predicate)                          \-            /*null*/;                           \-        else                                    \-            _assertFail(__FILE__, __LINE__)--#define CHECKM(predicate, msg, ...)             \-        if (predicate)                          \-            /*null*/;                           \-        else                                    \-            barf(msg, ##__VA_ARGS__)--#if !defined(DEBUG)-#define ASSERT(predicate) /* nothing */-#define ASSERTM(predicate,msg,...) /* nothing */-#else-#define ASSERT(predicate) CHECK(predicate)-#define ASSERTM(predicate,msg,...) CHECKM(predicate,msg,##__VA_ARGS__)-#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)--#if defined(DEBUG)-#define USED_IF_DEBUG-#define USED_IF_NOT_DEBUG STG_UNUSED-#else-#define USED_IF_DEBUG STG_UNUSED-#define USED_IF_NOT_DEBUG-#endif--#if defined(THREADED_RTS)-#define USED_IF_THREADS-#define USED_IF_NOT_THREADS STG_UNUSED-#else-#define USED_IF_THREADS STG_UNUSED-#define USED_IF_NOT_THREADS-#endif--#define FMT_SizeT    "zu"-#define FMT_HexSizeT "zx"--/* ------------------------------------------------------------------------------   Include everything STG-ish-   -------------------------------------------------------------------------- */--/* System headers: stdlib.h is needed 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>--#include "rts/Config.h"--/* Global constraints */-#include "rts/Constants.h"--/* Profiling information */-#include "rts/prof/CCS.h"-#include "rts/prof/LDV.h"--/* Parallel information */-#include "rts/OSThreads.h"-#include "rts/SpinLock.h"--#include "rts/Messages.h"-#include "rts/Threads.h"--/* Storage format definitions */-#include "rts/storage/FunTypes.h"-#include "rts/storage/InfoTables.h"-#include "rts/storage/Closures.h"-#include "rts/storage/Heap.h"-#include "rts/storage/ClosureTypes.h"-#include "rts/storage/TSO.h"-#include "stg/MiscClosures.h" /* InfoTables, closures etc. defined in the RTS */-#include "rts/storage/Block.h"-#include "rts/storage/ClosureMacros.h"-#include "rts/storage/MBlock.h"-#include "rts/storage/GC.h"--/* Other RTS external APIs */-#include "rts/Parallel.h"-#include "rts/Signals.h"-#include "rts/BlockSignals.h"-#include "rts/Hpc.h"-#include "rts/Flags.h"-#include "rts/Adjustor.h"-#include "rts/FileLock.h"-#include "rts/GetTime.h"-#include "rts/Globals.h"-#include "rts/IOManager.h"-#include "rts/Linker.h"-#include "rts/Ticky.h"-#include "rts/Timer.h"-#include "rts/StablePtr.h"-#include "rts/StableName.h"-#include "rts/TTY.h"-#include "rts/Utils.h"-#include "rts/PrimFloat.h"-#include "rts/Main.h"-#include "rts/Profiling.h"-#include "rts/StaticPtrTable.h"-#include "rts/Libdw.h"-#include "rts/LibdwPool.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;--void reportStackOverflow(StgTSO* tso);-void reportHeapOverflow(void);--void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__);--#if !defined(mingw32_HOST_OS)-int stg_sig_install (int, int, void *);-#endif--/* ------------------------------------------------------------------------------   Ways-   -------------------------------------------------------------------------- */--// Returns non-zero if the RTS is a profiling version-int rts_isProfiled(void);--// Returns non-zero if the RTS is a dynamically-linked version-int rts_isDynamic(void);--/* ------------------------------------------------------------------------------   RTS Exit codes-   -------------------------------------------------------------------------- */--/* 255 is allegedly used by dynamic linkers to report linking failure */-#define EXIT_INTERNAL_ERROR 254-#define EXIT_DEADLOCK       253-#define EXIT_INTERRUPTED    252-#define EXIT_HEAPOVERFLOW   251-#define EXIT_KILLED         250--/* ------------------------------------------------------------------------------   Miscellaneous garbage-   -------------------------------------------------------------------------- */--#if defined(DEBUG)-#define TICK_VAR(arity) \-  extern StgInt SLOW_CALLS_##arity; \-  extern StgInt RIGHT_ARITY_##arity; \-  extern StgInt TAGGED_PTR_##arity;--extern StgInt TOTAL_CALLS;--TICK_VAR(1)-TICK_VAR(2)-#endif--/* ------------------------------------------------------------------------------   Assertions and Debuggery-   -------------------------------------------------------------------------- */--#define IF_RTSFLAGS(c,s)  if (RtsFlags.c) { s; } doNothing()--#if defined(DEBUG)-#if IN_STG_CODE-#define IF_DEBUG(c,s)  if (RtsFlags[0].DebugFlags.c) { s; } doNothing()-#else-#define IF_DEBUG(c,s)  if (RtsFlags.DebugFlags.c) { s; } doNothing()-#endif-#else-#define IF_DEBUG(c,s)  doNothing()-#endif--#if defined(DEBUG)-#define DEBUG_ONLY(s) s-#else-#define DEBUG_ONLY(s) doNothing()-#endif--#if defined(DEBUG)-#define DEBUG_IS_ON   1-#else-#define DEBUG_IS_ON   0-#endif--/* ------------------------------------------------------------------------------   Useful macros and inline functions-   -------------------------------------------------------------------------- */--#if defined(__GNUC__)-#define SUPPORTS_TYPEOF-#endif--#if defined(SUPPORTS_TYPEOF)-#define stg_min(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _a : _b; })-#define stg_max(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _b : _a; })-#else-#define stg_min(a,b) ((a) <= (b) ? (a) : (b))-#define stg_max(a,b) ((a) <= (b) ? (b) : (a))-#endif--/* -------------------------------------------------------------------------- */--#if defined(__cplusplus)-}-#endif
− includes/RtsAPI.h
@@ -1,487 +0,0 @@-/* ----------------------------------------------------------------------------- *- * (c) The GHC Team, 1998-2004- *- * API for invoking Haskell functions via the RTS- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * --------------------------------------------------------------------------*/--#pragma once--#if defined(__cplusplus)-extern "C" {-#endif--#include "HsFFI.h"-#include "rts/Time.h"-#include "rts/EventLogWriter.h"--/*- * Running the scheduler- */-typedef enum {-    NoStatus,    /* not finished yet */-    Success,     /* completed successfully */-    Killed,      /* uncaught exception */-    Interrupted, /* stopped in response to a call to interruptStgRts */-    HeapExhausted /* out of memory */-} SchedulerStatus;--typedef struct StgClosure_ *HaskellObj;--/*- * An abstract type representing the token returned by rts_lock() and- * used when allocating objects and threads in the RTS.- */-typedef struct Capability_ Capability;--/*- * The public view of a Capability: we can be sure it starts with- * these two components (but it may have more private fields).- */-typedef struct CapabilityPublic_ {-    StgFunTable f;-    StgRegTable r;-} CapabilityPublic;--/* -----------------------------------------------------------------------------   RTS configuration settings, for passing to hs_init_ghc()-   ------------------------------------------------------------------------- */--typedef enum {-    RtsOptsNone,         // +RTS causes an error-    RtsOptsIgnore,       // Ignore command line arguments-    RtsOptsIgnoreAll,    // Ignore command line and Environment arguments-    RtsOptsSafeOnly,     // safe RTS options allowed; others cause an error-    RtsOptsAll           // all RTS options allowed-  } RtsOptsEnabledEnum;--struct GCDetails_;--// The RtsConfig struct is passed (by value) to hs_init_ghc().  The-// reason for using a struct is extensibility: we can add more-// fields to this later without breaking existing client code.-typedef struct {--    // Whether to interpret +RTS options on the command line-    RtsOptsEnabledEnum rts_opts_enabled;--    // Whether to give RTS flag suggestions-    HsBool rts_opts_suggestions;--    // additional RTS options-    const char *rts_opts;--    // True if GHC was not passed -no-hs-main-    HsBool rts_hs_main;--    // Whether to retain CAFs (default: false)-    HsBool keep_cafs;--    // Writer a for eventlog.-    const EventLogWriter *eventlog_writer;--    // Called before processing command-line flags, so that default-    // settings for RtsFlags can be provided.-    void (* defaultsHook) (void);--    // Called just before exiting-    void (* onExitHook) (void);--    // Called on a stack overflow, before exiting-    void (* stackOverflowHook) (W_ stack_size);--    // Called on heap overflow, before exiting-    void (* outOfHeapHook) (W_ request_size, W_ heap_size);--    // Called when malloc() fails, before exiting-    void (* mallocFailHook) (W_ request_size /* in bytes */, const char *msg);--    // Called for every GC-    void (* gcDoneHook) (const struct GCDetails_ *stats);--    // Called when GC sync takes too long (+RTS --long-gc-sync=<time>)-    void (* longGCSync) (uint32_t this_cap, Time time_ns);-    void (* longGCSyncEnd) (Time time_ns);-} RtsConfig;--// Clients should start with defaultRtsConfig and then customise it.-// Bah, I really wanted this to be a const struct value, but it seems-// you can't do that in C (it generates code).-extern const RtsConfig defaultRtsConfig;--/* ------------------------------------------------------------------------------   Statistics-   -------------------------------------------------------------------------- */--//-// Stats about a single GC-//-typedef struct GCDetails_ {-    // The generation number of this GC-  uint32_t gen;-    // Number of threads used in this GC-  uint32_t threads;-    // Number of bytes allocated since the previous GC-  uint64_t allocated_bytes;-    // Total amount of live data in the heap (incliudes large + compact data).-    // Updated after every GC. Data in uncollected generations (in minor GCs)-    // are considered live.-  uint64_t live_bytes;-    // Total amount of live data in large objects-  uint64_t large_objects_bytes;-    // Total amount of live data in compact regions-  uint64_t compact_bytes;-    // Total amount of slop (wasted memory)-  uint64_t slop_bytes;-    // Total amount of memory in use by the RTS-  uint64_t mem_in_use_bytes;-    // Total amount of data copied during this GC-  uint64_t copied_bytes;-    // In parallel GC, the max amount of data copied by any one thread-  uint64_t par_max_copied_bytes;-  // In parallel GC, the amount of balanced data copied by all threads-  uint64_t par_balanced_copied_bytes;-    // The time elapsed during synchronisation before GC-  Time sync_elapsed_ns;-    // The CPU time used during GC itself-  Time cpu_ns;-    // The time elapsed during GC itself-  Time elapsed_ns;-} GCDetails;--//-// Stats about the RTS currently, and since the start of execution-//-typedef struct _RTSStats {--  // ------------------------------------  // Cumulative stats about memory use--    // Total number of GCs-  uint32_t gcs;-    // Total number of major (oldest generation) GCs-  uint32_t major_gcs;-    // Total bytes allocated-  uint64_t allocated_bytes;-    // Maximum live data (including large objects + compact regions) in the-    // heap. Updated after a major GC.-  uint64_t max_live_bytes;-    // Maximum live data in large objects-  uint64_t max_large_objects_bytes;-    // Maximum live data in compact regions-  uint64_t max_compact_bytes;-    // Maximum slop-  uint64_t max_slop_bytes;-    // Maximum memory in use by the RTS-  uint64_t max_mem_in_use_bytes;-    // Sum of live bytes across all major GCs.  Divided by major_gcs-    // gives the average live data over the lifetime of the program.-  uint64_t cumulative_live_bytes;-    // Sum of copied_bytes across all GCs-  uint64_t copied_bytes;-    // Sum of copied_bytes across all parallel GCs-  uint64_t par_copied_bytes;-    // Sum of par_max_copied_bytes across all parallel GCs-  uint64_t cumulative_par_max_copied_bytes;-    // Sum of par_balanced_copied_byes across all parallel GCs.-  uint64_t cumulative_par_balanced_copied_bytes;--  // ------------------------------------  // Cumulative stats about time use-  // (we use signed values here because due to inaccuracies in timers-  // the values can occasionally go slightly negative)--    // Total CPU time used by the init phase-  Time init_cpu_ns;-    // Total elapsed time used by the init phase-  Time init_elapsed_ns;-    // Total CPU time used by the mutator-  Time mutator_cpu_ns;-    // Total elapsed time used by the mutator-  Time mutator_elapsed_ns;-    // Total CPU time used by the GC-  Time gc_cpu_ns;-    // Total elapsed time used by the GC-  Time gc_elapsed_ns;-    // Total CPU time (at the previous GC)-  Time cpu_ns;-    // Total elapsed time (at the previous GC)-  Time elapsed_ns;--  // ------------------------------------  // Stats about the most recent GC--  GCDetails gc;--  // ------------------------------------  // Internal Counters--    // The number of times a GC thread spun on its 'gc_spin' lock.-    // Will be zero if the rts was not built with PROF_SPIN-  uint64_t gc_spin_spin;-    // The number of times a GC thread yielded on its 'gc_spin' lock.-    // Will be zero if the rts was not built with PROF_SPIN-  uint64_t gc_spin_yield;-    // The number of times a GC thread spun on its 'mut_spin' lock.-    // Will be zero if the rts was not built with PROF_SPIN-  uint64_t mut_spin_spin;-    // The number of times a GC thread yielded on its 'mut_spin' lock.-    // Will be zero if the rts was not built with PROF_SPIN-  uint64_t mut_spin_yield;-    // The number of times a GC thread has checked for work across all parallel-    // GCs-  uint64_t any_work;-    // The number of times a GC thread has checked for work and found none-    // across all parallel GCs-  uint64_t no_work;-    // The number of times a GC thread has iterated it's outer loop across all-    // parallel GCs-  uint64_t scav_find_work;-} RTSStats;--void getRTSStats (RTSStats *s);-int getRTSStatsEnabled (void);--// Returns the total number of bytes allocated since the start of the program.-// TODO: can we remove this?-uint64_t getAllocations (void);--/* -----------------------------------------------------------------------------   Starting up and shutting down the Haskell RTS.-   ------------------------------------------------------------------------- */--/* DEPRECATED, use hs_init() or hs_init_ghc() instead  */-extern void startupHaskell         ( int argc, char *argv[],-                                     void (*init_root)(void) );--/* DEPRECATED, use hs_exit() instead  */-extern void shutdownHaskell        ( void );--/* Like hs_init(), but allows rtsopts. For more complicated usage,- * use hs_init_ghc. */-extern void hs_init_with_rtsopts (int *argc, char **argv[]);--/*- * GHC-specific version of hs_init() that allows specifying whether- * +RTS ... -RTS options are allowed or not (default: only "safe"- * options are allowed), and allows passing an option string that is- * to be interpreted by the RTS only, not passed to the program.- */-extern void hs_init_ghc (int *argc, char **argv[],   // program arguments-                         RtsConfig rts_config);      // RTS configuration--extern void shutdownHaskellAndExit (int exitCode, int fastExit)-    GNUC3_ATTRIBUTE(__noreturn__);--#if !defined(mingw32_HOST_OS)-extern void shutdownHaskellAndSignal (int sig, int fastExit)-     GNUC3_ATTRIBUTE(__noreturn__);-#endif--extern void getProgArgv            ( int *argc, char **argv[] );-extern void setProgArgv            ( int argc, char *argv[] );-extern void getFullProgArgv        ( int *argc, char **argv[] );-extern void setFullProgArgv        ( int argc, char *argv[] );-extern void freeFullProgArgv       ( void ) ;--/* exit() override */-extern void (*exitFn)(int);--/* -----------------------------------------------------------------------------   Locking.--   You have to surround all access to the RtsAPI with these calls.-   ------------------------------------------------------------------------- */--// acquires a token which may be used to create new objects and-// evaluate them.-Capability *rts_lock (void);--// releases the token acquired with rts_lock().-void rts_unlock (Capability *token);--// If you are in a context where you know you have a current capability but-// do not know what it is, then use this to get it. Basically this only-// applies to "unsafe" foreign calls (as unsafe foreign calls are made with-// the capability held).-//-// WARNING: There is *no* guarantee this returns anything sensible (eg NULL)-// when there is no current capability.-Capability *rts_unsafeGetMyCapability (void);--/* -----------------------------------------------------------------------------   Which cpu should the OS thread and Haskell thread run on?--   1. Run the current thread on the given capability:-     rts_setInCallCapability(cap, 0);--   2. Run the current thread on the given capability and set the cpu affinity-      for this thread:-     rts_setInCallCapability(cap, 1);--   3. Run the current thread on the given numa node:-     rts_pinThreadToNumaNode(node);--   4. Run the current thread on the given capability and on the given numa node:-     rts_setInCallCapability(cap, 0);-     rts_pinThreadToNumaNode(cap);-   ------------------------------------------------------------------------- */--// Specify the Capability that the current OS thread should run on when it calls-// into Haskell.  The actual capability will be calculated as the supplied-// value modulo the number of enabled Capabilities.-//-// Note that the thread may still be migrated by the RTS scheduler, but that-// will only happen if there are multiple threads running on one Capability and-// another Capability is free.-//-// If affinity is non-zero, the current thread will be bound to-// specific CPUs according to the prevailing affinity policy for the-// specified capability, set by either +RTS -qa or +RTS --numa.-void rts_setInCallCapability (int preferred_capability, int affinity);--// Specify the CPU Node that the current OS thread should run on when it calls-// into Haskell. The argument can be either a node number or capability number.-// The actual node will be calculated as the supplied value modulo the number-// of numa nodes.-void rts_pinThreadToNumaNode (int node);--/* -----------------------------------------------------------------------------   Building Haskell objects from C datatypes.-   ------------------------------------------------------------------------- */-HaskellObj   rts_mkChar       ( Capability *, HsChar   c );-HaskellObj   rts_mkInt        ( Capability *, HsInt    i );-HaskellObj   rts_mkInt8       ( Capability *, HsInt8   i );-HaskellObj   rts_mkInt16      ( Capability *, HsInt16  i );-HaskellObj   rts_mkInt32      ( Capability *, HsInt32  i );-HaskellObj   rts_mkInt64      ( Capability *, HsInt64  i );-HaskellObj   rts_mkWord       ( Capability *, HsWord   w );-HaskellObj   rts_mkWord8      ( Capability *, HsWord8  w );-HaskellObj   rts_mkWord16     ( Capability *, HsWord16 w );-HaskellObj   rts_mkWord32     ( Capability *, HsWord32 w );-HaskellObj   rts_mkWord64     ( Capability *, HsWord64 w );-HaskellObj   rts_mkPtr        ( Capability *, HsPtr    a );-HaskellObj   rts_mkFunPtr     ( Capability *, HsFunPtr a );-HaskellObj   rts_mkFloat      ( Capability *, HsFloat  f );-HaskellObj   rts_mkDouble     ( Capability *, HsDouble f );-HaskellObj   rts_mkStablePtr  ( Capability *, HsStablePtr s );-HaskellObj   rts_mkBool       ( Capability *, HsBool   b );-HaskellObj   rts_mkString     ( Capability *, char    *s );--HaskellObj   rts_apply        ( Capability *, HaskellObj, HaskellObj );--/* -----------------------------------------------------------------------------   Deconstructing Haskell objects-   ------------------------------------------------------------------------- */-HsChar       rts_getChar      ( HaskellObj );-HsInt        rts_getInt       ( HaskellObj );-HsInt8       rts_getInt8      ( HaskellObj );-HsInt16      rts_getInt16     ( HaskellObj );-HsInt32      rts_getInt32     ( HaskellObj );-HsInt64      rts_getInt64     ( HaskellObj );-HsWord       rts_getWord      ( HaskellObj );-HsWord8      rts_getWord8     ( HaskellObj );-HsWord16     rts_getWord16    ( HaskellObj );-HsWord32     rts_getWord32    ( HaskellObj );-HsWord64     rts_getWord64    ( HaskellObj );-HsPtr        rts_getPtr       ( HaskellObj );-HsFunPtr     rts_getFunPtr    ( HaskellObj );-HsFloat      rts_getFloat     ( HaskellObj );-HsDouble     rts_getDouble    ( HaskellObj );-HsStablePtr  rts_getStablePtr ( HaskellObj );-HsBool       rts_getBool      ( HaskellObj );--/* -----------------------------------------------------------------------------   Evaluating Haskell expressions--   The versions ending in '_' allow you to specify an initial stack size.-   Note that these calls may cause Garbage Collection, so all HaskellObj-   references are rendered invalid by these calls.--   All of these functions take a (Capability **) - there is a-   Capability pointer both input and output.  We use an inout-   parameter because this is less error-prone for the client than a-   return value - the client could easily forget to use the return-   value, whereas incorrectly using an inout parameter will usually-   result in a type error.-   ------------------------------------------------------------------------- */--void rts_eval (/* inout */ Capability **,-               /* in    */ HaskellObj p,-               /* out */   HaskellObj *ret);--void rts_eval_ (/* inout */ Capability **,-                /* in    */ HaskellObj p,-                /* in    */ unsigned int stack_size,-                /* out   */ HaskellObj *ret);--void rts_evalIO (/* inout */ Capability **,-                 /* in    */ HaskellObj p,-                 /* out */   HaskellObj *ret);--void rts_evalStableIOMain (/* inout */ Capability **,-                           /* in    */ HsStablePtr s,-                           /* out */   HsStablePtr *ret);--void rts_evalStableIO (/* inout */ Capability **,-                       /* in    */ HsStablePtr s,-                       /* out */   HsStablePtr *ret);--void rts_evalLazyIO (/* inout */ Capability **,-                     /* in    */ HaskellObj p,-                     /* out */   HaskellObj *ret);--void rts_evalLazyIO_ (/* inout */ Capability **,-                      /* in    */ HaskellObj p,-                      /* in    */ unsigned int stack_size,-                      /* out   */ HaskellObj *ret);--void rts_checkSchedStatus (char* site, Capability *);--SchedulerStatus rts_getSchedStatus (Capability *cap);--/*- * The RTS allocates some thread-local data when you make a call into- * Haskell using one of the rts_eval() functions.  This data is not- * normally freed until hs_exit().  If you want to free it earlier- * than this, perhaps because the thread is about to exit, then call- * rts_done() from the thread.- *- * It is safe to make more rts_eval() calls after calling rts_done(),- * but the next one will cause allocation of the thread-local memory- * again.- */-void rts_done (void);--/* ---------------------------------------------------------------------------   Wrapper closures--   These are used by foreign export and foreign import "wrapper" stubs.-   ----------------------------------------------------------------------- */--// When producing Windows DLLs the we need to know which symbols are in the-//      local package/DLL vs external ones.-//-//      Note that RtsAPI.h is also included by foreign export stubs in-//      the base package itself.-//-#if defined(COMPILING_WINDOWS_DLL) && !defined(COMPILING_BASE_PACKAGE)-__declspec(dllimport) extern StgWord base_GHCziTopHandler_runIO_closure[];-__declspec(dllimport) extern StgWord base_GHCziTopHandler_runNonIO_closure[];-#else-extern StgWord base_GHCziTopHandler_runIO_closure[];-extern StgWord base_GHCziTopHandler_runNonIO_closure[];-#endif--#define runIO_closure     base_GHCziTopHandler_runIO_closure-#define runNonIO_closure  base_GHCziTopHandler_runNonIO_closure--/* ------------------------------------------------------------------------ */--#if defined(__cplusplus)-}-#endif
− includes/Stg.h
@@ -1,599 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Top-level include file for everything required when compiling .hc- * code.  NOTE: in .hc files, Stg.h must be included *before* any- * other headers, because we define some register variables which must- * be done before any inline 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.- *- * In ordinary C code, do not #include this file directly: #include- * "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#if !(__STDC_VERSION__ >= 199901L) && !(__cplusplus >= 201103L)-# error __STDC_VERSION__ does not advertise C99, C++11 or later-#endif--/*- * If we are compiling a .hc file, then we want all the register- * variables.  This is the what happens if you #include "Stg.h" first:- * we assume this is a .hc file, and set IN_STG_CODE==1, which later- * causes the register variables to be enabled in stg/Regs.h.- *- * If instead "Rts.h" is included first, then we are compiling a- * vanilla C file.  Everything from Stg.h is provided, except that- * IN_STG_CODE is not defined, and the register variables will not be- * active.- */-#if !defined(IN_STG_CODE)-# define IN_STG_CODE 1--// Turn on C99 for .hc code.  This gives us the INFINITY and NAN-// constants from math.h, which we occasionally need to use in .hc (#1861)-# define _ISOC99_SOURCE--// We need _BSD_SOURCE so that math.h defines things like gamma-// on Linux-# define _BSD_SOURCE--// On AIX we need _BSD defined, otherwise <math.h> includes <stdlib.h>-# if defined(_AIX)-#  define _BSD 1-# endif--// '_BSD_SOURCE' is deprecated since glibc-2.20-// in favour of '_DEFAULT_SOURCE'-# define _DEFAULT_SOURCE-#endif--#if IN_STG_CODE == 0 || defined(llvm_CC_FLAVOR)-// C compilers that use an LLVM back end (clang or llvm-gcc) do not-// correctly support global register variables so we make sure that-// we do not declare them for these compilers.-# define NO_GLOBAL_REG_DECLS    /* don't define fixed registers */-#endif--/* Configuration */-#include "ghcconfig.h"--/* The code generator calls the math functions directly in .hc code.-   NB. after configuration stuff above, because this sets #defines-   that depend on config info, such as __USE_FILE_OFFSET64 */-#include <math.h>--// On Solaris, we don't get the INFINITY and NAN constants unless we-// #define _STDC_C99, and we can't do that unless we also use -std=c99,-// because _STDC_C99 causes the headers to use C99 syntax (e.g. restrict).-// We aren't ready for -std=c99 yet, so define INFINITY/NAN by hand using-// the gcc builtins.-#if !defined(INFINITY)-#if defined(__GNUC__)-#define INFINITY __builtin_inf()-#else-#error No definition for INFINITY-#endif-#endif--#if !defined(NAN)-#if defined(__GNUC__)-#define NAN __builtin_nan("")-#else-#error No definition for NAN-#endif-#endif--/* ------------------------------------------------------------------------------   Useful definitions-   -------------------------------------------------------------------------- */--/*- * The C backend likes to refer to labels by just mentioning their- * names.  However, 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 IN_STG_CODE-#define RTS_VAR(x) (x)[]-#define RTS_DEREF(x) (*(x))-#else-#define RTS_VAR(x) x-#define RTS_DEREF(x) x-#endif--/* bit macros- */-#define BITS_PER_BYTE 8-#define BITS_IN(x) (BITS_PER_BYTE * sizeof(x))--/* Compute offsets of struct fields- */-#define STG_FIELD_OFFSET(s_type, field) ((StgWord)&(((s_type*)0)->field))--/*- * 'Portable' inlining:- * INLINE_HEADER is for inline functions in header files (macros)- * STATIC_INLINE is for inline functions in source files- * EXTERN_INLINE is for functions that we want to inline sometimes- * (we also compile a static version of the function; see Inlines.c)- */--// We generally assume C99 semantics albeit these two definitions work fine even-// when gnu90 semantics are active (i.e. when __GNUC_GNU_INLINE__ is defined or-// when a GCC older than 4.2 is used)-//-// The problem, however, is with 'extern inline' whose semantics significantly-// differs between gnu90 and C99-#define INLINE_HEADER static inline-#define STATIC_INLINE static inline--// Figure out whether `__attributes__((gnu_inline))` is needed-// to force gnu90-style 'external inline' semantics.-#if defined(FORCE_GNU_INLINE)-// disable auto-detection since HAVE_GNU_INLINE has been defined externally-#elif defined(__GNUC_GNU_INLINE__) && __GNUC__ == 4 && __GNUC_MINOR__ == 2-// GCC 4.2.x didn't properly support C99 inline semantics (GCC 4.3 was the first-// release to properly support C99 inline semantics), and therefore warned when-// using 'extern inline' while in C99 mode unless `__attributes__((gnu_inline))`-// was explicitly set.-# define FORCE_GNU_INLINE 1-#endif--#if defined(FORCE_GNU_INLINE)-// Force compiler into gnu90 semantics-# if defined(KEEP_INLINES)-#  define EXTERN_INLINE inline __attribute__((gnu_inline))-# else-#  define EXTERN_INLINE extern inline __attribute__((gnu_inline))-# endif-#elif defined(__GNUC_GNU_INLINE__)-// we're currently in gnu90 inline mode by default and-// __attribute__((gnu_inline)) may not be supported, so better leave it off-# if defined(KEEP_INLINES)-#  define EXTERN_INLINE inline-# else-#  define EXTERN_INLINE extern inline-# endif-#else-// Assume C99 semantics (yes, this curiously results in swapped definitions!)-// This is the preferred branch, and at some point we may drop support for-// compilers not supporting C99 semantics altogether.-# if defined(KEEP_INLINES)-#  define EXTERN_INLINE extern inline-# else-#  define EXTERN_INLINE inline-# endif-#endif---/*- * GCC attributes- */-#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--/* Used to mark a switch case that falls-through */-#if (defined(__GNUC__) && __GNUC__ >= 7)-// N.B. Don't enable fallthrough annotations when compiling with Clang.-// Apparently clang doesn't enable implicitly fallthrough warnings by default-// http://llvm.org/viewvc/llvm-project?revision=167655&view=revision-// when compiling C and the attribute cause warnings of their own (#16019).-#define FALLTHROUGH GNU_ATTRIBUTE(fallthrough)-#else-#define FALLTHROUGH ((void)0)-#endif /* __GNUC__ >= 7 */--#if !defined(DEBUG) && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3))-#define GNUC_ATTR_HOT __attribute__((hot))-#else-#define GNUC_ATTR_HOT /* nothing */-#endif--#define STG_UNUSED    GNUC3_ATTRIBUTE(__unused__)--/* Prevent functions from being optimized.-   See Note [Windows Stack allocations] */-#if defined(__clang__)-#define STG_NO_OPTIMIZE __attribute__((optnone))-#elif defined(__GNUC__) || defined(__GNUG__)-#define STG_NO_OPTIMIZE __attribute__((optimize("O0")))-#else-#define STG_NO_OPTIMIZE /* nothing */-#endif--/* ------------------------------------------------------------------------------   Global type definitions-   -------------------------------------------------------------------------- */--#include "MachDeps.h"-#include "stg/Types.h"--/* ------------------------------------------------------------------------------   Shorthand forms-   -------------------------------------------------------------------------- */--typedef StgChar      C_;-typedef StgWord      W_;-typedef StgWord*  P_;-typedef StgInt    I_;-typedef StgWord StgWordArray[];-typedef StgFunPtr       F_;--/* byte arrays (and strings): */-#define EB_(X)    extern const char X[]-#define IB_(X)    static const char X[]-/* static (non-heap) closures (requires alignment for pointer tagging): */-#define EC_(X)    extern       StgWordArray (X) GNU_ATTRIBUTE(aligned (8))-#define IC_(X)    static       StgWordArray (X) GNU_ATTRIBUTE(aligned (8))-/* writable data (does not require alignment): */-#define ERW_(X)   extern       StgWordArray (X)-#define IRW_(X)   static       StgWordArray (X)-/* read-only data (does not require alignment): */-#define ERO_(X)   extern const StgWordArray (X)-#define IRO_(X)   static const StgWordArray (X)-/* stg-native functions: */-#define IF_(f)    static StgFunPtr GNUC3_ATTRIBUTE(used) f(void)-#define FN_(f)           StgFunPtr f(void)-#define EF_(f)           StgFunPtr f(void) /* External Cmm functions */-/* foreign functions: */-#define EFF_(f)   void f() /* See Note [External function prototypes] */--/* Note [External function prototypes]  See Trac #8965, #11395-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-In generated C code we need to distinct between two types-of external symbols:-1.  Cmm functions declared by 'EF_' macro (External Functions)-2.    C functions declared by 'EFF_' macro (External Foreign Functions)--Cmm functions are simple as they are internal to GHC.--C functions are trickier:--The external-function macro EFF_(F) used to be defined as-    extern StgFunPtr f(void)-i.e a function of zero arguments.  On most platforms this doesn't-matter very much: calls to these functions put the parameters in the-usual places anyway, and (with the exception of varargs) things just-work.--However, the ELFv2 ABI on ppc64 optimises stack allocation-(http://gcc.gnu.org/ml/gcc-patches/2013-11/msg01149.html): a call to a-function that has a prototype, is not varargs, and receives all parameters-in registers rather than on the stack does not require the caller to-allocate an argument save area.  The incorrect prototypes cause GCC to-believe that all functions declared this way can be called without an-argument save area, but if the callee has sufficiently many arguments then-it will expect that area to be present, and will thus corrupt the caller's-stack.  This happens in particular with calls to runInteractiveProcess in-libraries/process/cbits/runProcess.c, and led to Trac #8965.--The simplest fix appears to be to declare these external functions with an-unspecified argument list rather than a void argument list.  This is no-worse for platforms that don't care either way, and allows a successful-bootstrap of GHC 7.8 on little-endian Linux ppc64 (which uses the ELFv2-ABI).--Another case is m68k ABI where 'void*' return type is returned by 'a0'-register while 'long' return type is returned by 'd0'. Thus we trick-external prototype return neither of these types to workaround #11395.-*/---/* ------------------------------------------------------------------------------   Tail calls-   -------------------------------------------------------------------------- */--#define JMP_(cont) return((StgFunPtr)(cont))--/* ------------------------------------------------------------------------------   Other Stg stuff...-   -------------------------------------------------------------------------- */--#include "stg/DLL.h"-#include "stg/RtsMachRegs.h"-#include "stg/Regs.h"-#include "stg/Ticky.h"--#if IN_STG_CODE-/*- * This is included later for RTS sources, after definitions of- * StgInfoTable, StgClosure and so on.- */-#include "stg/MiscClosures.h"-#endif--#include "stg/Prim.h" /* ghc-prim fallbacks */-#include "stg/SMP.h" // write_barrier() inline is required--/* ------------------------------------------------------------------------------   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_VOID_P--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_VOID_P */--#if ALIGNMENT_DOUBLE <= ALIGNMENT_VOID_P--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_VOID_P */--/* 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 defined(sparc_HOST_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_HOST_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_HOST_ARCH */--#endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */---/* ------------------------------------------------------------------------------   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.-   -------------------------------------------------------------------------- */--#if SIZEOF_HSWORD == 4--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 /* SIZEOF_HSWORD == 4 */--/* ------------------------------------------------------------------------------   Integer multiply with overflow-   -------------------------------------------------------------------------- */--/* 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--#if defined(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--/* Approximate version when we don't have long arithmetic (on 64-bit archs) */--/* If we have n-bit words then we have n-1 bits after accounting for the- * sign bit, so we can fit the result of multiplying 2 (n-1)/2-bit numbers */-#define HALF_POS_INT  (((I_)1) << ((BITS_IN (I_) - 1) / 2))-#define HALF_NEG_INT  (-HALF_POS_INT)--#define mulIntMayOflo(a,b)       \-({                                              \-  I_ c;              \-  if ((I_)a <= HALF_NEG_INT || a >= HALF_POS_INT    \-      || (I_)b <= HALF_NEG_INT || b >= HALF_POS_INT) {\-    c = 1;              \-  } else {              \-    c = 0;              \-  }                  \-  c;                                            \-})-#endif
− includes/rts/Adjustor.h
@@ -1,22 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Adjustor API- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--/* Creating and destroying an adjustor thunk */-void* createAdjustor (int cconv, -                      StgStablePtr hptr,-                      StgFunPtr wptr,-                      char *typeString);--void freeHaskellFunctionPtr (void* ptr);
− includes/rts/BlockSignals.h
@@ -1,34 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * RTS signal handling - *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--/* Used by runProcess() in the process package- */--/*- * Function: blockUserSignals()- *- * Temporarily block the delivery of further console events. Needed to- * avoid race conditions when GCing the queue of outstanding handlers or- * when emptying the queue by running the handlers.- * - */-void blockUserSignals(void);--/*- * Function: unblockUserSignals()- *- * The inverse of blockUserSignals(); re-enable the deliver of console events.- */-void unblockUserSignals(void);
− includes/rts/Bytecodes.h
@@ -1,106 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Bytecode definitions.- *- * ---------------------------------------------------------------------------*/--/* --------------------------------------------------------------------------- * Instructions- *- * Notes:- * o CASEFAIL is generated by the compiler whenever it tests an "irrefutable"- *   pattern which fails.  If we don't see too many of these, we could- *   optimise out the redundant test.- * ------------------------------------------------------------------------*/--/* NOTE:--   THIS FILE IS INCLUDED IN HASKELL SOURCES (ghc/compiler/ghci/ByteCodeAsm.hs).-   DO NOT PUT C-SPECIFIC STUFF IN HERE!--   I hope that's clear :-)-*/--#define bci_STKCHECK  			1-#define bci_PUSH_L    			2-#define bci_PUSH_LL   			3-#define bci_PUSH_LLL  			4-#define bci_PUSH8                       5-#define bci_PUSH16                      6-#define bci_PUSH32                      7-#define bci_PUSH8_W                     8-#define bci_PUSH16_W                    9-#define bci_PUSH32_W                    10-#define bci_PUSH_G    			11-#define bci_PUSH_ALTS  			12-#define bci_PUSH_ALTS_P			13-#define bci_PUSH_ALTS_N			14-#define bci_PUSH_ALTS_F			15-#define bci_PUSH_ALTS_D			16-#define bci_PUSH_ALTS_L			17-#define bci_PUSH_ALTS_V			18-#define bci_PUSH_PAD8                   19-#define bci_PUSH_PAD16                  20-#define bci_PUSH_PAD32                  21-#define bci_PUSH_UBX8                   22-#define bci_PUSH_UBX16                  23-#define bci_PUSH_UBX32                  24-#define bci_PUSH_UBX  			25-#define bci_PUSH_APPLY_N		26-#define bci_PUSH_APPLY_F		27-#define bci_PUSH_APPLY_D		28-#define bci_PUSH_APPLY_L		29-#define bci_PUSH_APPLY_V		30-#define bci_PUSH_APPLY_P		31-#define bci_PUSH_APPLY_PP		32-#define bci_PUSH_APPLY_PPP		33-#define bci_PUSH_APPLY_PPPP		34-#define bci_PUSH_APPLY_PPPPP		35-#define bci_PUSH_APPLY_PPPPPP		36-/* #define bci_PUSH_APPLY_PPPPPPP		37 */-#define bci_SLIDE     			38-#define bci_ALLOC_AP   			39-#define bci_ALLOC_AP_NOUPD		40-#define bci_ALLOC_PAP  			41-#define bci_MKAP      			42-#define bci_MKPAP      			43-#define bci_UNPACK    			44-#define bci_PACK      			45-#define bci_TESTLT_I   			46-#define bci_TESTEQ_I  			47-#define bci_TESTLT_F  			48-#define bci_TESTEQ_F  			49-#define bci_TESTLT_D  			50-#define bci_TESTEQ_D  			51-#define bci_TESTLT_P  			52-#define bci_TESTEQ_P  			53-#define bci_CASEFAIL  			54-#define bci_JMP       			55-#define bci_CCALL     			56-#define bci_SWIZZLE   			57-#define bci_ENTER     			58-#define bci_RETURN    			59-#define bci_RETURN_P 			60-#define bci_RETURN_N 			61-#define bci_RETURN_F 			62-#define bci_RETURN_D 			63-#define bci_RETURN_L 			64-#define bci_RETURN_V 			65-#define bci_BRK_FUN			66-#define bci_TESTLT_W   			67-#define bci_TESTEQ_W  			68-/* If you need to go past 255 then you will run into the flags */--/* If you need to go below 0x0100 then you will run into the instructions */-#define bci_FLAG_LARGE_ARGS     0x8000--/* If a BCO definitely requires less than this many words of stack,-   don't include an explicit STKCHECK insn in it.  The interpreter-   will check for this many words of stack before running each BCO,-   rendering an explicit check unnecessary in the majority of-   cases. */-#define INTERP_STACK_CHECK_THRESH  50--/*-------------------------------------------------------------------------*/
− includes/rts/Config.h
@@ -1,48 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Rts settings.- *- * NOTE: assumes #include "ghcconfig.h"- * - * NB: THIS FILE IS INCLUDED IN NON-C CODE AND DATA!  #defines only please.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#if defined(TICKY_TICKY) && defined(THREADED_RTS)-#error TICKY_TICKY is incompatible with THREADED_RTS-#endif--/*- * Whether the runtime system will use libbfd for debugging purposes.- */-#if defined(DEBUG) && defined(HAVE_BFD_H) && defined(HAVE_LIBBFD) && !defined(_WIN32)-#define USING_LIBBFD 1-#endif--/* DEBUG implies TRACING and TICKY_TICKY  */-#if defined(DEBUG)-#if !defined(TRACING)-#define TRACING-#endif-#if !defined(TICKY_TICKY)-#define TICKY_TICKY-#endif-#endif---/* ------------------------------------------------------------------------------   Signals - supported on non-PAR versions of the runtime.  See RtsSignals.h.-   -------------------------------------------------------------------------- */--#define RTS_USER_SIGNALS 1--/* Profile spin locks */--#define PROF_SPIN
− includes/rts/Constants.h
@@ -1,332 +0,0 @@-/* ----------------------------------------------------------------------------- *- * (c) The GHC Team, 1998-2009- *- * Constants- *- * NOTE: this information is used by both the compiler and the RTS.- * Some of it is tweakable, and some of it must be kept up to date- * with various other parts of the system.- *- * Constants which are derived automatically from other definitions in- * the system (eg. structure sizes) are generated into the file- * DerivedConstants.h by a C program (mkDerivedConstantsHdr).- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--/* ------------------------------------------------------------------------------   Minimum closure sizes--   This is the minimum number of words in the payload of a-   heap-allocated closure, so that the closure has enough room to be-   overwritten with a forwarding pointer during garbage collection.-   -------------------------------------------------------------------------- */--#define MIN_PAYLOAD_SIZE 1--/* ------------------------------------------------------------------------------   Constants to do with specialised closure types.-   -------------------------------------------------------------------------- */--/* We have some pre-compiled selector thunks defined in rts/StgStdThunks.hc.- * This constant defines the highest selectee index that we can replace with a- * reference to the pre-compiled code.- */--#define MAX_SPEC_SELECTEE_SIZE 15--/* Vector-apply thunks.  These thunks just push their free variables- * on the stack and enter the first one.  They're a bit like PAPs, but- * don't have a dynamic size.  We've pre-compiled a few to save- * space.- */--#define MAX_SPEC_AP_SIZE       7--/* Specialised FUN/THUNK/CONSTR closure types */--#define MAX_SPEC_THUNK_SIZE    2-#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--/* Each byte in the card table for an StgMutaArrPtrs covers- * (1<<MUT_ARR_PTRS_CARD_BITS) elements in the array.  To find a good- * value for this, I used the benchmarks nofib/gc/hash,- * nofib/gc/graph, and nofib/gc/gc_bench.- */-#define MUT_ARR_PTRS_CARD_BITS 7--/* ------------------------------------------------------------------------------   STG Registers.--   Note that in MachRegs.h we define how many of these registers are-   *real* machine registers, and not just offsets in the Register Table.-   -------------------------------------------------------------------------- */--#define MAX_VANILLA_REG 10-#define MAX_FLOAT_REG   6-#define MAX_DOUBLE_REG  6-#define MAX_LONG_REG    1-#define MAX_XMM_REG     6--/* ------------------------------------------------------------------------------   Semi-Tagging constants--   Old Comments about this stuff:--   Tags for indirection nodes and ``other'' (probably unevaluated) nodes;-   normal-form values of algebraic data types will have tags 0, 1, ...--   @INFO_IND_TAG@ is different from @INFO_OTHER_TAG@ just so we can count-   how often we bang into indirection nodes; that's all.  (WDP 95/11)--   ToDo: find out if we need any of this.-   -------------------------------------------------------------------------- */--#define INFO_OTHER_TAG          (-1)-#define INFO_IND_TAG            (-2)-#define INFO_FIRST_TAG          0--/* ------------------------------------------------------------------------------   How much C stack to reserve for local temporaries when in the STG-   world.  Used in StgCRun.c.-   -------------------------------------------------------------------------- */--#define RESERVED_C_STACK_BYTES (2048 * SIZEOF_LONG)--/* ------------------------------------------------------------------------------   How large is the stack frame saved by StgRun?-   world.  Used in StgCRun.c.--   The size has to be enough to save the registers (see StgCRun)-   plus padding if the result is not 16 byte aligned.-   See the Note [Stack Alignment on X86] in StgCRun.c for details.--   -------------------------------------------------------------------------- */-#if defined(x86_64_HOST_ARCH)-#  if defined(mingw32_HOST_OS)-#    define STG_RUN_STACK_FRAME_SIZE 144-#  else-#    define STG_RUN_STACK_FRAME_SIZE 48-#  endif-#endif--/* ------------------------------------------------------------------------------   StgRun related labels shared between StgCRun.c and StgStartup.cmm.-   -------------------------------------------------------------------------- */--#if defined(LEADING_UNDERSCORE)-#define STG_RUN "_StgRun"-#define STG_RUN_JMP _StgRunJmp-#define STG_RETURN "_StgReturn"-#else-#define STG_RUN "StgRun"-#define STG_RUN_JMP StgRunJmp-#define STG_RETURN "StgReturn"-#endif--/* ------------------------------------------------------------------------------   How much Haskell stack space to reserve for the saving of registers-   etc. in the case of a stack/heap overflow.--   This must be large enough to accommodate the largest stack frame-   pushed in one of the heap check fragments in HeapStackCheck.hc-   (ie. currently the generic heap checks - 3 words for StgRetDyn,-   18 words for the saved registers, see StgMacros.h).-   -------------------------------------------------------------------------- */--#define RESERVED_STACK_WORDS 21--/* ------------------------------------------------------------------------------   The limit on the size of the stack check performed when we enter an-   AP_STACK, in words.  See raiseAsync() and bug #1466.-   -------------------------------------------------------------------------- */--#define AP_STACK_SPLIM 1024--/* ------------------------------------------------------------------------------   Storage manager constants-   -------------------------------------------------------------------------- */--/* The size of a block (2^BLOCK_SHIFT bytes) */-#define BLOCK_SHIFT  12--/* The size of a megablock (2^MBLOCK_SHIFT bytes) */-#define MBLOCK_SHIFT   20--/* ------------------------------------------------------------------------------   Bitmap/size fields (used in info tables)-   -------------------------------------------------------------------------- */--/* In a 32-bit bitmap field, we use 5 bits for the size, and 27 bits- * for the bitmap.  If the bitmap requires more than 27 bits, then we- * store it in a separate array, and leave a pointer in the bitmap- * field.  On a 64-bit machine, the sizes are extended accordingly.- */-#if SIZEOF_VOID_P == 4-#define BITMAP_SIZE_MASK     0x1f-#define BITMAP_BITS_SHIFT    5-#elif SIZEOF_VOID_P == 8-#define BITMAP_SIZE_MASK     0x3f-#define BITMAP_BITS_SHIFT    6-#else-#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 ThreadComplete  4       /* thread has finished */--/*- * Constants for the why_blocked field of a TSO- * NB. keep these in sync with GHC/Conc/Sync.hs: threadStatus- */-#define NotBlocked          0-#define BlockedOnMVar       1-#define BlockedOnMVarRead   14 /* TODO: renumber me, see #9003 */-#define BlockedOnBlackHole  2-#define BlockedOnRead       3-#define BlockedOnWrite      4-#define BlockedOnDelay      5-#define BlockedOnSTM        6--/* Win32 only: */-#define BlockedOnDoProc     7--/* Only relevant for THREADED_RTS: */-#define BlockedOnCCall      10-#define BlockedOnCCall_Interruptible 11-   /* same as above but permit killing the worker thread */--/* Involved in a message sent to tso->msg_cap */-#define BlockedOnMsgThrowTo 12--/* The thread is not on any run queues, but can be woken up-   by tryWakeupThread() */-#define ThreadMigrating     13--/* WARNING WARNING top number is BlockedOnMVarRead 14, not 13!! */--/*- * 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--/*- * Flags for the tso->flags field.- */--/*- * TSO_LOCKED is set when a TSO is locked to a particular Capability.- */-#define TSO_LOCKED  2--/*- * TSO_BLOCKEX: the TSO is blocking exceptions- *- * TSO_INTERRUPTIBLE: the TSO can be interrupted if it blocks- * interruptibly (eg. with BlockedOnMVar).- *- * TSO_STOPPED_ON_BREAKPOINT: the thread is currently stopped in a breakpoint- */-#define TSO_BLOCKEX       4-#define TSO_INTERRUPTIBLE 8-#define TSO_STOPPED_ON_BREAKPOINT 16--/*- * Used by the sanity checker to check whether TSOs are on the correct- * mutable list.- */-#define TSO_MARKED 64--/*- * Used to communicate between stackSqueeze() and- * threadStackOverflow() that a thread's stack was squeezed and the- * stack may not need to be expanded.- */-#define TSO_SQUEEZED 128--/*- * Enables the AllocationLimitExceeded exception when the thread's- * allocation limit goes negative.- */-#define TSO_ALLOC_LIMIT 256--/*- * The number of times we spin in a spin lock before yielding (see- * #3758).  To tune this value, use the benchmark in #3758: run the- * server with -N2 and the client both on a dual-core.  Also make sure- * that the chosen value doesn't slow down any of the parallel- * benchmarks in nofib/parallel.- */-#define SPIN_COUNT 1000--/* ------------------------------------------------------------------------------   Spare workers per Capability in the threaded RTS--   No more than MAX_SPARE_WORKERS will be kept in the thread pool-   associated with each Capability.-   -------------------------------------------------------------------------- */--#define MAX_SPARE_WORKERS 6--/*- * The maximum number of NUMA nodes we support.  This is a fixed limit so that- * we can have static arrays of this size in the RTS for speed.- */-#define MAX_NUMA_NODES 16
− includes/rts/EventLogFormat.h
@@ -1,264 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2008-2009- *- * Event log format- *- * The log format is designed to be extensible: old tools should be- * able to parse (but not necessarily understand all of) new versions- * of the format, and new tools will be able to understand old log- * files.- *- * Each event has a specific format.  If you add new events, give them- * new numbers: we never re-use old event numbers.- *- * - The format is endian-independent: all values are represented in- *    bigendian order.- *- * - The format is extensible:- *- *    - The header describes each event type and its length.  Tools- *      that don't recognise a particular event type can skip those events.- *- *    - There is room for extra information in the event type- *      specification, which can be ignored by older tools.- *- *    - Events can have extra information added, but existing fields- *      cannot be changed.  Tools should ignore extra fields at the- *      end of the event record.- *- *    - Old event type ids are never re-used; just take a new identifier.- *- *- * The format- * ----------- *- * log : EVENT_HEADER_BEGIN- *       EventType*- *       EVENT_HEADER_END- *       EVENT_DATA_BEGIN- *       Event*- *       EVENT_DATA_END- *- * EventType :- *       EVENT_ET_BEGIN- *       Word16         -- unique identifier for this event- *       Int16          -- >=0  size of the event in bytes (minus the header)- *                      -- -1   variable size- *       Word32         -- length of the next field in bytes- *       Word8*         -- string describing the event- *       Word32         -- length of the next field in bytes- *       Word8*         -- extra info (for future extensions)- *       EVENT_ET_END- *- * Event :- *       Word16         -- event_type- *       Word64         -- time (nanosecs)- *       [Word16]       -- length of the rest (for variable-sized events only)- *       ... extra event-specific info ...- *- *- * To add a new event- * ------------------- *- *  - In this file:- *    - give it a new number, add a new #define EVENT_XXX below- *  - In EventLog.c- *    - add it to the EventDesc array- *    - emit the event type in initEventLogging()- *    - emit the new event in postEvent_()- *    - generate the event itself by calling postEvent() somewhere- *  - In the Haskell code to parse the event log file:- *    - add types and code to read the new event- *- * -------------------------------------------------------------------------- */--#pragma once--/*- * Markers for begin/end of the Header.- */-#define EVENT_HEADER_BEGIN    0x68647262 /* 'h' 'd' 'r' 'b' */-#define EVENT_HEADER_END      0x68647265 /* 'h' 'd' 'r' 'e' */--#define EVENT_DATA_BEGIN      0x64617462 /* 'd' 'a' 't' 'b' */-#define EVENT_DATA_END        0xffff--/*- * Markers for begin/end of the list of Event Types in the Header.- * Header, Event Type, Begin = hetb- * Header, Event Type, End = hete- */-#define EVENT_HET_BEGIN       0x68657462 /* 'h' 'e' 't' 'b' */-#define EVENT_HET_END         0x68657465 /* 'h' 'e' 't' 'e' */--#define EVENT_ET_BEGIN        0x65746200 /* 'e' 't' 'b' 0 */-#define EVENT_ET_END          0x65746500 /* 'e' 't' 'e' 0 */--/*- * Types of event- */-#define EVENT_CREATE_THREAD        0 /* (thread)               */-#define EVENT_RUN_THREAD           1 /* (thread)               */-#define EVENT_STOP_THREAD          2 /* (thread, status, blockinfo) */-#define EVENT_THREAD_RUNNABLE      3 /* (thread)               */-#define EVENT_MIGRATE_THREAD       4 /* (thread, new_cap)      */-/* 5, 6, 7 deprecated */-#define EVENT_THREAD_WAKEUP        8 /* (thread, other_cap)    */-#define EVENT_GC_START             9 /* ()                     */-#define EVENT_GC_END              10 /* ()                     */-#define EVENT_REQUEST_SEQ_GC      11 /* ()                     */-#define EVENT_REQUEST_PAR_GC      12 /* ()                     */-/* 13, 14 deprecated */-#define EVENT_CREATE_SPARK_THREAD 15 /* (spark_thread)         */-#define EVENT_LOG_MSG             16 /* (message ...)          */-/* 17 deprecated */-#define EVENT_BLOCK_MARKER        18 /* (size, end_time, capability) */-#define EVENT_USER_MSG            19 /* (message ...)          */-#define EVENT_GC_IDLE             20 /* () */-#define EVENT_GC_WORK             21 /* () */-#define EVENT_GC_DONE             22 /* () */-/* 23, 24 used by eden */-#define EVENT_CAPSET_CREATE       25 /* (capset, capset_type)  */-#define EVENT_CAPSET_DELETE       26 /* (capset)               */-#define EVENT_CAPSET_ASSIGN_CAP   27 /* (capset, cap)          */-#define EVENT_CAPSET_REMOVE_CAP   28 /* (capset, cap)          */-/* the RTS identifier is in the form of "GHC-version rts_way"  */-#define EVENT_RTS_IDENTIFIER      29 /* (capset, name_version_string) */-/* the vectors in these events are null separated strings             */-#define EVENT_PROGRAM_ARGS        30 /* (capset, commandline_vector)  */-#define EVENT_PROGRAM_ENV         31 /* (capset, environment_vector)  */-#define EVENT_OSPROCESS_PID       32 /* (capset, pid)          */-#define EVENT_OSPROCESS_PPID      33 /* (capset, parent_pid)   */-#define EVENT_SPARK_COUNTERS      34 /* (crt,dud,ovf,cnv,gcd,fiz,rem) */-#define EVENT_SPARK_CREATE        35 /* ()                     */-#define EVENT_SPARK_DUD           36 /* ()                     */-#define EVENT_SPARK_OVERFLOW      37 /* ()                     */-#define EVENT_SPARK_RUN           38 /* ()                     */-#define EVENT_SPARK_STEAL         39 /* (victim_cap)           */-#define EVENT_SPARK_FIZZLE        40 /* ()                     */-#define EVENT_SPARK_GC            41 /* ()                     */-#define EVENT_INTERN_STRING       42 /* (string, id) {not used by ghc} */-#define EVENT_WALL_CLOCK_TIME     43 /* (capset, unix_epoch_seconds, nanoseconds) */-#define EVENT_THREAD_LABEL        44 /* (thread, name_string)  */-#define EVENT_CAP_CREATE          45 /* (cap)                  */-#define EVENT_CAP_DELETE          46 /* (cap)                  */-#define EVENT_CAP_DISABLE         47 /* (cap)                  */-#define EVENT_CAP_ENABLE          48 /* (cap)                  */-#define EVENT_HEAP_ALLOCATED      49 /* (heap_capset, alloc_bytes) */-#define EVENT_HEAP_SIZE           50 /* (heap_capset, size_bytes) */-#define EVENT_HEAP_LIVE           51 /* (heap_capset, live_bytes) */-#define EVENT_HEAP_INFO_GHC       52 /* (heap_capset, n_generations,-                                         max_heap_size, alloc_area_size,-                                         mblock_size, block_size) */-#define EVENT_GC_STATS_GHC        53 /* (heap_capset, generation,-                                         copied_bytes, slop_bytes, frag_bytes,-                                         par_n_threads,-                                         par_max_copied,-                                         par_tot_copied, par_balanced_copied) */-#define EVENT_GC_GLOBAL_SYNC      54 /* ()                     */-#define EVENT_TASK_CREATE         55 /* (taskID, cap, tid)       */-#define EVENT_TASK_MIGRATE        56 /* (taskID, cap, new_cap)   */-#define EVENT_TASK_DELETE         57 /* (taskID)                 */-#define EVENT_USER_MARKER         58 /* (marker_name) */-#define EVENT_HACK_BUG_T9003      59 /* Hack: see trac #9003 */--/* Range 60 - 80 is used by eden for parallel tracing- * see http://www.mathematik.uni-marburg.de/~eden/- */--/* Range 100 - 139 is reserved for Mercury. */--/* Range 140 - 159 is reserved for Perf events. */--/* Range 160 - 180 is reserved for cost-centre heap profiling events. */--#define EVENT_HEAP_PROF_BEGIN              160-#define EVENT_HEAP_PROF_COST_CENTRE        161-#define EVENT_HEAP_PROF_SAMPLE_BEGIN       162-#define EVENT_HEAP_PROF_SAMPLE_COST_CENTRE 163-#define EVENT_HEAP_PROF_SAMPLE_STRING      164--#define EVENT_USER_BINARY_MSG              181--/*- * The highest event code +1 that ghc itself emits. Note that some event- * ranges higher than this are reserved but not currently emitted by ghc.- * This must match the size of the EventDesc[] array in EventLog.c- */-#define NUM_GHC_EVENT_TAGS        182--#if 0  /* DEPRECATED EVENTS: */-/* we don't actually need to record the thread, it's implicit */-#define EVENT_RUN_SPARK            5 /* (thread)               */-#define EVENT_STEAL_SPARK          6 /* (thread, victim_cap)   */-/* shutdown replaced by EVENT_CAP_DELETE */-#define EVENT_SHUTDOWN             7 /* ()                     */-/* ghc changed how it handles sparks so these are no longer applicable */-#define EVENT_CREATE_SPARK        13 /* (cap, thread) */-#define EVENT_SPARK_TO_THREAD     14 /* (cap, thread, spark_thread) */-#define EVENT_STARTUP             17 /* (num_capabilities)     */-/* these are used by eden but are replaced by new alternatives for ghc */-#define EVENT_VERSION             23 /* (version_string) */-#define EVENT_PROGRAM_INVOCATION  24 /* (commandline_string) */-#endif--/*- * Status values for EVENT_STOP_THREAD- *- * 1-5 are the StgRun return values (from includes/Constants.h):- *- * #define HeapOverflow   1- * #define StackOverflow  2- * #define ThreadYielding 3- * #define ThreadBlocked  4- * #define ThreadFinished 5- * #define ForeignCall                  6- * #define BlockedOnMVar                7- * #define BlockedOnBlackHole           8- * #define BlockedOnRead                9- * #define BlockedOnWrite               10- * #define BlockedOnDelay               11- * #define BlockedOnSTM                 12- * #define BlockedOnDoProc              13- * #define BlockedOnCCall               -- not used (see ForeignCall)- * #define BlockedOnCCall_NoUnblockExc  -- not used (see ForeignCall)- * #define BlockedOnMsgThrowTo          16- */-#define THREAD_SUSPENDED_FOREIGN_CALL 6--/*- * Capset type values for EVENT_CAPSET_CREATE- */-#define CAPSET_TYPE_CUSTOM      1  /* reserved for end-user applications */-#define CAPSET_TYPE_OSPROCESS   2  /* caps belong to the same OS process */-#define CAPSET_TYPE_CLOCKDOMAIN 3  /* caps share a local clock/time      */--/*- * Heap profile breakdown types. See EVENT_HEAP_PROF_BEGIN.- */-typedef enum {-    HEAP_PROF_BREAKDOWN_COST_CENTRE = 0x1,-    HEAP_PROF_BREAKDOWN_MODULE,-    HEAP_PROF_BREAKDOWN_CLOSURE_DESCR,-    HEAP_PROF_BREAKDOWN_TYPE_DESCR,-    HEAP_PROF_BREAKDOWN_RETAINER,-    HEAP_PROF_BREAKDOWN_BIOGRAPHY,-    HEAP_PROF_BREAKDOWN_CLOSURE_TYPE-} HeapProfBreakdown;--#if !defined(EVENTLOG_CONSTANTS_ONLY)--typedef StgWord16 EventTypeNum;-typedef StgWord64 EventTimestamp; /* in nanoseconds */-typedef StgWord32 EventThreadID;-typedef StgWord16 EventCapNo;-typedef StgWord16 EventPayloadSize; /* variable-size events */-typedef StgWord16 EventThreadStatus; /* status for EVENT_STOP_THREAD */-typedef StgWord32 EventCapsetID;-typedef StgWord16 EventCapsetType;   /* types for EVENT_CAPSET_CREATE */-typedef StgWord64 EventTaskId;         /* for EVENT_TASK_* */-typedef StgWord64 EventKernelThreadId; /* for EVENT_TASK_CREATE */--#define EVENT_PAYLOAD_SIZE_MAX STG_WORD16_MAX-#endif
− includes/rts/EventLogWriter.h
@@ -1,40 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2008-2017- *- * Support for fast binary event logging.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#include <stddef.h>-#include <stdbool.h>--/*- *  Abstraction for writing eventlog data.- */-typedef struct {-    // Initialize an EventLogWriter (may be NULL)-    void (* initEventLogWriter) (void);--    // Write a series of events-    bool (* writeEventLog) (void *eventlog, size_t eventlog_size);--    // Flush possibly existing buffers (may be NULL)-    void (* flushEventLog) (void);--    // Close an initialized EventLogOutput (may be NULL)-    void (* stopEventLogWriter) (void);-} EventLogWriter;--/*- * An EventLogWriter which writes eventlogs to- * a file `program.eventlog`.- */-extern const EventLogWriter FileEventLogWriter;
− includes/rts/FileLock.h
@@ -1,19 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2007-2009- *- * File locking support as required by Haskell- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#include "Stg.h"--int  lockFile(int fd, StgWord64 dev, StgWord64 ino, int for_writing);-int  unlockFile(int fd);
− includes/rts/Flags.h
@@ -1,289 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Datatypes that holds the command-line flag settings.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#include <stdio.h>-#include <stdint.h>-#include <stdbool.h>-#include "stg/Types.h"-#include "Time.h"--/* For defaults, see the @initRtsFlagsDefaults@ routine. */--/* Note [Synchronization of flags and base APIs]- *- * We provide accessors to RTS flags in base. (GHC.RTS module)- * The API should be updated whenever RTS flags are modified.- */--/* See Note [Synchronization of flags and base APIs] */-typedef struct _GC_FLAGS {-    FILE   *statsFile;-    uint32_t  giveStats;-#define NO_GC_STATS	 0-#define COLLECT_GC_STATS 1-#define ONELINE_GC_STATS 2-#define SUMMARY_GC_STATS 3-#define VERBOSE_GC_STATS 4--    uint32_t     maxStkSize;         /* in *words* */-    uint32_t     initialStkSize;     /* in *words* */-    uint32_t     stkChunkSize;       /* in *words* */-    uint32_t     stkChunkBufferSize; /* in *words* */--    uint32_t     maxHeapSize;        /* in *blocks* */-    uint32_t     minAllocAreaSize;   /* in *blocks* */-    uint32_t     largeAllocLim;      /* in *blocks* */-    uint32_t     nurseryChunkSize;   /* in *blocks* */-    uint32_t     minOldGenSize;      /* in *blocks* */-    uint32_t     heapSizeSuggestion; /* in *blocks* */-    bool heapSizeSuggestionAuto;-    double  oldGenFactor;-    double  pcFreeHeap;--    uint32_t     generations;-    bool squeezeUpdFrames;--    bool compact;		/* True <=> "compact all the time" */-    double  compactThreshold;--    bool sweep;		/* use "mostly mark-sweep" instead of copying-                                 * for the oldest generation */-    bool ringBell;--    Time    idleGCDelayTime;    /* units: TIME_RESOLUTION */-    bool doIdleGC;--    Time    longGCSync;         /* units: TIME_RESOLUTION */--    StgWord heapBase;           /* address to ask the OS for memory */--    StgWord allocLimitGrace;    /* units: *blocks*-                                 * After an AllocationLimitExceeded-                                 * exception has been raised, how much-                                 * extra space is given to the thread-                                 * to handle the exception before we-                                 * raise it again.-                                 */-    StgWord heapLimitGrace;     /* units: *blocks*-                                 * After a HeapOverflow exception has-                                 * been raised, how much extra space is-                                 * given to the thread to handle the-                                 * exception before we raise it again.-                                 */--    bool numa;                   /* Use NUMA */-    StgWord numaMask;-} GC_FLAGS;--/* See Note [Synchronization of flags and base APIs] */-typedef struct _DEBUG_FLAGS {-    /* flags to control debugging output & extra checking in various subsystems */-    bool scheduler;      /* 's' */-    bool interpreter;    /* 'i' */-    bool weak;           /* 'w' */-    bool gccafs;         /* 'G' */-    bool gc;             /* 'g' */-    bool block_alloc;    /* 'b' */-    bool sanity;         /* 'S'   warning: might be expensive! */-    bool stable;         /* 't' */-    bool prof;           /* 'p' */-    bool linker;         /* 'l'   the object linker */-    bool apply;          /* 'a' */-    bool stm;            /* 'm' */-    bool squeeze;        /* 'z'  stack squeezing & lazy blackholing */-    bool hpc;            /* 'c' coverage */-    bool sparks;         /* 'r' */-    bool numa;           /* '--debug-numa' */-    bool compact;        /* 'C' */-} DEBUG_FLAGS;--/* See Note [Synchronization of flags and base APIs] */-typedef struct _COST_CENTRE_FLAGS {-    uint32_t    doCostCentres;-# define COST_CENTRES_NONE      0-# define COST_CENTRES_SUMMARY	1-# define COST_CENTRES_VERBOSE	2 /* incl. serial time profile */-# define COST_CENTRES_ALL	3-# define COST_CENTRES_JSON      4--    int	    profilerTicks;   /* derived */-    int	    msecsPerTick;    /* derived */-    char const *outputFileNameStem;-} COST_CENTRE_FLAGS;--/* See Note [Synchronization of flags and base APIs] */-typedef struct _PROFILING_FLAGS {-    uint32_t doHeapProfile;-# define NO_HEAP_PROFILING	0	/* N.B. Used as indexes into arrays */-# define HEAP_BY_CCS		1-# define HEAP_BY_MOD		2-# define HEAP_BY_DESCR		4-# define HEAP_BY_TYPE		5-# define HEAP_BY_RETAINER       6-# define HEAP_BY_LDV            7--# define HEAP_BY_CLOSURE_TYPE   8--    Time        heapProfileInterval; /* time between samples */-    uint32_t    heapProfileIntervalTicks; /* ticks between samples (derived) */-    bool        includeTSOs;---    bool		showCCSOnException;--    uint32_t    maxRetainerSetSize;--    uint32_t    ccsLength;--    const char*         modSelector;-    const char*         descrSelector;-    const char*         typeSelector;-    const char*         ccSelector;-    const char*         ccsSelector;-    const char*         retainerSelector;-    const char*         bioSelector;--} PROFILING_FLAGS;--#define TRACE_NONE      0-#define TRACE_EVENTLOG  1-#define TRACE_STDERR    2--/* See Note [Synchronization of flags and base APIs] */-typedef struct _TRACE_FLAGS {-    int tracing;-    bool timestamp;      /* show timestamp in stderr output */-    bool scheduler;      /* trace scheduler events */-    bool gc;             /* trace GC events */-    bool sparks_sampled; /* trace spark events by a sampled method */-    bool sparks_full;    /* trace spark events 100% accurately */-    bool user;           /* trace user events (emitted from Haskell code) */-    char *trace_output;  /* output filename for eventlog */-} TRACE_FLAGS;--/* See Note [Synchronization of flags and base APIs] */-typedef struct _CONCURRENT_FLAGS {-    Time ctxtSwitchTime;         /* units: TIME_RESOLUTION */-    int ctxtSwitchTicks;         /* derived */-} CONCURRENT_FLAGS;--/*- * The tickInterval is the time interval between "ticks", ie.- * timer signals (see Timer.{c,h}).  It is the frequency at- * which we sample CCCS for profiling.- *- * It is changed by the +RTS -V<secs> flag.- */-#define DEFAULT_TICK_INTERVAL USToTime(10000)--/* See Note [Synchronization of flags and base APIs] */-typedef struct _MISC_FLAGS {-    Time    tickInterval;        /* units: TIME_RESOLUTION */-    bool install_signal_handlers;-    bool install_seh_handlers;-    bool generate_dump_file;-    bool generate_stack_trace;-    bool machineReadable;-    bool internalCounters;       /* See Note [Internal Counter Stats] */-    StgWord linkerMemBase;       /* address to ask the OS for memory-                                  * for the linker, NULL ==> off */-} MISC_FLAGS;--/* See Note [Synchronization of flags and base APIs] */-typedef struct _PAR_FLAGS {-  uint32_t       nCapabilities;  /* number of threads to run simultaneously */-  bool           migrate;        /* migrate threads between capabilities */-  uint32_t       maxLocalSparks;-  bool           parGcEnabled;   /* enable parallel GC */-  uint32_t       parGcGen;       /* do parallel GC in this generation-                                  * and higher only */-  bool           parGcLoadBalancingEnabled;-                                 /* enable load-balancing in the-                                  * parallel GC */-  uint32_t       parGcLoadBalancingGen;-                                 /* do load-balancing in this-                                  * generation and higher only */--  uint32_t       parGcNoSyncWithIdle;-                                 /* if a Capability has been idle for-                                  * this many GCs, do not try to wake-                                  * it up when doing a-                                  * non-load-balancing parallel GC.-                                  * (zero disables) */--  uint32_t       parGcThreads;-                                 /* Use this many threads for parallel-                                  * GC (default: use all nNodes). */--  bool           setAffinity;    /* force thread affinity with CPUs */-} PAR_FLAGS;--/* See Note [Synchronization of flags and base APIs] */-typedef struct _TICKY_FLAGS {-    bool showTickyStats;-    FILE   *tickyFile;-} TICKY_FLAGS;--/* Put them together: */--/* See Note [Synchronization of flags and base APIs] */-typedef struct _RTS_FLAGS {-    /* The first portion of RTS_FLAGS is invariant. */-    GC_FLAGS	      GcFlags;-    CONCURRENT_FLAGS  ConcFlags;-    MISC_FLAGS        MiscFlags;-    DEBUG_FLAGS	      DebugFlags;-    COST_CENTRE_FLAGS CcFlags;-    PROFILING_FLAGS   ProfFlags;-    TRACE_FLAGS       TraceFlags;-    TICKY_FLAGS	      TickyFlags;-    PAR_FLAGS	      ParFlags;-} RTS_FLAGS;--#if defined(COMPILING_RTS_MAIN)-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 RTS_FLAGS RtsFlags;-#endif--/*- * The printf formats are here, so we are less likely to make- * overly-long filenames (with disastrous results).  No more than 128- * chars, please!- */--#define STATS_FILENAME_MAXLEN	128--#define GR_FILENAME_FMT		"%0.124s.gr"-#define HP_FILENAME_FMT		"%0.124s.hp"-#define LIFE_FILENAME_FMT	"%0.122s.life"-#define PROF_FILENAME_FMT	"%0.122s.prof"-#define PROF_FILENAME_FMT_GUM	"%0.118s.%03d.prof"-#define QP_FILENAME_FMT		"%0.124s.qp"-#define STAT_FILENAME_FMT	"%0.122s.stat"-#define TICKY_FILENAME_FMT	"%0.121s.ticky"-#define TIME_FILENAME_FMT	"%0.122s.time"-#define TIME_FILENAME_FMT_GUM	"%0.118s.%03d.time"--/* an "int" so as to match normal "argc" */-/* Now defined in Stg.h (lib/std/cbits need these too.)-extern int     prog_argc;-extern char  **prog_argv;-*/-extern int      rts_argc;  /* ditto */-extern char   **rts_argv;
− includes/rts/GetTime.h
@@ -1,16 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1995-2009- *- * Interface to the RTS time- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--StgWord64 getMonotonicNSec (void);
− includes/rts/Globals.h
@@ -1,36 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2006-2009- *- * The RTS stores some "global" values on behalf of libraries, so that- * some libraries can ensure that certain top-level things are shared- * even when multiple versions of the library are loaded.  e.g. see- * Data.Typeable and GHC.Conc.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#define mkStoreAccessorPrototype(name)                                  \-    StgStablePtr                                                        \-    getOrSet##name(StgStablePtr ptr);--mkStoreAccessorPrototype(GHCConcSignalSignalHandlerStore)-mkStoreAccessorPrototype(GHCConcWindowsPendingDelaysStore)-mkStoreAccessorPrototype(GHCConcWindowsIOManagerThreadStore)-mkStoreAccessorPrototype(GHCConcWindowsProddingStore)-mkStoreAccessorPrototype(SystemEventThreadEventManagerStore)-mkStoreAccessorPrototype(SystemEventThreadIOManagerThreadStore)-mkStoreAccessorPrototype(SystemTimerThreadEventManagerStore)-mkStoreAccessorPrototype(SystemTimerThreadIOManagerThreadStore)-mkStoreAccessorPrototype(LibHSghcFastStringTable)-mkStoreAccessorPrototype(LibHSghcPersistentLinkerState)-mkStoreAccessorPrototype(LibHSghcInitLinkerDone)-mkStoreAccessorPrototype(LibHSghcGlobalDynFlags)-mkStoreAccessorPrototype(LibHSghcStaticOptions)-mkStoreAccessorPrototype(LibHSghcStaticOptionsReady)
− includes/rts/Hpc.h
@@ -1,34 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2008-2009- *- * Haskell Program Coverage- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--// Simple linked list of modules-typedef struct _HpcModuleInfo {-  char *modName;                // name of module-  StgWord32 tickCount;          // number of ticks-  StgWord32 hashNo;             // Hash number for this module's mix info-  StgWord64 *tixArr;            // tix Array; local for this module-  bool from_file;               // data was read from the .tix file-  struct _HpcModuleInfo *next;-} HpcModuleInfo;--void hs_hpc_module (char *modName,-                    StgWord32 modCount,-                    StgWord32 modHashNo,-                    StgWord64 *tixArr);--HpcModuleInfo * hs_hpc_rootModule (void);--void startupHpc(void);-void exitHpc(void);
− includes/rts/IOManager.h
@@ -1,43 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * IO Manager functionality in the RTS- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--#if defined(mingw32_HOST_OS)--int  rts_InstallConsoleEvent ( int action, StgStablePtr *handler );-void rts_ConsoleHandlerDone  ( int ev );-extern StgInt console_handler;--void *   getIOManagerEvent  (void);-HsWord32 readIOManagerEvent (void);-void     sendIOManagerEvent (HsWord32 event);--#else--void     setIOManagerControlFd   (uint32_t cap_no, int fd);-void     setTimerManagerControlFd(int fd);-void     setIOManagerWakeupFd   (int fd);--#endif--//-// Communicating with the IO manager thread (see GHC.Conc).-// Posix implementation in posix/Signals.c-// Win32 implementation in win32/ThrIOManager.c-//-void ioManagerWakeup (void);-#if defined(THREADED_RTS)-void ioManagerDie (void);-void ioManagerStart (void);-#endif
− includes/rts/Libdw.h
@@ -1,97 +0,0 @@-/* ---------------------------------------------------------------------------- *- * (c) The GHC Team, 2014-2015- *- * Producing DWARF-based stacktraces with libdw.- *- * --------------------------------------------------------------------------*/--#pragma once--// for FILE-#include <stdio.h>--// Chunk capacity-// This is rather arbitrary-#define BACKTRACE_CHUNK_SZ 256--/*- * Note [Chunked stack representation]- * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~- *- * Consider the stack,- *     main                   calls                        (bottom of stack)- *       func1                which in turn calls- *         func2              which calls- *          func3             which calls- *            func4           which calls- *              func5         which calls- *                func6       which calls- *                  func7     which requests a backtrace   (top of stack)- *- * This would produce the Backtrace (using a smaller chunk size of three for- * illustrative purposes),- *- * Backtrace     /----> Chunk         /----> Chunk         /----> Chunk- * last --------/       next --------/       next --------/       next- * n_frames=8           n_frames=2           n_frames=3           n_frames=3- *                      ~~~~~~~~~~           ~~~~~~~~~~           ~~~~~~~~~~- *                      func1                func4                func7- *                      main                 func3                func6- *                                           func2                func5- *- */--/* A chunk of code addresses from an execution stack- *- * The first address in this list corresponds to the stack frame- * nearest to the "top" of the stack.- */-typedef struct BacktraceChunk_ {-    StgWord n_frames;                      // number of frames in this chunk-    struct BacktraceChunk_ *next;          // the chunk following this one-    StgPtr frames[BACKTRACE_CHUNK_SZ];     // the code addresses from the-                                           // frames-} __attribute__((packed)) BacktraceChunk;--/* A chunked list of code addresses from an execution stack- *- * This structure is optimized for append operations since we append O(stack- * depth) times yet typically only traverse the stack trace once. Consequently,- * the "top" stack frame (that is, the one where we started unwinding) can be- * found in the last chunk. Yes, this is a bit inconsistent with the ordering- * within a chunk. See Note [Chunked stack representation] for a depiction.- */-typedef struct Backtrace_ {-    StgWord n_frames;        // Total number of frames in the backtrace-    BacktraceChunk *last;    // The first chunk of frames (corresponding to the-                             // bottom of the stack)-} Backtrace;--/* Various information describing the location of an address */-typedef struct Location_ {-    const char *object_file;-    const char *function;--    // lineno and colno are only valid if source_file /= NULL-    const char *source_file;-    StgWord32 lineno;-    StgWord32 colno;-} __attribute__((packed)) Location;--struct LibdwSession_;-typedef struct LibdwSession_ LibdwSession;--/* Free a backtrace */-void backtraceFree(Backtrace *bt);--/* Request a backtrace of the current stack state.- * May return NULL if a backtrace can't be acquired. */-Backtrace *libdwGetBacktrace(LibdwSession *session);--/* Lookup Location information for the given address.- * Returns 0 if successful, 1 if address could not be found. */-int libdwLookupLocation(LibdwSession *session, Location *loc, StgPtr pc);--/* Pretty-print a backtrace to the given FILE */-void libdwPrintBacktrace(LibdwSession *session, FILE *file, Backtrace *bt);
− includes/rts/LibdwPool.h
@@ -1,19 +0,0 @@-/* ---------------------------------------------------------------------------- *- * (c) The GHC Team, 2015-2016- *- * A pool of libdw sessions- *- * --------------------------------------------------------------------------*/--#pragma once--/* Claim a session from the pool */-LibdwSession *libdwPoolTake(void);--/* Return a session to the pool */-void libdwPoolRelease(LibdwSession *sess);--/* Free any sessions in the pool forcing a reload of any loaded debug- * information */-void libdwPoolClear(void);
− includes/rts/Linker.h
@@ -1,101 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2009- *- * RTS Object Linker- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#if defined(mingw32_HOST_OS)-typedef wchar_t pathchar;-#define PATH_FMT "ls"-#else-typedef char    pathchar;-#define PATH_FMT "s"-#endif--/* Initialize the object linker. Equivalent to initLinker_(1). */-void initLinker (void);--/* Initialize the object linker.- * The retain_cafs argument is:- *- *   non-zero => Retain CAFs unconditionally in linked Haskell code.- *               Note that this prevents any code from being unloaded.- *               It should not be necessary unless you are GHCi or- *               hs-plugins, which needs to be able call any function- *               in the compiled code.- *- *   zero     => Do not retain CAFs.  Everything reachable from foreign- *               exports will be retained, due to the StablePtrs- *               created by the module initialisation code.  unloadObj- *               frees these StablePtrs, which will allow the CAFs to- *               be GC'd and the code to be removed.- */-void initLinker_ (int retain_cafs);--/* insert a symbol in the hash table */-HsInt insertSymbol(pathchar* obj_name, char* key, void* data);--/* lookup a symbol in the hash table */-void *lookupSymbol( char *lbl );--/* See Linker.c Note [runtime-linker-phases] */-typedef enum {-    OBJECT_LOADED,-    OBJECT_NEEDED,-    OBJECT_RESOLVED,-    OBJECT_UNLOADED,-    OBJECT_DONT_RESOLVE,-    OBJECT_NOT_LOADED     /* The object was either never loaded or has been-                             fully unloaded */-} OStatus;--/* check object load status */-OStatus getObjectLoadStatus( pathchar *path );--/* delete an object from the pool */-HsInt unloadObj( pathchar *path );--/* purge an object's symbols from the symbol table, but don't unload it */-HsInt purgeObj( pathchar *path );--/* add an obj (populate the global symbol table, but don't resolve yet) */-HsInt loadObj( pathchar *path );--/* add an arch (populate the global symbol table, but don't resolve yet) */-HsInt loadArchive( pathchar *path );--/* resolve all the currently unlinked objects in memory */-HsInt resolveObjs( void );--/* load a dynamic library */-const char *addDLL( pathchar* dll_name );--/* add a path to the library search path */-HsPtr addLibrarySearchPath(pathchar* dll_path);--/* removes a directory from the search path,-   path must have been added using addLibrarySearchPath */-HsBool removeLibrarySearchPath(HsPtr dll_path_index);--/* give a warning about missing Windows patches that would make-   the linker work better */-void warnMissingKBLibraryPaths( void );--/* ------------------------------------------------------------------------------* Searches the system directories to determine if there is a system DLL that-* satisfies the given name. This prevent GHCi from linking against a static-* library if a DLL is available.-*/-pathchar* findSystemLibrary(pathchar* dll_name);--/* called by the initialization code for a module, not a user API */-StgStablePtr foreignExportStablePtr (StgPtr p);
− includes/rts/Main.h
@@ -1,18 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2009- *- * Entry point for standalone Haskell programs.- *- * ---------------------------------------------------------------------------*/--#pragma once--/* ------------------------------------------------------------------------------ * The entry point for Haskell programs that use a Haskell main function- * -------------------------------------------------------------------------- */--int hs_main (int argc, char *argv[],     // program args-             StgClosure *main_closure,   // closure for Main.main-             RtsConfig rts_config)       // RTS configuration-   GNUC3_ATTRIBUTE(__noreturn__);
− includes/rts/Messages.h
@@ -1,104 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Message API for use inside the RTS.  All messages generated by the- * RTS should go through one of the functions declared here, and we- * also provide hooks so that messages from the RTS can be redirected- * as appropriate.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#include <stdarg.h>--#if defined(mingw32_HOST_OS)-/* On Win64, if we say "printf" then gcc thinks we are going to use-   MS format specifiers like %I64d rather than %llu */-#define PRINTF gnu_printf-#else-/* However, on OS X, "gnu_printf" isn't recognised */-#define PRINTF printf-#endif--/* ------------------------------------------------------------------------------ * Message generation- * -------------------------------------------------------------------------- */--/*- * A fatal internal error: this is for errors that probably indicate- * bugs in the RTS or compiler.  We normally output bug reporting- * instructions along with the error message.- *- * barf() invokes (*fatalInternalErrorFn)().  This function is not- * expected to return.- */-void barf(const char *s, ...)-   GNUC3_ATTRIBUTE(__noreturn__)-   GNUC3_ATTRIBUTE(format(PRINTF, 1, 2));--void vbarf(const char *s, va_list ap)-   GNUC3_ATTRIBUTE(__noreturn__);--// declared in Rts.h:-// extern void _assertFail(const char *filename, unsigned int linenum)-//    GNUC3_ATTRIBUTE(__noreturn__);--/*- * An error condition which is caused by and/or can be corrected by- * the user.- *- * errorBelch() invokes (*errorMsgFn)().- */-void errorBelch(const char *s, ...)-   GNUC3_ATTRIBUTE(format (PRINTF, 1, 2));--void verrorBelch(const char *s, va_list ap);--/*- * An error condition which is caused by and/or can be corrected by- * the user, and which has an associated error condition reported- * by the system (in errno on Unix, and GetLastError() on Windows).- * The system error message is appended to the message generated- * from the supplied format string.- *- * sysErrorBelch() invokes (*sysErrorMsgFn)().- */-void sysErrorBelch(const char *s, ...)-   GNUC3_ATTRIBUTE(format (PRINTF, 1, 2));--void vsysErrorBelch(const char *s, va_list ap);--/*- * A debugging message.  Debugging messages are generated either as a- * virtue of having DEBUG turned on, or by being explicitly selected- * via RTS options (eg. +RTS -Ds).- *- * debugBelch() invokes (*debugMsgFn)().- */-void debugBelch(const char *s, ...)-   GNUC3_ATTRIBUTE(format (PRINTF, 1, 2));--void vdebugBelch(const char *s, va_list ap);---/* Hooks for redirecting message generation: */--typedef void RtsMsgFunction(const char *, va_list);--extern RtsMsgFunction *fatalInternalErrorFn;-extern RtsMsgFunction *debugMsgFn;-extern RtsMsgFunction *errorMsgFn;--/* Default stdio implementation of the message hooks: */--extern RtsMsgFunction rtsFatalInternalErrorFn;-extern RtsMsgFunction rtsDebugMsgFn;-extern RtsMsgFunction rtsErrorMsgFn;-extern RtsMsgFunction rtsSysErrorMsgFn;
− includes/rts/OSThreads.h
@@ -1,258 +0,0 @@-/* ---------------------------------------------------------------------------- *- * (c) The GHC Team, 2001-2009- *- * Accessing OS threads functionality in a (mostly) OS-independent- * manner.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * --------------------------------------------------------------------------*/--#pragma once--#if defined(HAVE_PTHREAD_H) && !defined(mingw32_HOST_OS)--#if defined(CMINUSMINUS)--#define OS_ACQUIRE_LOCK(mutex) foreign "C" pthread_mutex_lock(mutex)-#define OS_RELEASE_LOCK(mutex) foreign "C" pthread_mutex_unlock(mutex)-#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */--#else--#include <pthread.h>-#include <errno.h>--typedef pthread_cond_t  Condition;-typedef pthread_mutex_t Mutex;-typedef pthread_t       OSThreadId;-typedef pthread_key_t   ThreadLocalKey;--#define OSThreadProcAttr /* nothing */--#define INIT_COND_VAR       PTHREAD_COND_INITIALIZER--#if defined(LOCK_DEBUG)-#define LOCK_DEBUG_BELCH(what, mutex) \-  debugBelch("%s(0x%p) %s %d\n", what, mutex, __FILE__, __LINE__)-#else-#define LOCK_DEBUG_BELCH(what, mutex) /* nothing */-#endif--/* Always check the result of lock and unlock. */-#define OS_ACQUIRE_LOCK(mutex) \-  LOCK_DEBUG_BELCH("ACQUIRE_LOCK", mutex); \-  if (pthread_mutex_lock(mutex) == EDEADLK) { \-    barf("multiple ACQUIRE_LOCK: %s %d", __FILE__,__LINE__); \-  }--// Returns zero if the lock was acquired.-EXTERN_INLINE int TRY_ACQUIRE_LOCK(pthread_mutex_t *mutex);-EXTERN_INLINE int TRY_ACQUIRE_LOCK(pthread_mutex_t *mutex)-{-    LOCK_DEBUG_BELCH("TRY_ACQUIRE_LOCK", mutex);-    return pthread_mutex_trylock(mutex);-}--#define OS_RELEASE_LOCK(mutex) \-  LOCK_DEBUG_BELCH("RELEASE_LOCK", mutex); \-  if (pthread_mutex_unlock(mutex) != 0) { \-    barf("RELEASE_LOCK: I do not own this lock: %s %d", __FILE__,__LINE__); \-  }--// Note: this assertion calls pthread_mutex_lock() on a mutex that-// is already held by the calling thread.  The mutex should therefore-// have been created with PTHREAD_MUTEX_ERRORCHECK, otherwise this-// assertion will hang.  We always initialise mutexes with-// PTHREAD_MUTEX_ERRORCHECK when DEBUG is on (see rts/posix/OSThreads.h).-#define OS_ASSERT_LOCK_HELD(mutex) ASSERT(pthread_mutex_lock(mutex) == EDEADLK)--#endif // CMINUSMINUS--# elif defined(HAVE_WINDOWS_H)--#if defined(CMINUSMINUS)--/* We jump through a hoop here to get a CCall EnterCriticalSection-   and LeaveCriticalSection, as that's what C-- wants. */--#define OS_ACQUIRE_LOCK(mutex) foreign "stdcall" EnterCriticalSection(mutex)-#define OS_RELEASE_LOCK(mutex) foreign "stdcall" LeaveCriticalSection(mutex)-#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */--#else--#include <windows.h>--typedef HANDLE Condition;-typedef DWORD OSThreadId;-// don't be tempted to use HANDLE as the OSThreadId: there can be-// many HANDLES to a given thread, so comparison would not work.-typedef DWORD ThreadLocalKey;--#define OSThreadProcAttr __stdcall--#define INIT_COND_VAR  0--// We have a choice for implementing Mutexes on Windows.  Standard-// Mutexes are kernel objects that require kernel calls to-// acquire/release, whereas CriticalSections are spin-locks that block-// in the kernel after spinning for a configurable number of times.-// CriticalSections are *much* faster, so we use those.  The Mutex-// implementation is left here for posterity.-#define USE_CRITICAL_SECTIONS 1--#if USE_CRITICAL_SECTIONS--typedef CRITICAL_SECTION Mutex;--#if defined(LOCK_DEBUG)--#define OS_ACQUIRE_LOCK(mutex) \-  debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \-  EnterCriticalSection(mutex)-#define OS_RELEASE_LOCK(mutex) \-  debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \-  LeaveCriticalSection(mutex)-#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */--#else--#define OS_ACQUIRE_LOCK(mutex)      EnterCriticalSection(mutex)-#define TRY_ACQUIRE_LOCK(mutex)  (TryEnterCriticalSection(mutex) == 0)-#define OS_RELEASE_LOCK(mutex)      LeaveCriticalSection(mutex)--// I don't know how to do this.  TryEnterCriticalSection() doesn't do-// the right thing.-#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */--#endif--#else--typedef HANDLE Mutex;--// casting to (Mutex *) here required due to use in .cmm files where-// the argument has (void *) type.-#define OS_ACQUIRE_LOCK(mutex)                                     \-    if (WaitForSingleObject(*((Mutex *)mutex),INFINITE) == WAIT_FAILED) { \-        barf("WaitForSingleObject: %d", GetLastError());        \-    }--#define OS_RELEASE_LOCK(mutex)                             \-    if (ReleaseMutex(*((Mutex *)mutex)) == 0) {         \-        barf("ReleaseMutex: %d", GetLastError());       \-    }--#define OS_ASSERT_LOCK_HELD(mutex) /* nothing */-#endif--#endif // CMINUSMINUS--# elif defined(THREADED_RTS)-#  error "Threads not supported"-# endif---#if !defined(CMINUSMINUS)-//-// General thread operations-//-extern OSThreadId osThreadId      ( void );-extern void shutdownThread        ( void )   GNUC3_ATTRIBUTE(__noreturn__);-extern void yieldThread           ( void );--typedef void* OSThreadProcAttr OSThreadProc(void *);--extern int  createOSThread        ( OSThreadId* tid, char *name,-                                    OSThreadProc *startProc, void *param);-extern bool osThreadIsAlive       ( OSThreadId id );-extern void interruptOSThread     (OSThreadId id);--//-// Condition Variables-//-extern void initCondition         ( Condition* pCond );-extern void closeCondition        ( Condition* pCond );-extern bool broadcastCondition    ( Condition* pCond );-extern bool signalCondition       ( Condition* pCond );-extern bool waitCondition         ( Condition* pCond, Mutex* pMut );--//-// Mutexes-//-extern void initMutex             ( Mutex* pMut );-extern void closeMutex            ( Mutex* pMut );--//-// Thread-local storage-//-void  newThreadLocalKey (ThreadLocalKey *key);-void *getThreadLocalVar (ThreadLocalKey *key);-void  setThreadLocalVar (ThreadLocalKey *key, void *value);-void  freeThreadLocalKey (ThreadLocalKey *key);--// Processors and affinity-void setThreadAffinity (uint32_t n, uint32_t m);-void setThreadNode (uint32_t node);-void releaseThreadNode (void);-#endif // !CMINUSMINUS--#if defined(THREADED_RTS)--#define ACQUIRE_LOCK(l) OS_ACQUIRE_LOCK(l)-#define RELEASE_LOCK(l) OS_RELEASE_LOCK(l)-#define ASSERT_LOCK_HELD(l) OS_ASSERT_LOCK_HELD(l)--#else--#define ACQUIRE_LOCK(l)-#define RELEASE_LOCK(l)-#define ASSERT_LOCK_HELD(l)--#endif /* defined(THREADED_RTS) */--#if !defined(CMINUSMINUS)-//-// Support for forkOS (defined regardless of THREADED_RTS, but does-// nothing when !THREADED_RTS).-//-int forkOS_createThread ( HsStablePtr entry );--//-// Free any global resources created in OSThreads.-//-void freeThreadingResources(void);--//-// Returns the number of processor cores in the machine-//-uint32_t getNumberOfProcessors (void);--//-// Support for getting at the kernel thread Id for tracing/profiling.-//-// This stuff is optional and only used for tracing/profiling purposes, to-// match up thread ids recorded by other tools. For example, on Linux and OSX-// the pthread_t type is not the same as the kernel thread id, and system-// profiling tools like Linux perf, and OSX's DTrace use the kernel thread Id.-// So if we want to match up RTS tasks with kernel threads recorded by these-// tools then we need to know the kernel thread Id, and this must be a separate-// type from the OSThreadId.-//-// If the feature cannot be supported on an OS, it is OK to always return 0.-// In particular it would almost certaily be meaningless on systems not using-// a 1:1 threading model.--// We use a common serialisable representation on all OSs-// This is ok for Windows, OSX and Linux.-typedef StgWord64 KernelThreadId;--// Get the current kernel thread id-KernelThreadId kernelThreadId (void);--#endif /* CMINUSMINUS */
− includes/rts/Parallel.h
@@ -1,16 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Parallelism-related functionality- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--StgInt newSpark (StgRegTable *reg, StgClosure *p);
− includes/rts/PrimFloat.h
@@ -1,17 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Primitive floating-point operations- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--StgDouble __int_encodeDouble (I_ j, I_ e);-StgFloat  __int_encodeFloat (I_ j, I_ e);-StgDouble __word_encodeDouble (W_ j, I_ e);-StgFloat  __word_encodeFloat (W_ j, I_ e);
− includes/rts/Profiling.h
@@ -1,17 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2017-2018- *- * Cost-centre profiling API- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--void registerCcList(CostCentre **cc_list);-void registerCcsList(CostCentreStack **cc_list);
− includes/rts/Signals.h
@@ -1,23 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * RTS signal handling - *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--/* NB. #included in Haskell code, no prototypes in here. */--/* arguments to stg_sig_install() */-#define STG_SIG_DFL   (-1)-#define STG_SIG_IGN   (-2)-#define STG_SIG_ERR   (-3)-#define STG_SIG_HAN   (-4)-#define STG_SIG_RST   (-5)
− includes/rts/SpinLock.h
@@ -1,116 +0,0 @@-/* ----------------------------------------------------------------------------- *- * (c) The GHC Team, 2006-2009- *- * Spin locks- *- * These are simple spin-only locks as opposed to Mutexes which- * probably spin for a while before blocking in the kernel.  We use- * these when we are sure that all our threads are actively running on- * a CPU, eg. in the GC.- *- * TODO: measure whether we really need these, or whether Mutexes- * would do (and be a bit safer if a CPU becomes loaded).- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--#if defined(THREADED_RTS)--#if defined(PROF_SPIN)-typedef struct SpinLock_-{-    StgWord   lock;-    StgWord64 spin;  // incremented every time we spin in ACQUIRE_SPIN_LOCK-    StgWord64 yield; // incremented every time we yield in ACQUIRE_SPIN_LOCK-} SpinLock;-#else-typedef StgWord SpinLock;-#endif--#if defined(PROF_SPIN)--// PROF_SPIN enables counting the number of times we spin on a lock--// acquire spin lock-INLINE_HEADER void ACQUIRE_SPIN_LOCK(SpinLock * p)-{-    StgWord32 r = 0;-    uint32_t i;-    do {-        for (i = 0; i < SPIN_COUNT; i++) {-            r = cas((StgVolatilePtr)&(p->lock), 1, 0);-            if (r != 0) return;-            p->spin++;-            busy_wait_nop();-        }-        p->yield++;-        yieldThread();-    } while (1);-}--// release spin lock-INLINE_HEADER void RELEASE_SPIN_LOCK(SpinLock * p)-{-    write_barrier();-    p->lock = 1;-}--// initialise spin lock-INLINE_HEADER void initSpinLock(SpinLock * p)-{-    write_barrier();-    p->lock = 1;-    p->spin = 0;-    p->yield = 0;-}--#else--// acquire spin lock-INLINE_HEADER void ACQUIRE_SPIN_LOCK(SpinLock * p)-{-    StgWord32 r = 0;-    uint32_t i;-    do {-        for (i = 0; i < SPIN_COUNT; i++) {-            r = cas((StgVolatilePtr)p, 1, 0);-            if (r != 0) return;-            busy_wait_nop();-        }-        yieldThread();-    } while (1);-}--// release spin lock-INLINE_HEADER void RELEASE_SPIN_LOCK(SpinLock * p)-{-    write_barrier();-    (*p) = 1;-}--// init spin lock-INLINE_HEADER void initSpinLock(SpinLock * p)-{-    write_barrier();-    (*p) = 1;-}--#endif /* PROF_SPIN */--#else /* !THREADED_RTS */--// Using macros here means we don't have to ensure the argument is in scope-#define ACQUIRE_SPIN_LOCK(p) /* nothing */-#define RELEASE_SPIN_LOCK(p) /* nothing */--INLINE_HEADER void initSpinLock(void * p STG_UNUSED)-{ /* nothing */ }--#endif /* THREADED_RTS */
− includes/rts/StableName.h
@@ -1,32 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Stable Names- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--/* ------------------------------------------------------------------------------   PRIVATE from here.-   -------------------------------------------------------------------------- */--typedef struct {-    StgPtr  addr;        // Haskell object when entry is in use, next free-                         // entry (NULL when this is the last free entry)-                         // otherwise. May be NULL temporarily during GC (when-                         // pointee dies).--    StgPtr  old;         // Old Haskell object, used during GC--    StgClosure *sn_obj;  // The StableName object, or NULL when the entry is-                         // free-} snEntry;--extern DLL_IMPORT_RTS snEntry *stable_name_table;
− includes/rts/StablePtr.h
@@ -1,35 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * Stable Pointers- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--EXTERN_INLINE StgPtr deRefStablePtr (StgStablePtr stable_ptr);-StgStablePtr getStablePtr  (StgPtr p);--/* ------------------------------------------------------------------------------   PRIVATE from here.-   -------------------------------------------------------------------------- */--typedef struct {-    StgPtr addr;         // Haskell object when entry is in use, next free-                         // entry (NULL when this is the last free entry)-                         // otherwise.-} spEntry;--extern DLL_IMPORT_RTS spEntry *stable_ptr_table;--EXTERN_INLINE-StgPtr deRefStablePtr(StgStablePtr sp)-{-    return stable_ptr_table[(StgWord)sp].addr;-}
− includes/rts/StaticPtrTable.h
@@ -1,44 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2008-2009- *- * Initialization of the Static Pointer Table- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--/** Inserts an entry in the Static Pointer Table.- *- * The key is a fingerprint computed from the static pointer and the spe_closure- * is a pointer to the closure defining the table entry.- *- * A stable pointer to the closure is made to prevent it from being garbage- * collected while the entry exists on the table.- *- * This function is called from the code generated by- * compiler/deSugar/StaticPtrTable.sptInitCode- *- * */-void hs_spt_insert (StgWord64 key[2],void* spe_closure);--/** Inserts an entry for a StgTablePtr in the Static Pointer Table.- *- * This function is called from the GHCi interpreter to insert- * SPT entries for bytecode objects.- *- * */-void hs_spt_insert_stableptr(StgWord64 key[2], StgStablePtr *entry);--/** Removes an entry from the Static Pointer Table.- *- * This function is called from the code generated by- * compiler/deSugar/StaticPtrTable.sptInitCode- *- * */-void hs_spt_remove (StgWord64 key[2]);
− includes/rts/TTY.h
@@ -1,17 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2009- *- * POSIX TTY-related functionality- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * -------------------------------------------------------------------------- */--#pragma once--void* __hscore_get_saved_termios(int fd);-void  __hscore_set_saved_termios(int fd, void* ts);
− includes/rts/Threads.h
@@ -1,74 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team 1998-2009- *- * External API for the scheduler.  For most uses, the functions in- * RtsAPI.h should be enough.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#if defined(HAVE_SYS_TYPES_H)-#include <sys/types.h>-#endif--//-// Creating threads-//-StgTSO *createThread (Capability *cap, W_ stack_size);--void scheduleWaitThread (/* in    */ StgTSO *tso,-                         /* out   */ HaskellObj* ret,-                         /* inout */ Capability **cap);--StgTSO *createGenThread       (Capability *cap, W_ stack_size,-                               StgClosure *closure);-StgTSO *createIOThread        (Capability *cap, W_ stack_size,-                               StgClosure *closure);-StgTSO *createStrictIOThread  (Capability *cap, W_ stack_size,-                               StgClosure *closure);--// Suspending/resuming threads around foreign calls-void *        suspendThread (StgRegTable *, bool interruptible);-StgRegTable * resumeThread  (void *);--//-// Thread operations from Threads.c-//-int     cmp_thread                       (StgPtr tso1, StgPtr tso2);-int     rts_getThreadId                  (StgPtr tso);-void    rts_enableThreadAllocationLimit  (StgPtr tso);-void    rts_disableThreadAllocationLimit (StgPtr tso);--#if !defined(mingw32_HOST_OS)-pid_t  forkProcess     (HsStablePtr *entry);-#else-pid_t  forkProcess     (HsStablePtr *entry)-    GNU_ATTRIBUTE(__noreturn__);-#endif--HsBool rtsSupportsBoundThreads (void);--// The number of Capabilities.-// ToDo: I would like this to be private to the RTS and instead expose a-// function getNumCapabilities(), but it is used in compiler/cbits/genSym.c-extern unsigned int n_capabilities;--// The number of Capabilities that are not disabled-extern uint32_t enabled_capabilities;--#if !IN_STG_CODE-extern Capability MainCapability;-#endif--//-// Change the number of capabilities (only supports increasing the-// current value at the moment).-//-extern void setNumCapabilities (uint32_t new_);
− includes/rts/Ticky.h
@@ -1,32 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * TICKY_TICKY types- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--/* ------------------------------------------------------------------------------   The StgEntCounter type - needed regardless of TICKY_TICKY-   -------------------------------------------------------------------------- */--typedef struct _StgEntCounter {-  /* Using StgWord for everything, because both the C and asm code-     generators make trouble if you try to pack things tighter */-    StgWord     registeredp;    /* 0 == no, 1 == yes */-    StgInt      arity;          /* arity (static info) */-    StgInt      allocd;         /* # allocation of this closure */-                                /* (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;
− includes/rts/Time.h
@@ -1,44 +0,0 @@-/* ----------------------------------------------------------------------------- *- * (c) The GHC Team, 1998-2004- *- * Time values in the RTS- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * --------------------------------------------------------------------------*/--#pragma once--// For most time values in the RTS we use a fixed resolution of nanoseconds,-// normalising the time we get from platform-dependent APIs to this-// resolution.-#define TIME_RESOLUTION 1000000000-typedef int64_t Time;--#define TIME_MAX HS_INT64_MAX--#if TIME_RESOLUTION == 1000000000-// I'm being lazy, but it's awkward to define fully general versions of these-#define TimeToMS(t)      ((t) / 1000000)-#define TimeToUS(t)      ((t) / 1000)-#define TimeToNS(t)      (t)-#define MSToTime(t)      ((Time)(t) * 1000000)-#define USToTime(t)      ((Time)(t) * 1000)-#define NSToTime(t)      ((Time)(t))-#else-#error Fix TimeToNS(), TimeToUS() etc.-#endif--#define SecondsToTime(t) ((Time)(t) * TIME_RESOLUTION)-#define TimeToSeconds(t) ((t) / TIME_RESOLUTION)--// Use instead of SecondsToTime() when we have a floating-point-// seconds value, to avoid truncating it.-INLINE_HEADER Time fsecondsToTime (double t)-{-    return (Time)(t * TIME_RESOLUTION);-}--Time getProcessElapsedTime (void);
− includes/rts/Timer.h
@@ -1,18 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1995-2009- *- * Interface to the RTS timer signal (uses OS-dependent Ticker.h underneath)- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--void startTimer (void);-void stopTimer  (void);-int rtsTimerSignal (void);
− includes/rts/Types.h
@@ -1,31 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * RTS-specific types.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#include <stddef.h>-#include <stdbool.h>--// Deprecated, use uint32_t instead.-typedef unsigned int nat __attribute__((deprecated));  /* uint32_t */--/* ullong (64|128-bit) type: only include if needed (not ANSI) */-#if defined(__GNUC__)-#define LL(x) (x##LL)-#else-#define LL(x) (x##L)-#endif--typedef struct StgClosure_   StgClosure;-typedef struct StgInfoTable_ StgInfoTable;-typedef struct StgTSO_       StgTSO;
− includes/rts/Utils.h
@@ -1,16 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * RTS external APIs.  This file declares everything that the GHC RTS- * exposes externally.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--/* Alternate to raise(3) for threaded rts, for BSD-based OSes */-int genericRaise(int sig);
− includes/rts/prof/CCS.h
@@ -1,226 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2009-2012- *- * Macros for profiling operations in STG code- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--/* ------------------------------------------------------------------------------ * Data Structures- * ---------------------------------------------------------------------------*/-/*- * Note [struct alignment]- * NB. be careful to avoid unwanted padding between fields, by- * putting the 8-byte fields on an 8-byte boundary.  Padding can- * vary between C compilers, and we don't take into account any- * possible padding when generating CCS and CC decls in the code- * generator (compiler/codeGen/StgCmmProf.hs).- */--typedef struct CostCentre_ {-    StgInt ccID;              // Unique Id, allocated by the RTS--    char * label;-    char * module;-    char * srcloc;--    // used for accumulating costs at the end of the run...-    StgWord64 mem_alloc;      // align 8 (Note [struct alignment])-    StgWord   time_ticks;--    StgBool is_caf;           // true <=> CAF cost centre--    struct CostCentre_ *link;-} CostCentre;--typedef struct CostCentreStack_ {-    StgInt ccsID;               // unique ID, allocated by the RTS--    CostCentre *cc;             // Cost centre at the top of the stack--    struct CostCentreStack_ *prevStack;   // parent-    struct IndexTable_      *indexTable;  // children-    struct CostCentreStack_ *root;        // root of stack-    StgWord    depth;           // number of items in the stack--    StgWord64  scc_count;       // Count of times this CCS is entered-                                // align 8 (Note [struct alignment])--    StgWord    selected;        // is this CCS shown in the heap-                                // profile? (zero if excluded via -hc-                                // -hm etc.)--    StgWord    time_ticks;      // number of time ticks accumulated by-                                // this CCS--    StgWord64  mem_alloc;       // mem allocated by this CCS-                                // align 8 (Note [struct alignment])--    StgWord64  inherited_alloc; // sum of mem_alloc over all children-                                // (calculated at the end)-                                // align 8 (Note [struct alignment])--    StgWord    inherited_ticks; // sum of time_ticks over all children-                                // (calculated at the end)-} CostCentreStack;---/* ------------------------------------------------------------------------------ * Start and stop the profiling timer.  These can be called from- * Haskell to restrict the profile to portion(s) of the execution.- * See the module GHC.Profiling.- * ---------------------------------------------------------------------------*/--void stopProfTimer      ( void );-void startProfTimer     ( void );--/* ------------------------------------------------------------------------------ * The rest is PROFILING only...- * ---------------------------------------------------------------------------*/--#if defined(PROFILING)--/* ------------------------------------------------------------------------------ * Constants- * ---------------------------------------------------------------------------*/--#define EMPTY_STACK NULL-#define EMPTY_TABLE NULL--/* Constants used to set is_caf flag on CostCentres */-#define CC_IS_CAF      true-#define CC_NOT_CAF     false-/* ------------------------------------------------------------------------------ * Data Structures- * ---------------------------------------------------------------------------*/--// IndexTable is the list of children of a CCS. (Alternatively it is a-// cache of the results of pushing onto a CCS, so that the second and-// subsequent times we push a certain CC on a CCS we get the same-// result).--typedef struct IndexTable_ {-    // Just a linked list of (cc, ccs) pairs, where the `ccs` is the result of-    // pushing `cc` to the owner of the index table (another CostCentreStack).-    CostCentre *cc;-    CostCentreStack *ccs;-    struct IndexTable_ *next;-    // back_edge is true when `cc` is already in the stack, so pushing it-    // truncates or drops (see RECURSION_DROPS and RECURSION_TRUNCATES in-    // Profiling.c).-    bool back_edge;-} IndexTable;---/* ------------------------------------------------------------------------------   Pre-defined cost centres and cost centre stacks-   -------------------------------------------------------------------------- */--#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_OVERHEAD[];-extern StgWord CCS_OVERHEAD[];   // Profiling overhead--extern StgWord CC_DONT_CARE[];-extern StgWord CCS_DONT_CARE[];  // CCS attached to static constructors--#else--extern CostCentre      CC_MAIN[];-extern CostCentreStack CCS_MAIN[];      // Top CCS--extern CostCentre      CC_SYSTEM[];-extern CostCentreStack CCS_SYSTEM[];    // RTS costs--extern CostCentre      CC_GC[];-extern CostCentreStack CCS_GC[];         // Garbage collector costs--extern CostCentre      CC_OVERHEAD[];-extern CostCentreStack CCS_OVERHEAD[];   // Profiling overhead--extern CostCentre      CC_DONT_CARE[];-extern CostCentreStack CCS_DONT_CARE[];  // shouldn't ever get set--extern CostCentre      CC_PINNED[];-extern CostCentreStack CCS_PINNED[];     // pinned memory--extern CostCentre      CC_IDLE[];-extern CostCentreStack CCS_IDLE[];       // capability is idle--#endif /* IN_STG_CODE */--extern unsigned int RTS_VAR(era);--/* ------------------------------------------------------------------------------ * Functions- * ---------------------------------------------------------------------------*/--CostCentreStack * pushCostCentre (CostCentreStack *, CostCentre *);-void              enterFunCCS    (StgRegTable *reg, CostCentreStack *);-CostCentre *mkCostCentre (char *label, char *module, char *srcloc);--extern CostCentre * RTS_VAR(CC_LIST);               // registered CC list--/* ------------------------------------------------------------------------------ * Declaring Cost Centres & Cost Centre Stacks.- * -------------------------------------------------------------------------- */--# define CC_DECLARE(cc_ident,name,mod,loc,caf,is_local)  \-     is_local CostCentre cc_ident[1]                     \-       = {{ .ccID       = 0,                             \-            .label      = name,                          \-            .module     = mod,                           \-            .srcloc     = loc,                           \-            .time_ticks = 0,                             \-            .mem_alloc  = 0,                             \-            .link       = 0,                             \-            .is_caf     = caf                            \-         }};--# define CCS_DECLARE(ccs_ident,cc_ident,is_local)        \-     is_local CostCentreStack ccs_ident[1]               \-       = {{ .ccsID               = 0,                    \-            .cc                  = cc_ident,             \-            .prevStack           = NULL,                 \-            .indexTable          = NULL,                 \-            .root                = NULL,                 \-            .depth               = 0,                    \-            .selected            = 0,                    \-            .scc_count           = 0,                    \-            .time_ticks          = 0,                    \-            .mem_alloc           = 0,                    \-            .inherited_ticks     = 0,                    \-            .inherited_alloc     = 0                     \-       }};--/* ------------------------------------------------------------------------------ * Time / Allocation Macros- * ---------------------------------------------------------------------------*/--/* eliminate profiling overhead from allocation costs */-#define CCS_ALLOC(ccs, size) (ccs)->mem_alloc += ((size)-sizeofW(StgProfHeader))-#define ENTER_CCS_THUNK(cap,p) cap->r.rCCCS = p->header.prof.ccs--#else /* !PROFILING */--#define CCS_ALLOC(ccs, amount) doNothing()-#define ENTER_CCS_THUNK(cap,p) doNothing()--#endif /* PROFILING */
− includes/rts/prof/LDV.h
@@ -1,44 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The University of Glasgow, 2009- *- * Lag/Drag/Void profiling.- *- * Do not #include this file directly: #include "Rts.h" instead.- *- * To understand the structure of the RTS headers, see the wiki:- *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes- *- * ---------------------------------------------------------------------------*/--#pragma once--#if defined(PROFILING)--/* 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.- */--#if defined(CMINUSMINUS)--#else--#define LDV_RECORD_CREATE(c)   \-  LDVW((c)) = ((StgWord)RTS_DEREF(era) << LDV_SHIFT) | LDV_STATE_CREATE--#endif--#else  /* !PROFILING */--#define LDV_RECORD_CREATE(c)   /* nothing */--#endif /* PROFILING */
− includes/rts/storage/Block.h
@@ -1,341 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-1999- *- * Block structure for the storage manager- *- * ---------------------------------------------------------------------------*/--#pragma once--#include "ghcconfig.h"--/* The actual block and megablock-size constants are defined in- * includes/Constants.h, all constants here are derived from these.- */--/* Block related constants (BLOCK_SHIFT is defined in Constants.h) */--#if SIZEOF_LONG == SIZEOF_VOID_P-#define UNIT 1UL-#elif SIZEOF_LONG_LONG == SIZEOF_VOID_P-#define UNIT 1ULL-#else-#error "Size of pointer is suspicious."-#endif--#if defined(CMINUSMINUS)-#define BLOCK_SIZE   (1<<BLOCK_SHIFT)-#else-#define BLOCK_SIZE   (UNIT<<BLOCK_SHIFT)-// Note [integer overflow]-#endif--#define BLOCK_SIZE_W (BLOCK_SIZE/sizeof(W_))-#define BLOCK_MASK   (BLOCK_SIZE-1)--#define BLOCK_ROUND_UP(p)   (((W_)(p)+BLOCK_SIZE-1) & ~BLOCK_MASK)-#define BLOCK_ROUND_DOWN(p) ((void *) ((W_)(p) & ~BLOCK_MASK))--/* Megablock related constants (MBLOCK_SHIFT is defined in Constants.h) */--#if defined(CMINUSMINUS)-#define MBLOCK_SIZE    (1<<MBLOCK_SHIFT)-#else-#define MBLOCK_SIZE    (UNIT<<MBLOCK_SHIFT)-// Note [integer overflow]-#endif--#define MBLOCK_SIZE_W  (MBLOCK_SIZE/sizeof(W_))-#define MBLOCK_MASK    (MBLOCK_SIZE-1)--#define MBLOCK_ROUND_UP(p)   ((void *)(((W_)(p)+MBLOCK_SIZE-1) & ~MBLOCK_MASK))-#define MBLOCK_ROUND_DOWN(p) ((void *)((W_)(p) & ~MBLOCK_MASK ))--/* The largest size an object can be before we give it a block of its- * own and treat it as an immovable object during GC, expressed as a- * fraction of BLOCK_SIZE.- */-#define LARGE_OBJECT_THRESHOLD ((uint32_t)(BLOCK_SIZE * 8 / 10))--/*- * Note [integer overflow]- *- * The UL suffix in BLOCK_SIZE and MBLOCK_SIZE promotes the expression- * to an unsigned long, which means that expressions involving these- * will be promoted to unsigned long, which makes integer overflow- * less likely.  Historically, integer overflow in expressions like- *    (n * BLOCK_SIZE)- * where n is int or unsigned int, have caused obscure segfaults in- * programs that use large amounts of memory (e.g. #7762, #5086).- */--/* ------------------------------------------------------------------------------ * Block descriptor.  This structure *must* be the right length, so we- * can do pointer arithmetic on pointers to it.- */--/* The block descriptor is 64 bytes on a 64-bit machine, and 32-bytes- * on a 32-bit machine.- */--// Note: fields marked with [READ ONLY] must not be modified by the-// client of the block allocator API.  All other fields can be-// freely modified.--#if !defined(CMINUSMINUS)-typedef struct bdescr_ {--    StgPtr start;              // [READ ONLY] start addr of memory--    StgPtr free;               // First free byte of memory.-                               // allocGroup() sets this to the value of start.-                               // NB. during use this value should lie-                               // between start and start + blocks *-                               // BLOCK_SIZE.  Values outside this-                               // range are reserved for use by the-                               // block allocator.  In particular, the-                               // value (StgPtr)(-1) is used to-                               // indicate that a block is unallocated.--    struct bdescr_ *link;      // used for chaining blocks together--    union {-        struct bdescr_ *back;  // used (occasionally) for doubly-linked lists-        StgWord *bitmap;       // bitmap for marking GC-        StgPtr  scan;          // scan pointer for copying GC-    } u;--    struct generation_ *gen;   // generation--    StgWord16 gen_no;          // gen->no, cached-    StgWord16 dest_no;         // number of destination generation-    StgWord16 node;            // which memory node does this block live on?--    StgWord16 flags;           // block flags, see below--    StgWord32 blocks;          // [READ ONLY] no. of blocks in a group-                               // (if group head, 0 otherwise)--#if SIZEOF_VOID_P == 8-    StgWord32 _padding[3];-#else-    StgWord32 _padding[0];-#endif-} bdescr;-#endif--#if SIZEOF_VOID_P == 8-#define BDESCR_SIZE  0x40-#define BDESCR_MASK  0x3f-#define BDESCR_SHIFT 6-#else-#define BDESCR_SIZE  0x20-#define BDESCR_MASK  0x1f-#define BDESCR_SHIFT 5-#endif--/* Block contains objects evacuated during this GC */-#define BF_EVACUATED 1-/* Block is a large object */-#define BF_LARGE     2-/* Block is pinned */-#define BF_PINNED    4-/* Block is to be marked, not copied */-#define BF_MARKED    8-/* Block is executable */-#define BF_EXEC      32-/* Block contains only a small amount of live data */-#define BF_FRAGMENTED 64-/* we know about this block (for finding leaks) */-#define BF_KNOWN     128-/* Block was swept in the last generation */-#define BF_SWEPT     256-/* Block is part of a Compact */-#define BF_COMPACT   512-/* Maximum flag value (do not define anything higher than this!) */-#define BF_FLAG_MAX  (1 << 15)--/* Finding the block descriptor for a given block -------------------------- */--#if defined(CMINUSMINUS)--#define Bdescr(p) \-    ((((p) &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) \-     | ((p) & ~MBLOCK_MASK))--#else--EXTERN_INLINE bdescr *Bdescr(StgPtr p);-EXTERN_INLINE bdescr *Bdescr(StgPtr p)-{-  return (bdescr *)-    ((((W_)p &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT))-     | ((W_)p & ~MBLOCK_MASK)-     );-}--#endif--/* Useful Macros ------------------------------------------------------------ */--/* Offset of first real data block in a megablock */--#define FIRST_BLOCK_OFF \-   ((W_)BLOCK_ROUND_UP(BDESCR_SIZE * (MBLOCK_SIZE / BLOCK_SIZE)))--/* First data block in a given megablock */--#define FIRST_BLOCK(m) ((void *)(FIRST_BLOCK_OFF + (W_)(m)))--/* Last data block in a given megablock */--#define LAST_BLOCK(m)  ((void *)(MBLOCK_SIZE-BLOCK_SIZE + (W_)(m)))--/* First real block descriptor in a megablock */--#define FIRST_BDESCR(m) \-   ((bdescr *)((FIRST_BLOCK_OFF>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m)))--/* Last real block descriptor in a megablock */--#define LAST_BDESCR(m) \-  ((bdescr *)(((MBLOCK_SIZE-BLOCK_SIZE)>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m)))--/* Number of usable blocks in a megablock */--#if !defined(CMINUSMINUS) // already defined in DerivedConstants.h-#define BLOCKS_PER_MBLOCK ((MBLOCK_SIZE - FIRST_BLOCK_OFF) / BLOCK_SIZE)-#endif--/* How many blocks in this megablock group */--#define MBLOCK_GROUP_BLOCKS(n) \-   (BLOCKS_PER_MBLOCK + (n-1) * (MBLOCK_SIZE / BLOCK_SIZE))--/* Compute the required size of a megablock group */--#define BLOCKS_TO_MBLOCKS(n) \-   (1 + (W_)MBLOCK_ROUND_UP((n-BLOCKS_PER_MBLOCK) * BLOCK_SIZE) / MBLOCK_SIZE)---#if !defined(CMINUSMINUS)-/* to the end... */--/* Double-linked block lists: --------------------------------------------- */--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;-}--INLINE_HEADER void-dbl_link_remove(bdescr *bd, bdescr **list)-{-    if (bd->u.back) {-        bd->u.back->link = bd->link;-    } else {-        *list = bd->link;-    }-    if (bd->link) {-        bd->link->u.back = bd->u.back;-    }-}--INLINE_HEADER void-dbl_link_insert_after(bdescr *bd, bdescr *after)-{-    bd->link = after->link;-    bd->u.back = after;-    if (after->link) {-        after->link->u.back = bd;-    }-    after->link = bd;-}--INLINE_HEADER void-dbl_link_replace(bdescr *new_, bdescr *old, bdescr **list)-{-    new_->link = old->link;-    new_->u.back = old->u.back;-    if (old->link) {-        old->link->u.back = new_;-    }-    if (old->u.back) {-        old->u.back->link = new_;-    } else {-        *list = new_;-    }-}--/* Initialisation ---------------------------------------------------------- */--extern void initBlockAllocator(void);--/* Allocation -------------------------------------------------------------- */--bdescr *allocGroup(W_ n);--EXTERN_INLINE bdescr* allocBlock(void);-EXTERN_INLINE bdescr* allocBlock(void)-{-    return allocGroup(1);-}--bdescr *allocGroupOnNode(uint32_t node, W_ n);--EXTERN_INLINE bdescr* allocBlockOnNode(uint32_t node);-EXTERN_INLINE bdescr* allocBlockOnNode(uint32_t node)-{-    return allocGroupOnNode(node,1);-}--// versions that take the storage manager lock for you:-bdescr *allocGroup_lock(W_ n);-bdescr *allocBlock_lock(void);--bdescr *allocGroupOnNode_lock(uint32_t node, W_ n);-bdescr *allocBlockOnNode_lock(uint32_t node);--/* De-Allocation ----------------------------------------------------------- */--void freeGroup(bdescr *p);-void freeChain(bdescr *p);--// versions that take the storage manager lock for you:-void freeGroup_lock(bdescr *p);-void freeChain_lock(bdescr *p);--bdescr * splitBlockGroup (bdescr *bd, uint32_t blocks);--/* Round a value to megablocks --------------------------------------------- */--// We want to allocate an object around a given size, round it up or-// down to the nearest size that will fit in an mblock group.-INLINE_HEADER StgWord-round_to_mblocks(StgWord words)-{-    if (words > BLOCKS_PER_MBLOCK * BLOCK_SIZE_W) {-        // first, ignore the gap at the beginning of the first mblock by-        // adding it to the total words.  Then we can pretend we're-        // dealing in a uniform unit of megablocks.-        words += FIRST_BLOCK_OFF/sizeof(W_);--        if ((words % MBLOCK_SIZE_W) < (MBLOCK_SIZE_W / 2)) {-            words = (words / MBLOCK_SIZE_W) * MBLOCK_SIZE_W;-        } else {-            words = ((words / MBLOCK_SIZE_W) + 1) * MBLOCK_SIZE_W;-        }--        words -= FIRST_BLOCK_OFF/sizeof(W_);-    }-    return words;-}--#endif /* !CMINUSMINUS */
− includes/rts/storage/ClosureMacros.h
@@ -1,587 +0,0 @@-/* ----------------------------------------------------------------------------- *- * (c) The GHC Team, 1998-2012- *- * Macros for building and manipulating closures- *- * -------------------------------------------------------------------------- */--#pragma once--/* ------------------------------------------------------------------------------   Info tables are slammed up against the entry code, and the label-   for the info table is at the *end* of the table itself.  This-   inline function adjusts an info pointer to point to the beginning-   of the table, so we can use standard C structure indexing on it.--   Note: this works for SRT info tables as long as you don't want to-   access the SRT, since they are laid out the same with the SRT-   pointer as the first word in the table.--   NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:--   A couple of definitions:--       "info pointer"    The first word of the closure.  Might point-                         to either the end or the beginning of the-                         info table, depending on whether we're using-                         the mini interpreter or not.  GET_INFO(c)-                         retrieves the info pointer of a closure.--       "info table"      The info table structure associated with a-                         closure.  This is always a pointer to the-                         beginning of the structure, so we can-                         use standard C structure indexing to pull out-                         the fields.  get_itbl(c) returns a pointer to-                         the info table for closure c.--   An address of the form xxxx_info points to the end of the info-   table or the beginning of the info table depending on whether we're-   mangling or not respectively.  So,--         c->header.info = xxx_info--   makes absolute sense, whether mangling or not.--   -------------------------------------------------------------------------- */--INLINE_HEADER void SET_INFO(StgClosure *c, const StgInfoTable *info) {-    c->header.info = info;-}-INLINE_HEADER const StgInfoTable *GET_INFO(StgClosure *c) {-    return c->header.info;-}--#define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))--#if defined(TABLES_NEXT_TO_CODE)-EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);-EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;}-EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info);-EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;}-INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;}-INLINE_HEADER StgThunkInfoTable *THUNK_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgThunkInfoTable *)info - 1;}-INLINE_HEADER StgConInfoTable *CON_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgConInfoTable *)info - 1;}-INLINE_HEADER StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (StgFunInfoTable *)(i + 1) - 1;}-INLINE_HEADER StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;}-INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;}-INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;}-#else-EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);-EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;}-EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info);-EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;}-INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info;}-INLINE_HEADER StgThunkInfoTable *THUNK_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgThunkInfoTable *)info;}-INLINE_HEADER StgConInfoTable *CON_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgConInfoTable *)info;}-INLINE_HEADER StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (StgFunInfoTable *)i;}-INLINE_HEADER StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)i;}-INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)i;}-INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)i;}-#endif--EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c);-EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c)-{-   return INFO_PTR_TO_STRUCT(c->header.info);-}--EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c);-EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c)-{-   return RET_INFO_PTR_TO_STRUCT(c->header.info);-}--INLINE_HEADER const StgFunInfoTable *get_fun_itbl(const StgClosure *c)-{-   return FUN_INFO_PTR_TO_STRUCT(c->header.info);-}--INLINE_HEADER const StgThunkInfoTable *get_thunk_itbl(const StgClosure *c)-{-   return THUNK_INFO_PTR_TO_STRUCT(c->header.info);-}--INLINE_HEADER const StgConInfoTable *get_con_itbl(const StgClosure *c)-{-   return CON_INFO_PTR_TO_STRUCT((c)->header.info);-}--INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con)-{-    return get_itbl(con)->srt;-}--/* ------------------------------------------------------------------------------   Macros for building closures-   -------------------------------------------------------------------------- */--#if defined(PROFILING)-#if defined(DEBUG_RETAINER)-/*-  For the sake of debugging, we take the safest way for the moment. Actually, this-  is useful to check the sanity of heap before beginning retainer profiling.-  flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.-  Note: change those functions building Haskell objects from C datatypes, i.e.,-  all rts_mk???() functions in RtsAPI.c, as well.- */-#define SET_PROF_HDR(c,ccs_)            \-        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))-#else-/*-  For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to-  NULL | flip (flip is defined in RetainerProfile.c) because even when flip-  is 1, rs is invalid and will be initialized to NULL | flip later when-  the closure *c is visited.- */-/*-#define SET_PROF_HDR(c,ccs_)            \-        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)- */-/*-  The following macro works for both retainer profiling and LDV profiling:-  for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.-  See the invariants on ldvTime.- */-#define SET_PROF_HDR(c,ccs_)            \-        ((c)->header.prof.ccs = ccs_,   \-        LDV_RECORD_CREATE((c)))-#endif /* DEBUG_RETAINER */-#else-#define SET_PROF_HDR(c,ccs)-#endif--#define SET_HDR(c,_info,ccs)                            \-   {                                                    \-        (c)->header.info = _info;                       \-        SET_PROF_HDR((StgClosure *)(c),ccs);            \-   }--#define SET_ARR_HDR(c,info,costCentreStack,n_bytes)     \-   SET_HDR(c,info,costCentreStack);                     \-   (c)->bytes = n_bytes;--// Use when changing a closure from one kind to another-#define OVERWRITE_INFO(c, new_info)                             \-    OVERWRITING_CLOSURE((StgClosure *)(c));                     \-    SET_INFO((StgClosure *)(c), (new_info));                    \-    LDV_RECORD_CREATE(c);--/* ------------------------------------------------------------------------------   How to get hold of the static link field for a static closure.-   -------------------------------------------------------------------------- */--/* These are hard-coded. */-#define THUNK_STATIC_LINK(p) (&(p)->payload[1])-#define IND_STATIC_LINK(p)   (&(p)->payload[1])--INLINE_HEADER StgClosure **-STATIC_LINK(const StgInfoTable *info, StgClosure *p)-{-    switch (info->type) {-    case THUNK_STATIC:-        return THUNK_STATIC_LINK(p);-    case IND_STATIC:-        return IND_STATIC_LINK(p);-    default:-        return &(p)->payload[info->layout.payload.ptrs +-                             info->layout.payload.nptrs];-    }-}--/* ------------------------------------------------------------------------------   INTLIKE and CHARLIKE closures.-   -------------------------------------------------------------------------- */--INLINE_HEADER P_ CHARLIKE_CLOSURE(int n) {-    return (P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE];-}-INLINE_HEADER P_ INTLIKE_CLOSURE(int n) {-    return (P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE];-}--/* -----------------------------------------------------------------------------   Macros for untagging and retagging closure pointers-   For more information look at the comments in Cmm.h-   ------------------------------------------------------------------------- */--static inline StgWord-GET_CLOSURE_TAG(const StgClosure * p)-{-    return (StgWord)p & TAG_MASK;-}--static inline StgClosure *-UNTAG_CLOSURE(StgClosure * p)-{-    return (StgClosure*)((StgWord)p & ~TAG_MASK);-}--static inline const StgClosure *-UNTAG_CONST_CLOSURE(const StgClosure * p)-{-    return (const StgClosure*)((StgWord)p & ~TAG_MASK);-}--static inline StgClosure *-TAG_CLOSURE(StgWord tag,StgClosure * p)-{-    return (StgClosure*)((StgWord)p | tag);-}--/* ------------------------------------------------------------------------------   Forwarding pointers-   -------------------------------------------------------------------------- */--#define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)-#define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)-#define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)--/* ------------------------------------------------------------------------------   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...-   -------------------------------------------------------------------------- */--INLINE_HEADER bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)-{-    StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)p);-    return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;-}--INLINE_HEADER bool LOOKS_LIKE_INFO_PTR (StgWord p)-{-    return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));-}--INLINE_HEADER bool LOOKS_LIKE_CLOSURE_PTR (const void *p)-{-    return LOOKS_LIKE_INFO_PTR((StgWord)-            (UNTAG_CONST_CLOSURE((const StgClosure *)(p)))->header.info);-}--/* ------------------------------------------------------------------------------   Macros for calculating the size of a closure-   -------------------------------------------------------------------------- */--EXTERN_INLINE StgOffset PAP_sizeW   ( uint32_t n_args );-EXTERN_INLINE StgOffset PAP_sizeW   ( uint32_t n_args )-{ return sizeofW(StgPAP) + n_args; }--EXTERN_INLINE StgOffset AP_sizeW   ( uint32_t n_args );-EXTERN_INLINE StgOffset AP_sizeW   ( uint32_t n_args )-{ return sizeofW(StgAP) + n_args; }--EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size );-EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size )-{ return sizeofW(StgAP_STACK) + size; }--EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np );-EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np )-{ return sizeofW(StgHeader) + p + np; }--EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void );-EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void )-{ return sizeofW(StgSelector); }--EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void );-EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void )-{ return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection--/* ---------------------------------------------------------------------------   Sizes of closures-   ------------------------------------------------------------------------*/--EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl );-EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl )-{ return sizeofW(StgClosure)-       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs-       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }--EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl );-EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )-{ return sizeofW(StgThunk)-       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs-       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }--EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x );-EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x )-{ return AP_STACK_sizeW(x->size); }--EXTERN_INLINE StgOffset ap_sizeW( StgAP* x );-EXTERN_INLINE StgOffset ap_sizeW( StgAP* x )-{ return AP_sizeW(x->n_args); }--EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x );-EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x )-{ return PAP_sizeW(x->n_args); }--EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x);-EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x)-{ return ROUNDUP_BYTES_TO_WDS(x->bytes); }--EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x );-EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x )-{ return sizeofW(StgArrBytes) + arr_words_words(x); }--EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );-EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )-{ return sizeofW(StgMutArrPtrs) + x->size; }--EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x );-EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x )-{ return sizeofW(StgSmallMutArrPtrs) + x->ptrs; }--EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );-EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )-{ return sizeofW(StgStack) + stack->stack_size; }--EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );-EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )-{ return bco->size; }--EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str );-EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str )-{ return str->totalW; }--/*- * TODO: Consider to switch return type from 'uint32_t' to 'StgWord' #8742- *- * (Also for 'closure_sizeW' below)- */-EXTERN_INLINE uint32_t-closure_sizeW_ (const StgClosure *p, const StgInfoTable *info);-EXTERN_INLINE uint32_t-closure_sizeW_ (const StgClosure *p, const StgInfoTable *info)-{-    switch (info->type) {-    case THUNK_0_1:-    case THUNK_1_0:-        return sizeofW(StgThunk) + 1;-    case FUN_0_1:-    case CONSTR_0_1:-    case FUN_1_0:-    case CONSTR_1_0:-        return sizeofW(StgHeader) + 1;-    case THUNK_0_2:-    case THUNK_1_1:-    case THUNK_2_0:-        return sizeofW(StgThunk) + 2;-    case FUN_0_2:-    case CONSTR_0_2:-    case FUN_1_1:-    case CONSTR_1_1:-    case FUN_2_0:-    case CONSTR_2_0:-        return sizeofW(StgHeader) + 2;-    case THUNK:-        return thunk_sizeW_fromITBL(info);-    case THUNK_SELECTOR:-        return THUNK_SELECTOR_sizeW();-    case AP_STACK:-        return ap_stack_sizeW((StgAP_STACK *)p);-    case AP:-        return ap_sizeW((StgAP *)p);-    case PAP:-        return pap_sizeW((StgPAP *)p);-    case IND:-        return sizeofW(StgInd);-    case ARR_WORDS:-        return arr_words_sizeW((StgArrBytes *)p);-    case MUT_ARR_PTRS_CLEAN:-    case MUT_ARR_PTRS_DIRTY:-    case MUT_ARR_PTRS_FROZEN_CLEAN:-    case MUT_ARR_PTRS_FROZEN_DIRTY:-        return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);-    case SMALL_MUT_ARR_PTRS_CLEAN:-    case SMALL_MUT_ARR_PTRS_DIRTY:-    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:-    case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:-        return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);-    case TSO:-        return sizeofW(StgTSO);-    case STACK:-        return stack_sizeW((StgStack*)p);-    case BCO:-        return bco_sizeW((StgBCO *)p);-    case TREC_CHUNK:-        return sizeofW(StgTRecChunk);-    default:-        return sizeW_fromITBL(info);-    }-}--// The definitive way to find the size, in words, of a heap-allocated closure-EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p);-EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p)-{-    return closure_sizeW_(p, get_itbl(p));-}--/* ------------------------------------------------------------------------------   Sizes of stack frames-   -------------------------------------------------------------------------- */--EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );-EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )-{-    const StgRetInfoTable *info;--    info = get_ret_itbl(frame);-    switch (info->i.type) {--    case RET_FUN:-        return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;--    case RET_BIG:-        return 1 + GET_LARGE_BITMAP(&info->i)->size;--    case RET_BCO:-        return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);--    default:-        return 1 + BITMAP_SIZE(info->i.layout.bitmap);-    }-}--/* ------------------------------------------------------------------------------   StgMutArrPtrs macros--   An StgMutArrPtrs has a card table to indicate which elements are-   dirty for the generational GC.  The card table is an array of-   bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)-   elements.  The card table is directly after the array data itself.-   -------------------------------------------------------------------------- */--// The number of card bytes needed-INLINE_HEADER W_ mutArrPtrsCards (W_ elems)-{-    return (W_)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)-                           >> MUT_ARR_PTRS_CARD_BITS);-}--// The number of words in the card table-INLINE_HEADER W_ mutArrPtrsCardTableSize (W_ elems)-{-    return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));-}--// The address of the card for a particular card number-INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)-{-    return ((StgWord8 *)&(a->payload[a->ptrs]) + n);-}--/* ------------------------------------------------------------------------------   Replacing a closure with a different one.  We must call-   OVERWRITING_CLOSURE(p) on the old closure that is about to be-   overwritten.--   Note [zeroing slop]--   In some scenarios we write zero words into "slop"; memory that is-   left unoccupied after we overwrite a closure in the heap with a-   smaller closure.--   Zeroing slop is required for:--    - full-heap sanity checks (DEBUG, and +RTS -DS)-    - LDV profiling (PROFILING, and +RTS -hb)--   Zeroing slop must be disabled for:--    - THREADED_RTS with +RTS -N2 and greater, because we cannot-      overwrite slop when another thread might be reading it.--   Hence, slop is zeroed when either:--    - PROFILING && era <= 0 (LDV is on)-    - !THREADED_RTS && DEBUG--   And additionally:--    - LDV profiling and +RTS -N2 are incompatible-    - full-heap sanity checks are disabled for THREADED_RTS--   -------------------------------------------------------------------------- */--#if defined(PROFILING)-#define ZERO_SLOP_FOR_LDV_PROF 1-#else-#define ZERO_SLOP_FOR_LDV_PROF 0-#endif--#if defined(DEBUG) && !defined(THREADED_RTS)-#define ZERO_SLOP_FOR_SANITY_CHECK 1-#else-#define ZERO_SLOP_FOR_SANITY_CHECK 0-#endif--#if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK-#define OVERWRITING_CLOSURE(c) overwritingClosure(c)-#define OVERWRITING_CLOSURE_OFS(c,n) overwritingClosureOfs(c,n)-#else-#define OVERWRITING_CLOSURE(c) /* nothing */-#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */-#endif--#if defined(PROFILING)-void LDV_recordDead (const StgClosure *c, uint32_t size);-#endif--EXTERN_INLINE void overwritingClosure_ (StgClosure *p,-                                        uint32_t offset /* in words */,-                                        uint32_t size /* closure size, in words */);-EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t size)-{-#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK-    // see Note [zeroing slop], also #8402-    if (era <= 0) return;-#endif--    // For LDV profiling, we need to record the closure as dead-#if defined(PROFILING)-    LDV_recordDead(p, size);-#endif--    for (uint32_t i = offset; i < size; i++) {-        ((StgWord *)p)[i] = 0;-    }-}--EXTERN_INLINE void overwritingClosure (StgClosure *p);-EXTERN_INLINE void overwritingClosure (StgClosure *p)-{-    overwritingClosure_(p, sizeofW(StgThunkHeader), closure_sizeW(p));-}--// Version of 'overwritingClosure' which overwrites only a suffix of a-// closure.  The offset is expressed in words relative to 'p' and shall-// be less than or equal to closure_sizeW(p), and usually at least as-// large as the respective thunk header.-//-// Note: As this calls LDV_recordDead() you have to call LDV_RECORD()-//       on the final state of the closure at the call-site-EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset);-EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset)-{-    overwritingClosure_(p, offset, closure_sizeW(p));-}--// Version of 'overwritingClosure' which takes closure size as argument.-EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */);-EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size)-{-    overwritingClosure_(p, sizeofW(StgThunkHeader), size);-}
− includes/rts/storage/ClosureTypes.h
@@ -1,86 +0,0 @@-/* ----------------------------------------------------------------------------- *- * (c) The GHC Team, 1998-2005- *- * Closure Type Constants: out here because the native code generator- * needs to get at them.- *- * -------------------------------------------------------------------------- */--#pragma once--/*- * WARNING WARNING WARNING- *- * If you add or delete any closure types, don't forget to update the following,- *   - the closure flags table in rts/ClosureFlags.c- *   - isRetainer in rts/RetainerProfile.c- *   - the closure_type_names list in rts/Printer.c- */--/* Object tag 0 raises an internal error */-#define INVALID_OBJECT                0-#define CONSTR                        1-#define CONSTR_1_0                    2-#define CONSTR_0_1                    3-#define CONSTR_2_0                    4-#define CONSTR_1_1                    5-#define CONSTR_0_2                    6-#define CONSTR_NOCAF                  7-#define FUN                           8-#define FUN_1_0                       9-#define FUN_0_1                       10-#define FUN_2_0                       11-#define FUN_1_1                       12-#define FUN_0_2                       13-#define FUN_STATIC                    14-#define THUNK                         15-#define THUNK_1_0                     16-#define THUNK_0_1                     17-#define THUNK_2_0                     18-#define THUNK_1_1                     19-#define THUNK_0_2                     20-#define THUNK_STATIC                  21-#define THUNK_SELECTOR                22-#define BCO                           23-#define AP                            24-#define PAP                           25-#define AP_STACK                      26-#define IND                           27-#define IND_STATIC                    28-#define RET_BCO                       29-#define RET_SMALL                     30-#define RET_BIG                       31-#define RET_FUN                       32-#define UPDATE_FRAME                  33-#define CATCH_FRAME                   34-#define UNDERFLOW_FRAME               35-#define STOP_FRAME                    36-#define BLOCKING_QUEUE                37-#define BLACKHOLE                     38-#define MVAR_CLEAN                    39-#define MVAR_DIRTY                    40-#define TVAR                          41-#define ARR_WORDS                     42-#define MUT_ARR_PTRS_CLEAN            43-#define MUT_ARR_PTRS_DIRTY            44-#define MUT_ARR_PTRS_FROZEN_DIRTY     45-#define MUT_ARR_PTRS_FROZEN_CLEAN     46-#define MUT_VAR_CLEAN                 47-#define MUT_VAR_DIRTY                 48-#define WEAK                          49-#define PRIM                          50-#define MUT_PRIM                      51-#define TSO                           52-#define STACK                         53-#define TREC_CHUNK                    54-#define ATOMICALLY_FRAME              55-#define CATCH_RETRY_FRAME             56-#define CATCH_STM_FRAME               57-#define WHITEHOLE                     58-#define SMALL_MUT_ARR_PTRS_CLEAN      59-#define SMALL_MUT_ARR_PTRS_DIRTY      60-#define SMALL_MUT_ARR_PTRS_FROZEN_DIRTY 61-#define SMALL_MUT_ARR_PTRS_FROZEN_CLEAN 62-#define COMPACT_NFDATA                63-#define N_CLOSURE_TYPES               64
− includes/rts/storage/Closures.h
@@ -1,470 +0,0 @@-/* ----------------------------------------------------------------------------- *- * (c) The GHC Team, 1998-2004- *- * Closures- *- * -------------------------------------------------------------------------- */--#pragma once--/*- * The Layout of a closure header depends on which kind of system we're- * compiling for: profiling, parallel, ticky, etc.- */--/* ------------------------------------------------------------------------------   The profiling header-   -------------------------------------------------------------------------- */--typedef struct {-  CostCentreStack *ccs;-  union {-    struct _RetainerSet *rs;  /* Retainer Set */-    StgWord ldvw;             /* Lag/Drag/Void Word */-  } hp;-} StgProfHeader;--/* ------------------------------------------------------------------------------   The SMP header--   A thunk has a padding word to take the updated value.  This is so-   that the update doesn't overwrite the payload, so we can avoid-   needing to lock the thunk during entry and update.--   Note: this doesn't apply to THUNK_STATICs, which have no payload.--   Note: we leave this padding word in all ways, rather than just SMP,-   so that we don't have to recompile all our libraries for SMP.-   -------------------------------------------------------------------------- */--typedef struct {-    StgWord pad;-} StgSMPThunkHeader;--/* ------------------------------------------------------------------------------   The full fixed-size closure header--   The size of the fixed header is the sum of the optional parts plus a single-   word for the entry code pointer.-   -------------------------------------------------------------------------- */--typedef struct {-    const StgInfoTable* info;-#if defined(PROFILING)-    StgProfHeader         prof;-#endif-} StgHeader;--typedef struct {-    const StgInfoTable* info;-#if defined(PROFILING)-    StgProfHeader         prof;-#endif-    StgSMPThunkHeader     smp;-} StgThunkHeader;--#define THUNK_EXTRA_HEADER_W (sizeofW(StgThunkHeader)-sizeofW(StgHeader))--/* ------------------------------------------------------------------------------   Closure Types--   For any given closure type (defined in InfoTables.h), there is a-   corresponding structure defined below.  The name of the structure-   is obtained by concatenating the closure type with '_closure'-   -------------------------------------------------------------------------- */--/* All closures follow the generic format */--typedef struct StgClosure_ {-    StgHeader   header;-    struct StgClosure_ *payload[];-} *StgClosurePtr; // StgClosure defined in rts/Types.h--typedef struct {-    StgThunkHeader  header;-    struct StgClosure_ *payload[];-} StgThunk;--typedef struct {-    StgThunkHeader   header;-    StgClosure *selectee;-} StgSelector;--typedef struct {-    StgHeader   header;-    StgHalfWord arity;          /* zero if it is an AP */-    StgHalfWord n_args;-    StgClosure *fun;            /* really points to a fun */-    StgClosure *payload[];-} StgPAP;--typedef struct {-    StgThunkHeader   header;-    StgHalfWord arity;          /* zero if it is an AP */-    StgHalfWord n_args;-    StgClosure *fun;            /* really points to a fun */-    StgClosure *payload[];-} StgAP;--typedef struct {-    StgThunkHeader   header;-    StgWord     size;                    /* number of words in payload */-    StgClosure *fun;-    StgClosure *payload[]; /* contains a chunk of *stack* */-} StgAP_STACK;--typedef struct {-    StgHeader   header;-    StgClosure *indirectee;-} StgInd;--typedef struct {-    StgHeader     header;-    StgClosure   *indirectee;-    StgClosure   *static_link; // See Note [CAF lists]-    const StgInfoTable *saved_info;-        // `saved_info` also used for the link field for `debug_caf_list`,-        // see `newCAF` and Note [CAF lists] in rts/sm/Storage.h.-} StgIndStatic;--typedef struct StgBlockingQueue_ {-    StgHeader   header;-    struct StgBlockingQueue_ *link;-        // here so it looks like an IND, to be able to skip the queue without-        // deleting it (done in wakeBlockingQueue())-    StgClosure *bh;  // the BLACKHOLE-    StgTSO     *owner;-    struct MessageBlackHole_ *queue;-        // holds TSOs blocked on `bh`-} StgBlockingQueue;--typedef struct {-    StgHeader  header;-    StgWord    bytes;-    StgWord    payload[];-} StgArrBytes;--typedef struct {-    StgHeader   header;-    StgWord     ptrs;-    StgWord     size; // ptrs plus card table-    StgClosure *payload[];-    // see also: StgMutArrPtrs macros in ClosureMacros.h-} StgMutArrPtrs;--typedef struct {-    StgHeader   header;-    StgWord     ptrs;-    StgClosure *payload[];-} StgSmallMutArrPtrs;--typedef struct {-    StgHeader   header;-    StgClosure *var;-} StgMutVar;--typedef struct _StgUpdateFrame {-    StgHeader  header;-    StgClosure *updatee;-} StgUpdateFrame;--typedef struct {-    StgHeader  header;-    StgWord    exceptions_blocked;-    StgClosure *handler;-} StgCatchFrame;--typedef struct {-    const StgInfoTable* info;-    struct StgStack_ *next_chunk;-} StgUnderflowFrame;--typedef struct {-    StgHeader  header;-} StgStopFrame;--typedef struct {-  StgHeader header;-  StgWord data;-} StgIntCharlikeClosure;--/* statically allocated */-typedef struct {-  StgHeader  header;-} StgRetry;--typedef struct _StgStableName {-  StgHeader      header;-  StgWord        sn;-} StgStableName;--typedef struct _StgWeak {       /* Weak v */-  StgHeader header;-  StgClosure *cfinalizers;-  StgClosure *key;-  StgClosure *value;            /* v */-  StgClosure *finalizer;-  struct _StgWeak *link;-} StgWeak;--typedef struct _StgCFinalizerList {-  StgHeader header;-  StgClosure *link;-  void (*fptr)(void);-  void *ptr;-  void *eptr;-  StgWord flag; /* has environment (0 or 1) */-} StgCFinalizerList;--/* Byte code objects.  These are fixed size objects with pointers to- * four arrays, designed so that a BCO can be easily "re-linked" to- * other BCOs, to facilitate GHC's intelligent recompilation.  The- * array of instructions is static and not re-generated when the BCO- * is re-linked, but the other 3 arrays will be regenerated.- *- * A BCO represents either a function or a stack frame.  In each case,- * it needs a bitmap to describe to the garbage collector the- * pointerhood of its arguments/free variables respectively, and in- * the case of a function it also needs an arity.  These are stored- * directly in the BCO, rather than in the instrs array, for two- * reasons:- * (a) speed: we need to get at the bitmap info quickly when- *     the GC is examining APs and PAPs that point to this BCO- * (b) a subtle interaction with the compacting GC.  In compacting- *     GC, the info that describes the size/layout of a closure- *     cannot be in an object more than one level of indirection- *     away from the current object, because of the order in- *     which pointers are updated to point to their new locations.- */--typedef struct {-    StgHeader      header;-    StgArrBytes   *instrs;      /* a pointer to an ArrWords */-    StgArrBytes   *literals;    /* a pointer to an ArrWords */-    StgMutArrPtrs *ptrs;        /* a pointer to a  MutArrPtrs */-    StgHalfWord   arity;        /* arity of this BCO */-    StgHalfWord   size;         /* size of this BCO (in words) */-    StgWord       bitmap[];  /* an StgLargeBitmap */-} StgBCO;--#define BCO_BITMAP(bco)      ((StgLargeBitmap *)((StgBCO *)(bco))->bitmap)-#define BCO_BITMAP_SIZE(bco) (BCO_BITMAP(bco)->size)-#define BCO_BITMAP_BITS(bco) (BCO_BITMAP(bco)->bitmap)-#define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \-                                / BITS_IN(StgWord))--/* A function return stack frame: used when saving the state for a- * garbage collection at a function entry point.  The function- * arguments are on the stack, and we also save the function (its- * info table describes the pointerhood of the arguments).- *- * The stack frame size is also cached in the frame for convenience.- *- * The only RET_FUN is stg_gc_fun, which is created by __stg_gc_fun,- * both in HeapStackCheck.cmm.- */-typedef struct {-    const StgInfoTable* info;-    StgWord        size;-    StgClosure *   fun;-    StgClosure *   payload[];-} StgRetFun;--/* Concurrent communication objects */--typedef struct StgMVarTSOQueue_ {-    StgHeader                header;-    struct StgMVarTSOQueue_ *link;-    struct StgTSO_          *tso;-} StgMVarTSOQueue;--typedef struct {-    StgHeader                header;-    struct StgMVarTSOQueue_ *head;-    struct StgMVarTSOQueue_ *tail;-    StgClosure*              value;-} StgMVar;---/* STM data structures- *- *  StgTVar defines the only type that can be updated through the STM- *  interface.- *- *  Note that various optimisations may be possible in order to use less- *  space for these data structures at the cost of more complexity in the- *  implementation:- *- *   - In StgTVar, current_value and first_watch_queue_entry could be held in- *     the same field: if any thread is waiting then its expected_value for- *     the tvar is the current value.- *- *   - In StgTRecHeader, it might be worthwhile having separate chunks- *     of read-only and read-write locations.  This would save a- *     new_value field in the read-only locations.- *- *   - In StgAtomicallyFrame, we could combine the waiting bit into- *     the header (maybe a different info tbl for a waiting transaction).- *     This means we can specialise the code for the atomically frame- *     (it immediately switches on frame->waiting anyway).- */--typedef struct StgTRecHeader_ StgTRecHeader;--typedef struct StgTVarWatchQueue_ {-  StgHeader                  header;-  StgClosure                *closure; // StgTSO-  struct StgTVarWatchQueue_ *next_queue_entry;-  struct StgTVarWatchQueue_ *prev_queue_entry;-} StgTVarWatchQueue;--typedef struct {-  StgHeader                  header;-  StgClosure                *volatile current_value;-  StgTVarWatchQueue         *volatile first_watch_queue_entry;-  StgInt                     volatile num_updates;-} StgTVar;--/* new_value == expected_value for read-only accesses */-/* new_value is a StgTVarWatchQueue entry when trec in state TREC_WAITING */-typedef struct {-  StgTVar                   *tvar;-  StgClosure                *expected_value;-  StgClosure                *new_value;-#if defined(THREADED_RTS)-  StgInt                     num_updates;-#endif-} TRecEntry;--#define TREC_CHUNK_NUM_ENTRIES 16--typedef struct StgTRecChunk_ {-  StgHeader                  header;-  struct StgTRecChunk_      *prev_chunk;-  StgWord                    next_entry_idx;-  TRecEntry                  entries[TREC_CHUNK_NUM_ENTRIES];-} StgTRecChunk;--typedef enum {-  TREC_ACTIVE,        /* Transaction in progress, outcome undecided */-  TREC_CONDEMNED,     /* Transaction in progress, inconsistent / out of date reads */-  TREC_COMMITTED,     /* Transaction has committed, now updating tvars */-  TREC_ABORTED,       /* Transaction has aborted, now reverting tvars */-  TREC_WAITING,       /* Transaction currently waiting */-} TRecState;--struct StgTRecHeader_ {-  StgHeader                  header;-  struct StgTRecHeader_     *enclosing_trec;-  StgTRecChunk              *current_chunk;-  TRecState                  state;-};--typedef struct {-  StgHeader   header;-  StgClosure *code;-  StgClosure *result;-} StgAtomicallyFrame;--typedef struct {-  StgHeader   header;-  StgClosure *code;-  StgClosure *handler;-} StgCatchSTMFrame;--typedef struct {-  StgHeader      header;-  StgWord        running_alt_code;-  StgClosure    *first_code;-  StgClosure    *alt_code;-} StgCatchRetryFrame;--/* -----------------------------------------------------------------------------   Messages-   ------------------------------------------------------------------------- */--typedef struct Message_ {-    StgHeader        header;-    struct Message_ *link;-} Message;--typedef struct MessageWakeup_ {-    StgHeader header;-    Message  *link;-    StgTSO   *tso;-} MessageWakeup;--typedef struct MessageThrowTo_ {-    StgHeader   header;-    struct MessageThrowTo_ *link;-    StgTSO     *source;-    StgTSO     *target;-    StgClosure *exception;-} MessageThrowTo;--typedef struct MessageBlackHole_ {-    StgHeader   header;-    struct MessageBlackHole_ *link;-        // here so it looks like an IND, to be able to skip the message without-        // deleting it (done in throwToMsg())-    StgTSO     *tso;-    StgClosure *bh;-} MessageBlackHole;--/* -----------------------------------------------------------------------------   Compact Regions-   ------------------------------------------------------------------------- */--//-// A compact region is a list of blocks.  Each block starts with an-// StgCompactNFDataBlock structure, and the list is chained through the next-// field of these structs.  (the link field of the bdescr is used to chain-// together multiple compact region on the compact_objects field of a-// generation).-//-// See Note [Compact Normal Forms] for details-//-typedef struct StgCompactNFDataBlock_ {-    struct StgCompactNFDataBlock_ *self;-       // the address of this block this is copied over to the-       // receiving end when serializing a compact, so the receiving-       // end can allocate the block at best as it can, and then-       // verify if pointer adjustment is needed or not by comparing-       // self with the actual address; the same data is sent over as-       // SerializedCompact metadata, but having it here simplifies-       // the fixup implementation.-    struct StgCompactNFData_ *owner;-       // the closure who owns this block (used in objectGetCompact)-    struct StgCompactNFDataBlock_ *next;-       // chain of blocks used for serialization and freeing-} StgCompactNFDataBlock;--//-// This is the Compact# primitive object.-//-typedef struct StgCompactNFData_ {-    StgHeader header;-      // for sanity and other checks in practice, nothing should ever-      // need the compact info pointer (we don't even need fwding-      // pointers because it's a large object)-    StgWord totalW;-      // Total number of words in all blocks in the compact-    StgWord autoBlockW;-      // size of automatically appended blocks-    StgPtr hp, hpLim;-      // the beginning and end of the free area in the nursery block.  This is-      // just a convenience so that we can avoid multiple indirections through-      // the nursery pointer below during compaction.-    StgCompactNFDataBlock *nursery;-      // where to (try to) allocate from when appending-    StgCompactNFDataBlock *last;-      // the last block of the chain (to know where to append new-      // blocks for resize)-    struct hashtable *hash;-      // the hash table for the current compaction, or NULL if-      // there's no (sharing-preserved) compaction in progress.-    StgClosure *result;-      // Used temporarily to store the result of compaction.  Doesn't need to be-      // a GC root.-} StgCompactNFData;
− includes/rts/storage/FunTypes.h
@@ -1,54 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 2002- *- * Things for functions.- *- * ---------------------------------------------------------------------------*/--#pragma once--/* generic - function comes with a small bitmap */-#define ARG_GEN      0   --/* generic - function comes with a large bitmap */-#define ARG_GEN_BIG  1--/* BCO - function is really a BCO */-#define ARG_BCO      2--/*- * Specialised function types: bitmaps and calling sequences- * for these functions are pre-generated: see ghc/utils/genapply and- * generated code in ghc/rts/AutoApply.cmm.- *- *  NOTE: other places to change if you change this table:- *       - utils/genapply/Main.hs: stackApplyTypes- *       - compiler/codeGen/StgCmmLayout.hs: stdPattern- */-#define ARG_NONE     3 -#define ARG_N        4  -#define ARG_P        5 -#define ARG_F        6 -#define ARG_D        7 -#define ARG_L        8 -#define ARG_V16      9 -#define ARG_V32      10-#define ARG_V64      11-#define ARG_NN       12 -#define ARG_NP       13-#define ARG_PN       14-#define ARG_PP       15-#define ARG_NNN      16-#define ARG_NNP      17-#define ARG_NPN      18-#define ARG_NPP      19-#define ARG_PNN      20-#define ARG_PNP      21-#define ARG_PPN      22-#define ARG_PPP      23-#define ARG_PPPP     24-#define ARG_PPPPP    25-#define ARG_PPPPPP   26-#define ARG_PPPPPPP  27-#define ARG_PPPPPPPP 28
− includes/rts/storage/GC.h
@@ -1,248 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2004- *- * External Storage Manger Interface- *- * ---------------------------------------------------------------------------*/--#pragma once--#include <stddef.h>-#include "rts/OSThreads.h"--/* ------------------------------------------------------------------------------ * Generational GC- *- * We support an arbitrary number of generations.  Notes (in no particular- * order):- *- *       - Objects "age" in the nursery for one GC cycle before being promoted- *         to the next generation.  There is no aging in other generations.- *- *       - generation 0 is the allocation area.  It is given- *         a fixed set of blocks during initialisation, and these blocks- *         normally stay in G0S0.  In parallel execution, each- *         Capability has its own nursery.- *- *       - during garbage collection, each generation which is an- *         evacuation destination (i.e. all generations except G0) is- *         allocated a to-space.  evacuated objects are allocated into- *         the generation's to-space until GC is finished, when the- *         original generations's contents may be freed and replaced- *         by the to-space.- *- *       - the mutable-list is per-generation.  G0 doesn't have one- *         (since every garbage collection collects at least G0).- *- *       - block descriptors contain a pointer to 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-generation, and are promoted in the- *         same way as small objects.- *- * ------------------------------------------------------------------------- */--// A count of blocks needs to store anything up to the size of memory-// divided by the block size.  The safest thing is therefore to use a-// type that can store the full range of memory addresses,-// ie. StgWord.  Note that we have had some tricky int overflows in a-// couple of cases caused by using ints rather than longs (e.g. #5086)--typedef StgWord memcount;--typedef struct nursery_ {-    bdescr *       blocks;-    memcount       n_blocks;-} nursery;--// Nursery invariants:-//-//  - cap->r.rNursery points to the nursery for this capability-//-//  - cap->r.rCurrentNursery points to the block in the nursery that we are-//    currently allocating into.  While in Haskell the current heap pointer is-//    in Hp, outside Haskell it is stored in cap->r.rCurrentNursery->free.-//-//  - the blocks *after* cap->rCurrentNursery in the chain are empty-//    (although their bd->free pointers have not been updated to-//    reflect that)-//-//  - the blocks *before* cap->rCurrentNursery have been used.  Except-//    for rCurrentAlloc.-//-//  - cap->r.rCurrentAlloc is either NULL, or it points to a block in-//    the nursery *before* cap->r.rCurrentNursery.-//-// See also Note [allocation accounting] to understand how total-// memory allocation is tracked.--typedef struct generation_ {-    uint32_t       no;                  // generation number--    bdescr *       blocks;              // blocks in this gen-    memcount       n_blocks;            // number of blocks-    memcount       n_words;             // number of used words--    bdescr *       large_objects;       // large objects (doubly linked)-    memcount       n_large_blocks;      // no. of blocks used by large objs-    memcount       n_large_words;       // no. of words used by large objs-    memcount       n_new_large_words;   // words of new large objects-                                        // (for doYouWantToGC())--    bdescr *       compact_objects;     // compact objects chain-                                        // the second block in each compact is-                                        // linked from the closure object, while-                                        // the second compact object in the-                                        // chain is linked from bd->link (like-                                        // large objects)-    memcount       n_compact_blocks;    // no. of blocks used by all compacts-    bdescr *       compact_blocks_in_import; // compact objects being imported-                                             // (not known to the GC because-                                             // potentially invalid, but we-                                             // need to keep track of them-                                             // to avoid assertions in Sanity)-                                             // this is a list shaped like compact_objects-    memcount       n_compact_blocks_in_import; // no. of blocks used by compacts-                                               // being imported--    // Max blocks to allocate in this generation before collecting it. Collect-    // this generation when-    //-    //     n_blocks + n_large_blocks + n_compact_blocks > max_blocks-    //-    memcount       max_blocks;--    StgTSO *       threads;             // threads in this gen-                                        // linked via global_link-    StgWeak *      weak_ptr_list;       // weak pointers in this gen--    struct generation_ *to;             // destination gen for live objects--    // stats information-    uint32_t collections;-    uint32_t par_collections;-    uint32_t failed_promotions;         // Currently unused--    // -------------------------------------    // Fields below are used during GC only--#if defined(THREADED_RTS)-    char pad[128];                      // make sure the following is-                                        // on a separate cache line.-    SpinLock     sync;                  // lock for large_objects-                                        //    and scavenged_large_objects-#endif--    int          mark;                  // mark (not copy)? (old gen only)-    int          compact;               // compact (not sweep)? (old gen only)--    // During GC, if we are collecting this gen, blocks and n_blocks-    // are copied into the following two fields.  After GC, these blocks-    // are freed.-    bdescr *     old_blocks;            // bdescr of first from-space block-    memcount     n_old_blocks;         // number of blocks in from-space-    memcount     live_estimate;         // for sweeping: estimate of live data--    bdescr *     scavenged_large_objects;  // live large objs after GC (d-link)-    memcount     n_scavenged_large_blocks; // size (not count) of above--    bdescr *     live_compact_objects;  // live compact objs after GC (d-link)-    memcount     n_live_compact_blocks; // size (not count) of above--    bdescr *     bitmap;                // bitmap for compacting collection--    StgTSO *     old_threads;-    StgWeak *    old_weak_ptr_list;-} generation;--extern generation * generations;-extern generation * g0;-extern generation * oldest_gen;--/* ------------------------------------------------------------------------------   Generic allocation--   StgPtr allocate(Capability *cap, W_ n)-                                Allocates memory from the nursery in-                                the current Capability.--   StgPtr allocatePinned(Capability *cap, W_ 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.--   -------------------------------------------------------------------------- */--StgPtr  allocate          ( Capability *cap, W_ n );-StgPtr  allocateMightFail ( Capability *cap, W_ n );-StgPtr  allocatePinned    ( Capability *cap, W_ n );--/* memory allocator for executable memory */-typedef void* AdjustorWritable;-typedef void* AdjustorExecutable;--AdjustorWritable allocateExec(W_ len, AdjustorExecutable *exec_addr);-void flushExec(W_ len, AdjustorExecutable exec_addr);-#if defined(ios_HOST_OS)-AdjustorWritable execToWritable(AdjustorExecutable exec);-#endif-void             freeExec (AdjustorExecutable p);--// Used by GC checks in external .cmm code:-extern W_ large_alloc_lim;--/* ------------------------------------------------------------------------------   Performing Garbage Collection-   -------------------------------------------------------------------------- */--void performGC(void);-void performMajorGC(void);--/* ------------------------------------------------------------------------------   The CAF table - used to let us revert CAFs in GHCi-   -------------------------------------------------------------------------- */--StgInd *newCAF         (StgRegTable *reg, StgIndStatic *caf);-StgInd *newRetainedCAF (StgRegTable *reg, StgIndStatic *caf);-StgInd *newGCdCAF      (StgRegTable *reg, StgIndStatic *caf);-void revertCAFs (void);--// Request that all CAFs are retained indefinitely.-// (preferably use RtsConfig.keep_cafs instead)-void setKeepCAFs (void);--/* ------------------------------------------------------------------------------   This is the write barrier for MUT_VARs, a.k.a. IORefs.  A-   MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY-   is.  When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY-   and is put on the mutable list.-   -------------------------------------------------------------------------- */--void dirty_MUT_VAR(StgRegTable *reg, StgClosure *p);--/* set to disable CAF garbage collection in GHCi. */-/* (needed when dynamic libraries are used). */-extern bool keepCAFs;--INLINE_HEADER void initBdescr(bdescr *bd, generation *gen, generation *dest)-{-    bd->gen     = gen;-    bd->gen_no  = gen->no;-    bd->dest_no = dest->no;-}
− includes/rts/storage/Heap.h
@@ -1,18 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The University of Glasgow 2006-2017- *- * Introspection into GHC's heap representation- *- * ---------------------------------------------------------------------------*/--#pragma once--#include "rts/storage/Closures.h"--StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure);--void heap_view_closure_ptrs_in_pap_payload(StgClosure *ptrs[], StgWord *nptrs-                        , StgClosure *fun, StgClosure **payload, StgWord size);--StgWord heap_view_closureSize(StgClosure *closure);
− includes/rts/storage/InfoTables.h
@@ -1,405 +0,0 @@-/* ----------------------------------------------------------------------------- *- * (c) The GHC Team, 1998-2002- *- * Info Tables- *- * -------------------------------------------------------------------------- */--#pragma once--/* -----------------------------------------------------------------------------   Relative pointers--   Several pointer fields in info tables are expressed as offsets-   relative to the info pointer, so that we can generate-   position-independent code.--   Note [x86-64-relative]-   There is a complication on the x86_64 platform, where pointers are-   64 bits, but the tools don't support 64-bit relative relocations.-   However, the default memory model (small) ensures that all symbols-   have values in the lower 2Gb of the address space, so offsets all-   fit in 32 bits.  Hence we can use 32-bit offset fields.--   Somewhere between binutils-2.16.1 and binutils-2.16.91.0.6,-   support for 64-bit PC-relative relocations was added, so maybe this-   hackery can go away sometime.-   ------------------------------------------------------------------------- */--#if defined(x86_64_TARGET_ARCH)-#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n-#else-#define OFFSET_FIELD(n) StgInt n-#endif--/* ------------------------------------------------------------------------------   Profiling info-   -------------------------------------------------------------------------- */--typedef struct {-#if !defined(TABLES_NEXT_TO_CODE)-    char *closure_type;-    char *closure_desc;-#else-    OFFSET_FIELD(closure_type_off);-    OFFSET_FIELD(closure_desc_off);-#endif-} StgProfInfo;--/* ------------------------------------------------------------------------------   Closure flags-   -------------------------------------------------------------------------- */--/* The type flags provide quick access to certain properties of a closure. */--#define _HNF (1<<0)  /* head normal form?    */-#define _BTM (1<<1)  /* uses info->layout.bitmap */-#define _NS  (1<<2)  /* non-sparkable        */-#define _THU (1<<3)  /* thunk?               */-#define _MUT (1<<4)  /* mutable?             */-#define _UPT (1<<5)  /* unpointed?           */-#define _SRT (1<<6)  /* has an SRT?          */-#define _IND (1<<7)  /* is an indirection?   */--#define isMUTABLE(flags)   ((flags) &_MUT)-#define isBITMAP(flags)    ((flags) &_BTM)-#define isTHUNK(flags)     ((flags) &_THU)-#define isUNPOINTED(flags) ((flags) &_UPT)-#define hasSRT(flags)      ((flags) &_SRT)--extern StgWord16 closure_flags[];--#define closureFlags(c)         (closure_flags[get_itbl \-                                    (UNTAG_CONST_CLOSURE(c))->type])--#define closure_HNF(c)          (  closureFlags(c) & _HNF)-#define closure_BITMAP(c)       (  closureFlags(c) & _BTM)-#define closure_NON_SPARK(c)    ( (closureFlags(c) & _NS))-#define closure_SHOULD_SPARK(c) (!(closureFlags(c) & _NS))-#define closure_THUNK(c)        (  closureFlags(c) & _THU)-#define closure_MUTABLE(c)      (  closureFlags(c) & _MUT)-#define closure_UNPOINTED(c)    (  closureFlags(c) & _UPT)-#define closure_SRT(c)          (  closureFlags(c) & _SRT)-#define closure_IND(c)          (  closureFlags(c) & _IND)--/* same as above but for info-ptr rather than closure */-#define ipFlags(ip)             (closure_flags[ip->type])--#define ip_HNF(ip)               (  ipFlags(ip) & _HNF)-#define ip_BITMAP(ip)            (  ipFlags(ip) & _BTM)-#define ip_SHOULD_SPARK(ip)      (!(ipFlags(ip) & _NS))-#define ip_THUNK(ip)             (  ipFlags(ip) & _THU)-#define ip_MUTABLE(ip)           (  ipFlags(ip) & _MUT)-#define ip_UNPOINTED(ip)         (  ipFlags(ip) & _UPT)-#define ip_SRT(ip)               (  ipFlags(ip) & _SRT)-#define ip_IND(ip)               (  ipFlags(ip) & _IND)--/* ------------------------------------------------------------------------------   Bitmaps--   These are used to describe the pointerhood of a sequence of words-   (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.-   -------------------------------------------------------------------------- */--/*- * Small bitmaps:  for a small bitmap, we store the size and bitmap in- * the same word, using the following macros.  If the bitmap doesn't- * fit in a single word, we use a pointer to an StgLargeBitmap below.- */-#define MK_SMALL_BITMAP(size,bits) (((bits)<<BITMAP_BITS_SHIFT) | (size))--#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)-#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)--/*- * A large bitmap.- */-typedef struct {-  StgWord size;-  StgWord bitmap[];-} StgLargeBitmap;--/* -----------------------------------------------------------------------------   Info Tables-   ------------------------------------------------------------------------- */--/*- * Stuff describing the closure layout.  Well, actually, it might- * contain the selector index for a THUNK_SELECTOR.  This union is one- * word long.- */-typedef union {-    struct {                    /* Heap closure payload layout: */-        StgHalfWord ptrs;       /* number of pointers */-        StgHalfWord nptrs;      /* number of non-pointers */-    } payload;--    StgWord bitmap;               /* word-sized bit pattern describing */-                                  /*  a stack frame: see below */--#if !defined(TABLES_NEXT_TO_CODE)-    StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */-#else-    OFFSET_FIELD(large_bitmap_offset);  /* offset from info table to large bitmap structure */-#endif--    StgWord selector_offset;      /* used in THUNK_SELECTORs */--} StgClosureInfo;---#if defined(x86_64_TARGET_ARCH) && defined(TABLES_NEXT_TO_CODE)-// On x86_64 we can fit a pointer offset in half a word, so put the SRT offset-// in the info->srt field directly.-//-// See the section "Referring to an SRT from the info table" in-// Note [SRTs] in CmmBuildInfoTables.hs-#define USE_INLINE_SRT_FIELD-#endif--#if defined(USE_INLINE_SRT_FIELD)-// offset to the SRT / closure, or zero if there's no SRT-typedef StgHalfInt StgSRTField;-#else-// non-zero if there is an SRT, the offset is in the optional srt field.-typedef StgHalfWord StgSRTField;-#endif---/*- * The "standard" part of an info table.  Every info table has this bit.- */-typedef struct StgInfoTable_ {--#if !defined(TABLES_NEXT_TO_CODE)-    StgFunPtr       entry;      /* pointer to the entry code */-#endif--#if defined(PROFILING)-    StgProfInfo     prof;-#endif--    StgClosureInfo  layout;     /* closure layout info (one word) */--    StgHalfWord     type;       /* closure type */-    StgSRTField     srt;-       /* In a CONSTR:-            - the constructor tag-          In a FUN/THUNK-            - if USE_INLINE_SRT_FIELD-              - offset to the SRT (or zero if no SRT)-            - otherwise-              - non-zero if there is an SRT, offset is in srt_offset-       */--#if defined(TABLES_NEXT_TO_CODE)-    StgCode         code[];-#endif-} *StgInfoTablePtr; // StgInfoTable defined in rts/Types.h---/* ------------------------------------------------------------------------------   Function info tables--   This is the general form of function info tables.  The compiler-   will omit some of the fields in common cases:--   -  If fun_type is not ARG_GEN or ARG_GEN_BIG, then the slow_apply-      and bitmap fields may be left out (they are at the end, so omitting-      them doesn't affect the layout).--   -  If has_srt (in the std info table part) is zero, then the srt-      field needn't be set.  This only applies if the slow_apply and-      bitmap fields have also been omitted.-   -------------------------------------------------------------------------- */--/*-   Note [Encoding static reference tables]-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--   As static reference tables appear frequently in code, we use a special-   compact encoding for the common case of a module defining only a few CAFs: We-   produce one table containing a list of CAFs in the module and then include a-   bitmap in each info table describing which entries of this table the closure-   references.- */--typedef struct StgFunInfoExtraRev_ {-    OFFSET_FIELD(slow_apply_offset); /* apply to args on the stack */-    union {-        StgWord bitmap;-        OFFSET_FIELD(bitmap_offset);    /* arg ptr/nonptr bitmap */-    } b;-#if !defined(USE_INLINE_SRT_FIELD)-    OFFSET_FIELD(srt_offset);   /* pointer to the SRT closure */-#endif-    StgHalfWord    fun_type;    /* function type */-    StgHalfWord    arity;       /* function arity */-} StgFunInfoExtraRev;--typedef struct StgFunInfoExtraFwd_ {-    StgHalfWord    fun_type;    /* function type */-    StgHalfWord    arity;       /* function arity */-    StgClosure    *srt;         /* pointer to the SRT closure */-    union { /* union for compat. with TABLES_NEXT_TO_CODE version */-        StgWord        bitmap;  /* arg ptr/nonptr bitmap */-    } b;-    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;--// canned bitmap for each arg type, indexed by constants in FunTypes.h-extern const StgWord stg_arg_bitmaps[];--/* ------------------------------------------------------------------------------   Return info tables-   -------------------------------------------------------------------------- */--/*- * When info tables are laid out backwards, we can omit the SRT- * pointer iff has_srt is zero.- */--typedef struct {-#if defined(TABLES_NEXT_TO_CODE)-#if !defined(USE_INLINE_SRT_FIELD)-    OFFSET_FIELD(srt_offset);   /* offset to the SRT closure */-#endif-    StgInfoTable i;-#else-    StgInfoTable i;-    StgClosure  *srt;           /* pointer to the SRT closure */-#endif-} StgRetInfoTable;--/* ------------------------------------------------------------------------------   Thunk info tables-   -------------------------------------------------------------------------- */--/*- * When info tables are laid out backwards, we can omit the SRT- * pointer iff has_srt is zero.- */--typedef struct StgThunkInfoTable_ {-#if defined(TABLES_NEXT_TO_CODE)-#if !defined(USE_INLINE_SRT_FIELD)-    OFFSET_FIELD(srt_offset);   /* offset to the SRT closure */-#endif-    StgInfoTable i;-#else-    StgInfoTable i;-    StgClosure  *srt;           /* pointer to the SRT closure */-#endif-} StgThunkInfoTable;--/* ------------------------------------------------------------------------------   Constructor info tables-   -------------------------------------------------------------------------- */--typedef struct StgConInfoTable_ {-#if !defined(TABLES_NEXT_TO_CODE)-    StgInfoTable i;-#endif--#if defined(TABLES_NEXT_TO_CODE)-    OFFSET_FIELD(con_desc); // the name of the data constructor-                            // as: Package:Module.Name-#else-    char *con_desc;-#endif--#if defined(TABLES_NEXT_TO_CODE)-    StgInfoTable i;-#endif-} StgConInfoTable;---/* ------------------------------------------------------------------------------   Accessor macros for fields that might be offsets (C version)-   -------------------------------------------------------------------------- */--/*- * GET_SRT(info)- * info must be a Stg[Ret|Thunk]InfoTable* (an info table that has a SRT)- */-#if defined(TABLES_NEXT_TO_CODE)-#if defined(x86_64_TARGET_ARCH)-#define GET_SRT(info) \-  ((StgClosure*) (((StgWord) ((info)+1)) + (info)->i.srt))-#else-#define GET_SRT(info) \-  ((StgClosure*) (((StgWord) ((info)+1)) + (info)->srt_offset))-#endif-#else // !TABLES_NEXT_TO_CODE-#define GET_SRT(info) ((info)->srt)-#endif--/*- * GET_CON_DESC(info)- * info must be a StgConInfoTable*.- */-#if defined(TABLES_NEXT_TO_CODE)-#define GET_CON_DESC(info) \-            ((const char *)((StgWord)((info)+1) + (info->con_desc)))-#else-#define GET_CON_DESC(info) ((const char *)(info)->con_desc)-#endif--/*- * GET_FUN_SRT(info)- * info must be a StgFunInfoTable*- */-#if defined(TABLES_NEXT_TO_CODE)-#if defined(x86_64_TARGET_ARCH)-#define GET_FUN_SRT(info) \-  ((StgClosure*) (((StgWord) ((info)+1)) + (info)->i.srt))-#else-#define GET_FUN_SRT(info) \-  ((StgClosure*) (((StgWord) ((info)+1)) + (info)->f.srt_offset))-#endif-#else-#define GET_FUN_SRT(info) ((info)->f.srt)-#endif--#if defined(TABLES_NEXT_TO_CODE)-#define GET_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \-                                        + (info)->layout.large_bitmap_offset))-#else-#define GET_LARGE_BITMAP(info) ((info)->layout.large_bitmap)-#endif--#if defined(TABLES_NEXT_TO_CODE)-#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \-                                        + (info)->f.b.bitmap_offset))-#else-#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.b.bitmap))-#endif--/*- * GET_PROF_TYPE, GET_PROF_DESC- */-#if defined(TABLES_NEXT_TO_CODE)-#define GET_PROF_TYPE(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_type_off)))-#else-#define GET_PROF_TYPE(info) ((info)->prof.closure_type)-#endif-#if defined(TABLES_NEXT_TO_CODE)-#define GET_PROF_DESC(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_desc_off)))-#else-#define GET_PROF_DESC(info) ((info)->prof.closure_desc)-#endif
− includes/rts/storage/MBlock.h
@@ -1,32 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2008- *- * MegaBlock Allocator interface.- *- * See wiki commentary at- *  http://ghc.haskell.org/trac/ghc/wiki/Commentary/HeapAlloced- *- * ---------------------------------------------------------------------------*/--#pragma once--extern W_ peak_mblocks_allocated;-extern W_ mblocks_allocated;--extern void initMBlocks(void);-extern void * getMBlock(void);-extern void * getMBlocks(uint32_t n);-extern void * getMBlockOnNode(uint32_t node);-extern void * getMBlocksOnNode(uint32_t node, uint32_t n);-extern void freeMBlocks(void *addr, uint32_t n);-extern void releaseFreeMemory(void);-extern void freeAllMBlocks(void);--extern void *getFirstMBlock(void **state);-extern void *getNextMBlock(void **state, void *mblock);--#if defined(THREADED_RTS)-// needed for HEAP_ALLOCED below-extern SpinLock gc_alloc_block_sync;-#endif
− includes/rts/storage/TSO.h
@@ -1,261 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The GHC Team, 1998-2009- *- * The definitions for Thread State Objects.- *- * ---------------------------------------------------------------------------*/--#pragma once--/*- * PROFILING info in a TSO- */-typedef struct {-  CostCentreStack *cccs;       /* thread's current CCS */-} StgTSOProfInfo;--/*- * There is no TICKY info in a TSO at this time.- */--/*- * Thread IDs are 32 bits.- */-typedef StgWord32 StgThreadID;--#define tsoLocked(tso) ((tso)->flags & TSO_LOCKED)--/*- * Type returned after running a thread.  Values of this type- * include HeapOverflow, StackOverflow etc.  See Constants.h for the- * full list.- */-typedef unsigned int StgThreadReturnCode;--#if defined(mingw32_HOST_OS)-/* results from an async I/O request + its request ID. */-typedef struct {-  unsigned int reqID;-  int          len;-  int          errCode;-} StgAsyncIOResult;-#endif--/* Reason for thread being blocked. See comment above struct StgTso_. */-typedef union {-  StgClosure *closure;-  StgTSO *prev; // a back-link when the TSO is on the run queue (NotBlocked)-  struct MessageBlackHole_ *bh;-  struct MessageThrowTo_ *throwto;-  struct MessageWakeup_  *wakeup;-  StgInt fd;    /* StgInt instead of int, so that it's the same size as the ptrs */-#if defined(mingw32_HOST_OS)-  StgAsyncIOResult *async_result;-#endif-#if !defined(THREADED_RTS)-  StgWord target;-    // Only for the non-threaded RTS: the target time for a thread-    // blocked in threadDelay, in units of 1ms.  This is a-    // compromise: we don't want to take up much space in the TSO.  If-    // you want better resolution for threadDelay, use -threaded.-#endif-} StgTSOBlockInfo;---/*- * TSOs live on the heap, and therefore look just like heap objects.- * Large TSOs will live in their own "block group" allocated by the- * storage manager, and won't be copied during garbage collection.- */--/*- * 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 struct StgTSO_ {-    StgHeader               header;--    /* The link field, for linking threads together in lists (e.g. the-       run queue on a Capability.-    */-    struct StgTSO_*         _link;-    /*-      Currently used for linking TSOs on:-      * cap->run_queue_{hd,tl}-      * (non-THREADED_RTS); the blocked_queue-      * and pointing to the next chunk for a ThreadOldStack--       NOTE!!!  do not modify _link directly, it is subject to-       a write barrier for generational GC.  Instead use the-       setTSOLink() function.  Exceptions to this rule are:--       * setting the link field to END_TSO_QUEUE-       * setting the link field of the currently running TSO, as it-         will already be dirty.-    */--    struct StgTSO_*         global_link;    // Links threads on the-                                            // generation->threads lists--    /*-     * The thread's stack-     */-    struct StgStack_       *stackobj;--    /*-     * The tso->dirty flag indicates that this TSO's stack should be-     * scanned during garbage collection.  It also indicates that this-     * TSO is on the mutable list.-     *-     * NB. The dirty flag gets a word to itself, so that it can be set-     * safely by multiple threads simultaneously (the flags field is-     * not safe for this purpose; see #3429).  It is harmless for the-     * TSO to be on the mutable list multiple times.-     *-     * tso->dirty is set by dirty_TSO(), and unset by the garbage-     * collector (only).-     */--    StgWord16               what_next;      // Values defined in Constants.h-    StgWord16               why_blocked;    // Values defined in Constants.h-    StgWord32               flags;          // Values defined in Constants.h-    StgTSOBlockInfo         block_info;-    StgThreadID             id;-    StgWord32               saved_errno;-    StgWord32               dirty;          /* non-zero => dirty */-    struct InCall_*         bound;-    struct Capability_*     cap;--    struct StgTRecHeader_ * trec;       /* STM transaction record */--    /*-     * A list of threads blocked on this TSO waiting to throw exceptions.-    */-    struct MessageThrowTo_ * blocked_exceptions;--    /*-     * A list of StgBlockingQueue objects, representing threads-     * blocked on thunks that are under evaluation by this thread.-    */-    struct StgBlockingQueue_ *bq;--    /*-     * The allocation limit for this thread, which is updated as the-     * thread allocates.  If the value drops below zero, and-     * TSO_ALLOC_LIMIT is set in flags, we raise an exception in the-     * thread, and give the thread a little more space to handle the-     * exception before we raise the exception again.-     *-     * This is an integer, because we might update it in a place where-     * it isn't convenient to raise the exception, so we want it to-     * stay negative until we get around to checking it.-     *-     * Use only PK_Int64/ASSIGN_Int64 macros to get/set the value of alloc_limit-     * in C code otherwise you will cause alignment issues on SPARC-     */-    StgInt64  alloc_limit;     /* in bytes */--    /*-     * sum of the sizes of all stack chunks (in words), used to decide-     * whether to throw the StackOverflow exception when the stack-     * overflows, or whether to just chain on another stack chunk.-     *-     * Note that this overestimates the real stack size, because each-     * chunk will have a gap at the end, of +RTS -kb<size> words.-     * This means stack overflows are not entirely accurate, because-     * the more gaps there are, the sooner the stack will run into the-     * hard +RTS -K<size> limit.-     */-    StgWord32  tot_stack_size;--#if defined(TICKY_TICKY)-    /* TICKY-specific stuff would go here. */-#endif-#if defined(PROFILING)-    StgTSOProfInfo prof;-#endif-#if defined(mingw32_HOST_OS)-    StgWord32 saved_winerror;-#endif--} *StgTSOPtr; // StgTSO defined in rts/Types.h--typedef struct StgStack_ {-    StgHeader  header;-    StgWord32  stack_size;     // stack size in *words*-    StgWord32  dirty;          // non-zero => dirty-    StgPtr     sp;             // current stack pointer-    StgWord    stack[];-} StgStack;--// Calculate SpLim from a TSO (reads tso->stackobj, but no fields from-// the stackobj itself).-INLINE_HEADER StgPtr tso_SpLim (StgTSO* tso)-{-    return tso->stackobj->stack + RESERVED_STACK_WORDS;-}--/* ------------------------------------------------------------------------------   functions-   -------------------------------------------------------------------------- */--void dirty_TSO  (Capability *cap, StgTSO *tso);-void setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target);-void setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target);--void dirty_STACK (Capability *cap, StgStack *stack);--/* ------------------------------------------------------------------------------   Invariants:--   An active thread has the following properties:--      tso->stack < tso->sp < tso->stack+tso->stack_size-      tso->stack_size <= tso->max_stack_size--      RESERVED_STACK_WORDS is large enough for any heap-check or-      stack-check failure.--      The size of the TSO struct plus the stack is either-        (a) smaller than a block, or-        (b) a multiple of BLOCK_SIZE--        tso->why_blocked       tso->block_info      location-        -----------------------------------------------------------------------        NotBlocked             END_TSO_QUEUE        runnable_queue, or running--        BlockedOnBlackHole     MessageBlackHole *   TSO->bq--        BlockedOnMVar          the MVAR             the MVAR's queue--        BlockedOnSTM           END_TSO_QUEUE        STM wait queue(s)-        BlockedOnSTM           STM_AWOKEN           run queue--        BlockedOnMsgThrowTo    MessageThrowTo *     TSO->blocked_exception--        BlockedOnRead          NULL                 blocked_queue-        BlockedOnWrite         NULL                 blocked_queue-        BlockedOnDelay         NULL                 blocked_queue--      tso->link == END_TSO_QUEUE, if the thread is currently running.--   A zombie thread has the following properties:--      tso->what_next == ThreadComplete or ThreadKilled-      tso->link     ==  (could be on some queue somewhere)-      tso->sp       ==  tso->stack + tso->stack_size - 1 (i.e. top stack word)-      tso->sp[0]    ==  return value of thread, if what_next == ThreadComplete,-                        exception             , if what_next == ThreadKilled--      (tso->sp is left pointing at the top word on the stack so that-      the return value or exception will be retained by a GC).-- ---------------------------------------------------------------------------- */--/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */-#define END_TSO_QUEUE  ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure)