[Git][ghc/ghc][wip/ghci-primcall] use call_info name consistently (instead of tuple_info)
Luite Stegeman (@luite)
gitlab at gitlab.haskell.org
Mon Jan 9 10:03:01 UTC 2023
Luite Stegeman pushed to branch wip/ghci-primcall at Glasgow Haskell Compiler / GHC
Commits:
60322fa3 by Luite Stegeman at 2023-01-09T19:01:35+09:00
use call_info name consistently (instead of tuple_info)
- - - - -
2 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/StgToByteCode.hs
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -389,14 +389,14 @@ assembleI platform i = case i of
-> do let ul_bco = assembleBCO platform proto
p <- ioptr (liftM BCOPtrBCO ul_bco)
emit (push_alts pk) [Op p]
- PUSH_ALTS_TUPLE proto tuple_info tuple_proto
+ PUSH_ALTS_TUPLE proto call_info tuple_proto
-> do let ul_bco = assembleBCO platform proto
ul_tuple_bco = assembleBCO platform
tuple_proto
p <- ioptr (liftM BCOPtrBCO ul_bco)
p_tup <- ioptr (liftM BCOPtrBCO ul_tuple_bco)
info <- int (fromIntegral $
- mkNativeCallInfoSig platform tuple_info)
+ mkNativeCallInfoSig platform call_info)
emit bci_PUSH_ALTS_T
[Op p, Op info, Op p_tup]
PUSH_PAD8 -> emit bci_PUSH_PAD8 []
@@ -623,8 +623,8 @@ mkNativeCallInfoSig platform NativeCallInfo{..}
regs = allArgRegsCover platform
mkNativeCallInfoLit :: Platform -> NativeCallInfo -> Literal
-mkNativeCallInfoLit platform tuple_info =
- mkLitWord platform . fromIntegral $ mkNativeCallInfoSig platform tuple_info
+mkNativeCallInfoLit platform call_info =
+ mkLitWord platform . fromIntegral $ mkNativeCallInfoSig platform call_info
-- Make lists of host-sized words for literals, so that when the
-- words are placed in memory at increasing addresses, the
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -464,10 +464,10 @@ returnUnliftedReps d s szb reps = do
[rep] -> return (unitOL $ RETURN_UNLIFTED (toArgRep platform rep))
-- otherwise use RETURN_TUPLE with a tuple descriptor
nv_reps -> do
- let (tuple_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 (primRepCmmType platform) nv_reps
+ let (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 (primRepCmmType platform) nv_reps
args_ptrs = map (\(rep, off) -> (isFollowableArg (toArgRep platform rep), off)) args_offsets
- tuple_bco <- emitBc (tupleBCO platform tuple_info args_ptrs)
- return $ PUSH_UBX (mkNativeCallInfoLit platform tuple_info) 1 `consOL`
+ tuple_bco <- emitBc (tupleBCO platform call_info args_ptrs)
+ return $ PUSH_UBX (mkNativeCallInfoLit platform call_info) 1 `consOL`
PUSH_BCO tuple_bco `consOL`
unitOL RETURN_TUPLE
return ( mkSlideB platform szb (d - s) -- clear to sequel
@@ -484,11 +484,11 @@ returnUnboxedTuple d s p es = do
profile <- getProfile
let platform = profilePlatform profile
arg_ty e = primRepCmmType platform (atomPrimRep e)
- (tuple_info, tuple_components) = layoutNativeCall profile
- NativeTupleReturn
- d
- arg_ty
- es
+ (call_info, tuple_components) = layoutNativeCall profile
+ NativeTupleReturn
+ d
+ arg_ty
+ es
go _ pushes [] = return (reverse pushes)
go !dd pushes ((a, off):cs) = do (push, szb) <- pushAtom dd p a
massert (off == dd + szb)
@@ -496,7 +496,7 @@ returnUnboxedTuple d s p es = do
pushes <- go d [] tuple_components
ret <- returnUnliftedReps d
s
- (wordsToBytes platform $ nativeCallSize tuple_info)
+ (wordsToBytes platform $ nativeCallSize call_info)
(map atomPrimRep es)
return (mconcat pushes `appOL` ret)
@@ -844,14 +844,14 @@ doCase d s p scrut bndr alts
| ubx_frame = wordSize platform
| otherwise = 0
- (bndr_size, tuple_info, args_offsets)
+ (bndr_size, call_info, args_offsets)
| ubx_tuple_frame =
let bndr_ty = primRepCmmType platform
bndr_reps = filter (not.isVoidRep) (bcIdPrimReps bndr)
- (tuple_info, args_offsets) =
+ (call_info, args_offsets) =
layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps
- in ( wordsToBytes platform (nativeCallSize tuple_info)
- , tuple_info
+ in ( wordsToBytes platform (nativeCallSize call_info)
+ , call_info
, args_offsets
)
| otherwise = ( wordsToBytes platform (idSizeW platform bndr)
@@ -889,7 +889,7 @@ doCase d s p scrut bndr alts
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
let bndr_ty = primRepCmmType platform . bcIdPrimRep
tuple_start = d_bndr
- (tuple_info, args_offsets) =
+ (call_info, args_offsets) =
layoutNativeCall profile
NativeTupleReturn
0
@@ -900,7 +900,7 @@ doCase d s p scrut bndr alts
p' = Map.insertList
[ (arg, tuple_start -
- wordsToBytes platform (nativeCallSize tuple_info) +
+ wordsToBytes platform (nativeCallSize call_info) +
offset)
| (arg, offset) <- args_offsets
, not (isVoidRep $ bcIdPrimRep arg)]
@@ -1033,8 +1033,8 @@ doCase d s p scrut bndr alts
let args_ptrs =
map (\(rep, off) -> (isFollowableArg (toArgRep platform rep), off))
args_offsets
- tuple_bco <- emitBc (tupleBCO platform tuple_info args_ptrs)
- return (PUSH_ALTS_TUPLE alt_bco' tuple_info tuple_bco
+ tuple_bco <- emitBc (tupleBCO platform call_info args_ptrs)
+ return (PUSH_ALTS_TUPLE alt_bco' call_info tuple_bco
`consOL` scrut_code)
else let push_alts
| not ubx_frame
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60322fa3f7a8b8587b48842053eb7d96d2eff14b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60322fa3f7a8b8587b48842053eb7d96d2eff14b
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/20230109/5c990791/attachment-0001.html>
More information about the ghc-commits
mailing list