| ... |
... |
@@ -37,7 +37,7 @@ import GHC.Cmm.BlockId |
|
37
|
37
|
import GHC.Cmm.Graph
|
|
38
|
38
|
import GHC.Stg.Syntax
|
|
39
|
39
|
import GHC.Cmm
|
|
40
|
|
-import GHC.Unit ( rtsUnit, moduleName, moduleNameFS )
|
|
|
40
|
+import GHC.Unit ( rtsUnit )
|
|
41
|
41
|
import GHC.Core.Type ( Type, tyConAppTyCon_maybe )
|
|
42
|
42
|
import GHC.Core.TyCon
|
|
43
|
43
|
import GHC.Cmm.CLabel
|
| ... |
... |
@@ -96,13 +96,7 @@ cmmPrimOpApp cfg primop cmm_args mres_ty = do |
|
96
|
96
|
-- if the result type isn't explicitly given, we directly use the
|
|
97
|
97
|
-- result type of the primop.
|
|
98
|
98
|
res_ty = fromMaybe (primOpResultType primop) mres_ty
|
|
99
|
|
- -- When -fcheck-prim-bounds is on, record the primop name so that any
|
|
100
|
|
- -- bounds-check failure handler emitted while compiling it can name it in the
|
|
101
|
|
- -- error message. Guarded by the flag so that the common (unchecked) case pays
|
|
102
|
|
- -- nothing: no name thunk, no FCodeState update.
|
|
103
|
|
- if stgToCmmDoBoundsCheck cfg
|
|
104
|
|
- then withCurrentPrimOpName (occNameFS (primOpOcc primop)) (f res_ty)
|
|
105
|
|
- else f res_ty
|
|
|
99
|
+ f res_ty
|
|
106
|
100
|
|
|
107
|
101
|
externalPrimop :: PrimOp -> [CmmExpr] -> PrimopCmmEmit
|
|
108
|
102
|
externalPrimop primop args = outOfLinePrimop (callExternalPrimop primop args)
|
| ... |
... |
@@ -188,27 +182,27 @@ emitPrimOp cfg primop = |
|
188
|
182
|
|
|
189
|
183
|
CopyArrayOp -> \case
|
|
190
|
184
|
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
|
|
191
|
|
- inlinePrimop $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
|
|
|
185
|
+ inlinePrimop $ \ [] -> doCopyArrayOp op_name src src_off dst dst_off (fromInteger n)
|
|
192
|
186
|
[src, src_off, dst, dst_off, n] ->
|
|
193
|
187
|
outOfLinePrimop $ do
|
|
194
|
188
|
profile <- getProfile
|
|
195
|
189
|
platform <- getPlatform
|
|
196
|
190
|
whenCheckBounds $ ifNonZero n $ do
|
|
197
|
|
- emitRangeBoundsCheck src_off n (ptrArraySize platform profile src)
|
|
198
|
|
- emitRangeBoundsCheck dst_off n (ptrArraySize platform profile dst)
|
|
|
191
|
+ emitRangeBoundsCheck op_name src_off n (ptrArraySize platform profile src)
|
|
|
192
|
+ emitRangeBoundsCheck op_name dst_off n (ptrArraySize platform profile dst)
|
|
199
|
193
|
callExternalPrimop CopyArrayOp [src, src_off, dst, dst_off, n]
|
|
200
|
194
|
_ -> panic "CopyArrayOp"
|
|
201
|
195
|
|
|
202
|
196
|
CopyMutableArrayOp -> \case
|
|
203
|
197
|
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
|
|
204
|
|
- inlinePrimop $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
|
|
|
198
|
+ inlinePrimop $ \ [] -> doCopyMutableArrayOp op_name src src_off dst dst_off (fromInteger n)
|
|
205
|
199
|
[src, src_off, dst, dst_off, n] ->
|
|
206
|
200
|
outOfLinePrimop $ do
|
|
207
|
201
|
profile <- getProfile
|
|
208
|
202
|
platform <- getPlatform
|
|
209
|
203
|
whenCheckBounds $ ifNonZero n $ do
|
|
210
|
|
- emitRangeBoundsCheck src_off n (ptrArraySize platform profile src)
|
|
211
|
|
- emitRangeBoundsCheck dst_off n (ptrArraySize platform profile dst)
|
|
|
204
|
+ emitRangeBoundsCheck op_name src_off n (ptrArraySize platform profile src)
|
|
|
205
|
+ emitRangeBoundsCheck op_name dst_off n (ptrArraySize platform profile dst)
|
|
212
|
206
|
callExternalPrimop CopyMutableArrayOp [src, src_off, dst, dst_off, n]
|
|
213
|
207
|
_ -> panic "CopyMutableArrayOp"
|
|
214
|
208
|
|
| ... |
... |
@@ -249,27 +243,27 @@ emitPrimOp cfg primop = |
|
249
|
243
|
|
|
250
|
244
|
CopySmallArrayOp -> \case
|
|
251
|
245
|
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
|
|
252
|
|
- inlinePrimop $ \ [] -> doCopySmallArrayOp src src_off dst dst_off (fromInteger n)
|
|
|
246
|
+ inlinePrimop $ \ [] -> doCopySmallArrayOp op_name src src_off dst dst_off (fromInteger n)
|
|
253
|
247
|
[src, src_off, dst, dst_off, n] ->
|
|
254
|
248
|
outOfLinePrimop $ do
|
|
255
|
249
|
profile <- getProfile
|
|
256
|
250
|
platform <- getPlatform
|
|
257
|
251
|
whenCheckBounds $ ifNonZero n $ do
|
|
258
|
|
- emitRangeBoundsCheck src_off n (smallPtrArraySize platform profile src)
|
|
259
|
|
- emitRangeBoundsCheck dst_off n (smallPtrArraySize platform profile dst)
|
|
|
252
|
+ emitRangeBoundsCheck op_name src_off n (smallPtrArraySize platform profile src)
|
|
|
253
|
+ emitRangeBoundsCheck op_name dst_off n (smallPtrArraySize platform profile dst)
|
|
260
|
254
|
callExternalPrimop CopySmallArrayOp [src, src_off, dst, dst_off, n]
|
|
261
|
255
|
_ -> panic "CopySmallArrayOp"
|
|
262
|
256
|
|
|
263
|
257
|
CopySmallMutableArrayOp -> \case
|
|
264
|
258
|
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
|
|
265
|
|
- inlinePrimop $ \ [] -> doCopySmallMutableArrayOp src src_off dst dst_off (fromInteger n)
|
|
|
259
|
+ inlinePrimop $ \ [] -> doCopySmallMutableArrayOp op_name src src_off dst dst_off (fromInteger n)
|
|
266
|
260
|
[src, src_off, dst, dst_off, n] ->
|
|
267
|
261
|
outOfLinePrimop $ do
|
|
268
|
262
|
profile <- getProfile
|
|
269
|
263
|
platform <- getPlatform
|
|
270
|
264
|
whenCheckBounds $ ifNonZero n $ do
|
|
271
|
|
- emitRangeBoundsCheck src_off n (smallPtrArraySize platform profile src)
|
|
272
|
|
- emitRangeBoundsCheck dst_off n (smallPtrArraySize platform profile dst)
|
|
|
265
|
+ emitRangeBoundsCheck op_name src_off n (smallPtrArraySize platform profile src)
|
|
|
266
|
+ emitRangeBoundsCheck op_name dst_off n (smallPtrArraySize platform profile dst)
|
|
273
|
267
|
callExternalPrimop CopySmallMutableArrayOp [src, src_off, dst, dst_off, n]
|
|
274
|
268
|
_ -> panic "CopySmallMutableArrayOp"
|
|
275
|
269
|
|
| ... |
... |
@@ -447,18 +441,18 @@ emitPrimOp cfg primop = |
|
447
|
441
|
-- Reading/writing pointer arrays
|
|
448
|
442
|
|
|
449
|
443
|
ReadArrayOp -> \[obj, ix] -> inlinePrimop $ \[res] ->
|
|
450
|
|
- doReadPtrArrayOp res obj ix
|
|
|
444
|
+ doReadPtrArrayOp op_name res obj ix
|
|
451
|
445
|
IndexArrayOp -> \[obj, ix] -> inlinePrimop $ \[res] ->
|
|
452
|
|
- doReadPtrArrayOp res obj ix
|
|
|
446
|
+ doReadPtrArrayOp op_name res obj ix
|
|
453
|
447
|
WriteArrayOp -> \[obj, ix, v] -> inlinePrimop $ \[] ->
|
|
454
|
|
- doWritePtrArrayOp obj ix v
|
|
|
448
|
+ doWritePtrArrayOp op_name obj ix v
|
|
455
|
449
|
|
|
456
|
450
|
ReadSmallArrayOp -> \[obj, ix] -> inlinePrimop $ \[res] ->
|
|
457
|
|
- doReadSmallPtrArrayOp res obj ix
|
|
|
451
|
+ doReadSmallPtrArrayOp op_name res obj ix
|
|
458
|
452
|
IndexSmallArrayOp -> \[obj, ix] -> inlinePrimop $ \[res] ->
|
|
459
|
|
- doReadSmallPtrArrayOp res obj ix
|
|
|
453
|
+ doReadSmallPtrArrayOp op_name res obj ix
|
|
460
|
454
|
WriteSmallArrayOp -> \[obj,ix,v] -> inlinePrimop $ \[] ->
|
|
461
|
|
- doWriteSmallPtrArrayOp obj ix v
|
|
|
455
|
+ doWriteSmallPtrArrayOp op_name obj ix v
|
|
462
|
456
|
|
|
463
|
457
|
-- Getting the size of pointer arrays
|
|
464
|
458
|
|
| ... |
... |
@@ -636,134 +630,134 @@ emitPrimOp cfg primop = |
|
636
|
630
|
-- IndexXXXArray
|
|
637
|
631
|
|
|
638
|
632
|
IndexByteArrayOp_Char -> \args -> inlinePrimop $ \res ->
|
|
639
|
|
- doIndexByteArrayOp (Just (mo_u_8ToWord platform)) b8 res args
|
|
|
633
|
+ doIndexByteArrayOp op_name (Just (mo_u_8ToWord platform)) b8 res args
|
|
640
|
634
|
IndexByteArrayOp_WideChar -> \args -> inlinePrimop $ \res ->
|
|
641
|
|
- doIndexByteArrayOp (Just (mo_u_32ToWord platform)) b32 res args
|
|
|
635
|
+ doIndexByteArrayOp op_name (Just (mo_u_32ToWord platform)) b32 res args
|
|
642
|
636
|
IndexByteArrayOp_Int -> \args -> inlinePrimop $ \res ->
|
|
643
|
|
- doIndexByteArrayOp Nothing (bWord platform) res args
|
|
|
637
|
+ doIndexByteArrayOp op_name Nothing (bWord platform) res args
|
|
644
|
638
|
IndexByteArrayOp_Word -> \args -> inlinePrimop $ \res ->
|
|
645
|
|
- doIndexByteArrayOp Nothing (bWord platform) res args
|
|
|
639
|
+ doIndexByteArrayOp op_name Nothing (bWord platform) res args
|
|
646
|
640
|
IndexByteArrayOp_Addr -> \args -> inlinePrimop $ \res ->
|
|
647
|
|
- doIndexByteArrayOp Nothing (bWord platform) res args
|
|
|
641
|
+ doIndexByteArrayOp op_name Nothing (bWord platform) res args
|
|
648
|
642
|
IndexByteArrayOp_Float -> \args -> inlinePrimop $ \res ->
|
|
649
|
|
- doIndexByteArrayOp Nothing f32 res args
|
|
|
643
|
+ doIndexByteArrayOp op_name Nothing f32 res args
|
|
650
|
644
|
IndexByteArrayOp_Double -> \args -> inlinePrimop $ \res ->
|
|
651
|
|
- doIndexByteArrayOp Nothing f64 res args
|
|
|
645
|
+ doIndexByteArrayOp op_name Nothing f64 res args
|
|
652
|
646
|
IndexByteArrayOp_StablePtr -> \args -> inlinePrimop $ \res ->
|
|
653
|
|
- doIndexByteArrayOp Nothing (bWord platform) res args
|
|
|
647
|
+ doIndexByteArrayOp op_name Nothing (bWord platform) res args
|
|
654
|
648
|
IndexByteArrayOp_Int8 -> \args -> inlinePrimop $ \res ->
|
|
655
|
|
- doIndexByteArrayOp Nothing b8 res args
|
|
|
649
|
+ doIndexByteArrayOp op_name Nothing b8 res args
|
|
656
|
650
|
IndexByteArrayOp_Int16 -> \args -> inlinePrimop $ \res ->
|
|
657
|
|
- doIndexByteArrayOp Nothing b16 res args
|
|
|
651
|
+ doIndexByteArrayOp op_name Nothing b16 res args
|
|
658
|
652
|
IndexByteArrayOp_Int32 -> \args -> inlinePrimop $ \res ->
|
|
659
|
|
- doIndexByteArrayOp Nothing b32 res args
|
|
|
653
|
+ doIndexByteArrayOp op_name Nothing b32 res args
|
|
660
|
654
|
IndexByteArrayOp_Int64 -> \args -> inlinePrimop $ \res ->
|
|
661
|
|
- doIndexByteArrayOp Nothing b64 res args
|
|
|
655
|
+ doIndexByteArrayOp op_name Nothing b64 res args
|
|
662
|
656
|
IndexByteArrayOp_Word8 -> \args -> inlinePrimop $ \res ->
|
|
663
|
|
- doIndexByteArrayOp Nothing b8 res args
|
|
|
657
|
+ doIndexByteArrayOp op_name Nothing b8 res args
|
|
664
|
658
|
IndexByteArrayOp_Word16 -> \args -> inlinePrimop $ \res ->
|
|
665
|
|
- doIndexByteArrayOp Nothing b16 res args
|
|
|
659
|
+ doIndexByteArrayOp op_name Nothing b16 res args
|
|
666
|
660
|
IndexByteArrayOp_Word32 -> \args -> inlinePrimop $ \res ->
|
|
667
|
|
- doIndexByteArrayOp Nothing b32 res args
|
|
|
661
|
+ doIndexByteArrayOp op_name Nothing b32 res args
|
|
668
|
662
|
IndexByteArrayOp_Word64 -> \args -> inlinePrimop $ \res ->
|
|
669
|
|
- doIndexByteArrayOp Nothing b64 res args
|
|
|
663
|
+ doIndexByteArrayOp op_name Nothing b64 res args
|
|
670
|
664
|
|
|
671
|
665
|
-- ReadXXXArray, identical to IndexXXXArray.
|
|
672
|
666
|
|
|
673
|
667
|
ReadByteArrayOp_Char -> \args -> inlinePrimop $ \res ->
|
|
674
|
|
- doIndexByteArrayOp (Just (mo_u_8ToWord platform)) b8 res args
|
|
|
668
|
+ doIndexByteArrayOp op_name (Just (mo_u_8ToWord platform)) b8 res args
|
|
675
|
669
|
ReadByteArrayOp_WideChar -> \args -> inlinePrimop $ \res ->
|
|
676
|
|
- doIndexByteArrayOp (Just (mo_u_32ToWord platform)) b32 res args
|
|
|
670
|
+ doIndexByteArrayOp op_name (Just (mo_u_32ToWord platform)) b32 res args
|
|
677
|
671
|
ReadByteArrayOp_Int -> \args -> inlinePrimop $ \res ->
|
|
678
|
|
- doIndexByteArrayOp Nothing (bWord platform) res args
|
|
|
672
|
+ doIndexByteArrayOp op_name Nothing (bWord platform) res args
|
|
679
|
673
|
ReadByteArrayOp_Word -> \args -> inlinePrimop $ \res ->
|
|
680
|
|
- doIndexByteArrayOp Nothing (bWord platform) res args
|
|
|
674
|
+ doIndexByteArrayOp op_name Nothing (bWord platform) res args
|
|
681
|
675
|
ReadByteArrayOp_Addr -> \args -> inlinePrimop $ \res ->
|
|
682
|
|
- doIndexByteArrayOp Nothing (bWord platform) res args
|
|
|
676
|
+ doIndexByteArrayOp op_name Nothing (bWord platform) res args
|
|
683
|
677
|
ReadByteArrayOp_Float -> \args -> inlinePrimop $ \res ->
|
|
684
|
|
- doIndexByteArrayOp Nothing f32 res args
|
|
|
678
|
+ doIndexByteArrayOp op_name Nothing f32 res args
|
|
685
|
679
|
ReadByteArrayOp_Double -> \args -> inlinePrimop $ \res ->
|
|
686
|
|
- doIndexByteArrayOp Nothing f64 res args
|
|
|
680
|
+ doIndexByteArrayOp op_name Nothing f64 res args
|
|
687
|
681
|
ReadByteArrayOp_StablePtr -> \args -> inlinePrimop $ \res ->
|
|
688
|
|
- doIndexByteArrayOp Nothing (bWord platform) res args
|
|
|
682
|
+ doIndexByteArrayOp op_name Nothing (bWord platform) res args
|
|
689
|
683
|
ReadByteArrayOp_Int8 -> \args -> inlinePrimop $ \res ->
|
|
690
|
|
- doIndexByteArrayOp Nothing b8 res args
|
|
|
684
|
+ doIndexByteArrayOp op_name Nothing b8 res args
|
|
691
|
685
|
ReadByteArrayOp_Int16 -> \args -> inlinePrimop $ \res ->
|
|
692
|
|
- doIndexByteArrayOp Nothing b16 res args
|
|
|
686
|
+ doIndexByteArrayOp op_name Nothing b16 res args
|
|
693
|
687
|
ReadByteArrayOp_Int32 -> \args -> inlinePrimop $ \res ->
|
|
694
|
|
- doIndexByteArrayOp Nothing b32 res args
|
|
|
688
|
+ doIndexByteArrayOp op_name Nothing b32 res args
|
|
695
|
689
|
ReadByteArrayOp_Int64 -> \args -> inlinePrimop $ \res ->
|
|
696
|
|
- doIndexByteArrayOp Nothing b64 res args
|
|
|
690
|
+ doIndexByteArrayOp op_name Nothing b64 res args
|
|
697
|
691
|
ReadByteArrayOp_Word8 -> \args -> inlinePrimop $ \res ->
|
|
698
|
|
- doIndexByteArrayOp Nothing b8 res args
|
|
|
692
|
+ doIndexByteArrayOp op_name Nothing b8 res args
|
|
699
|
693
|
ReadByteArrayOp_Word16 -> \args -> inlinePrimop $ \res ->
|
|
700
|
|
- doIndexByteArrayOp Nothing b16 res args
|
|
|
694
|
+ doIndexByteArrayOp op_name Nothing b16 res args
|
|
701
|
695
|
ReadByteArrayOp_Word32 -> \args -> inlinePrimop $ \res ->
|
|
702
|
|
- doIndexByteArrayOp Nothing b32 res args
|
|
|
696
|
+ doIndexByteArrayOp op_name Nothing b32 res args
|
|
703
|
697
|
ReadByteArrayOp_Word64 -> \args -> inlinePrimop $ \res ->
|
|
704
|
|
- doIndexByteArrayOp Nothing b64 res args
|
|
|
698
|
+ doIndexByteArrayOp op_name Nothing b64 res args
|
|
705
|
699
|
|
|
706
|
700
|
-- IndexWord8ArrayAsXXX
|
|
707
|
701
|
|
|
708
|
702
|
IndexByteArrayOp_Word8AsChar -> \args -> inlinePrimop $ \res ->
|
|
709
|
|
- doIndexByteArrayOpAs (Just (mo_u_8ToWord platform)) b8 b8 res args
|
|
|
703
|
+ doIndexByteArrayOpAs op_name (Just (mo_u_8ToWord platform)) b8 b8 res args
|
|
710
|
704
|
IndexByteArrayOp_Word8AsWideChar -> \args -> inlinePrimop $ \res ->
|
|
711
|
|
- doIndexByteArrayOpAs (Just (mo_u_32ToWord platform)) b32 b8 res args
|
|
|
705
|
+ doIndexByteArrayOpAs op_name (Just (mo_u_32ToWord platform)) b32 b8 res args
|
|
712
|
706
|
IndexByteArrayOp_Word8AsInt -> \args -> inlinePrimop $ \res ->
|
|
713
|
|
- doIndexByteArrayOpAs Nothing (bWord platform) b8 res args
|
|
|
707
|
+ doIndexByteArrayOpAs op_name Nothing (bWord platform) b8 res args
|
|
714
|
708
|
IndexByteArrayOp_Word8AsWord -> \args -> inlinePrimop $ \res ->
|
|
715
|
|
- doIndexByteArrayOpAs Nothing (bWord platform) b8 res args
|
|
|
709
|
+ doIndexByteArrayOpAs op_name Nothing (bWord platform) b8 res args
|
|
716
|
710
|
IndexByteArrayOp_Word8AsAddr -> \args -> inlinePrimop $ \res ->
|
|
717
|
|
- doIndexByteArrayOpAs Nothing (bWord platform) b8 res args
|
|
|
711
|
+ doIndexByteArrayOpAs op_name Nothing (bWord platform) b8 res args
|
|
718
|
712
|
IndexByteArrayOp_Word8AsFloat -> \args -> inlinePrimop $ \res ->
|
|
719
|
|
- doIndexByteArrayOpAs Nothing f32 b8 res args
|
|
|
713
|
+ doIndexByteArrayOpAs op_name Nothing f32 b8 res args
|
|
720
|
714
|
IndexByteArrayOp_Word8AsDouble -> \args -> inlinePrimop $ \res ->
|
|
721
|
|
- doIndexByteArrayOpAs Nothing f64 b8 res args
|
|
|
715
|
+ doIndexByteArrayOpAs op_name Nothing f64 b8 res args
|
|
722
|
716
|
IndexByteArrayOp_Word8AsStablePtr -> \args -> inlinePrimop $ \res ->
|
|
723
|
|
- doIndexByteArrayOpAs Nothing (bWord platform) b8 res args
|
|
|
717
|
+ doIndexByteArrayOpAs op_name Nothing (bWord platform) b8 res args
|
|
724
|
718
|
IndexByteArrayOp_Word8AsInt16 -> \args -> inlinePrimop $ \res ->
|
|
725
|
|
- doIndexByteArrayOpAs Nothing b16 b8 res args
|
|
|
719
|
+ doIndexByteArrayOpAs op_name Nothing b16 b8 res args
|
|
726
|
720
|
IndexByteArrayOp_Word8AsInt32 -> \args -> inlinePrimop $ \res ->
|
|
727
|
|
- doIndexByteArrayOpAs Nothing b32 b8 res args
|
|
|
721
|
+ doIndexByteArrayOpAs op_name Nothing b32 b8 res args
|
|
728
|
722
|
IndexByteArrayOp_Word8AsInt64 -> \args -> inlinePrimop $ \res ->
|
|
729
|
|
- doIndexByteArrayOpAs Nothing b64 b8 res args
|
|
|
723
|
+ doIndexByteArrayOpAs op_name Nothing b64 b8 res args
|
|
730
|
724
|
IndexByteArrayOp_Word8AsWord16 -> \args -> inlinePrimop $ \res ->
|
|
731
|
|
- doIndexByteArrayOpAs Nothing b16 b8 res args
|
|
|
725
|
+ doIndexByteArrayOpAs op_name Nothing b16 b8 res args
|
|
732
|
726
|
IndexByteArrayOp_Word8AsWord32 -> \args -> inlinePrimop $ \res ->
|
|
733
|
|
- doIndexByteArrayOpAs Nothing b32 b8 res args
|
|
|
727
|
+ doIndexByteArrayOpAs op_name Nothing b32 b8 res args
|
|
734
|
728
|
IndexByteArrayOp_Word8AsWord64 -> \args -> inlinePrimop $ \res ->
|
|
735
|
|
- doIndexByteArrayOpAs Nothing b64 b8 res args
|
|
|
729
|
+ doIndexByteArrayOpAs op_name Nothing b64 b8 res args
|
|
736
|
730
|
|
|
737
|
731
|
-- ReadInt8ArrayAsXXX, identical to IndexInt8ArrayAsXXX
|
|
738
|
732
|
|
|
739
|
733
|
ReadByteArrayOp_Word8AsChar -> \args -> inlinePrimop $ \res ->
|
|
740
|
|
- doIndexByteArrayOpAs (Just (mo_u_8ToWord platform)) b8 b8 res args
|
|
|
734
|
+ doIndexByteArrayOpAs op_name (Just (mo_u_8ToWord platform)) b8 b8 res args
|
|
741
|
735
|
ReadByteArrayOp_Word8AsWideChar -> \args -> inlinePrimop $ \res ->
|
|
742
|
|
- doIndexByteArrayOpAs (Just (mo_u_32ToWord platform)) b32 b8 res args
|
|
|
736
|
+ doIndexByteArrayOpAs op_name (Just (mo_u_32ToWord platform)) b32 b8 res args
|
|
743
|
737
|
ReadByteArrayOp_Word8AsInt -> \args -> inlinePrimop $ \res ->
|
|
744
|
|
- doIndexByteArrayOpAs Nothing (bWord platform) b8 res args
|
|
|
738
|
+ doIndexByteArrayOpAs op_name Nothing (bWord platform) b8 res args
|
|
745
|
739
|
ReadByteArrayOp_Word8AsWord -> \args -> inlinePrimop $ \res ->
|
|
746
|
|
- doIndexByteArrayOpAs Nothing (bWord platform) b8 res args
|
|
|
740
|
+ doIndexByteArrayOpAs op_name Nothing (bWord platform) b8 res args
|
|
747
|
741
|
ReadByteArrayOp_Word8AsAddr -> \args -> inlinePrimop $ \res ->
|
|
748
|
|
- doIndexByteArrayOpAs Nothing (bWord platform) b8 res args
|
|
|
742
|
+ doIndexByteArrayOpAs op_name Nothing (bWord platform) b8 res args
|
|
749
|
743
|
ReadByteArrayOp_Word8AsFloat -> \args -> inlinePrimop $ \res ->
|
|
750
|
|
- doIndexByteArrayOpAs Nothing f32 b8 res args
|
|
|
744
|
+ doIndexByteArrayOpAs op_name Nothing f32 b8 res args
|
|
751
|
745
|
ReadByteArrayOp_Word8AsDouble -> \args -> inlinePrimop $ \res ->
|
|
752
|
|
- doIndexByteArrayOpAs Nothing f64 b8 res args
|
|
|
746
|
+ doIndexByteArrayOpAs op_name Nothing f64 b8 res args
|
|
753
|
747
|
ReadByteArrayOp_Word8AsStablePtr -> \args -> inlinePrimop $ \res ->
|
|
754
|
|
- doIndexByteArrayOpAs Nothing (bWord platform) b8 res args
|
|
|
748
|
+ doIndexByteArrayOpAs op_name Nothing (bWord platform) b8 res args
|
|
755
|
749
|
ReadByteArrayOp_Word8AsInt16 -> \args -> inlinePrimop $ \res ->
|
|
756
|
|
- doIndexByteArrayOpAs Nothing b16 b8 res args
|
|
|
750
|
+ doIndexByteArrayOpAs op_name Nothing b16 b8 res args
|
|
757
|
751
|
ReadByteArrayOp_Word8AsInt32 -> \args -> inlinePrimop $ \res ->
|
|
758
|
|
- doIndexByteArrayOpAs Nothing b32 b8 res args
|
|
|
752
|
+ doIndexByteArrayOpAs op_name Nothing b32 b8 res args
|
|
759
|
753
|
ReadByteArrayOp_Word8AsInt64 -> \args -> inlinePrimop $ \res ->
|
|
760
|
|
- doIndexByteArrayOpAs Nothing b64 b8 res args
|
|
|
754
|
+ doIndexByteArrayOpAs op_name Nothing b64 b8 res args
|
|
761
|
755
|
ReadByteArrayOp_Word8AsWord16 -> \args -> inlinePrimop $ \res ->
|
|
762
|
|
- doIndexByteArrayOpAs Nothing b16 b8 res args
|
|
|
756
|
+ doIndexByteArrayOpAs op_name Nothing b16 b8 res args
|
|
763
|
757
|
ReadByteArrayOp_Word8AsWord32 -> \args -> inlinePrimop $ \res ->
|
|
764
|
|
- doIndexByteArrayOpAs Nothing b32 b8 res args
|
|
|
758
|
+ doIndexByteArrayOpAs op_name Nothing b32 b8 res args
|
|
765
|
759
|
ReadByteArrayOp_Word8AsWord64 -> \args -> inlinePrimop $ \res ->
|
|
766
|
|
- doIndexByteArrayOpAs Nothing b64 b8 res args
|
|
|
760
|
+ doIndexByteArrayOpAs op_name Nothing b64 b8 res args
|
|
767
|
761
|
|
|
768
|
762
|
-- WriteXXXoffAddr
|
|
769
|
763
|
|
| ... |
... |
@@ -803,94 +797,94 @@ emitPrimOp cfg primop = |
|
803
|
797
|
-- WriteXXXArray
|
|
804
|
798
|
|
|
805
|
799
|
WriteByteArrayOp_Char -> \args -> inlinePrimop $ \res ->
|
|
806
|
|
- doWriteByteArrayOp (Just (mo_WordTo8 platform)) b8 res args
|
|
|
800
|
+ doWriteByteArrayOp op_name (Just (mo_WordTo8 platform)) b8 res args
|
|
807
|
801
|
WriteByteArrayOp_WideChar -> \args -> inlinePrimop $ \res ->
|
|
808
|
|
- doWriteByteArrayOp (Just (mo_WordTo32 platform)) b32 res args
|
|
|
802
|
+ doWriteByteArrayOp op_name (Just (mo_WordTo32 platform)) b32 res args
|
|
809
|
803
|
WriteByteArrayOp_Int -> \args -> inlinePrimop $ \res ->
|
|
810
|
|
- doWriteByteArrayOp Nothing (bWord platform) res args
|
|
|
804
|
+ doWriteByteArrayOp op_name Nothing (bWord platform) res args
|
|
811
|
805
|
WriteByteArrayOp_Word -> \args -> inlinePrimop $ \res ->
|
|
812
|
|
- doWriteByteArrayOp Nothing (bWord platform) res args
|
|
|
806
|
+ doWriteByteArrayOp op_name Nothing (bWord platform) res args
|
|
813
|
807
|
WriteByteArrayOp_Addr -> \args -> inlinePrimop $ \res ->
|
|
814
|
|
- doWriteByteArrayOp Nothing (bWord platform) res args
|
|
|
808
|
+ doWriteByteArrayOp op_name Nothing (bWord platform) res args
|
|
815
|
809
|
WriteByteArrayOp_Float -> \args -> inlinePrimop $ \res ->
|
|
816
|
|
- doWriteByteArrayOp Nothing f32 res args
|
|
|
810
|
+ doWriteByteArrayOp op_name Nothing f32 res args
|
|
817
|
811
|
WriteByteArrayOp_Double -> \args -> inlinePrimop $ \res ->
|
|
818
|
|
- doWriteByteArrayOp Nothing f64 res args
|
|
|
812
|
+ doWriteByteArrayOp op_name Nothing f64 res args
|
|
819
|
813
|
WriteByteArrayOp_StablePtr -> \args -> inlinePrimop $ \res ->
|
|
820
|
|
- doWriteByteArrayOp Nothing (bWord platform) res args
|
|
|
814
|
+ doWriteByteArrayOp op_name Nothing (bWord platform) res args
|
|
821
|
815
|
WriteByteArrayOp_Int8 -> \args -> inlinePrimop $ \res ->
|
|
822
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
816
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
823
|
817
|
WriteByteArrayOp_Int16 -> \args -> inlinePrimop $ \res ->
|
|
824
|
|
- doWriteByteArrayOp Nothing b16 res args
|
|
|
818
|
+ doWriteByteArrayOp op_name Nothing b16 res args
|
|
825
|
819
|
WriteByteArrayOp_Int32 -> \args -> inlinePrimop $ \res ->
|
|
826
|
|
- doWriteByteArrayOp Nothing b32 res args
|
|
|
820
|
+ doWriteByteArrayOp op_name Nothing b32 res args
|
|
827
|
821
|
WriteByteArrayOp_Int64 -> \args -> inlinePrimop $ \res ->
|
|
828
|
|
- doWriteByteArrayOp Nothing b64 res args
|
|
|
822
|
+ doWriteByteArrayOp op_name Nothing b64 res args
|
|
829
|
823
|
WriteByteArrayOp_Word8 -> \args -> inlinePrimop $ \res ->
|
|
830
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
824
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
831
|
825
|
WriteByteArrayOp_Word16 -> \args -> inlinePrimop $ \res ->
|
|
832
|
|
- doWriteByteArrayOp Nothing b16 res args
|
|
|
826
|
+ doWriteByteArrayOp op_name Nothing b16 res args
|
|
833
|
827
|
WriteByteArrayOp_Word32 -> \args -> inlinePrimop $ \res ->
|
|
834
|
|
- doWriteByteArrayOp Nothing b32 res args
|
|
|
828
|
+ doWriteByteArrayOp op_name Nothing b32 res args
|
|
835
|
829
|
WriteByteArrayOp_Word64 -> \args -> inlinePrimop $ \res ->
|
|
836
|
|
- doWriteByteArrayOp Nothing b64 res args
|
|
|
830
|
+ doWriteByteArrayOp op_name Nothing b64 res args
|
|
837
|
831
|
|
|
838
|
832
|
-- WriteInt8ArrayAsXXX
|
|
839
|
833
|
|
|
840
|
834
|
WriteByteArrayOp_Word8AsChar -> \args -> inlinePrimop $ \res ->
|
|
841
|
|
- doWriteByteArrayOp (Just (mo_WordTo8 platform)) b8 res args
|
|
|
835
|
+ doWriteByteArrayOp op_name (Just (mo_WordTo8 platform)) b8 res args
|
|
842
|
836
|
WriteByteArrayOp_Word8AsWideChar -> \args -> inlinePrimop $ \res ->
|
|
843
|
|
- doWriteByteArrayOp (Just (mo_WordTo32 platform)) b8 res args
|
|
|
837
|
+ doWriteByteArrayOp op_name (Just (mo_WordTo32 platform)) b8 res args
|
|
844
|
838
|
WriteByteArrayOp_Word8AsInt -> \args -> inlinePrimop $ \res ->
|
|
845
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
839
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
846
|
840
|
WriteByteArrayOp_Word8AsWord -> \args -> inlinePrimop $ \res ->
|
|
847
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
841
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
848
|
842
|
WriteByteArrayOp_Word8AsAddr -> \args -> inlinePrimop $ \res ->
|
|
849
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
843
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
850
|
844
|
WriteByteArrayOp_Word8AsFloat -> \args -> inlinePrimop $ \res ->
|
|
851
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
845
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
852
|
846
|
WriteByteArrayOp_Word8AsDouble -> \args -> inlinePrimop $ \res ->
|
|
853
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
847
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
854
|
848
|
WriteByteArrayOp_Word8AsStablePtr -> \args -> inlinePrimop $ \res ->
|
|
855
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
849
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
856
|
850
|
WriteByteArrayOp_Word8AsInt16 -> \args -> inlinePrimop $ \res ->
|
|
857
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
851
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
858
|
852
|
WriteByteArrayOp_Word8AsInt32 -> \args -> inlinePrimop $ \res ->
|
|
859
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
853
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
860
|
854
|
WriteByteArrayOp_Word8AsInt64 -> \args -> inlinePrimop $ \res ->
|
|
861
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
855
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
862
|
856
|
WriteByteArrayOp_Word8AsWord16 -> \args -> inlinePrimop $ \res ->
|
|
863
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
857
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
864
|
858
|
WriteByteArrayOp_Word8AsWord32 -> \args -> inlinePrimop $ \res ->
|
|
865
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
859
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
866
|
860
|
WriteByteArrayOp_Word8AsWord64 -> \args -> inlinePrimop $ \res ->
|
|
867
|
|
- doWriteByteArrayOp Nothing b8 res args
|
|
|
861
|
+ doWriteByteArrayOp op_name Nothing b8 res args
|
|
868
|
862
|
|
|
869
|
863
|
-- Copying and setting byte arrays
|
|
870
|
864
|
CopyByteArrayOp -> \[src,src_off,dst,dst_off,n] -> inlinePrimop $ \[] ->
|
|
871
|
|
- doCopyByteArrayOp src src_off dst dst_off n
|
|
|
865
|
+ doCopyByteArrayOp op_name src src_off dst dst_off n
|
|
872
|
866
|
CopyMutableByteArrayOp -> \[src,src_off,dst,dst_off,n] -> inlinePrimop $ \[] ->
|
|
873
|
|
- doCopyMutableByteArrayOp src src_off dst dst_off n
|
|
|
867
|
+ doCopyMutableByteArrayOp op_name src src_off dst dst_off n
|
|
874
|
868
|
CopyMutableByteArrayNonOverlappingOp -> \[src,src_off,dst,dst_off,n] -> inlinePrimop $ \[] ->
|
|
875
|
|
- doCopyMutableByteArrayNonOverlappingOp src src_off dst dst_off n
|
|
|
869
|
+ doCopyMutableByteArrayNonOverlappingOp op_name src src_off dst dst_off n
|
|
876
|
870
|
CopyByteArrayToAddrOp -> \[src,src_off,dst,n] -> inlinePrimop $ \[] ->
|
|
877
|
|
- doCopyByteArrayToAddrOp src src_off dst n
|
|
|
871
|
+ doCopyByteArrayToAddrOp op_name src src_off dst n
|
|
878
|
872
|
CopyMutableByteArrayToAddrOp -> \[src,src_off,dst,n] -> inlinePrimop $ \[] ->
|
|
879
|
|
- doCopyMutableByteArrayToAddrOp src src_off dst n
|
|
|
873
|
+ doCopyMutableByteArrayToAddrOp op_name src src_off dst n
|
|
880
|
874
|
CopyAddrToByteArrayOp -> \[src,dst,dst_off,n] -> inlinePrimop $ \[] ->
|
|
881
|
|
- doCopyAddrToByteArrayOp src dst dst_off n
|
|
|
875
|
+ doCopyAddrToByteArrayOp op_name src dst dst_off n
|
|
882
|
876
|
CopyAddrToAddrOp -> \[src,dst,n] -> inlinePrimop $ \[] ->
|
|
883
|
877
|
doCopyAddrToAddrOp src dst n
|
|
884
|
878
|
CopyAddrToAddrNonOverlappingOp -> \[src,dst,n] -> inlinePrimop $ \[] ->
|
|
885
|
|
- doCopyAddrToAddrNonOverlappingOp src dst n
|
|
|
879
|
+ doCopyAddrToAddrNonOverlappingOp op_name src dst n
|
|
886
|
880
|
SetByteArrayOp -> \[ba,off,len,c] -> inlinePrimop $ \[] ->
|
|
887
|
|
- doSetByteArrayOp ba off len c
|
|
|
881
|
+ doSetByteArrayOp op_name ba off len c
|
|
888
|
882
|
SetAddrRangeOp -> \[dst,len,c] -> inlinePrimop $ \[] ->
|
|
889
|
883
|
doSetAddrRangeOp dst len c
|
|
890
|
884
|
|
|
891
|
885
|
-- Comparing byte arrays
|
|
892
|
886
|
CompareByteArraysOp -> \[ba1,ba1_off,ba2,ba2_off,n] -> inlinePrimop $ \[res] ->
|
|
893
|
|
- doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n
|
|
|
887
|
+ doCompareByteArraysOp op_name res ba1 ba1_off ba2 ba2_off n
|
|
894
|
888
|
|
|
895
|
889
|
BSwap16Op -> \[w] -> inlinePrimop $ \[res] ->
|
|
896
|
890
|
emitBSwapCall res w W16
|
| ... |
... |
@@ -1051,21 +1045,21 @@ emitPrimOp cfg primop = |
|
1051
|
1045
|
|
|
1052
|
1046
|
(VecIndexByteArrayOp vcat n w) -> \args -> inlinePrimop $ \res0 -> do
|
|
1053
|
1047
|
checkVecCompatibility cfg vcat n w
|
|
1054
|
|
- doIndexByteArrayOp Nothing ty res0 args
|
|
|
1048
|
+ doIndexByteArrayOp op_name Nothing ty res0 args
|
|
1055
|
1049
|
where
|
|
1056
|
1050
|
ty :: CmmType
|
|
1057
|
1051
|
ty = vecCmmType vcat n w
|
|
1058
|
1052
|
|
|
1059
|
1053
|
(VecReadByteArrayOp vcat n w) -> \args -> inlinePrimop $ \res0 -> do
|
|
1060
|
1054
|
checkVecCompatibility cfg vcat n w
|
|
1061
|
|
- doIndexByteArrayOp Nothing ty res0 args
|
|
|
1055
|
+ doIndexByteArrayOp op_name Nothing ty res0 args
|
|
1062
|
1056
|
where
|
|
1063
|
1057
|
ty :: CmmType
|
|
1064
|
1058
|
ty = vecCmmType vcat n w
|
|
1065
|
1059
|
|
|
1066
|
1060
|
(VecWriteByteArrayOp vcat n w) -> \args -> inlinePrimop $ \res0 -> do
|
|
1067
|
1061
|
checkVecCompatibility cfg vcat n w
|
|
1068
|
|
- doWriteByteArrayOp Nothing ty res0 args
|
|
|
1062
|
+ doWriteByteArrayOp op_name Nothing ty res0 args
|
|
1069
|
1063
|
where
|
|
1070
|
1064
|
ty :: CmmType
|
|
1071
|
1065
|
ty = vecCmmType vcat n w
|
| ... |
... |
@@ -1093,7 +1087,7 @@ emitPrimOp cfg primop = |
|
1093
|
1087
|
|
|
1094
|
1088
|
(VecIndexScalarByteArrayOp vcat n w) -> \args -> inlinePrimop $ \res0 -> do
|
|
1095
|
1089
|
checkVecCompatibility cfg vcat n w
|
|
1096
|
|
- doIndexByteArrayOpAs Nothing vecty ty res0 args
|
|
|
1090
|
+ doIndexByteArrayOpAs op_name Nothing vecty ty res0 args
|
|
1097
|
1091
|
where
|
|
1098
|
1092
|
vecty :: CmmType
|
|
1099
|
1093
|
vecty = vecCmmType vcat n w
|
| ... |
... |
@@ -1103,7 +1097,7 @@ emitPrimOp cfg primop = |
|
1103
|
1097
|
|
|
1104
|
1098
|
(VecReadScalarByteArrayOp vcat n w) -> \args -> inlinePrimop $ \res0 -> do
|
|
1105
|
1099
|
checkVecCompatibility cfg vcat n w
|
|
1106
|
|
- doIndexByteArrayOpAs Nothing vecty ty res0 args
|
|
|
1100
|
+ doIndexByteArrayOpAs op_name Nothing vecty ty res0 args
|
|
1107
|
1101
|
where
|
|
1108
|
1102
|
vecty :: CmmType
|
|
1109
|
1103
|
vecty = vecCmmType vcat n w
|
| ... |
... |
@@ -1113,7 +1107,7 @@ emitPrimOp cfg primop = |
|
1113
|
1107
|
|
|
1114
|
1108
|
(VecWriteScalarByteArrayOp vcat n w) -> \args -> inlinePrimop $ \res0 -> do
|
|
1115
|
1109
|
checkVecCompatibility cfg vcat n w
|
|
1116
|
|
- doWriteByteArrayOp Nothing ty res0 args
|
|
|
1110
|
+ doWriteByteArrayOp op_name Nothing ty res0 args
|
|
1117
|
1111
|
where
|
|
1118
|
1112
|
ty :: CmmType
|
|
1119
|
1113
|
ty = vecCmmCat vcat w
|
| ... |
... |
@@ -1187,31 +1181,31 @@ emitPrimOp cfg primop = |
|
1187
|
1181
|
|
|
1188
|
1182
|
-- Atomic read-modify-write
|
|
1189
|
1183
|
FetchAddByteArrayOp_Int -> \[mba, ix, n] -> inlinePrimop $ \[res] ->
|
|
1190
|
|
- doAtomicByteArrayRMW res AMO_Add mba ix (bWord platform) n
|
|
|
1184
|
+ doAtomicByteArrayRMW op_name res AMO_Add mba ix (bWord platform) n
|
|
1191
|
1185
|
FetchSubByteArrayOp_Int -> \[mba, ix, n] -> inlinePrimop $ \[res] ->
|
|
1192
|
|
- doAtomicByteArrayRMW res AMO_Sub mba ix (bWord platform) n
|
|
|
1186
|
+ doAtomicByteArrayRMW op_name res AMO_Sub mba ix (bWord platform) n
|
|
1193
|
1187
|
FetchAndByteArrayOp_Int -> \[mba, ix, n] -> inlinePrimop $ \[res] ->
|
|
1194
|
|
- doAtomicByteArrayRMW res AMO_And mba ix (bWord platform) n
|
|
|
1188
|
+ doAtomicByteArrayRMW op_name res AMO_And mba ix (bWord platform) n
|
|
1195
|
1189
|
FetchNandByteArrayOp_Int -> \[mba, ix, n] -> inlinePrimop $ \[res] ->
|
|
1196
|
|
- doAtomicByteArrayRMW res AMO_Nand mba ix (bWord platform) n
|
|
|
1190
|
+ doAtomicByteArrayRMW op_name res AMO_Nand mba ix (bWord platform) n
|
|
1197
|
1191
|
FetchOrByteArrayOp_Int -> \[mba, ix, n] -> inlinePrimop $ \[res] ->
|
|
1198
|
|
- doAtomicByteArrayRMW res AMO_Or mba ix (bWord platform) n
|
|
|
1192
|
+ doAtomicByteArrayRMW op_name res AMO_Or mba ix (bWord platform) n
|
|
1199
|
1193
|
FetchXorByteArrayOp_Int -> \[mba, ix, n] -> inlinePrimop $ \[res] ->
|
|
1200
|
|
- doAtomicByteArrayRMW res AMO_Xor mba ix (bWord platform) n
|
|
|
1194
|
+ doAtomicByteArrayRMW op_name res AMO_Xor mba ix (bWord platform) n
|
|
1201
|
1195
|
AtomicReadByteArrayOp_Int -> \[mba, ix] -> inlinePrimop $ \[res] ->
|
|
1202
|
|
- doAtomicReadByteArray res mba ix (bWord platform)
|
|
|
1196
|
+ doAtomicReadByteArray op_name res mba ix (bWord platform)
|
|
1203
|
1197
|
AtomicWriteByteArrayOp_Int -> \[mba, ix, val] -> inlinePrimop $ \[] ->
|
|
1204
|
|
- doAtomicWriteByteArray mba ix (bWord platform) val
|
|
|
1198
|
+ doAtomicWriteByteArray op_name mba ix (bWord platform) val
|
|
1205
|
1199
|
CasByteArrayOp_Int -> \[mba, ix, old, new] -> inlinePrimop $ \[res] ->
|
|
1206
|
|
- doCasByteArray res mba ix (bWord platform) old new
|
|
|
1200
|
+ doCasByteArray op_name res mba ix (bWord platform) old new
|
|
1207
|
1201
|
CasByteArrayOp_Int8 -> \[mba, ix, old, new] -> inlinePrimop $ \[res] ->
|
|
1208
|
|
- doCasByteArray res mba ix b8 old new
|
|
|
1202
|
+ doCasByteArray op_name res mba ix b8 old new
|
|
1209
|
1203
|
CasByteArrayOp_Int16 -> \[mba, ix, old, new] -> inlinePrimop $ \[res] ->
|
|
1210
|
|
- doCasByteArray res mba ix b16 old new
|
|
|
1204
|
+ doCasByteArray op_name res mba ix b16 old new
|
|
1211
|
1205
|
CasByteArrayOp_Int32 -> \[mba, ix, old, new] -> inlinePrimop $ \[res] ->
|
|
1212
|
|
- doCasByteArray res mba ix b32 old new
|
|
|
1206
|
+ doCasByteArray op_name res mba ix b32 old new
|
|
1213
|
1207
|
CasByteArrayOp_Int64 -> \[mba, ix, old, new] -> inlinePrimop $ \[res] ->
|
|
1214
|
|
- doCasByteArray res mba ix b64 old new
|
|
|
1208
|
+ doCasByteArray op_name res mba ix b64 old new
|
|
1215
|
1209
|
|
|
1216
|
1210
|
-- The rest just translate straightforwardly
|
|
1217
|
1211
|
|
| ... |
... |
@@ -1865,6 +1859,10 @@ emitPrimOp cfg primop = |
|
1865
|
1859
|
platform = stgToCmmPlatform cfg
|
|
1866
|
1860
|
result_info = getPrimOpResultInfo primop
|
|
1867
|
1861
|
|
|
|
1862
|
+ -- The source name of the primop, for -fcheck-prim-bounds error messages.
|
|
|
1863
|
+ -- Lazy: only forced when such a check is emitted.
|
|
|
1864
|
+ op_name = occNameFS (primOpOcc primop)
|
|
|
1865
|
+
|
|
1868
|
1866
|
opNop :: [CmmExpr] -> PrimopCmmEmit
|
|
1869
|
1867
|
opNop args = inlinePrimop $ \[res] -> emitAssign (CmmLocal res) arg
|
|
1870
|
1868
|
where [arg] = args
|
| ... |
... |
@@ -2463,40 +2461,43 @@ doIndexOffAddrOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx] |
|
2463
|
2461
|
doIndexOffAddrOpAs _ _ _ _ _
|
|
2464
|
2462
|
= panic "GHC.StgToCmm.Prim: doIndexOffAddrOpAs"
|
|
2465
|
2463
|
|
|
2466
|
|
-doIndexByteArrayOp :: Maybe MachOp
|
|
|
2464
|
+doIndexByteArrayOp :: FastString
|
|
|
2465
|
+ -> Maybe MachOp
|
|
2467
|
2466
|
-> CmmType
|
|
2468
|
2467
|
-> [LocalReg]
|
|
2469
|
2468
|
-> [CmmExpr]
|
|
2470
|
2469
|
-> FCode ()
|
|
2471
|
|
-doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
|
|
|
2470
|
+doIndexByteArrayOp op_name maybe_post_read_cast rep [res] [addr,idx]
|
|
2472
|
2471
|
= do profile <- getProfile
|
|
2473
|
|
- doByteArrayBoundsCheck idx addr rep rep
|
|
|
2472
|
+ doByteArrayBoundsCheck op_name idx addr rep rep
|
|
2474
|
2473
|
mkBasicIndexedRead False NaturallyAligned (arrWordsHdrSize profile) maybe_post_read_cast rep res addr rep idx
|
|
2475
|
|
-doIndexByteArrayOp _ _ _ _
|
|
|
2474
|
+doIndexByteArrayOp _ _ _ _ _
|
|
2476
|
2475
|
= panic "GHC.StgToCmm.Prim: doIndexByteArrayOp"
|
|
2477
|
2476
|
|
|
2478
|
|
-doIndexByteArrayOpAs :: Maybe MachOp
|
|
|
2477
|
+doIndexByteArrayOpAs :: FastString
|
|
|
2478
|
+ -> Maybe MachOp
|
|
2479
|
2479
|
-> CmmType
|
|
2480
|
2480
|
-> CmmType
|
|
2481
|
2481
|
-> [LocalReg]
|
|
2482
|
2482
|
-> [CmmExpr]
|
|
2483
|
2483
|
-> FCode ()
|
|
2484
|
|
-doIndexByteArrayOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx]
|
|
|
2484
|
+doIndexByteArrayOpAs op_name maybe_post_read_cast rep idx_rep [res] [addr,idx]
|
|
2485
|
2485
|
= do profile <- getProfile
|
|
2486
|
|
- doByteArrayBoundsCheck idx addr idx_rep rep
|
|
|
2486
|
+ doByteArrayBoundsCheck op_name idx addr idx_rep rep
|
|
2487
|
2487
|
let alignment = alignmentFromTypes rep idx_rep
|
|
2488
|
2488
|
mkBasicIndexedRead False alignment (arrWordsHdrSize profile) maybe_post_read_cast rep res addr idx_rep idx
|
|
2489
|
|
-doIndexByteArrayOpAs _ _ _ _ _
|
|
|
2489
|
+doIndexByteArrayOpAs _ _ _ _ _ _
|
|
2490
|
2490
|
= panic "GHC.StgToCmm.Prim: doIndexByteArrayOpAs"
|
|
2491
|
2491
|
|
|
2492
|
|
-doReadPtrArrayOp :: LocalReg
|
|
|
2492
|
+doReadPtrArrayOp :: FastString
|
|
|
2493
|
+ -> LocalReg
|
|
2493
|
2494
|
-> CmmExpr
|
|
2494
|
2495
|
-> CmmExpr
|
|
2495
|
2496
|
-> FCode ()
|
|
2496
|
|
-doReadPtrArrayOp res addr idx
|
|
|
2497
|
+doReadPtrArrayOp op_name res addr idx
|
|
2497
|
2498
|
= do profile <- getProfile
|
|
2498
|
2499
|
platform <- getPlatform
|
|
2499
|
|
- doPtrArrayBoundsCheck idx addr
|
|
|
2500
|
+ doPtrArrayBoundsCheck op_name idx addr
|
|
2500
|
2501
|
mkBasicIndexedRead True NaturallyAligned (arrPtrsHdrSize profile) Nothing (gcWord platform) res addr (gcWord platform) idx
|
|
2501
|
2502
|
|
|
2502
|
2503
|
doWriteOffAddrOp :: Maybe MachOp
|
| ... |
... |
@@ -2509,31 +2510,33 @@ doWriteOffAddrOp castOp idx_ty [] [addr,idx, val] |
|
2509
|
2510
|
doWriteOffAddrOp _ _ _ _
|
|
2510
|
2511
|
= panic "GHC.StgToCmm.Prim: doWriteOffAddrOp"
|
|
2511
|
2512
|
|
|
2512
|
|
-doWriteByteArrayOp :: Maybe MachOp
|
|
|
2513
|
+doWriteByteArrayOp :: FastString
|
|
|
2514
|
+ -> Maybe MachOp
|
|
2513
|
2515
|
-> CmmType
|
|
2514
|
2516
|
-> [LocalReg]
|
|
2515
|
2517
|
-> [CmmExpr]
|
|
2516
|
2518
|
-> FCode ()
|
|
2517
|
|
-doWriteByteArrayOp castOp idx_ty [] [addr,idx, rawVal]
|
|
|
2519
|
+doWriteByteArrayOp op_name castOp idx_ty [] [addr,idx, rawVal]
|
|
2518
|
2520
|
= do profile <- getProfile
|
|
2519
|
2521
|
platform <- getPlatform
|
|
2520
|
2522
|
let val = maybeCast castOp rawVal
|
|
2521
|
|
- doByteArrayBoundsCheck idx addr idx_ty (cmmExprType platform val)
|
|
|
2523
|
+ doByteArrayBoundsCheck op_name idx addr idx_ty (cmmExprType platform val)
|
|
2522
|
2524
|
mkBasicIndexedWrite False (arrWordsHdrSize profile) addr idx_ty idx val
|
|
2523
|
|
-doWriteByteArrayOp _ _ _ _
|
|
|
2525
|
+doWriteByteArrayOp _ _ _ _ _
|
|
2524
|
2526
|
= panic "GHC.StgToCmm.Prim: doWriteByteArrayOp"
|
|
2525
|
2527
|
|
|
2526
|
|
-doWritePtrArrayOp :: CmmExpr
|
|
|
2528
|
+doWritePtrArrayOp :: FastString
|
|
|
2529
|
+ -> CmmExpr
|
|
2527
|
2530
|
-> CmmExpr
|
|
2528
|
2531
|
-> CmmExpr
|
|
2529
|
2532
|
-> FCode ()
|
|
2530
|
|
-doWritePtrArrayOp addr idx val
|
|
|
2533
|
+doWritePtrArrayOp op_name addr idx val
|
|
2531
|
2534
|
= do profile <- getProfile
|
|
2532
|
2535
|
platform <- getPlatform
|
|
2533
|
2536
|
let ty = cmmExprType platform val
|
|
2534
|
2537
|
hdr_size = arrPtrsHdrSize profile
|
|
2535
|
2538
|
|
|
2536
|
|
- doPtrArrayBoundsCheck idx addr
|
|
|
2539
|
+ doPtrArrayBoundsCheck op_name idx addr
|
|
2537
|
2540
|
|
|
2538
|
2541
|
-- Update remembered set for non-moving collector
|
|
2539
|
2542
|
whenUpdRemSetEnabled
|
| ... |
... |
@@ -2947,15 +2950,16 @@ doNewByteArrayOp res_r n = do |
|
2947
|
2950
|
-- ----------------------------------------------------------------------------
|
|
2948
|
2951
|
-- Comparing byte arrays
|
|
2949
|
2952
|
|
|
2950
|
|
-doCompareByteArraysOp :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
|
2953
|
+doCompareByteArraysOp :: FastString
|
|
|
2954
|
+ -> LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
2951
|
2955
|
-> FCode ()
|
|
2952
|
|
-doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n = do
|
|
|
2956
|
+doCompareByteArraysOp op_name res ba1 ba1_off ba2 ba2_off n = do
|
|
2953
|
2957
|
profile <- getProfile
|
|
2954
|
2958
|
platform <- getPlatform
|
|
2955
|
2959
|
|
|
2956
|
2960
|
whenCheckBounds $ ifNonZero n $ do
|
|
2957
|
|
- emitRangeBoundsCheck ba1_off n (byteArraySize platform profile ba1)
|
|
2958
|
|
- emitRangeBoundsCheck ba2_off n (byteArraySize platform profile ba2)
|
|
|
2961
|
+ emitRangeBoundsCheck op_name ba1_off n (byteArraySize platform profile ba1)
|
|
|
2962
|
+ emitRangeBoundsCheck op_name ba2_off n (byteArraySize platform profile ba2)
|
|
2959
|
2963
|
|
|
2960
|
2964
|
ba1_p <- assignTempE $ cmmOffsetExpr platform (cmmOffsetB platform ba1 (arrWordsHdrSize profile)) ba1_off
|
|
2961
|
2965
|
ba2_p <- assignTempE $ cmmOffsetExpr platform (cmmOffsetB platform ba2 (arrWordsHdrSize profile)) ba2_off
|
| ... |
... |
@@ -3011,23 +3015,25 @@ doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n = do |
|
3011
|
3015
|
-- destination 'MutableByteArray#', an offset into the destination
|
|
3012
|
3016
|
-- array, and the number of bytes to copy. Copies the given number of
|
|
3013
|
3017
|
-- bytes from the source array to the destination array.
|
|
3014
|
|
-doCopyByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
|
3018
|
+doCopyByteArrayOp :: FastString
|
|
|
3019
|
+ -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
3015
|
3020
|
-> FCode ()
|
|
3016
|
|
-doCopyByteArrayOp = emitCopyByteArray copy
|
|
|
3021
|
+doCopyByteArrayOp op_name = emitCopyByteArray op_name copy
|
|
3017
|
3022
|
where
|
|
3018
|
3023
|
-- Copy data (we assume the arrays aren't overlapping since
|
|
3019
|
3024
|
-- they're of different types)
|
|
3020
|
3025
|
copy _src _dst dst_p src_p bytes align =
|
|
3021
|
|
- emitCheckedMemcpyCall dst_p src_p bytes align
|
|
|
3026
|
+ emitCheckedMemcpyCall op_name dst_p src_p bytes align
|
|
3022
|
3027
|
|
|
3023
|
3028
|
-- | Takes a source 'MutableByteArray#', an offset in the source
|
|
3024
|
3029
|
-- array, a destination 'MutableByteArray#', an offset into the
|
|
3025
|
3030
|
-- destination array, and the number of bytes to copy. Copies the
|
|
3026
|
3031
|
-- given number of bytes from the source array to the destination
|
|
3027
|
3032
|
-- array.
|
|
3028
|
|
-doCopyMutableByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
|
3033
|
+doCopyMutableByteArrayOp :: FastString
|
|
|
3034
|
+ -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
3029
|
3035
|
-> FCode ()
|
|
3030
|
|
-doCopyMutableByteArrayOp = emitCopyByteArray copy
|
|
|
3036
|
+doCopyMutableByteArrayOp op_name = emitCopyByteArray op_name copy
|
|
3031
|
3037
|
where
|
|
3032
|
3038
|
-- The only time the memory might overlap is when the two arrays
|
|
3033
|
3039
|
-- we were provided are the same array!
|
| ... |
... |
@@ -3044,25 +3050,27 @@ doCopyMutableByteArrayOp = emitCopyByteArray copy |
|
3044
|
3050
|
-- destination array, and the number of bytes to copy. Copies the
|
|
3045
|
3051
|
-- given number of bytes from the source array to the destination
|
|
3046
|
3052
|
-- array. Assumes the two ranges are disjoint
|
|
3047
|
|
-doCopyMutableByteArrayNonOverlappingOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
|
3053
|
+doCopyMutableByteArrayNonOverlappingOp :: FastString
|
|
|
3054
|
+ -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
3048
|
3055
|
-> FCode ()
|
|
3049
|
|
-doCopyMutableByteArrayNonOverlappingOp = emitCopyByteArray copy
|
|
|
3056
|
+doCopyMutableByteArrayNonOverlappingOp op_name = emitCopyByteArray op_name copy
|
|
3050
|
3057
|
where
|
|
3051
|
3058
|
copy _src _dst dst_p src_p bytes align = do
|
|
3052
|
|
- emitCheckedMemcpyCall dst_p src_p bytes align
|
|
|
3059
|
+ emitCheckedMemcpyCall op_name dst_p src_p bytes align
|
|
3053
|
3060
|
|
|
3054
|
3061
|
|
|
3055
|
|
-emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
|
3062
|
+emitCopyByteArray :: FastString
|
|
|
3063
|
+ -> (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
3056
|
3064
|
-> Alignment -> FCode ())
|
|
3057
|
3065
|
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
3058
|
3066
|
-> FCode ()
|
|
3059
|
|
-emitCopyByteArray copy src src_off dst dst_off n = do
|
|
|
3067
|
+emitCopyByteArray op_name copy src src_off dst dst_off n = do
|
|
3060
|
3068
|
profile <- getProfile
|
|
3061
|
3069
|
platform <- getPlatform
|
|
3062
|
3070
|
|
|
3063
|
3071
|
whenCheckBounds $ ifNonZero n $ do
|
|
3064
|
|
- emitRangeBoundsCheck src_off n (byteArraySize platform profile src)
|
|
3065
|
|
- emitRangeBoundsCheck dst_off n (byteArraySize platform profile dst)
|
|
|
3072
|
+ emitRangeBoundsCheck op_name src_off n (byteArraySize platform profile src)
|
|
|
3073
|
+ emitRangeBoundsCheck op_name dst_off n (byteArraySize platform profile dst)
|
|
3066
|
3074
|
|
|
3067
|
3075
|
let byteArrayAlignment = wordAlignment platform
|
|
3068
|
3076
|
srcOffAlignment = cmmExprAlignment src_off
|
| ... |
... |
@@ -3075,35 +3083,35 @@ emitCopyByteArray copy src src_off dst dst_off n = do |
|
3075
|
3083
|
-- | Takes a source 'ByteArray#', an offset in the source array, a
|
|
3076
|
3084
|
-- destination 'Addr#', and the number of bytes to copy. Copies the given
|
|
3077
|
3085
|
-- number of bytes from the source array to the destination memory region.
|
|
3078
|
|
-doCopyByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
|
|
3079
|
|
-doCopyByteArrayToAddrOp src src_off dst_p bytes = do
|
|
|
3086
|
+doCopyByteArrayToAddrOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
|
|
|
3087
|
+doCopyByteArrayToAddrOp op_name src src_off dst_p bytes = do
|
|
3080
|
3088
|
-- Use memcpy (we are allowed to assume the arrays aren't overlapping)
|
|
3081
|
3089
|
profile <- getProfile
|
|
3082
|
3090
|
platform <- getPlatform
|
|
3083
|
3091
|
whenCheckBounds $ ifNonZero bytes $ do
|
|
3084
|
|
- emitRangeBoundsCheck src_off bytes (byteArraySize platform profile src)
|
|
|
3092
|
+ emitRangeBoundsCheck op_name src_off bytes (byteArraySize platform profile src)
|
|
3085
|
3093
|
src_p <- assignTempE $ cmmOffsetExpr platform (cmmOffsetB platform src (arrWordsHdrSize profile)) src_off
|
|
3086
|
|
- emitCheckedMemcpyCall dst_p src_p bytes (mkAlignment 1)
|
|
|
3094
|
+ emitCheckedMemcpyCall op_name dst_p src_p bytes (mkAlignment 1)
|
|
3087
|
3095
|
|
|
3088
|
3096
|
-- | Takes a source 'MutableByteArray#', an offset in the source array, a
|
|
3089
|
3097
|
-- destination 'Addr#', and the number of bytes to copy. Copies the given
|
|
3090
|
3098
|
-- number of bytes from the source array to the destination memory region.
|
|
3091
|
|
-doCopyMutableByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
|
3099
|
+doCopyMutableByteArrayToAddrOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
3092
|
3100
|
-> FCode ()
|
|
3093
|
3101
|
doCopyMutableByteArrayToAddrOp = doCopyByteArrayToAddrOp
|
|
3094
|
3102
|
|
|
3095
|
3103
|
-- | Takes a source 'Addr#', a destination 'MutableByteArray#', an offset into
|
|
3096
|
3104
|
-- the destination array, and the number of bytes to copy. Copies the given
|
|
3097
|
3105
|
-- number of bytes from the source memory region to the destination array.
|
|
3098
|
|
-doCopyAddrToByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
|
|
3099
|
|
-doCopyAddrToByteArrayOp src_p dst dst_off bytes = do
|
|
|
3106
|
+doCopyAddrToByteArrayOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
|
|
|
3107
|
+doCopyAddrToByteArrayOp op_name src_p dst dst_off bytes = do
|
|
3100
|
3108
|
-- Use memcpy (we are allowed to assume the arrays aren't overlapping)
|
|
3101
|
3109
|
profile <- getProfile
|
|
3102
|
3110
|
platform <- getPlatform
|
|
3103
|
3111
|
whenCheckBounds $ ifNonZero bytes $ do
|
|
3104
|
|
- emitRangeBoundsCheck dst_off bytes (byteArraySize platform profile dst)
|
|
|
3112
|
+ emitRangeBoundsCheck op_name dst_off bytes (byteArraySize platform profile dst)
|
|
3105
|
3113
|
dst_p <- assignTempE $ cmmOffsetExpr platform (cmmOffsetB platform dst (arrWordsHdrSize profile)) dst_off
|
|
3106
|
|
- emitCheckedMemcpyCall dst_p src_p bytes (mkAlignment 1)
|
|
|
3114
|
+ emitCheckedMemcpyCall op_name dst_p src_p bytes (mkAlignment 1)
|
|
3107
|
3115
|
|
|
3108
|
3116
|
-- | Takes a source 'Addr#', a destination 'Addr#', and the number of
|
|
3109
|
3117
|
-- bytes to copy. Copies the given number of bytes from the source
|
| ... |
... |
@@ -3116,10 +3124,10 @@ doCopyAddrToAddrOp src_p dst_p bytes = do |
|
3116
|
3124
|
-- | Takes a source 'Addr#', a destination 'Addr#', and the number of
|
|
3117
|
3125
|
-- bytes to copy. Copies the given number of bytes from the source
|
|
3118
|
3126
|
-- memory region to the destination region. The regions may not overlap.
|
|
3119
|
|
-doCopyAddrToAddrNonOverlappingOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
|
|
3120
|
|
-doCopyAddrToAddrNonOverlappingOp src_p dst_p bytes = do
|
|
|
3127
|
+doCopyAddrToAddrNonOverlappingOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
|
|
|
3128
|
+doCopyAddrToAddrNonOverlappingOp op_name src_p dst_p bytes = do
|
|
3121
|
3129
|
-- Use memcpy; the ranges may not overlap
|
|
3122
|
|
- emitCheckedMemcpyCall dst_p src_p bytes (mkAlignment 1)
|
|
|
3130
|
+ emitCheckedMemcpyCall op_name dst_p src_p bytes (mkAlignment 1)
|
|
3123
|
3131
|
|
|
3124
|
3132
|
ifNonZero :: CmmExpr -> FCode () -> FCode ()
|
|
3125
|
3133
|
ifNonZero e it = do
|
| ... |
... |
@@ -3137,14 +3145,14 @@ ifNonZero e it = do |
|
3137
|
3145
|
-- | Takes a 'MutableByteArray#', an offset into the array, a length,
|
|
3138
|
3146
|
-- and a byte, and sets each of the selected bytes in the array to the
|
|
3139
|
3147
|
-- given byte.
|
|
3140
|
|
-doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
|
3148
|
+doSetByteArrayOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
|
|
3141
|
3149
|
-> FCode ()
|
|
3142
|
|
-doSetByteArrayOp ba off len c = do
|
|
|
3150
|
+doSetByteArrayOp op_name ba off len c = do
|
|
3143
|
3151
|
profile <- getProfile
|
|
3144
|
3152
|
platform <- getPlatform
|
|
3145
|
3153
|
|
|
3146
|
3154
|
whenCheckBounds $ ifNonZero len $
|
|
3147
|
|
- emitRangeBoundsCheck off len (byteArraySize platform profile ba)
|
|
|
3155
|
+ emitRangeBoundsCheck op_name off len (byteArraySize platform profile ba)
|
|
3148
|
3156
|
|
|
3149
|
3157
|
let byteArrayAlignment = wordAlignment platform -- known since BA is allocated on heap
|
|
3150
|
3158
|
offsetAlignment = cmmExprAlignment off
|
| ... |
... |
@@ -3215,15 +3223,15 @@ assignTempE e = do |
|
3215
|
3223
|
-- destination 'MutableArray#', an offset into the destination array,
|
|
3216
|
3224
|
-- and the number of elements to copy. Copies the given number of
|
|
3217
|
3225
|
-- elements from the source array to the destination array.
|
|
3218
|
|
-doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
|
|
|
3226
|
+doCopyArrayOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
|
|
3219
|
3227
|
-> FCode ()
|
|
3220
|
|
-doCopyArrayOp = emitCopyArray copy
|
|
|
3228
|
+doCopyArrayOp op_name = emitCopyArray op_name copy
|
|
3221
|
3229
|
where
|
|
3222
|
3230
|
-- Copy data (we assume the arrays aren't overlapping since
|
|
3223
|
3231
|
-- they're of different types)
|
|
3224
|
3232
|
copy _src _dst dst_p src_p bytes =
|
|
3225
|
3233
|
do platform <- getPlatform
|
|
3226
|
|
- emitCheckedMemcpyCall dst_p src_p (mkIntExpr platform (toTargetInt bytes))
|
|
|
3234
|
+ emitCheckedMemcpyCall op_name dst_p src_p (mkIntExpr platform (toTargetInt bytes))
|
|
3227
|
3235
|
(wordAlignment platform)
|
|
3228
|
3236
|
|
|
3229
|
3237
|
|
| ... |
... |
@@ -3231,9 +3239,9 @@ doCopyArrayOp = emitCopyArray copy |
|
3231
|
3239
|
-- destination 'MutableArray#', an offset into the destination array,
|
|
3232
|
3240
|
-- and the number of elements to copy. Copies the given number of
|
|
3233
|
3241
|
-- elements from the source array to the destination array.
|
|
3234
|
|
-doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
|
|
|
3242
|
+doCopyMutableArrayOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
|
|
3235
|
3243
|
-> FCode ()
|
|
3236
|
|
-doCopyMutableArrayOp = emitCopyArray copy
|
|
|
3244
|
+doCopyMutableArrayOp op_name = emitCopyArray op_name copy
|
|
3237
|
3245
|
where
|
|
3238
|
3246
|
-- The only time the memory might overlap is when the two arrays
|
|
3239
|
3247
|
-- we were provided are the same array!
|
| ... |
... |
@@ -3247,7 +3255,8 @@ doCopyMutableArrayOp = emitCopyArray copy |
|
3247
|
3255
|
(wordAlignment platform))
|
|
3248
|
3256
|
emit =<< mkCmmIfThenElse (cmmEqWord platform src dst) moveCall cpyCall
|
|
3249
|
3257
|
|
|
3250
|
|
-emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
|
|
|
3258
|
+emitCopyArray :: FastString -- ^ primop name
|
|
|
3259
|
+ -> (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
|
|
3251
|
3260
|
-> FCode ()) -- ^ copy function
|
|
3252
|
3261
|
-> CmmExpr -- ^ source array
|
|
3253
|
3262
|
-> CmmExpr -- ^ offset in source array
|
| ... |
... |
@@ -3255,7 +3264,7 @@ emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff |
|
3255
|
3264
|
-> CmmExpr -- ^ offset in destination array
|
|
3256
|
3265
|
-> WordOff -- ^ number of elements to copy
|
|
3257
|
3266
|
-> FCode ()
|
|
3258
|
|
-emitCopyArray copy src0 src_off dst0 dst_off0 n =
|
|
|
3267
|
+emitCopyArray op_name copy src0 src_off dst0 dst_off0 n =
|
|
3259
|
3268
|
when (n /= 0) $ do
|
|
3260
|
3269
|
profile <- getProfile
|
|
3261
|
3270
|
platform <- getPlatform
|
| ... |
... |
@@ -3266,9 +3275,9 @@ emitCopyArray copy src0 src_off dst0 dst_off0 n = |
|
3266
|
3275
|
dst_off <- assignTempE dst_off0
|
|
3267
|
3276
|
|
|
3268
|
3277
|
whenCheckBounds $ do
|
|
3269
|
|
- emitRangeBoundsCheck src_off (mkIntExpr platform (toTargetInt n))
|
|
|
3278
|
+ emitRangeBoundsCheck op_name src_off (mkIntExpr platform (toTargetInt n))
|
|
3270
|
3279
|
(ptrArraySize platform profile src)
|
|
3271
|
|
- emitRangeBoundsCheck dst_off (mkIntExpr platform (toTargetInt n))
|
|
|
3280
|
+ emitRangeBoundsCheck op_name dst_off (mkIntExpr platform (toTargetInt n))
|
|
3272
|
3281
|
(ptrArraySize platform profile dst)
|
|
3273
|
3282
|
|
|
3274
|
3283
|
-- Nonmoving collector write barrier
|
| ... |
... |
@@ -3292,21 +3301,21 @@ emitCopyArray copy src0 src_off dst0 dst_off0 n = |
|
3292
|
3301
|
|
|
3293
|
3302
|
emitSetCards dst_off dst_cards_p n
|
|
3294
|
3303
|
|
|
3295
|
|
-doCopySmallArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
|
|
|
3304
|
+doCopySmallArrayOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
|
|
3296
|
3305
|
-> FCode ()
|
|
3297
|
|
-doCopySmallArrayOp = emitCopySmallArray copy
|
|
|
3306
|
+doCopySmallArrayOp op_name = emitCopySmallArray op_name copy
|
|
3298
|
3307
|
where
|
|
3299
|
3308
|
-- Copy data (we assume the arrays aren't overlapping since
|
|
3300
|
3309
|
-- they're of different types)
|
|
3301
|
3310
|
copy _src _dst dst_p src_p bytes =
|
|
3302
|
3311
|
do platform <- getPlatform
|
|
3303
|
|
- emitCheckedMemcpyCall dst_p src_p (mkIntExpr platform (toTargetInt bytes))
|
|
|
3312
|
+ emitCheckedMemcpyCall op_name dst_p src_p (mkIntExpr platform (toTargetInt bytes))
|
|
3304
|
3313
|
(wordAlignment platform)
|
|
3305
|
3314
|
|
|
3306
|
3315
|
|
|
3307
|
|
-doCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
|
|
|
3316
|
+doCopySmallMutableArrayOp :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
|
|
3308
|
3317
|
-> FCode ()
|
|
3309
|
|
-doCopySmallMutableArrayOp = emitCopySmallArray copy
|
|
|
3318
|
+doCopySmallMutableArrayOp op_name = emitCopySmallArray op_name copy
|
|
3310
|
3319
|
where
|
|
3311
|
3320
|
-- The only time the memory might overlap is when the two arrays
|
|
3312
|
3321
|
-- we were provided are the same array!
|
| ... |
... |
@@ -3320,7 +3329,8 @@ doCopySmallMutableArrayOp = emitCopySmallArray copy |
|
3320
|
3329
|
(wordAlignment platform))
|
|
3321
|
3330
|
emit =<< mkCmmIfThenElse (cmmEqWord platform src dst) moveCall cpyCall
|
|
3322
|
3331
|
|
|
3323
|
|
-emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
|
|
|
3332
|
+emitCopySmallArray :: FastString -- ^ primop name
|
|
|
3333
|
+ -> (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
|
|
3324
|
3334
|
-> FCode ()) -- ^ copy function
|
|
3325
|
3335
|
-> CmmExpr -- ^ source array
|
|
3326
|
3336
|
-> CmmExpr -- ^ offset in source array
|
| ... |
... |
@@ -3328,7 +3338,7 @@ emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff |
|
3328
|
3338
|
-> CmmExpr -- ^ offset in destination array
|
|
3329
|
3339
|
-> WordOff -- ^ number of elements to copy
|
|
3330
|
3340
|
-> FCode ()
|
|
3331
|
|
-emitCopySmallArray copy src0 src_off dst0 dst_off n =
|
|
|
3341
|
+emitCopySmallArray op_name copy src0 src_off dst0 dst_off n =
|
|
3332
|
3342
|
when (n /= 0) $ do
|
|
3333
|
3343
|
profile <- getProfile
|
|
3334
|
3344
|
platform <- getPlatform
|
| ... |
... |
@@ -3338,9 +3348,9 @@ emitCopySmallArray copy src0 src_off dst0 dst_off n = |
|
3338
|
3348
|
dst <- assignTempE dst0
|
|
3339
|
3349
|
|
|
3340
|
3350
|
whenCheckBounds $ do
|
|
3341
|
|
- emitRangeBoundsCheck src_off (mkIntExpr platform (toTargetInt n))
|
|
|
3351
|
+ emitRangeBoundsCheck op_name src_off (mkIntExpr platform (toTargetInt n))
|
|
3342
|
3352
|
(smallPtrArraySize platform profile src)
|
|
3343
|
|
- emitRangeBoundsCheck dst_off (mkIntExpr platform (toTargetInt n))
|
|
|
3353
|
+ emitRangeBoundsCheck op_name dst_off (mkIntExpr platform (toTargetInt n))
|
|
3344
|
3354
|
(smallPtrArraySize platform profile dst)
|
|
3345
|
3355
|
|
|
3346
|
3356
|
-- Nonmoving collector write barrier
|
| ... |
... |
@@ -3461,27 +3471,29 @@ cardCmm platform i = |
|
3461
|
3471
|
------------------------------------------------------------------------------
|
|
3462
|
3472
|
-- SmallArray PrimOp implementations
|
|
3463
|
3473
|
|
|
3464
|
|
-doReadSmallPtrArrayOp :: LocalReg
|
|
|
3474
|
+doReadSmallPtrArrayOp :: FastString
|
|
|
3475
|
+ -> LocalReg
|
|
3465
|
3476
|
-> CmmExpr
|
|
3466
|
3477
|
-> CmmExpr
|
|
3467
|
3478
|
-> FCode ()
|
|
3468
|
|
-doReadSmallPtrArrayOp res addr idx = do
|
|
|
3479
|
+doReadSmallPtrArrayOp op_name res addr idx = do
|
|
3469
|
3480
|
profile <- getProfile
|
|
3470
|
3481
|
platform <- getPlatform
|
|
3471
|
|
- doSmallPtrArrayBoundsCheck idx addr
|
|
|
3482
|
+ doSmallPtrArrayBoundsCheck op_name idx addr
|
|
3472
|
3483
|
mkBasicIndexedRead True NaturallyAligned (smallArrPtrsHdrSize profile) Nothing (gcWord platform) res addr
|
|
3473
|
3484
|
(gcWord platform) idx
|
|
3474
|
3485
|
|
|
3475
|
|
-doWriteSmallPtrArrayOp :: CmmExpr
|
|
|
3486
|
+doWriteSmallPtrArrayOp :: FastString
|
|
|
3487
|
+ -> CmmExpr
|
|
3476
|
3488
|
-> CmmExpr
|
|
3477
|
3489
|
-> CmmExpr
|
|
3478
|
3490
|
-> FCode ()
|
|
3479
|
|
-doWriteSmallPtrArrayOp addr idx val = do
|
|
|
3491
|
+doWriteSmallPtrArrayOp op_name addr idx val = do
|
|
3480
|
3492
|
profile <- getProfile
|
|
3481
|
3493
|
platform <- getPlatform
|
|
3482
|
3494
|
let ty = cmmExprType platform val
|
|
3483
|
3495
|
|
|
3484
|
|
- doSmallPtrArrayBoundsCheck idx addr
|
|
|
3496
|
+ doSmallPtrArrayBoundsCheck op_name idx addr
|
|
3485
|
3497
|
|
|
3486
|
3498
|
-- Update remembered set for non-moving collector
|
|
3487
|
3499
|
tmp <- newTemp ty
|
| ... |
... |
@@ -3499,17 +3511,18 @@ doWriteSmallPtrArrayOp addr idx val = do |
|
3499
|
3511
|
-- reg contains that previous value of the element. Implies a full
|
|
3500
|
3512
|
-- memory barrier.
|
|
3501
|
3513
|
doAtomicByteArrayRMW
|
|
3502
|
|
- :: LocalReg -- ^ Result reg
|
|
|
3514
|
+ :: FastString -- ^ Primop name
|
|
|
3515
|
+ -> LocalReg -- ^ Result reg
|
|
3503
|
3516
|
-> AtomicMachOp -- ^ Atomic op (e.g. add)
|
|
3504
|
3517
|
-> CmmExpr -- ^ MutableByteArray#
|
|
3505
|
3518
|
-> CmmExpr -- ^ Index
|
|
3506
|
3519
|
-> CmmType -- ^ Type of element by which we are indexing
|
|
3507
|
3520
|
-> CmmExpr -- ^ Op argument (e.g. amount to add)
|
|
3508
|
3521
|
-> FCode ()
|
|
3509
|
|
-doAtomicByteArrayRMW res amop mba idx idx_ty n = do
|
|
|
3522
|
+doAtomicByteArrayRMW op_name res amop mba idx idx_ty n = do
|
|
3510
|
3523
|
profile <- getProfile
|
|
3511
|
3524
|
platform <- getPlatform
|
|
3512
|
|
- doByteArrayBoundsCheck idx mba idx_ty idx_ty
|
|
|
3525
|
+ doByteArrayBoundsCheck op_name idx mba idx_ty idx_ty
|
|
3513
|
3526
|
let width = typeWidth idx_ty
|
|
3514
|
3527
|
addr = cmmIndexOffExpr platform (arrWordsHdrSize profile)
|
|
3515
|
3528
|
width mba idx
|
| ... |
... |
@@ -3530,15 +3543,16 @@ doAtomicAddrRMW res amop addr ty n = |
|
3530
|
3543
|
|
|
3531
|
3544
|
-- | Emit an atomic read to a byte array that acts as a memory barrier.
|
|
3532
|
3545
|
doAtomicReadByteArray
|
|
3533
|
|
- :: LocalReg -- ^ Result reg
|
|
|
3546
|
+ :: FastString -- ^ Primop name
|
|
|
3547
|
+ -> LocalReg -- ^ Result reg
|
|
3534
|
3548
|
-> CmmExpr -- ^ MutableByteArray#
|
|
3535
|
3549
|
-> CmmExpr -- ^ Index
|
|
3536
|
3550
|
-> CmmType -- ^ Type of element by which we are indexing
|
|
3537
|
3551
|
-> FCode ()
|
|
3538
|
|
-doAtomicReadByteArray res mba idx idx_ty = do
|
|
|
3552
|
+doAtomicReadByteArray op_name res mba idx idx_ty = do
|
|
3539
|
3553
|
profile <- getProfile
|
|
3540
|
3554
|
platform <- getPlatform
|
|
3541
|
|
- doByteArrayBoundsCheck idx mba idx_ty idx_ty
|
|
|
3555
|
+ doByteArrayBoundsCheck op_name idx mba idx_ty idx_ty
|
|
3542
|
3556
|
let width = typeWidth idx_ty
|
|
3543
|
3557
|
addr = cmmIndexOffExpr platform (arrWordsHdrSize profile)
|
|
3544
|
3558
|
width mba idx
|
| ... |
... |
@@ -3558,15 +3572,16 @@ doAtomicReadAddr res addr ty = |
|
3558
|
3572
|
|
|
3559
|
3573
|
-- | Emit an atomic write to a byte array that acts as a memory barrier.
|
|
3560
|
3574
|
doAtomicWriteByteArray
|
|
3561
|
|
- :: CmmExpr -- ^ MutableByteArray#
|
|
|
3575
|
+ :: FastString -- ^ Primop name
|
|
|
3576
|
+ -> CmmExpr -- ^ MutableByteArray#
|
|
3562
|
3577
|
-> CmmExpr -- ^ Index
|
|
3563
|
3578
|
-> CmmType -- ^ Type of element by which we are indexing
|
|
3564
|
3579
|
-> CmmExpr -- ^ Value to write
|
|
3565
|
3580
|
-> FCode ()
|
|
3566
|
|
-doAtomicWriteByteArray mba idx idx_ty val = do
|
|
|
3581
|
+doAtomicWriteByteArray op_name mba idx idx_ty val = do
|
|
3567
|
3582
|
profile <- getProfile
|
|
3568
|
3583
|
platform <- getPlatform
|
|
3569
|
|
- doByteArrayBoundsCheck idx mba idx_ty idx_ty
|
|
|
3584
|
+ doByteArrayBoundsCheck op_name idx mba idx_ty idx_ty
|
|
3570
|
3585
|
let width = typeWidth idx_ty
|
|
3571
|
3586
|
addr = cmmIndexOffExpr platform (arrWordsHdrSize profile)
|
|
3572
|
3587
|
width mba idx
|
| ... |
... |
@@ -3585,17 +3600,18 @@ doAtomicWriteAddr addr ty val = |
|
3585
|
3600
|
[ addr, val ]
|
|
3586
|
3601
|
|
|
3587
|
3602
|
doCasByteArray
|
|
3588
|
|
- :: LocalReg -- ^ Result reg
|
|
|
3603
|
+ :: FastString -- ^ Primop name
|
|
|
3604
|
+ -> LocalReg -- ^ Result reg
|
|
3589
|
3605
|
-> CmmExpr -- ^ MutableByteArray#
|
|
3590
|
3606
|
-> CmmExpr -- ^ Index
|
|
3591
|
3607
|
-> CmmType -- ^ Type of element by which we are indexing
|
|
3592
|
3608
|
-> CmmExpr -- ^ Old value
|
|
3593
|
3609
|
-> CmmExpr -- ^ New value
|
|
3594
|
3610
|
-> FCode ()
|
|
3595
|
|
-doCasByteArray res mba idx idx_ty old new = do
|
|
|
3611
|
+doCasByteArray op_name res mba idx idx_ty old new = do
|
|
3596
|
3612
|
profile <- getProfile
|
|
3597
|
3613
|
platform <- getPlatform
|
|
3598
|
|
- doByteArrayBoundsCheck idx mba idx_ty idx_ty
|
|
|
3614
|
+ doByteArrayBoundsCheck op_name idx mba idx_ty idx_ty
|
|
3599
|
3615
|
let width = typeWidth idx_ty
|
|
3600
|
3616
|
addr = cmmIndexOffExpr platform (arrWordsHdrSize profile)
|
|
3601
|
3617
|
width mba idx
|
| ... |
... |
@@ -3617,15 +3633,14 @@ emitMemcpyCall dst src n align = |
|
3617
|
3633
|
|
|
3618
|
3634
|
-- | Emit a call to @memcpy@, but check for range
|
|
3619
|
3635
|
-- overlap when -fcheck-prim-bounds is on.
|
|
3620
|
|
-emitCheckedMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
|
|
3621
|
|
-emitCheckedMemcpyCall dst src n align = do
|
|
|
3636
|
+emitCheckedMemcpyCall :: FastString -> CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
|
|
|
3637
|
+emitCheckedMemcpyCall op_name dst src n align = do
|
|
3622
|
3638
|
whenCheckBounds (getPlatform >>= doCheck)
|
|
3623
|
3639
|
emitMemcpyCall dst src n align
|
|
3624
|
3640
|
where
|
|
3625
|
3641
|
doCheck platform = do
|
|
3626
|
|
- name <- fromMaybe (fsLit "<unknown primop>") <$> getCurrentPrimOpName
|
|
3627
|
|
- nameLbl <- newByteStringCLit (bytesFS name)
|
|
3628
|
|
- modLbl <- getCurrentModuleCLit
|
|
|
3642
|
+ nameLbl <- newByteStringCLit (bytesFS op_name)
|
|
|
3643
|
+ modLbl <- getModuleNameCLit
|
|
3629
|
3644
|
overlapCheckFailed <- getCode $
|
|
3630
|
3645
|
emitCCallNeverReturns []
|
|
3631
|
3646
|
(mkLblExpr mkMemcpyRangeOverlapLabel)
|
| ... |
... |
@@ -3742,48 +3757,43 @@ whenCheckBounds a = do |
|
3742
|
3757
|
False -> pure ()
|
|
3743
|
3758
|
True -> a
|
|
3744
|
3759
|
|
|
3745
|
|
--- | The bare name of the module currently being code-generated, as a string
|
|
3746
|
|
--- literal, for use in @-fcheck-prim-bounds@ failure diagnostics.
|
|
3747
|
|
-getCurrentModuleCLit :: FCode CmmLit
|
|
3748
|
|
-getCurrentModuleCLit = do
|
|
3749
|
|
- mod <- getModuleName
|
|
3750
|
|
- newByteStringCLit (bytesFS (moduleNameFS (moduleName mod)))
|
|
3751
|
|
-
|
|
3752
|
3760
|
-- | Emit a call to the RTS @rtsOutOfBoundsAccess@ bounds-check failure
|
|
3753
|
|
--- handler, passing the offending index, element count, array size, primop name
|
|
3754
|
|
--- (see 'withCurrentPrimOpName') and the module being compiled.
|
|
3755
|
|
-emitBoundsCheckFailed :: CmmExpr -- ^ accessed index
|
|
|
3761
|
+-- handler, passing the failing primop, the offending index, element count,
|
|
|
3762
|
+-- array size, and the module being compiled.
|
|
|
3763
|
+emitBoundsCheckFailed :: FastString -- ^ primop name
|
|
|
3764
|
+ -> CmmExpr -- ^ accessed index
|
|
3756
|
3765
|
-> CmmExpr -- ^ number of accessed elements
|
|
3757
|
3766
|
-> CmmExpr -- ^ array size (in elements)
|
|
3758
|
3767
|
-> FCode ()
|
|
3759
|
|
-emitBoundsCheckFailed idx count sz = do
|
|
3760
|
|
- name <- fromMaybe (fsLit "<unknown primop>") <$> getCurrentPrimOpName
|
|
3761
|
|
- nameLbl <- newByteStringCLit (bytesFS name)
|
|
3762
|
|
- modLbl <- getCurrentModuleCLit
|
|
|
3768
|
+emitBoundsCheckFailed op_name idx count sz = do
|
|
|
3769
|
+ nameLbl <- newByteStringCLit (bytesFS op_name)
|
|
|
3770
|
+ modLbl <- getModuleNameCLit
|
|
3763
|
3771
|
emitCCallNeverReturns []
|
|
3764
|
3772
|
(mkLblExpr mkOutOfBoundsAccessLabel)
|
|
3765
|
|
- [ (idx, NoHint)
|
|
|
3773
|
+ [ (CmmLit nameLbl, AddrHint)
|
|
|
3774
|
+ , (idx, NoHint)
|
|
3766
|
3775
|
, (count, NoHint)
|
|
3767
|
3776
|
, (sz, NoHint)
|
|
3768
|
|
- , (CmmLit nameLbl, AddrHint)
|
|
3769
|
3777
|
, (CmmLit modLbl, AddrHint) ]
|
|
3770
|
3778
|
|
|
3771
|
|
-emitBoundsCheck :: CmmExpr -- ^ accessed index
|
|
|
3779
|
+emitBoundsCheck :: FastString -- ^ primop name
|
|
|
3780
|
+ -> CmmExpr -- ^ accessed index
|
|
3772
|
3781
|
-> CmmExpr -- ^ array size (in elements)
|
|
3773
|
3782
|
-> FCode ()
|
|
3774
|
|
-emitBoundsCheck idx sz = do
|
|
|
3783
|
+emitBoundsCheck op_name idx sz = do
|
|
3775
|
3784
|
assertM (stgToCmmDoBoundsCheck <$> getStgToCmmConfig)
|
|
3776
|
3785
|
platform <- getPlatform
|
|
3777
|
3786
|
boundsCheckFailed <- getCode $
|
|
3778
|
|
- emitBoundsCheckFailed idx (mkIntExpr platform 1) sz
|
|
|
3787
|
+ emitBoundsCheckFailed op_name idx (mkIntExpr platform 1) sz
|
|
3779
|
3788
|
let isOutOfBounds = cmmUGeWord platform idx sz
|
|
3780
|
3789
|
emit =<< mkCmmIfThen' isOutOfBounds boundsCheckFailed (Just False)
|
|
3781
|
3790
|
|
|
3782
|
|
-emitRangeBoundsCheck :: CmmExpr -- ^ first accessed index
|
|
|
3791
|
+emitRangeBoundsCheck :: FastString -- ^ primop name
|
|
|
3792
|
+ -> CmmExpr -- ^ first accessed index
|
|
3783
|
3793
|
-> CmmExpr -- ^ number of accessed indices (non-zero)
|
|
3784
|
3794
|
-> CmmExpr -- ^ array size (in elements)
|
|
3785
|
3795
|
-> FCode ()
|
|
3786
|
|
-emitRangeBoundsCheck idx len arrSizeExpr = do
|
|
|
3796
|
+emitRangeBoundsCheck op_name idx len arrSizeExpr = do
|
|
3787
|
3797
|
assertM (stgToCmmDoBoundsCheck <$> getStgToCmmConfig)
|
|
3788
|
3798
|
config <- getStgToCmmConfig
|
|
3789
|
3799
|
platform <- getPlatform
|
| ... |
... |
@@ -3794,7 +3804,7 @@ emitRangeBoundsCheck idx len arrSizeExpr = do |
|
3794
|
3804
|
_ <- withSequel (AssignTo [lastSafeIndexReg, rangeTooLargeReg] False) $
|
|
3795
|
3805
|
cmmPrimOpApp config WordSubCOp [arrSize, len] Nothing
|
|
3796
|
3806
|
boundsCheckFailed <- getCode $
|
|
3797
|
|
- emitBoundsCheckFailed idx len arrSize
|
|
|
3807
|
+ emitBoundsCheckFailed op_name idx len arrSize
|
|
3798
|
3808
|
let
|
|
3799
|
3809
|
rangeTooLarge = CmmReg (CmmLocal rangeTooLargeReg)
|
|
3800
|
3810
|
lastSafeIndex = CmmReg (CmmLocal lastSafeIndexReg)
|
| ... |
... |
@@ -3807,30 +3817,33 @@ emitRangeBoundsCheck idx len arrSizeExpr = do |
|
3807
|
3817
|
emit =<< mkCmmIfThen' isOutOfBounds boundsCheckFailed (Just False)
|
|
3808
|
3818
|
|
|
3809
|
3819
|
doPtrArrayBoundsCheck
|
|
3810
|
|
- :: CmmExpr -- ^ accessed index (in bytes)
|
|
|
3820
|
+ :: FastString -- ^ primop name
|
|
|
3821
|
+ -> CmmExpr -- ^ accessed index (in bytes)
|
|
3811
|
3822
|
-> CmmExpr -- ^ pointer to @StgMutArrPtrs@
|
|
3812
|
3823
|
-> FCode ()
|
|
3813
|
|
-doPtrArrayBoundsCheck idx arr = whenCheckBounds $ do
|
|
|
3824
|
+doPtrArrayBoundsCheck op_name idx arr = whenCheckBounds $ do
|
|
3814
|
3825
|
profile <- getProfile
|
|
3815
|
3826
|
platform <- getPlatform
|
|
3816
|
|
- emitBoundsCheck idx (ptrArraySize platform profile arr)
|
|
|
3827
|
+ emitBoundsCheck op_name idx (ptrArraySize platform profile arr)
|
|
3817
|
3828
|
|
|
3818
|
3829
|
doSmallPtrArrayBoundsCheck
|
|
3819
|
|
- :: CmmExpr -- ^ accessed index (in bytes)
|
|
|
3830
|
+ :: FastString -- ^ primop name
|
|
|
3831
|
+ -> CmmExpr -- ^ accessed index (in bytes)
|
|
3820
|
3832
|
-> CmmExpr -- ^ pointer to @StgMutArrPtrs@
|
|
3821
|
3833
|
-> FCode ()
|
|
3822
|
|
-doSmallPtrArrayBoundsCheck idx arr = whenCheckBounds $ do
|
|
|
3834
|
+doSmallPtrArrayBoundsCheck op_name idx arr = whenCheckBounds $ do
|
|
3823
|
3835
|
profile <- getProfile
|
|
3824
|
3836
|
platform <- getPlatform
|
|
3825
|
|
- emitBoundsCheck idx (smallPtrArraySize platform profile arr)
|
|
|
3837
|
+ emitBoundsCheck op_name idx (smallPtrArraySize platform profile arr)
|
|
3826
|
3838
|
|
|
3827
|
3839
|
doByteArrayBoundsCheck
|
|
3828
|
|
- :: CmmExpr -- ^ accessed index (in elements)
|
|
|
3840
|
+ :: FastString -- ^ primop name
|
|
|
3841
|
+ -> CmmExpr -- ^ accessed index (in elements)
|
|
3829
|
3842
|
-> CmmExpr -- ^ pointer to @StgArrBytes@
|
|
3830
|
3843
|
-> CmmType -- ^ indexing type
|
|
3831
|
3844
|
-> CmmType -- ^ element type
|
|
3832
|
3845
|
-> FCode ()
|
|
3833
|
|
-doByteArrayBoundsCheck idx arr idx_ty elem_ty = whenCheckBounds $ do
|
|
|
3846
|
+doByteArrayBoundsCheck op_name idx arr idx_ty elem_ty = whenCheckBounds $ do
|
|
3834
|
3847
|
profile <- getProfile
|
|
3835
|
3848
|
platform <- getPlatform
|
|
3836
|
3849
|
let elem_w = typeWidth elem_ty
|
| ... |
... |
@@ -3840,8 +3853,8 @@ doByteArrayBoundsCheck idx arr idx_ty elem_ty = whenCheckBounds $ do |
|
3840
|
3853
|
effective_arr_sz =
|
|
3841
|
3854
|
cmmUShrWord platform arr_sz (mkIntExpr platform (toTargetInt (widthInLog idx_w)))
|
|
3842
|
3855
|
if elem_w == idx_w
|
|
3843
|
|
- then emitBoundsCheck idx effective_arr_sz -- aligned => simpler check
|
|
3844
|
|
- else assert (idx_w == W8) (emitRangeBoundsCheck idx elem_sz arr_sz)
|
|
|
3856
|
+ then emitBoundsCheck op_name idx effective_arr_sz -- aligned => simpler check
|
|
|
3857
|
+ else assert (idx_w == W8) (emitRangeBoundsCheck op_name idx elem_sz arr_sz)
|
|
3845
|
3858
|
|
|
3846
|
3859
|
-- | Write barrier for @MUT_VAR@ modification.
|
|
3847
|
3860
|
emitDirtyMutVar :: CmmExpr -> CmmExpr -> FCode ()
|