import SMRep
import ForeignCall
import Constants
-import StaticFlags ( opt_SccProfilingOn, opt_SMP )
+import StaticFlags ( opt_SccProfilingOn )
import Outputable
import Monad ( when )
)
stmtC (the_call vols)
stmtC (CmmCall (CmmForeignCall resumeThread CCallConv)
- (if opt_SMP then [(CmmGlobal BaseReg, PtrHint)] else [])
- -- Assign the result to BaseReg: we might now have
- -- a different Capability! Small optimisation:
- -- only do this in SMP mode, where there are >1
- -- Capabilities.
+ [ (CmmGlobal BaseReg, PtrHint) ]
+ -- Assign the result to BaseReg: we
+ -- might now have a different
+ -- Capability!
[ (CmmReg id, PtrHint) ]
(Just vols)
)
#include "HsVersions.h"
-import Constants ( mIN_UPD_SIZE )
import StgSyn ( AltType(..) )
import CLabel ( CLabel, mkRtsCodeLabel )
import CgUtils ( mkWordCLit, cmmRegOffW, cmmOffsetW,
padding_wds
| not is_caf = []
- | otherwise = replicate n (mkIntCLit 0) -- a bunch of 0s
- where n = max 0 (mIN_UPD_SIZE - length payload)
+ | otherwise = ASSERT(null payload) [mkIntCLit 0]
static_link_field
| is_caf || staticClosureNeedsLink cl_info = [static_link_value]
import PrimOp ( PrimOp(..) )
import SMRep ( tablesNextToCode )
import Constants ( wORD_SIZE, wORD_SIZE_IN_BITS )
-import StaticFlags ( opt_Parallel, opt_SMP )
+import StaticFlags ( opt_Parallel )
import Outputable
-- ---------------------------------------------------------------------------
emitPrimOp [res] ParOp [arg] live
- | not (opt_Parallel || opt_SMP)
- = stmtC (CmmAssign res (CmmLit (mkIntCLit 1)))
- | otherwise
= do
-- for now, just implement this in a C function
-- later, we might want to inline it.
import CLabel
-import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
+import Constants ( mIN_PAYLOAD_SIZE )
import Packages ( isDllName, HomeModules )
import StaticFlags ( opt_SccProfilingOn, opt_OmitBlackHoling,
- opt_Parallel, opt_DoTickyProfiling,
- opt_SMP )
+ opt_Parallel, opt_DoTickyProfiling )
import Id ( Id, idType, idArity, idName )
import DataCon ( DataCon, dataConTyCon, isNullaryRepDataCon, dataConName )
import Name ( Name, nameUnique, getOccName, getOccString )
knowledge of what the storage manager does with the various
representations...
-Slop Requirements:
-
- - Updatable closures must be mIN_UPD_SIZE.
-
- - Heap-resident Closures must be mIN_SIZE_NonUpdHeapObject
- (to make room for an StgEvacuated during GC).
-
-In SMP mode, we don't play the mIN_UPD_SIZE game. Instead, every
-thunk gets an extra padding word in the header, which takes the
-the updated value.
+Slop Requirements: every thunk gets an extra padding word in the
+header, which takes the the updated value.
\begin{code}
slopSize cl_info = computeSlopSize payload_size cl_info
BlackHoleRep -> min_upd_size
GenericRep _ _ _ _ | updatable -> min_upd_size
GenericRep True _ _ _ -> 0 -- static
- GenericRep False _ _ _ -> mIN_SIZE_NonUpdHeapObject
+ GenericRep False _ _ _ -> mIN_PAYLOAD_SIZE
-- ^^^^^___ dynamic
where
- min_upd_size
- | opt_SMP = ASSERT(mIN_SIZE_NonUpdHeapObject <=
- sIZEOF_StgSMPThunkHeader)
- 0 -- check that we already have enough
- -- room for mIN_SIZE_NonUpdHeapObject,
- -- due to the extra header word in SMP
- | otherwise = mIN_UPD_SIZE
+ min_upd_size =
+ ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
+ 0 -- check that we already have enough
+ -- room for mIN_SIZE_NonUpdHeapObject,
+ -- due to the extra header word in SMP
\end{code}
%************************************************************************
-- is the fast-entry code]
| updatable || opt_DoTickyProfiling -- to catch double entry
- || opt_SMP -- Always enter via node on SMP, since the
- -- thunk might have been blackholed in the
- -- meantime.
+ {- OLD: || opt_SMP
+ I decided to remove this, because in SMP mode it doesn't matter
+ if we enter the same thunk multiple times, so the optimisation
+ of jumping directly to the entry code is still valid. --SDM
+ -}
= ASSERT( n_args == 0 ) EnterIt
| otherwise -- Jump direct to code for single-entry thunks
import TyCon ( TyCon, tyConPrimRep )
import MachOp-- ( MachRep(..), MachHint(..), wordRep )
import StaticFlags ( opt_SccProfilingOn, opt_GranMacros,
- opt_Unregisterised, opt_SMP )
+ opt_Unregisterised )
import Constants
import Outputable
-- Thunks have an extra header word on SMP, so the update doesn't
-- splat the payload.
thunkHdrSize :: WordOff
-thunkHdrSize | opt_SMP = fixedHdrSize + smp_hdr
- | otherwise = fixedHdrSize
+thunkHdrSize = fixedHdrSize + smp_hdr
where smp_hdr = sIZEOF_StgSMPThunkHeader `quot` wORD_SIZE
\end{code}
ALLOC_AP n -> instr2 st bci_ALLOC_AP n
ALLOC_PAP arity n -> instr3 st bci_ALLOC_PAP arity n
MKAP off sz -> instr3 st bci_MKAP off sz
+ MKPAP off sz -> instr3 st bci_MKPAP off sz
UNPACK n -> instr2 st bci_UNPACK n
PACK dcon sz -> do (itbl_no,st2) <- itbl st dcon
instr3 st2 bci_PACK itbl_no sz
ALLOC_AP{} -> 2
ALLOC_PAP{} -> 3
MKAP{} -> 3
+ MKPAP{} -> 3
UNPACK{} -> 2
PACK{} -> 3
LABEL{} -> 0 -- !!
import OrdList
import Constants ( wORD_SIZE )
-import Data.List ( intersperse, sortBy, zip4, zip5, partition )
+import Data.List ( intersperse, sortBy, zip4, zip6, partition )
import Foreign ( Ptr, castPtr, mallocBytes, pokeByteOff, Word8,
withForeignPtr )
import Foreign.C ( CInt )
zipE = zipEqual "schemeE"
-- ToDo: don't build thunks for things with no free variables
- build_thunk dd [] size bco off
- = returnBc (PUSH_BCO bco
- `consOL` unitOL (MKAP (off+size) size))
- build_thunk dd (fv:fvs) size bco off = do
+ build_thunk dd [] size bco off arity
+ = returnBc (PUSH_BCO bco `consOL` unitOL (mkap (off+size) size))
+ where
+ mkap | arity == 0 = MKAP
+ | otherwise = MKPAP
+ build_thunk dd (fv:fvs) size bco off arity = do
(push_code, pushed_szw) <- pushAtom dd p' (AnnVar fv)
- more_push_code <- build_thunk (dd+pushed_szw) fvs size bco off
+ more_push_code <- build_thunk (dd+pushed_szw) fvs size bco off arity
returnBc (push_code `appOL` more_push_code)
alloc_code = toOL (zipWith mkAlloc sizes arities)
where mkAlloc sz 0 = ALLOC_AP sz
mkAlloc sz arity = ALLOC_PAP arity sz
- compile_bind d' fvs x rhs size off = do
+ compile_bind d' fvs x rhs size arity off = do
bco <- schemeR fvs (x,rhs)
- build_thunk d' fvs size bco off
+ build_thunk d' fvs size bco off arity
compile_binds =
- [ compile_bind d' fvs x rhs size n
- | (fvs, x, rhs, size, n) <-
- zip5 fvss xs rhss sizes [n_binds, n_binds-1 .. 1]
+ [ compile_bind d' fvs x rhs size arity n
+ | (fvs, x, rhs, size, arity, n) <-
+ zip6 fvss xs rhss sizes arities [n_binds, n_binds-1 .. 1]
]
in do
body_code <- schemeE d' s p' body
-- To do with the heap
| ALLOC_AP Int -- make an AP with this many payload words
| ALLOC_PAP Int Int -- make a PAP with this arity / payload words
- | MKAP Int{-ptr to AP/PAP is this far down stack-} Int{-# words-}
+ | MKAP Int{-ptr to AP is this far down stack-} Int{-# words-}
+ | MKPAP Int{-ptr to PAP is this far down stack-} Int{-# words-}
| UNPACK Int -- unpack N words from t.o.s Constr
| PACK DataCon Int
-- after assembly, the DataCon is an index into the
-- so can't use this info. Not that it matters much.
bciStackUse SLIDE{} = 0
bciStackUse MKAP{} = 0
+bciStackUse MKPAP{} = 0
bciStackUse PACK{} = 1 -- worst case is PACK 0 words
\end{code}
import SMRep ( typeCgRep )
import DataCon ( DataCon, dataConRepArgTys )
import TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
-import Constants ( mIN_SIZE_NonUpdHeapObject, wORD_SIZE )
+import Constants ( mIN_PAYLOAD_SIZE, wORD_SIZE )
import CgHeapery ( mkVirtHeapOffsets )
import FastString ( FastString(..) )
import Util ( lengthIs, listLengthCmp )
ptrs = ptr_wds
nptrs = tot_wds - ptr_wds
nptrs_really
- | ptrs + nptrs >= mIN_SIZE_NonUpdHeapObject = nptrs
- | otherwise = mIN_SIZE_NonUpdHeapObject - ptrs
+ | ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs
+ | otherwise = mIN_PAYLOAD_SIZE - ptrs
itbl = StgInfoTable {
ptrs = fromIntegral ptrs,
nptrs = fromIntegral nptrs_really,
mAX_SPEC_AP_SIZE = (MAX_SPEC_AP_SIZE :: Int)
-- closure sizes: these do NOT include the header (see below for header sizes)
-mIN_UPD_SIZE = (MIN_UPD_SIZE::Int)
-mIN_SIZE_NonUpdHeapObject = (MIN_NONUPD_SIZE::Int)
+mIN_PAYLOAD_SIZE = (MIN_PAYLOAD_SIZE::Int)
\end{code}
\begin{code}
opt_MaxContextReductionDepth,
opt_IrrefutableTuples,
opt_Parallel,
- opt_SMP,
opt_RuntimeTypes,
opt_Flatten,
opt_IrrefutableTuples = lookUp FSLIT("-firrefutable-tuples")
opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
opt_Parallel = lookUp FSLIT("-fparallel")
-opt_SMP = lookUp FSLIT("-fsmp")
opt_Flatten = lookUp FSLIT("-fflatten")
-- optimisation opts
"fdicts-strict",
"firrefutable-tuples",
"fparallel",
- "fsmp",
"fflatten",
"fsemi-tagging",
"flet-no-escape",
, "-optc-DGRAN"
, "-package concurrent" ]),
- (WaySMP, Way "s" False "SMP"
- [ "-fsmp"
+ (WaySMP, Way "s" True "SMP"
+ [
#if !defined(mingw32_TARGET_OS)
- , "-optc-pthread"
+ "-optc-pthread"
#endif
#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS)
, "-optl-pthread"
#endif
- , "-optc-DSMP" ]),
+ ]),
(WayNDP, Way "ndp" False "Nested data parallelism"
[ "-fparr"
#define bci_ALLOC_AP 27
#define bci_ALLOC_PAP 28
#define bci_MKAP 29
-#define bci_UNPACK 30
-#define bci_PACK 31
-#define bci_TESTLT_I 32
-#define bci_TESTEQ_I 33
-#define bci_TESTLT_F 34
-#define bci_TESTEQ_F 35
-#define bci_TESTLT_D 36
-#define bci_TESTEQ_D 37
-#define bci_TESTLT_P 38
-#define bci_TESTEQ_P 39
-#define bci_CASEFAIL 40
-#define bci_JMP 41
-#define bci_CCALL 42
-#define bci_SWIZZLE 43
-#define bci_ENTER 44
-#define bci_RETURN 45
-#define bci_RETURN_P 46
-#define bci_RETURN_N 47
-#define bci_RETURN_F 48
-#define bci_RETURN_D 49
-#define bci_RETURN_L 50
-#define bci_RETURN_V 51
+#define bci_MKPAP 30
+#define bci_UNPACK 31
+#define bci_PACK 32
+#define bci_TESTLT_I 33
+#define bci_TESTEQ_I 34
+#define bci_TESTLT_F 35
+#define bci_TESTEQ_F 36
+#define bci_TESTLT_D 37
+#define bci_TESTEQ_D 38
+#define bci_TESTLT_P 39
+#define bci_TESTEQ_P 40
+#define bci_CASEFAIL 41
+#define bci_JMP 42
+#define bci_CCALL 43
+#define bci_SWIZZLE 44
+#define bci_ENTER 45
+#define bci_RETURN 46
+#define bci_RETURN_P 47
+#define bci_RETURN_N 48
+#define bci_RETURN_F 49
+#define bci_RETURN_D 50
+#define bci_RETURN_L 51
+#define bci_RETURN_V 52
/* If a BCO definitely requires less than this many words of stack,
don't include an explicit STKCHECK insn in it. The interpreter
/* -----------------------------------------------------------------------------
The SMP header
-
- In SMP mode, we have an extra word of padding in a thunk's header.
- (Note: thunks only; other closures do not have this padding word).
+
+ 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 {
#endif
} StgHeader;
-/*
- * In SMP mode, 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.
- */
typedef struct {
const struct _StgInfoTable* info;
#ifdef PROFILING
#ifdef GRAN
StgGranHeader gran;
#endif
-#ifdef SMP
StgSMPThunkHeader smp;
-#endif
} StgThunkHeader;
+#define THUNK_EXTRA_HEADER_W (sizeofW(StgThunkHeader)-sizeofW(StgHeader))
+
/* -----------------------------------------------------------------------------
Closure Types
* the value from GHC, but it seems like too much trouble to do that
* for StgThunkHeader.
*/
-#ifdef SMP
#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
-#else
-#define SIZEOF_StgThunkHeader SIZEOF_StgHeader
-#endif
#define StgThunk_payload(__ptr__,__ix__) \
W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
/* -----------------------------------------------------------------------------
Minimum closure sizes
- Here we define the minimum size for updatable closures. All updates
- will be performed on closures of this size. For non-updatable closures
- the minimum size is 1 to allow for a forwarding pointer.
-
- When we used to keep the mutable list threaded through closures on
- the heap, MIN_UPD_SIZE used to be 2. Now it's 1.
-
- o MIN_UPD_SIZE doesn't apply to stack closures, static closures
- or non-updateable objects like PAPs or CONSTRs
- o MIN_UPD_SIZE is big enough to contain any of the following:
- o EVACUATED
- o BLACKHOLE
- o BLOCKING QUEUE
- o IND, IND_PERM, IND_OLDGEN and IND_OLDGEN_PERM
- (it need not be big enough for IND_STATIC - but it is)
- o MIN_NONUPD_SIZE doesn't apply to stack closures, static closures
- or updateable objects like APs, THUNKS or THUNK_SELECTORs
- o MIN_NONUPD_SIZE is big enough to contain any of the following:
- o EVACUATED
+ 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_UPD_SIZE 1
-#define MIN_NONUPD_SIZE 1
+#define MIN_PAYLOAD_SIZE 1
/* -----------------------------------------------------------------------------
Constants to do with specialised closure types.
{ return sizeofW(StgHeader) + p + np; }
INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void )
-{ return stg_max(sizeofW(StgHeader)+MIN_UPD_SIZE, sizeofW(StgSelector)); }
+{ return sizeofW(StgSelector); }
INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void )
-{ return sizeofW(StgHeader)+MIN_UPD_SIZE; }
+{ return sizeofW(StgHeader)+MIN_PAYLOAD_SIZE; }
/* --------------------------------------------------------------------------
Sizes of closures
INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco )
{ return bco->size; }
+STATIC_INLINE nat
+closure_sizeW_ (StgClosure *p, 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_SELECTOR:
+ return THUNK_SELECTOR_sizeW();
+ case AP_STACK:
+ return ap_stack_sizeW((StgAP_STACK *)p);
+ case AP:
+ case PAP:
+ return pap_sizeW((StgPAP *)p);
+ case IND:
+ case IND_PERM:
+ case IND_OLDGEN:
+ case IND_OLDGEN_PERM:
+ return sizeofW(StgInd);
+ case ARR_WORDS:
+ return arr_words_sizeW((StgArrWords *)p);
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
+ case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
+ return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+ case TSO:
+ return tso_sizeW((StgTSO *)p);
+ case BCO:
+ return bco_sizeW((StgBCO *)p);
+ case TVAR_WAIT_QUEUE:
+ return sizeofW(StgTVarWaitQueue);
+ case TVAR:
+ return sizeofW(StgTVar);
+ case TREC_CHUNK:
+ return sizeofW(StgTRecChunk);
+ case TREC_HEADER:
+ return sizeofW(StgTRecHeader);
+ default:
+ return sizeW_fromITBL(info);
+ }
+}
+
+STATIC_INLINE nat
+closure_sizeW (StgClosure *p)
+{
+ return closure_sizeW_(p, get_itbl(p));
+}
+
/* -----------------------------------------------------------------------------
Sizes of stack frames
-------------------------------------------------------------------------- */
printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%d)\n", size);
#endif
-#if defined(GEN_HASKELL)
-#define def_thunk_size(str, size) /* nothing */
-#else
-#define def_thunk_size(str, size) \
- printf("#define SIZEOF_" str " (SIZEOF_StgThunkHeader+%d)\n", size);
-#endif
-
#define struct_size(s_type) \
def_size(#s_type, sizeof(s_type));
def_closure_size(#s_type, sizeof(s_type) - sizeof(StgHeader));
#define thunk_size(s_type) \
- def_size(#s_type "_NoHdr", sizeof(s_type) - sizeof(StgHeader)); \
- def_thunk_size(#s_type, sizeof(s_type) - sizeof(StgHeader));
+ def_size(#s_type "_NoThunkHdr", sizeof(s_type) - sizeof(StgThunkHeader)); \
+ closure_size(s_type)
/* An access macro for use in C-- sources. */
#define closure_field_macro(str) \
printf("#define " str "(__ptr__) REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n");
-#define thunk_field_macro(str) \
- printf("#define " str "(__ptr__) REP_" str "[__ptr__+SIZEOF_StgThunkHeader+OFFSET_" str "]\n");
-
#define closure_field_offset_(str, s_type,field) \
def_offset(str, OFFSET(s_type,field) - sizeof(StgHeader));
-#define thunk_field_offset_(str, s_type, field) \
- closure_field_offset_(str, s_type, field)
-
#define closure_field_offset(s_type,field) \
closure_field_offset_(str(s_type,field),s_type,field)
-#define thunk_field_offset(s_type,field) \
- thunk_field_offset_(str(s_type,field),s_type,field)
-
#define closure_payload_macro(str) \
printf("#define " str "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n");
-#define thunk_payload_macro(str) \
- printf("#define " str "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgThunkHeader+OFFSET_" str " + WDS(__ix__)]\n");
-
#define closure_payload(s_type,field) \
closure_field_offset_(str(s_type,field),s_type,field); \
closure_payload_macro(str(s_type,field));
-#define thunk_payload(s_type,field) \
- thunk_field_offset_(str(s_type,field),s_type,field); \
- thunk_payload_macro(str(s_type,field));
-
/* Byte offset and MachRep for a closure field, minus the header */
#define closure_field(s_type, field) \
closure_field_offset(s_type,field) \
field_type(s_type, field); \
closure_field_macro(str(s_type,field))
-#define thunk_field(s_type, field) \
- thunk_field_offset(s_type,field) \
- field_type(s_type, field); \
- thunk_field_macro(str(s_type,field))
-
/* Byte offset and MachRep for a closure field, minus the header */
#define closure_field_(str, s_type, field) \
closure_field_offset_(str,s_type,field) \
field_type_(str, s_type, field); \
closure_field_macro(str)
-#define thunk_field_(str, s_type, field) \
- thunk_field_offset_(str,s_type,field) \
- field_type_(str, s_type, field); \
- thunk_field_macro(str)
-
/* Byte offset for a TSO field, minus the header and variable prof bit. */
#define tso_payload_offset(s_type, field) \
def_offset(str(s_type,field), OFFSET(s_type,field) - sizeof(StgHeader) - sizeof(StgTSOProfInfo));
closure_field(StgPAP, arity);
closure_payload(StgPAP, payload);
- closure_size(StgAP);
+ thunk_size(StgAP);
closure_field(StgAP, n_args);
closure_field(StgAP, fun);
closure_payload(StgAP, payload);
thunk_size(StgAP_STACK);
- thunk_field(StgAP_STACK, size);
- thunk_field(StgAP_STACK, fun);
- thunk_payload(StgAP_STACK, payload);
+ closure_field(StgAP_STACK, size);
+ closure_field(StgAP_STACK, fun);
+ closure_payload(StgAP_STACK, payload);
closure_field(StgInd, indirectee);
// Reload the stack
W_ i;
W_ p;
- p = ap + SIZEOF_StgThunkHeader + OFFSET_StgAP_STACK_payload;
+ p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
i = 0;
for:
if (i < Words) {
SET_EVACUAEE_FOR_LDV(src, size_to_reserve);
// fill the slop
if (size_to_reserve - size_to_copy_org > 0)
- FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org));
+ LDV_FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org));
#endif
return (StgClosure *)dest;
}
}
case BLOCKED_FETCH:
- ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE);
+ ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOD_SIZE);
to = copy(q,sizeofW(StgBlockedFetch),stp);
IF_DEBUG(gc,
debugBelch("@@ evacuate: %p (%s) to %p (%s)",
case REMOTE_REF:
# endif
case FETCH_ME:
- ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
+ ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE);
to = copy(q,sizeofW(StgFetchMe),stp);
IF_DEBUG(gc,
debugBelch("@@ evacuate: %p (%s) to %p (%s)",
return to;
case FETCH_ME_BQ:
- ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
+ ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE);
to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp);
IF_DEBUG(gc,
debugBelch("@@ evacuate: %p (%s) to %p (%s)",
// already scavenged?
if (is_marked(oldgen_scan+1,oldgen_scan_bd)) {
- oldgen_scan += sizeofW(StgHeader) + MIN_NONUPD_SIZE;
+ oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE;
goto loop;
}
push_mark_stack(oldgen_scan);
// ToDo: bump the linear scan by the actual size of the object
- oldgen_scan += sizeofW(StgHeader) + MIN_NONUPD_SIZE;
+ oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE;
goto linear_scan;
}
}
}
-STATIC_INLINE nat
-obj_sizeW( StgClosure *p, 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_SELECTOR:
- return THUNK_SELECTOR_sizeW();
- case AP_STACK:
- return ap_stack_sizeW((StgAP_STACK *)p);
- case AP:
- case PAP:
- return pap_sizeW((StgPAP *)p);
- case ARR_WORDS:
- return arr_words_sizeW((StgArrWords *)p);
- case MUT_ARR_PTRS_CLEAN:
- case MUT_ARR_PTRS_DIRTY:
- case MUT_ARR_PTRS_FROZEN:
- case MUT_ARR_PTRS_FROZEN0:
- return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
- case TSO:
- return tso_sizeW((StgTSO *)p);
- case BCO:
- return bco_sizeW((StgBCO *)p);
- case TVAR_WAIT_QUEUE:
- return sizeofW(StgTVarWaitQueue);
- case TVAR:
- return sizeofW(StgTVar);
- case TREC_CHUNK:
- return sizeofW(StgTRecChunk);
- case TREC_HEADER:
- return sizeofW(StgTRecHeader);
- default:
- return sizeW_fromITBL(info);
- }
-}
-
static void
thread_static( StgClosure* p )
{
unthread(p,free);
ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
info = get_itbl((StgClosure *)p);
- size = obj_sizeW((StgClosure *)p,info);
+ size = closure_sizeW_((StgClosure *)p,info);
if (free != p) {
move(free,p,size);
STATIC_INLINE StgPtr
-allocate_UPD (int n_words)
-{
- return allocate(stg_max(sizeofW(StgHeader)+MIN_UPD_SIZE, n_words));
-}
-
-STATIC_INLINE StgPtr
allocate_NONUPD (int n_words)
{
- return allocate(stg_max(sizeofW(StgHeader)+MIN_NONUPD_SIZE, n_words));
+ return allocate(stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
}
else /* arity > n */ {
// build a new PAP and return it.
StgPAP *new_pap;
- nat size;
- size = PAP_sizeW(pap->n_args + m);
- new_pap = (StgPAP *)allocate(size);
+ new_pap = (StgPAP *)allocate(PAP_sizeW(pap->n_args + m));
SET_HDR(new_pap,&stg_PAP_info,CCCS);
new_pap->arity = pap->arity - n;
new_pap->n_args = pap->n_args + m;
else /* arity > n */ {
// build a PAP and return it.
StgPAP *pap;
- nat size, i;
- size = PAP_sizeW(m);
- pap = (StgPAP *)allocate(size);
+ nat i;
+ pap = (StgPAP *)allocate(PAP_sizeW(m));
SET_HDR(pap, &stg_PAP_info,CCCS);
pap->arity = arity - n;
pap->fun = obj;
case bci_ALLOC_AP: {
StgAP* ap;
int n_payload = BCO_NEXT;
- int request = PAP_sizeW(n_payload);
- ap = (StgAP*)allocate_UPD(request);
+ ap = (StgAP*)allocate(AP_sizeW(n_payload));
Sp[-1] = (W_)ap;
ap->n_args = n_payload;
SET_HDR(ap, &stg_AP_info, CCS_SYSTEM/*ToDo*/)
StgPAP* pap;
int arity = BCO_NEXT;
int n_payload = BCO_NEXT;
- int request = PAP_sizeW(n_payload);
- pap = (StgPAP*)allocate_NONUPD(request);
+ pap = (StgPAP*)allocate(PAP_sizeW(n_payload));
Sp[-1] = (W_)pap;
pap->n_args = n_payload;
pap->arity = arity;
StgAP* ap = (StgAP*)Sp[stkoff];
ASSERT((int)ap->n_args == n_payload);
ap->fun = (StgClosure*)Sp[0];
-
+
// The function should be a BCO, and its bitmap should
// cover the payload of the AP correctly.
ASSERT(get_itbl(ap->fun)->type == BCO
- && (get_itbl(ap)->type == PAP ||
- BCO_BITMAP_SIZE(ap->fun) == ap->n_args));
-
+ && BCO_BITMAP_SIZE(ap->fun) == ap->n_args);
+
for (i = 0; i < n_payload; i++)
ap->payload[i] = (StgClosure*)Sp[i+1];
Sp += n_payload+1;
goto nextInsn;
}
+ case bci_MKPAP: {
+ int i;
+ int stkoff = BCO_NEXT;
+ int n_payload = BCO_NEXT;
+ StgPAP* pap = (StgPAP*)Sp[stkoff];
+ ASSERT((int)pap->n_args == n_payload);
+ pap->fun = (StgClosure*)Sp[0];
+
+ // The function should be a BCO
+ ASSERT(get_itbl(pap->fun)->type == BCO);
+
+ for (i = 0; i < n_payload; i++)
+ pap->payload[i] = (StgClosure*)Sp[i+1];
+ Sp += n_payload+1;
+ IF_DEBUG(interpreter,
+ debugBelch("\tBuilt ");
+ printObj((StgClosure*)pap);
+ );
+ goto nextInsn;
+ }
+
case bci_UNPACK: {
/* Unpack N ptr words from t.o.s constructor */
int i;
LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
{
StgInfoTable *info;
- nat nw, i;
+ nat size, i;
#if defined(__GNUC__) && __GNUC__ < 3 && defined(DEBUG)
#error Please use gcc 3.0+ to compile this file with DEBUG; gcc < 3.0 miscompiles it
#endif
if (era > 0) {
- info = get_itbl((p));
- switch (info->type) {
- case THUNK_1_0:
- case THUNK_0_1:
- nw = stg_max(MIN_UPD_SIZE,1);
- break;
+ // very like FILL_SLOP(), except that we call LDV_recordDead().
+ size = closure_sizeW(p);
- case THUNK_2_0:
- case THUNK_1_1:
- case THUNK_0_2:
- case THUNK_SELECTOR:
- nw = stg_max(MIN_UPD_SIZE,2);
- break;
+ LDV_recordDead((StgClosure *)(p), size);
- case THUNK:
- nw = stg_max(info->layout.payload.ptrs + info->layout.payload.nptrs,
- MIN_UPD_SIZE);
- break;
- case AP:
- nw = sizeofW(StgAP) - sizeofW(StgThunkHeader) + ((StgPAP *)p)->n_args;
- break;
- case AP_STACK:
- nw = sizeofW(StgAP_STACK) - sizeofW(StgThunkHeader)
- + ((StgAP_STACK *)p)->size;
- break;
- case CAF_BLACKHOLE:
- case BLACKHOLE:
- case SE_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
- nw = info->layout.payload.ptrs + info->layout.payload.nptrs;
- break;
- default:
- barf("Unexpected closure type %u in LDV_recordDead_FILL_SLOP_DYNAMIC()", info->type);
- break;
- }
- LDV_recordDead((StgClosure *)(p), nw + sizeofW(StgHeader));
- for (i = 0; i < nw; i++) {
- ((StgClosure *)(p))->payload[i] = 0;
+ if (size > sizeofW(StgThunkHeader)) {
+ for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
+ ((StgThunk *)(p))->payload[i] = 0;
+ }
}
}
}
));
}
+ if (info->type == EVACUATED) {
+ // The size of the evacuated closure is currently stored in
+ // the LDV field. See SET_EVACUAEE_FOR_LDV() in
+ // includes/StgLdvProf.h.
+ return LDVW(c);
+ }
+
+ size = closure_sizeW(c);
+
switch (info->type) {
/*
'inherently used' cases: do nothing.
*/
-
case TSO:
- size = tso_sizeW((StgTSO *)c);
- return size;
-
case MVAR:
- size = sizeofW(StgMVar);
- return size;
-
case MUT_ARR_PTRS_CLEAN:
case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
- size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
- return size;
-
case ARR_WORDS:
- size = arr_words_sizeW((StgArrWords *)c);
- return size;
-
case WEAK:
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
case BCO:
case STABLE_NAME:
- size = sizeW_fromITBL(info);
return size;
/*
ordinary cases: call LDV_recordDead().
*/
-
case THUNK:
- size = stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
- break;
-
case THUNK_1_0:
case THUNK_0_1:
case THUNK_SELECTOR:
- size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE, 1);
- break;
-
case THUNK_2_0:
case THUNK_1_1:
case THUNK_0_2:
- size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE, 2);
- break;
-
case AP:
- size = ap_sizeW((StgAP *)c);
- break;
-
case PAP:
- size = pap_sizeW((StgPAP *)c);
- break;
-
case AP_STACK:
- size = ap_stack_sizeW((StgAP_STACK *)c);
- break;
-
case CONSTR:
case CONSTR_1_0:
case CONSTR_0_1:
case CONSTR_2_0:
case CONSTR_1_1:
case CONSTR_0_2:
-
case FUN:
case FUN_1_0:
case FUN_0_1:
case FUN_2_0:
case FUN_1_1:
case FUN_0_2:
-
case BLACKHOLE:
case SE_BLACKHOLE:
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
- size = sizeW_fromITBL(info);
- break;
-
case IND_PERM:
case IND_OLDGEN_PERM:
- size = sizeofW(StgInd);
- break;
-
/*
'Ingore' cases
*/
// rate.
case IND:
case IND_OLDGEN:
- size = sizeofW(StgInd);
+ // Found a dead closure: record its size
+ LDV_recordDead(c, size);
return size;
- case EVACUATED:
- // The size of the evacuated closure is currently stored in
- // the LDV field. See SET_EVACUAEE_FOR_LDV() in
- // includes/StgLdvProf.h.
- return LDVW(c);
-
/*
Error case
*/
barf("Invalid object in processHeapClosureForDead(): %d", info->type);
return 0;
}
-
- // Found a dead closure: record its size
- LDV_recordDead(c, size);
- return size;
}
/* --------------------------------------------------------------------------
// Invoked when:
// 1) Hp is incremented and exceeds HpLim (in Updates.hc).
// 2) copypart() is called (in GC.c).
-#define FILL_SLOP(from, howManyBackwards) \
+#define LDV_FILL_SLOP(from, howManyBackwards) \
if (era > 0) { \
int i; \
for (i = 0;i < (howManyBackwards); i++) \
#include "RtsUtils.h"
#include "Schedule.h"
#include "Storage.h"
+#include "Sparks.h"
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
SymX(newTVarzh_fast) \
SymX(atomicModifyMutVarzh_fast) \
SymX(newPinnedByteArrayzh_fast) \
+ SymX(newSpark) \
SymX(orIntegerzh_fast) \
SymX(performGC) \
SymX(performMajorGC) \
case THUNK_1_1:
case THUNK_0_2:
case THUNK_2_0:
- size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE,2);
+ size = sizeofW(StgThunkHeader) + 2;
break;
case THUNK_1_0:
case THUNK_0_1:
case THUNK_SELECTOR:
- size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE,1);
+ size = sizeofW(StgThunkHeader) + 1;
break;
case CONSTR:
case CONSTR_2_0:
size = sizeW_fromITBL(info);
break;
-
+
case IND:
// Special case/Delicate Hack: INDs don't normally
// appear, since we're doing this heap census right
// debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
}
- info = get_itbl(c);
- switch (info->type) {
- case TSO:
- return tso_sizeW((StgTSO *)c);
-
- case THUNK:
- case THUNK_1_0:
- case THUNK_0_1:
- case THUNK_2_0:
- case THUNK_1_1:
- case THUNK_0_2:
- return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
-
- case MVAR:
- return sizeofW(StgMVar);
-
- case MUT_ARR_PTRS_CLEAN:
- case MUT_ARR_PTRS_DIRTY:
- case MUT_ARR_PTRS_FROZEN:
- case MUT_ARR_PTRS_FROZEN0:
- return mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
-
- case AP:
- case PAP:
- return pap_sizeW((StgPAP *)c);
-
- case AP:
- return ap_stack_sizeW((StgAP_STACK *)c);
-
- case ARR_WORDS:
- return arr_words_sizeW((StgArrWords *)c);
-
- case CONSTR:
- case CONSTR_1_0:
- case CONSTR_0_1:
- case CONSTR_2_0:
- case CONSTR_1_1:
- case CONSTR_0_2:
- case FUN:
- case FUN_1_0:
- case FUN_0_1:
- case FUN_2_0:
- case FUN_1_1:
- case FUN_0_2:
- case WEAK:
- case MUT_VAR_CLEAN:
- case MUT_VAR_DIRTY:
- case CAF_BLACKHOLE:
- case BLACKHOLE:
- case SE_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
- case IND_PERM:
- case IND_OLDGEN:
- case IND_OLDGEN_PERM:
- case BCO:
- case STABLE_NAME:
- return sizeW_fromITBL(info);
-
- case THUNK_SELECTOR:
- return sizeofW(StgHeader) + MIN_UPD_SIZE;
-
- /*
- Error case
- */
- case IND_STATIC:
- case CONSTR_STATIC:
- case FUN_STATIC:
- case THUNK_STATIC:
- case CONSTR_INTLIKE:
- case CONSTR_CHARLIKE:
- case CONSTR_NOCAF_STATIC:
- case UPDATE_FRAME:
- case CATCH_FRAME:
- case STOP_FRAME:
- case RET_DYN:
- case RET_BCO:
- case RET_SMALL:
- case RET_VEC_SMALL:
- case RET_BIG:
- case RET_VEC_BIG:
- case IND:
- case BLOCKED_FETCH:
- case FETCH_ME:
- case FETCH_ME_BQ:
- case RBH:
- case REMOTE_REF:
- case EVACUATED:
- case INVALID_OBJECT:
- default:
- barf("Invalid object in sanityCheckHeapClosure(): %d",
- get_itbl(c)->type);
- return 0;
- }
+ return closure_sizeW(c);
}
static nat
/* -----------------------------------------------------------------------------
*
- * (c) The GHC Team, 1998-2001
+ * (c) The GHC Team, 1998-2006
*
* Sanity checking code for the heap and stack.
*
for (i = 0; i < info->layout.payload.ptrs; i++) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgThunk *)p)->payload[i]));
}
- return stg_max(thunk_sizeW_fromITBL(info), sizeofW(StgHeader)+MIN_UPD_SIZE);
+ return thunk_sizeW_fromITBL(info);
}
case FUN:
*/
StgInd *ind = (StgInd *)p;
ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee));
- return sizeofW(StgHeader) + MIN_UPD_SIZE;
+ return sizeofW(StgInd);
}
case RET_BCO:
while (p < bd->free) {
nat size = checkClosure((StgClosure *)p);
/* This is the smallest size of closure that can live in the heap */
- ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
+ ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
p += size;
/* skip over slop */
size = sizeofW(StgFetchMe);
} else if (get_itbl((StgClosure*)p)->type == IND) {
*(p+2) = 0x0000ee11; /* mark slop in IND as garbage */
- size = MIN_UPD_SIZE;
+ size = sizeofW(StgInd);
} else {
size = checkClosure((StgClosure *)p);
/* This is the smallest size of closure that can live in the heap. */
- ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
+ ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
}
}
}
ASSERT(LOOKS_LIKE_INFO_PTR((void*)*p));
size = checkClosure((StgClosure *)p);
/* This is the smallest size of closure that can live in the heap. */
- ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
+ ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
}
}
#endif
// we've got an exception to raise, so let's pass it to the
// handler in this frame.
//
- raise = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+MIN_UPD_SIZE);
+ raise = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
TICK_ALLOC_SE_THK(1,0);
SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs);
raise->payload[0] = exception;
// thunks which are currently under evaluataion.
//
- //
+ // OLD COMMENT (we don't have MIN_UPD_SIZE now):
// LDV profiling: stg_raise_info has THUNK as its closure
// type. Since a THUNK takes at least MIN_UPD_SIZE words in its
// payload, MIN_UPD_SIZE is more approprate than 1. It seems that
// Only create raise_closure if we need to.
if (raise_closure == NULL) {
raise_closure =
- (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+MIN_UPD_SIZE);
+ (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
SET_HDR(raise_closure, &stg_raise_info, CCCS);
raise_closure->payload[0] = exception;
}
return 1;
}
+#else
+
+StgInt
+newSpark (StgRegTable *reg, StgClosure *p)
+{
+ /* nothing */
+ return 1;
+}
+
#endif /* PARALLEL_HASKELL || SMP */
+
/* -----------------------------------------------------------------------------
*
* GRAN & PARALLEL_HASKELL stuff beyond here.
#ifndef SPARKS_H
#define SPARKS_H
+#if !defined(GRAN)
+StgInt newSpark (StgRegTable *reg, StgClosure *p);
+#endif
+
#if defined(PARALLEL_HASKELL) || defined(SMP)
StgClosure * findSpark (Capability *cap);
void initSparkPools (void);
void markSparkQueue (evac_fn evac);
void createSparkThread (Capability *cap, StgClosure *p);
-StgInt newSpark (StgRegTable *reg, StgClosure *p);
INLINE_HEADER void discardSparks (StgSparkPool *pool);
INLINE_HEADER nat sparkPoolSize (StgSparkPool *pool);
* the slop in one of the threads would have a disastrous effect on
* the other (seen in the wild!).
*/
-#if !defined(DEBUG) || defined(SMP)
-
-#define DEBUG_FILL_SLOP(p) /* nothing */
-
-#else /* DEBUG */
-
#ifdef CMINUSMINUS
-#define DEBUG_FILL_SLOP(p) \
+#define FILL_SLOP(p) \
W_ inf; \
W_ sz; \
W_ i; \
inf = %GET_STD_INFO(p); \
- if (%INFO_TYPE(inf) != HALF_W_(THUNK_SELECTOR)) { \
- if (%INFO_TYPE(inf) != HALF_W_(BLACKHOLE)) { \
+ if (%INFO_TYPE(inf) != HALF_W_(THUNK_SELECTOR) \
+ && %INFO_TYPE(inf) != HALF_W_(BLACKHOLE) \
+ && %INFO_TYPE(inf) != HALF_W_(CAF_BLACKHOLE)) { \
if (%INFO_TYPE(inf) == HALF_W_(AP_STACK)) { \
- sz = StgAP_STACK_size(p) + BYTES_TO_WDS(SIZEOF_StgAP_STACK_NoHdr); \
+ sz = StgAP_STACK_size(p) + BYTES_TO_WDS(SIZEOF_StgAP_STACK_NoThunkHdr); \
} else { \
- sz = TO_W_(%INFO_PTRS(inf)) + TO_W_(%INFO_NPTRS(inf)); \
+ if (%INFO_TYPE(inf) == HALF_W_(AP)) { \
+ sz = TO_W_(StgAP_n_args(p)) + BYTES_TO_WDS(SIZEOF_StgAP_NoThunkHdr); \
+ } else { \
+ sz = TO_W_(%INFO_PTRS(inf)) + TO_W_(%INFO_NPTRS(inf)); \
+ } \
} \
- i = 1; /* skip over indirectee */ \
+ i = 0; \
for: \
if (i < sz) { \
StgThunk_payload(p,i) = 0; \
i = i + 1; \
goto for; \
} \
- } }
+ }
#else /* !CMINUSMINUS */
INLINE_HEADER void
-DEBUG_FILL_SLOP(StgClosure *p)
+FILL_SLOP(StgClosure *p)
{
StgInfoTable *inf = get_itbl(p);
nat i, sz;
switch (inf->type) {
case BLACKHOLE:
+ case CAF_BLACKHOLE:
case THUNK_SELECTOR:
return;
+ case AP:
+ sz = ((StgAP *)p)->n_args + sizeofW(StgAP) - sizeofW(StgThunkHeader);
+ break;
case AP_STACK:
- sz = ((StgAP_STACK *)p)->size + sizeofW(StgAP_STACK) - sizeofW(StgHeader);
+ sz = ((StgAP_STACK *)p)->size + sizeofW(StgAP_STACK) - sizeofW(StgThunkHeader);
break;
default:
sz = inf->layout.payload.ptrs + inf->layout.payload.nptrs;
break;
}
- // start at one to skip over the indirectee
- for (i = 1; i < sz; i++) {
+ for (i = 0; i < sz; i++) {
((StgThunk *)p)->payload[i] = 0;
}
}
#endif /* CMINUSMINUS */
-#endif /* DEBUG */
+
+#if !defined(DEBUG) || defined(SMP)
+#define DEBUG_FILL_SLOP(p) /* do nothing */
+#else
+#define DEBUG_FILL_SLOP(p) FILL_SLOP(p)
+#endif
/* We have two versions of this macro (sadly), one for use in C-- code,
* and the other for C.
#
# thr : threaded
# thr_p : threaded profiled
+# s : smp
# debug : debugging (compile with -g for the C compiler, and -DDEBUG)
# debug_p : debugging profiled
+# debug_s : debugging smp
# debug_u : debugging unregisterised
# thr_debug : debugging threaded
# thr_debug_p : debugging threaded profiled
ifeq "$(BootingFromHc)" "YES"
GhcRTSWays=
else
-GhcRTSWays=thr thr_p debug thr_debug
+GhcRTSWays=thr thr_p s debug debug_s thr_debug
endif
# Option flags to pass to GHC when it's compiling modules in
WAY_u_NAME=unregisterized (using portable C only)
WAY_u_HC_OPTS=-unreg
-# Way `s':
-WAY_s_NAME=threads (for SMP)
-WAY_s_HC_OPTS=-smp -optc-DTHREADED_RTS
-
# Way `mp':
WAY_mp_NAME=parallel
WAY_mp_HC_OPTS=-parallel
WAY_thr_p_NAME=threaded profiled
WAY_thr_p_HC_OPTS=-optc-DTHREADED_RTS -prof
+# Way `s':
+WAY_s_NAME=threads (for SMP)
+WAY_s_HC_OPTS=-optc-DSMP -optc-DTHREADED_RTS
+
# Way 'debug':
WAY_debug_NAME=debug
WAY_debug_HC_OPTS=-optc-DDEBUG
# Way 'debug_s':
WAY_debug_s_NAME=debug SMP
-WAY_debug_s_HC_OPTS=-optc-DDEBUG -optc-DTHREADED_RTS -smp
+WAY_debug_s_HC_OPTS=-optc-DDEBUG -optc-DTHREADED_RTS -optc-DSMP
# Way 'thr_debug':
WAY_thr_debug_NAME=threaded
projects / ghc-hetmet.git / commitdiff