Skip to content

GitLab

Commit 72bfc815 authored by dterei's avatar dterei
Browse files

Merge branch 'master' of http://darcs.haskell.org/ghc

parents 590988bd 8b48562e
Hide whitespace changes
Inline Side-by-side
compiler/codeGen/CgPrimOp.hs
View file @ 72bfc815
......@@ -241,7 +241,10 @@ emitPrimOp [res] DataToTagOp [arg] _
-- }
emitPrimOp [res] UnsafeFreezeArrayOp [arg] _
= stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
CmmAssign (CmmLocal res) arg ]
CmmAssign (CmmLocal res) arg ]
emitPrimOp [res] UnsafeFreezeArrayArrayOp [arg] _
= stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
CmmAssign (CmmLocal res) arg ]
-- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] _
......@@ -260,16 +263,37 @@ emitPrimOp [res] FreezeArrayOp [src,src_off,n] live =
emitPrimOp [res] ThawArrayOp [src,src_off,n] live =
emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n live
emitPrimOp [] CopyArrayArrayOp [src,src_off,dst,dst_off,n] live =
doCopyArrayOp src src_off dst dst_off n live
emitPrimOp [] CopyMutableArrayArrayOp [src,src_off,dst,dst_off,n] live =
doCopyMutableArrayOp src src_off dst dst_off n live
-- Reading/writing pointer arrays
emitPrimOp [r] ReadArrayOp [obj,ix] _ = doReadPtrArrayOp r obj ix
emitPrimOp [r] IndexArrayOp [obj,ix] _ = doReadPtrArrayOp r obj ix
emitPrimOp [] WriteArrayOp [obj,ix,v] _ = doWritePtrArrayOp obj ix v
emitPrimOp [r] IndexArrayArrayOp_ByteArray [obj,ix] _ = doReadPtrArrayOp r obj ix
emitPrimOp [r] IndexArrayArrayOp_ArrayArray [obj,ix] _ = doReadPtrArrayOp r obj ix
emitPrimOp [r] ReadArrayArrayOp_ByteArray [obj,ix] _ = doReadPtrArrayOp r obj ix
emitPrimOp [r] ReadArrayArrayOp_MutableByteArray [obj,ix] _ = doReadPtrArrayOp r obj ix
emitPrimOp [r] ReadArrayArrayOp_ArrayArray [obj,ix] _ = doReadPtrArrayOp r obj ix
emitPrimOp [r] ReadArrayArrayOp_MutableArrayArray [obj,ix] _ = doReadPtrArrayOp r obj ix
emitPrimOp [] WriteArrayArrayOp_ByteArray [obj,ix,v] _ = doWritePtrArrayOp obj ix v
emitPrimOp [] WriteArrayArrayOp_MutableByteArray [obj,ix,v] _ = doWritePtrArrayOp obj ix v
emitPrimOp [] WriteArrayArrayOp_ArrayArray [obj,ix,v] _ = doWritePtrArrayOp obj ix v
emitPrimOp [] WriteArrayArrayOp_MutableArrayArray [obj,ix,v] _ = doWritePtrArrayOp obj ix v
emitPrimOp [res] SizeofArrayOp [arg] _
= stmtC $ CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
= stmtC $
CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
emitPrimOp [res] SizeofMutableArrayOp [arg] live
= emitPrimOp [res] SizeofArrayOp [arg] live
emitPrimOp [res] SizeofArrayArrayOp [arg] live
= emitPrimOp [res] SizeofArrayOp [arg] live
emitPrimOp [res] SizeofMutableArrayArrayOp [arg] live
= emitPrimOp [res] SizeofArrayOp [arg] live
-- IndexXXXoffAddr
......@@ -565,6 +589,7 @@ translateOp SameMutVarOp = Just mo_wordEq
translateOp SameMVarOp = Just mo_wordEq
translateOp SameMutableArrayOp = Just mo_wordEq
translateOp SameMutableByteArrayOp = Just mo_wordEq
translateOp SameMutableArrayArrayOp= Just mo_wordEq
translateOp SameTVarOp = Just mo_wordEq
translateOp EqStablePtrOp = Just mo_wordEq
......
compiler/codeGen/StgCmmPrim.hs
View file @ 72bfc815
......@@ -307,8 +307,12 @@ emitPrimOp [res] DataToTagOp [arg]
-- }
emitPrimOp [res] UnsafeFreezeArrayOp [arg]
= emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
mkAssign (CmmLocal res) arg ]
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
mkAssign (CmmLocal res) arg ]
emitPrimOp [res] UnsafeFreezeArrayArrayOp [arg]
= emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
mkAssign (CmmLocal res) arg ]
-- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
emitPrimOp [res] UnsafeFreezeByteArrayOp [arg]
......@@ -626,6 +630,7 @@ translateOp SameMutVarOp = Just mo_wordEq
translateOp SameMVarOp = Just mo_wordEq
translateOp SameMutableArrayOp = Just mo_wordEq
translateOp SameMutableByteArrayOp = Just mo_wordEq
translateOp SameMutableArrayArrayOp= Just mo_wordEq
translateOp SameTVarOp = Just mo_wordEq
translateOp EqStablePtrOp = Just mo_wordEq
......
compiler/iface/FlagChecker.hs
View file @ 72bfc815
......@@ -13,6 +13,7 @@ import HscTypes
import Name
import Fingerprint
-- import Outputable
import StaticFlags
import qualified Data.IntSet as IntSet
import System.FilePath (normalise)
......@@ -42,6 +43,9 @@ fingerprintDynFlags DynFlags{..} nameio =
[ objectSuf, hcSuf, hiSuf ],
[ objectDir, hiDir, stubDir, outputFile, outputHi ])
-- -fprof-auto etc.
prof = if opt_SccProfilingOn then fromEnum profAuto else 0
in -- pprTrace "flags" (ppr (mainis, safeHs, lang, cpp, paths)) $
computeFingerprint nameio (mainis, safeHs, lang, cpp, paths)
computeFingerprint nameio (mainis, safeHs, lang, cpp, paths, prof)
compiler/main/DynFlags.hs
View file @ 72bfc815
......@@ -590,6 +590,7 @@ data ProfAuto
| ProfAutoTop -- ^ top-level functions annotated only
| ProfAutoExports -- ^ exported functions annotated only
| ProfAutoCalls -- ^ annotate call-sites
deriving (Enum)
data Settings = Settings {
sTargetPlatform :: Platform, -- Filled in by SysTools
......
compiler/prelude/PrelNames.lhs
View file @ 72bfc815
......@@ -1145,14 +1145,14 @@ selectorClassKey = mkPreludeClassUnique 41
%************************************************************************
\begin{code}
addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey,
addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey,
charPrimTyConKey, charTyConKey, doublePrimTyConKey, doubleTyConKey,
floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey,
intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey,
int32TyConKey, int64PrimTyConKey, int64TyConKey,
integerTyConKey, digitsTyConKey,
listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey,
mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey,
realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey,
anyTyConKey, eqTyConKey :: Unique
......@@ -1191,6 +1191,8 @@ stablePtrPrimTyConKey = mkPreludeTyConUnique 35
stablePtrTyConKey = mkPreludeTyConUnique 36
anyTyConKey = mkPreludeTyConUnique 37
eqTyConKey = mkPreludeTyConUnique 38
arrayArrayPrimTyConKey = mkPreludeTyConUnique 39
mutableArrayArrayPrimTyConKey = mkPreludeTyConUnique 40
statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
mutVarPrimTyConKey, ioTyConKey,
......
compiler/prelude/TysPrim.lhs
View file @ 72bfc815
......@@ -52,11 +52,13 @@ module TysPrim(
statePrimTyCon, mkStatePrimTy,
realWorldTyCon, realWorldTy, realWorldStatePrimTy,
arrayPrimTyCon, mkArrayPrimTy,
byteArrayPrimTyCon, byteArrayPrimTy,
mutableArrayPrimTyCon, mkMutableArrayPrimTy,
mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
mutVarPrimTyCon, mkMutVarPrimTy,
arrayPrimTyCon, mkArrayPrimTy,
byteArrayPrimTyCon, byteArrayPrimTy,
arrayArrayPrimTyCon, mkArrayArrayPrimTy,
mutableArrayPrimTyCon, mkMutableArrayPrimTy,
mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
mutVarPrimTyCon, mkMutVarPrimTy,
mVarPrimTyCon, mkMVarPrimTy,
tVarPrimTyCon, mkTVarPrimTy,
......@@ -105,6 +107,7 @@ primTyCons
= [ addrPrimTyCon
, arrayPrimTyCon
, byteArrayPrimTyCon
, arrayArrayPrimTyCon
, charPrimTyCon
, doublePrimTyCon
, floatPrimTyCon
......@@ -115,6 +118,7 @@ primTyCons
, weakPrimTyCon
, mutableArrayPrimTyCon
, mutableByteArrayPrimTyCon
, mutableArrayArrayPrimTyCon
, mVarPrimTyCon
, tVarPrimTyCon
, mutVarPrimTyCon
......@@ -145,7 +149,7 @@ mkPrimTc fs unique tycon
(ATyCon tycon) -- Relevant TyCon
UserSyntax -- None are built-in syntax
charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, realWorldTyConName, arrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName :: Name
charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName :: Name
charPrimTyConName = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
intPrimTyConName = mkPrimTc (fsLit "Int#") intPrimTyConKey intPrimTyCon
int32PrimTyConName = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
......@@ -161,8 +165,10 @@ eqPrimTyConName = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
realWorldTyConName = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
arrayPrimTyConName = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
byteArrayPrimTyConName = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
arrayArrayPrimTyConName = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
mutableArrayPrimTyConName = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
mutVarPrimTyConName = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
mVarPrimTyConName = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
tVarPrimTyConName = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
......@@ -488,20 +494,26 @@ defined in \tr{TysWiredIn.lhs}, not here.
\begin{code}
arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
byteArrayPrimTyCon :: TyCon
arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName 1 PtrRep
mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName 2 PtrRep
mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName 1 PtrRep
byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep
byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon :: TyCon
arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName 1 PtrRep
mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName 2 PtrRep
mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName 1 PtrRep
byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep
arrayArrayPrimTyCon = pcPrimTyCon0 arrayArrayPrimTyConName PtrRep
mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName 1 PtrRep
mkArrayPrimTy :: Type -> Type
mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt]
byteArrayPrimTy :: Type
byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon
mkArrayArrayPrimTy :: Type
mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
mkMutableArrayPrimTy :: Type -> Type -> Type
mkMutableArrayPrimTy s elt = mkTyConApp mutableArrayPrimTyCon [s, elt]
mkMutableByteArrayPrimTy :: Type -> Type
mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s]
mkMutableArrayArrayPrimTy :: Type -> Type
mkMutableArrayArrayPrimTy s = mkTyConApp mutableArrayArrayPrimTyCon [s]
\end{code}
%************************************************************************
......
compiler/prelude/primops.txt.pp
View file @ 72bfc815
......@@ -733,7 +733,7 @@ section "Byte Arrays"
index for reading from immutable byte arrays, and read/write
for mutable byte arrays. Each set contains operations for a
range of useful primitive data types. Each operation takes
an offset measured in terms of the size fo the primitive type
an offset measured in terms of the size of the primitive type
being read or written.}
------------------------------------------------------------------------
......@@ -1019,7 +1019,7 @@ primop CopyByteArrayOp "copyByteArray#" GenPrimOp
The two arrays must not be the same array in different states, but this is not checked either.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall }
code_size = { primOpCodeSizeForeignCall + 4}
can_fail = True
primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp
......@@ -1028,6 +1028,113 @@ primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp
Both arrays must fully contain the specified ranges, but this is not checked.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
can_fail = True
------------------------------------------------------------------------
section "Arrays of arrays"
{Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed}
arrays, such as {\tt ByteArray\#s}. Hence, it is not parameterised by the element types,
just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array#}.
We represent an {\tt ArrayArray\#} exactly as a {\tt Array\#}, but provide element-type-specific
indexing, reading, and writing.}
------------------------------------------------------------------------
primtype ArrayArray#
primtype MutableArrayArray# s
primop NewArrayArrayOp "newArrayArray#" GenPrimOp
Int# -> State# s -> (# State# s, MutableArrayArray# s #)
{Create a new mutable array of arrays with the specified number of elements,
in the specified state thread, with each element recursively referring to the
newly created array.}
with
out_of_line = True
has_side_effects = True
primop SameMutableArrayArrayOp "sameMutableArrayArray#" GenPrimOp
MutableArrayArray# s -> MutableArrayArray# s -> Bool
primop UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp
MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #)
{Make a mutable array of arrays immutable, without copying.}
with
has_side_effects = True
primop SizeofArrayArrayOp "sizeofArrayArray#" GenPrimOp
ArrayArray# -> Int#
{Return the number of elements in the array.}
primop SizeofMutableArrayArrayOp "sizeofMutableArrayArray#" GenPrimOp
MutableArrayArray# s -> Int#
{Return the number of elements in the array.}
primop IndexArrayArrayOp_ByteArray "indexByteArrayArray#" GenPrimOp
ArrayArray# -> Int# -> ByteArray#
with can_fail = True
primop IndexArrayArrayOp_ArrayArray "indexArrayArrayArray#" GenPrimOp
ArrayArray# -> Int# -> ArrayArray#
with can_fail = True
primop ReadArrayArrayOp_ByteArray "readByteArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #)
with has_side_effects = True
can_fail = True
primop ReadArrayArrayOp_MutableByteArray "readMutableByteArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
with has_side_effects = True
can_fail = True
primop ReadArrayArrayOp_ArrayArray "readArrayArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #)
with has_side_effects = True
can_fail = True
primop ReadArrayArrayOp_MutableArrayArray "readMutableArrayArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)
with has_side_effects = True
can_fail = True
primop WriteArrayArrayOp_ByteArray "writeByteArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteArrayArrayOp_MutableByteArray "writeMutableByteArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteArrayArrayOp_ArrayArray "writeArrayArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteArrayArrayOp_MutableArrayArray "writeMutableArrayArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop CopyArrayArrayOp "copyArrayArray#" GenPrimOp
ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
{Copy a range of the ArrayArray# to the specified region in the MutableArrayArray#.
Both arrays must fully contain the specified ranges, but this is not checked.
The two arrays must not be the same array in different states, but this is not checked either.}
with
has_side_effects = True
can_fail = True
code_size = { primOpCodeSizeForeignCall }
primop CopyMutableArrayArrayOp "copyMutableArrayArray#" GenPrimOp
MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
{Copy a range of the first MutableArrayArray# to the specified region in the second
MutableArrayArray#.
Both arrays must fully contain the specified ranges, but this is not checked.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall }
can_fail = True
......
compiler/simplCore/Simplify.lhs
View file @ 72bfc815
......@@ -1031,7 +1031,7 @@ simplTick env tickish expr cont
| not (tickishCanSplit tickish)
= no_floating_past_tick
| Just expr' <- want_to_push_tick_inside
| interesting_cont, Just expr' <- push_tick_inside tickish expr
-- see Note [case-of-scc-of-case]
= simplExprF env expr' cont
......@@ -1039,20 +1039,35 @@ simplTick env tickish expr cont
= no_floating_past_tick -- was: wrap_floats, see below
where
want_to_push_tick_inside
| not interesting_cont = Nothing
| not (tickishCanSplit tickish) = Nothing
interesting_cont = case cont of
Select _ _ _ _ _ -> True
_ -> False
push_tick_inside t expr0
| not (tickishCanSplit t) = Nothing
| otherwise
= case expr of
= case expr0 of
Tick t' expr
-- scc t (tick t' E)
-- Pull the tick to the outside
-- This one is important for #5363
| not (tickishScoped t')
-> Just (Tick t' (Tick t expr))
-- scc t (scc t' E)
-- Try to push t' into E first, and if that works,
-- try to push t in again
| Just expr' <- push_tick_inside t' expr
-> push_tick_inside t expr'
| otherwise -> Nothing
Case scrut bndr ty alts
-> Just (Case (mkTick tickish scrut) bndr ty alts')
where t_scope = mkNoTick tickish -- drop the tick on the dup'd ones
-> Just (Case (mkTick t scrut) bndr ty alts')
where t_scope = mkNoTick t -- drop the tick on the dup'd ones
alts' = [ (c,bs, mkTick t_scope e) | (c,bs,e) <- alts]
_other -> Nothing
where
interesting_cont = case cont of
Select _ _ _ _ _ -> True
_ -> False
no_floating_past_tick =
do { let (inc,outc) = splitCont cont
......
includes/rts/OSThreads.h
View file @ 72bfc815
......@@ -183,8 +183,7 @@ extern void initCondition ( Condition* pCond );
extern void closeCondition ( Condition* pCond );
extern rtsBool broadcastCondition ( Condition* pCond );
extern rtsBool signalCondition ( Condition* pCond );
extern rtsBool waitCondition ( Condition* pCond,
Mutex* pMut );
extern rtsBool waitCondition ( Condition* pCond, Mutex* pMut );
//
// Mutexes
......@@ -201,7 +200,6 @@ void setThreadLocalVar (ThreadLocalKey *key, void *value);
void freeThreadLocalKey (ThreadLocalKey *key);
// Processors and affinity
nat getNumberOfProcessors (void);
void setThreadAffinity (nat n, nat m);
#endif // !CMINUSMINUS
......@@ -213,12 +211,17 @@ void setThreadAffinity (nat n, nat m);
#endif /* defined(THREADED_RTS) */
#ifndef CMINUSMINUS
//
// Support for forkOS (defined regardless of THREADED_RTS, but does
// nothing when !THREADED_RTS).
//
#ifndef CMINUSMINUS
int forkOS_createThread ( HsStablePtr entry );
//
// Returns the number of processor cores in the machine
//
nat getNumberOfProcessors (void);
#endif
#endif /* RTS_OSTHREADS_H */
includes/stg/MiscClosures.h
View file @ 72bfc815
......@@ -381,6 +381,7 @@ RTS_FUN_DECL(stg_newByteArrayzh);
RTS_FUN_DECL(stg_newPinnedByteArrayzh);
RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
RTS_FUN_DECL(stg_newArrayzh);
RTS_FUN_DECL(stg_newArrayArrayzh);
RTS_FUN_DECL(stg_newMutVarzh);
RTS_FUN_DECL(stg_atomicModifyMutVarzh);
......
rts/Linker.c
View file @ 72bfc815
......@@ -826,6 +826,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(stg_myThreadIdzh) \
SymI_HasProto(stg_labelThreadzh) \
SymI_HasProto(stg_newArrayzh) \
SymI_HasProto(stg_newArrayArrayzh) \
SymI_HasProto(stg_newBCOzh) \
SymI_HasProto(stg_newByteArrayzh) \
SymI_HasProto_redirect(newCAF, newDynCAF) \
......@@ -849,6 +850,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(stg_readTVarIOzh) \
SymI_HasProto(resumeThread) \
SymI_HasProto(setNumCapabilities) \
SymI_HasProto(getNumberOfProcessors) \
SymI_HasProto(resolveObjs) \
SymI_HasProto(stg_retryzh) \
SymI_HasProto(rts_apply) \
......
rts/PrimOps.cmm
View file @ 72bfc815
......@@ -212,6 +212,45 @@ stg_unsafeThawArrayzh
}
}
stg_newArrayArrayzh
{
W_ words, n, arr, p, size;
/* Args: R1 = words */
n = R1;
MAYBE_GC(NO_PTRS,stg_newArrayArrayzh);
// the mark area contains one byte for each 2^MUT_ARR_PTRS_CARD_BITS words
// in the array, making sure we round up, and then rounding up to a whole
// number of words.
size = n + mutArrPtrsCardWords(n);
words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size;
("ptr" arr) = foreign "C" allocate(MyCapability() "ptr",words) [];
TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0);
SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
StgMutArrPtrs_ptrs(arr) = n;
StgMutArrPtrs_size(arr) = size;
// Initialise all elements of the array with a pointer to the new array
p = arr + SIZEOF_StgMutArrPtrs;
for:
if (p < arr + WDS(words)) {
W_[p] = arr;
p = p + WDS(1);
goto for;
}
// Initialise the mark bits with 0
for2:
if (p < arr + WDS(size)) {
W_[p] = 0;
p = p + WDS(1);
goto for2;
}
RET_P(arr);
}
/* -----------------------------------------------------------------------------
MutVar primitives
......
rts/posix/OSThreads.c
View file @ 72bfc815
......@@ -308,4 +308,9 @@ forkOS_createThread ( HsStablePtr entry STG_UNUSED )
return -1;
}
#endif /* !defined(THREADED_RTS) */
nat getNumberOfProcessors (void)
{
return 1;
}
#endif
rts/win32/OSThreads.c
View file @ 72bfc815
......@@ -308,4 +308,9 @@ forkOS_createThread ( HsStablePtr entry STG_UNUSED )
return -1;
}
nat getNumberOfProcessors (void)
{
return 1;
}
#endif /* !defined(THREADED_RTS) */
utils/genprimopcode/Main.hs
View file @ 72bfc815
......@@ -648,21 +648,22 @@ ppType (TyApp "ForeignObj#" []) = "foreignObjPrimTy"
ppType (TyApp "BCO#" []) = "bcoPrimTy"
ppType (TyApp "()" []) = "unitTy" -- unitTy is TysWiredIn's name for ()
ppType (TyVar "a") = "alphaTy"
ppType (TyVar "b") = "betaTy"
ppType (TyVar "c") = "gammaTy"
ppType (TyVar "s") = "deltaTy"
ppType (TyVar "o") = "openAlphaTy"
ppType (TyApp "State#" [x]) = "mkStatePrimTy " ++ ppType x
ppType (TyApp "MutVar#" [x,y]) = "mkMutVarPrimTy " ++ ppType x
++ " " ++ ppType y
ppType (TyApp "MutableArray#" [x,y]) = "mkMutableArrayPrimTy " ++ ppType x
++ " " ++ ppType y
ppType (TyApp "MutableByteArray#" [x]) = "mkMutableByteArrayPrimTy "
++ ppType x
ppType (TyApp "Array#" [x]) = "mkArrayPrimTy " ++ ppType x
ppType (TyVar "a") = "alphaTy"
ppType (TyVar "b") = "betaTy"
ppType (TyVar "c") = "gammaTy"
ppType (TyVar "s") = "deltaTy"
ppType (TyVar "o") = "openAlphaTy"
ppType (TyApp "State#" [x]) = "mkStatePrimTy " ++ ppType x
ppType (TyApp "MutVar#" [x,y]) = "mkMutVarPrimTy " ++ ppType x
++ " " ++ ppType y
ppType (TyApp "MutableArray#" [x,y]) = "mkMutableArrayPrimTy " ++ ppType x
++ " " ++ ppType y
ppType (TyApp "MutableArrayArray#" [x]) = "mkMutableArrayArrayPrimTy " ++ ppType x
ppType (TyApp "MutableByteArray#" [x]) = "mkMutableByteArrayPrimTy "
++ ppType x
ppType (TyApp "Array#" [x]) = "mkArrayPrimTy " ++ ppType x
ppType (TyApp "ArrayArray#" []) = "mkArrayArrayPrimTy"
ppType (TyApp "Weak#" [x]) = "mkWeakPrimTy " ++ ppType x
......
utils/testremove/checkremove.hs
View file @ 72bfc815
......@@ -2,26 +2,34 @@
module Main (main) where
import Control.Monad
import qualified Data.ByteString.Char8 as BSC
import Data.Function
import Data.List
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import System.Environment
import System.Exit
import System.FilePath
import System.IO
data CleanWhat = CleanFile FilePath
| CleanRec FilePath
deriving (Read, Show)
data Tree = Node FileInfo (Map FilePath Tree)
newtype FilePathFragment = FilePathFragment BSC.ByteString
deriving (Show, Eq, Ord)
toFilePathFragments :: FilePath -> [FilePathFragment]
toFilePathFragments
= map (FilePathFragment . BSC.pack) . splitDirectories . normalise
fromFilePathFragments :: [FilePathFragment] -> FilePath
fromFilePathFragments xs = joinPath $ map f $ reverse xs
where f (FilePathFragment frag) = BSC.unpack frag
data Tree = Node !FileInfo !(Map FilePathFragment Tree)
data FileInfo = FileInfo {
fiBefore :: Bool,
fiAfter :: Bool,
fiDeleted :: Bool
fiBefore :: !Bool,
fiAfter :: !Bool,