[Git][ghc/ghc][master] 2 commits: StgToByteCode: minor refactor
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri May 24 11:54:03 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
f0d257f7 by Krzysztof Gogolewski at 2024-05-24T07:51:55-04: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.
- - - - -
03137fd2 by Krzysztof Gogolewski at 2024-05-24T07:51:55-04: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/bdcc0f37fdccf4a21ef1e4885980d5e9af8973f6...03137fd2b9ed02dee73d9a1156d9828f83904475
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdcc0f37fdccf4a21ef1e4885980d5e9af8973f6...03137fd2b9ed02dee73d9a1156d9828f83904475
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/20240524/8099c5f0/attachment-0001.html>
More information about the ghc-commits
mailing list