[Git][ghc/ghc][wip/buggymcbugfix/appendArrays] Implement appendArray# (external) primop

[Vilem-Benjamin Liepelt]

Vilem-Benjamin Liepelt pushed to branch wip/buggymcbugfix/appendArrays at Glasgow Haskell Compiler / GHC


Commits:
fb3986fe by buggymcbugfix at 2020-08-31T14:29:27+02:00
Implement appendArray# (external) primop

- - - - -


3 changed files:

- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToCmm/Prim.hs
- rts/PrimOps.cmm


Changes:

=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1246,6 +1246,14 @@ primop  ThawArrayOp "thawArray#" GenPrimOp
   has_side_effects = True
   can_fail         = True
 
+primop AppendArrays "appendArrays#" GenPrimOp
+  Array# a -> Array# a -> Array# a
+  {Concatenate two arrays by @memcpy at ing them into a new array.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
 primop CasArrayOp  "casArray#" GenPrimOp
    MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
    {Given an array, an offset, the expected old value, and
@@ -1437,6 +1445,14 @@ primop  ThawSmallArrayOp "thawSmallArray#" GenPrimOp
   has_side_effects = True
   can_fail         = True
 
+primop AppendSmallArrays "appendSmallArrays#" GenPrimOp
+  SmallArray# a -> SmallArray# a -> SmallArray# a
+  {Concatenate two arrays by @memcpy at ing them into a new array.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
 primop CasSmallArrayOp  "casSmallArray#" GenPrimOp
    SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
    {Unsafe, machine-level atomic compare and swap on an element within an array.


=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -219,6 +219,8 @@ emitPrimOp dflags primop = case primop of
       -> opIntoRegs $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
     _ -> PrimopCmmEmit_External
 
+ AppendArrays -> const PrimopCmmEmit_External
+
   NewSmallArrayOp -> \case
     [(CmmLit (CmmInt n w)), init]
       | wordsToBytes platform (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
@@ -264,6 +266,8 @@ emitPrimOp dflags primop = case primop of
       -> opIntoRegs $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
     _ -> PrimopCmmEmit_External
 
+  AppendSmallArrays -> const PrimopCmmEmit_External
+
 -- First we handle various awkward cases specially.
 
   ParOp -> \[arg] -> opIntoRegs $ \[res] -> do


=====================================
rts/PrimOps.cmm
=====================================
@@ -343,6 +343,40 @@ stg_thawArrayzh ( gcptr src, W_ offset, W_ n )
     cloneArray(stg_MUT_ARR_PTRS_DIRTY_info, src, offset, n)
 }
 
+stg_appendArrayszh( gcptr src1, gcptr src2 )
+{
+    W_ words, n1, n2, nDest, size1, size2;
+    gcptr dst, dst_p, src1_p, src2_p;
+
+    again: MAYBE_GC(again);
+
+    n1 = StgMutArrPtrs_ptrs(src1);
+    n2 = StgMutArrPtrs_ptrs(src2);
+    nDest = n1 + n2;
+
+    size1 = n1 + mutArrPtrsCardWords(n1);
+    size2 = n2 + mutArrPtrsCardWords(n2);
+    sizeDest = nDest + mutArrPtrsCardWords(nDest);
+
+    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + sizeDest;
+
+    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words);
+    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(sizeDest), 0);
+
+    SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_CLEAN_info, CCCS);
+    StgMutArrPtrs_ptrs(dst) = nDest;
+    StgMutArrPtrs_size(dst) = sizeDest;
+
+    dst_p = dst + SIZEOF_StgMutArrPtrs;
+    src1_p = src1 + SIZEOF_StgMutArrPtrs;
+    src2_p = src2 + SIZEOF_StgMutArrPtrs;
+
+    prim %memcpy(dst_p, src1_p, WDS(n1), SIZEOF_W);
+    prim %memcpy(dst_p + WDS(n1), src2_p, WDS(n2), SIZEOF_W);
+
+    return (dst);
+}
+
 // RRN: Uses the ticketed approach; see casMutVar
 stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
 /* MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, Any a #) */
@@ -478,6 +512,34 @@ stg_thawSmallArrayzh ( gcptr src, W_ offset, W_ n )
     cloneSmallArray(stg_SMALL_MUT_ARR_PTRS_DIRTY_info, src, offset, n)
 }
 
+stg_appendSmallArrayszh( gcptr src1, gcptr src2 )
+{
+    W_ words, n1, n2, nDest;
+    gcptr dst, dst_p, src1_p, src2_p;
+
+    again: MAYBE_GC(again);
+
+    n1 = StgSmallMutArrPtrs_ptrs(src1);
+    n2 = StgSmallMutArrPtrs_ptrs(src2);
+    nDest = n1 + n2;
+    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + nDest;
+
+    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words);
+    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(nDest), 0);
+
+    SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN_info, CCCS);                                  \
+    StgSmallMutArrPtrs_ptrs(dst) = nDest;
+
+    dst_p = dst + SIZEOF_StgSmallMutArrPtrs;
+    src1_p = src1 + SIZEOF_StgSmallMutArrPtrs;
+    src2_p = src2 + SIZEOF_StgSmallMutArrPtrs;
+
+    prim %memcpy(dst_p, src1_p, WDS(n1), SIZEOF_W);
+    prim %memcpy(dst_p + WDS(n1), src2_p, WDS(n2), SIZEOF_W);
+
+    return (dst);
+}
+
 // Concurrent GC write barrier for pointer array copies
 //
 // hdr_size in bytes. dst_off in words, n in words.



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb3986fe47a298c97c19735b86dc026fec9aa9a0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb3986fe47a298c97c19735b86dc026fec9aa9a0
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200831/e032bbda/attachment-0001.html>