diff options
| -rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 29 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 9 | ||||
| -rw-r--r-- | compiler/prelude/PrelNames.lhs | 6 | ||||
| -rw-r--r-- | compiler/prelude/TysPrim.lhs | 34 | ||||
| -rw-r--r-- | compiler/prelude/primops.txt.pp | 111 | ||||
| -rw-r--r-- | includes/stg/MiscClosures.h | 1 | ||||
| -rw-r--r-- | rts/Linker.c | 1 | ||||
| -rw-r--r-- | rts/PrimOps.cmm | 39 | ||||
| -rw-r--r-- | utils/genprimopcode/Main.hs | 31 |
9 files changed, 227 insertions, 34 deletions
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index e912a08b6e..3b11054efe 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -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 diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 1795b55165..1d5a5b3cda 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -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 diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 319227ba37..f95b21dae2 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -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, diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 98ee6c426d..a3c2c6bb83 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -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} %************************************************************************ diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 1d67b584c6..a695344225 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -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 diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index fcfdede2ff..da3b07b978 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -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); diff --git a/rts/Linker.c b/rts/Linker.c index c1ea0dd206..f45c105bdc 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -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) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 2ca347e803..21ac05f3c3 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -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 diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index da15c2532c..7ac32f6124 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -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 |