[Git][ghc/ghc][wip/assert-nonvoid] 2 commits: StgToByteCode: minor refactor
Krzysztof Gogolewski (@monoidal)
gitlab at gitlab.haskell.org
Sun May 12 20:19:33 UTC 2024
Krzysztof Gogolewski pushed to branch wip/assert-nonvoid at Glasgow Haskell Compiler / GHC
Commits:
5bf8a32a by Krzysztof Gogolewski at 2024-05-12T21:45:33+02:00
StgToByteCode: minor refactor
Some functions in StgToByteCode were filtering out void arguments.
However, StgToByteCode is called after unarisation: the void arguments
should have been removed earlier.
Instead of filtering out, we assert that the args are non-void.
- - - - -
72eeda20 by Krzysztof Gogolewski at 2024-05-12T22:07:10+02:00
StgToByteCode: minor refactor
`layoutNativeCall` was always called with a `primRepCmmType platform`
callback. Hence we can put it inside of `layoutNativeCall` rather than
repeat it.
- - - - -
1 changed file:
- compiler/GHC/StgToByteCode.hs
Changes:
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -59,7 +59,7 @@ import GHC.Utils.Panic
import GHC.Utils.Exception (evaluate)
import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
addIdReps, addArgReps,
- nonVoidIds, nonVoidStgArgs )
+ assertNonVoidIds, assertNonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
import GHC.Data.Bitmap
@@ -523,7 +523,7 @@ returnUnliftedReps d s szb reps = do
[rep] -> return (unitOL $ RETURN (toArgRep platform rep))
-- otherwise use RETURN_TUPLE with a tuple descriptor
nv_reps -> do
- let (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 (primRepCmmType platform) nv_reps
+ let (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 id nv_reps
tuple_bco <- emitBc (tupleBCO platform call_info args_offsets)
return $ PUSH_UBX (mkNativeCallInfoLit platform call_info) 1 `consOL`
PUSH_BCO tuple_bco `consOL`
@@ -541,25 +541,21 @@ returnUnboxedTuple
returnUnboxedTuple d s p es = do
profile <- getProfile
let platform = profilePlatform profile
- arg_ty e = primRepCmmType platform (stgArgRepU e)
(call_info, tuple_components) = layoutNativeCall profile
NativeTupleReturn
d
- arg_ty
+ stgArgRepU
es
go _ pushes [] = return (reverse pushes)
go !dd pushes ((a, off):cs) = do (push, szb) <- pushAtom dd p a
massert (off == dd + szb)
go (dd + szb) (push:pushes) cs
pushes <- go d [] tuple_components
- let rep_to_maybe :: PrimOrVoidRep -> Maybe PrimRep
- rep_to_maybe VoidRep = Nothing
- rep_to_maybe (NVRep rep) = Just rep
ret <- returnUnliftedReps d
s
(wordsToBytes platform $ nativeCallSize call_info)
- (mapMaybe (rep_to_maybe . stgArgRep1) es)
+ (map stgArgRepU es)
return (mconcat pushes `appOL` ret)
-- Compile code to apply the given expression to the remaining args
@@ -760,7 +756,7 @@ mkConAppCode orig_d _ p con args = app_code
let platform = profilePlatform profile
non_voids =
- addArgReps (nonVoidStgArgs args)
+ addArgReps (assertNonVoidStgArgs args)
(_, _, args_offsets) =
mkVirtHeapOffsetsWithPadding profile StdHeader non_voids
@@ -901,10 +897,9 @@ doCase d s p scrut bndr alts
(bndr_size, call_info, args_offsets)
| ubx_tuple_frame =
- let bndr_ty = primRepCmmType platform
- bndr_reps = typePrimRep (idType bndr)
+ let bndr_reps = typePrimRep (idType bndr)
(call_info, args_offsets) =
- layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps
+ layoutNativeCall profile NativeTupleReturn 0 id bndr_reps
in ( wordsToBytes platform (nativeCallSize call_info)
, call_info
, args_offsets
@@ -942,14 +937,14 @@ doCase d s p scrut bndr alts
rhs_code <- schemeE d_alts s p_alts rhs
return (my_discr alt, rhs_code)
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
- let bndr_ty = primRepCmmType platform . idPrimRepU
+ let bndr_ty = idPrimRepU . fromNonVoid
tuple_start = d_bndr
(call_info, args_offsets) =
layoutNativeCall profile
NativeTupleReturn
0
bndr_ty
- bndrs
+ (assertNonVoidIds bndrs)
stack_bot = d_alts
@@ -957,8 +952,7 @@ doCase d s p scrut bndr alts
[ (arg, tuple_start -
wordsToBytes platform (nativeCallSize call_info) +
offset)
- | (arg, offset) <- args_offsets
- , not (isZeroBitTy $ idType arg)]
+ | (NonVoid arg, offset) <- args_offsets]
p_alts
in do
rhs_code <- schemeE stack_bot s p' rhs
@@ -967,7 +961,7 @@ doCase d s p scrut bndr alts
| otherwise =
let (tot_wds, _ptrs_wds, args_offsets) =
mkVirtHeapOffsets profile NoHeader
- (addIdReps (nonVoidIds real_bndrs))
+ (addIdReps (assertNonVoidIds real_bndrs))
size = WordOff tot_wds
stack_bot = d_alts + wordsToBytes platform size
@@ -1102,13 +1096,14 @@ doCase d s p scrut bndr alts
layoutNativeCall :: Profile
-> NativeCallType
-> ByteOff
- -> (a -> CmmType)
+ -> (a -> PrimRep)
-> [a]
-> ( NativeCallInfo -- See Note [GHCi TupleInfo]
, [(a, ByteOff)] -- argument, offset on stack
)
-layoutNativeCall profile call_type start_off arg_ty reps =
+layoutNativeCall profile call_type start_off arg_rep reps =
let platform = profilePlatform profile
+ arg_ty = primRepCmmType platform . arg_rep
(orig_stk_bytes, pos) = assignArgumentsPos profile
0
NativeReturn
@@ -1392,7 +1387,7 @@ generatePrimCall d s p target _mb_unit _result_ty args
layoutNativeCall profile
NativePrimCall
0
- (primRepCmmType platform . stgArgRepU)
+ stgArgRepU
nv_args
prim_args_offsets = mapFst stgArgRepU args_offsets
@@ -1645,7 +1640,7 @@ primRepToFFIType platform (NVRep r)
FloatRep -> FFIFloat
DoubleRep -> FFIDouble
BoxedRep _ -> FFIPointer
- _ -> pprPanic "primRepToFFIType" (ppr r)
+ VecRep{} -> pprPanic "primRepToFFIType" (ppr r)
where
(signed_word, unsigned_word) = case platformWordSize platform of
PW4 -> (FFISInt32, FFIUInt32)
@@ -1670,7 +1665,7 @@ mkDummyLiteral platform pr
DoubleRep -> LitDouble 0
FloatRep -> LitFloat 0
BoxedRep _ -> LitNullAddr
- _ -> pprPanic "mkDummyLiteral" (ppr pr)
+ VecRep{} -> pprPanic "mkDummyLiteral" (ppr pr)
-- Convert (eg)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed2b1231d2bb15d754def220ecb7a2b1f545d2c8...72eeda20a9f7619ba181a497a8932a25ab56fe40
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed2b1231d2bb15d754def220ecb7a2b1f545d2c8...72eeda20a9f7619ba181a497a8932a25ab56fe40
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/20240512/90a88674/attachment-0001.html>
More information about the ghc-commits
mailing list