[Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement MO_AtomicRead and MO_AtomicWrite
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sun Jun 11 14:59:25 UTC 2023
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
5b3c11e1 by Sven Tennie at 2023-06-11T14:58:14+00:00
Implement MO_AtomicRead and MO_AtomicWrite
- - - - -
4 changed files:
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Cond.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1577,8 +1577,12 @@ genCCall target dest_regs arg_regs bid = do
-- Memory Ordering
-- The concrete encoding is copied from load_load_barrier() and write_barrier() (SMP.h)
- MO_ReadBarrier -> return (unitOL (DMBSY DmbRead), Nothing)
- MO_WriteBarrier -> return (unitOL (DMBSY DmbWrite), Nothing)
+ -- TODO: This needs to be changed for https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10628
+ -- The related C functions are:
+ -- atomic_thread_fence(memory_order_acquire);
+ -- atomic_thread_fence(memory_order_release);
+ MO_ReadBarrier -> return (unitOL (DMBSY DmbRead DmbRead), Nothing)
+ MO_WriteBarrier -> return (unitOL (DMBSY DmbWrite DmbWrite), Nothing)
MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers)
-- Prefetch
MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint.
@@ -1606,32 +1610,53 @@ genCCall target dest_regs arg_regs bid = do
MO_BSwap w -> mkCCall (bSwapLabel w)
MO_BRev w -> mkCCall (bRevLabel w)
- -- -- Atomic read-modify-write.
- MO_AtomicRead w ord
+ -- Atomic read-modify-write.
+ mo@(MO_AtomicRead w ord)
| [p_reg] <- arg_regs
, [dst_reg] <- dest_regs -> do
(p, _fmt_p, code_p) <- getSomeReg p_reg
platform <- getPlatform
- let instr = case ord of
- MemOrderRelaxed -> LDR
- _ -> panic "no proper atomic write support" -- LDAR
+ -- See __atomic_load_n (in C)
+ let instrs = case ord of
+ MemOrderRelaxed -> unitOL $ ann moDescr (LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p))
+ MemOrderAcquire -> toOL [
+ ann moDescr (LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)),
+ DMBSY DmbRead DmbReadWrite
+ ]
+ MemOrderSeqCst -> toOL [
+ ann moDescr (DMBSY DmbReadWrite DmbReadWrite),
+ LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p),
+ DMBSY DmbRead DmbReadWrite
+ ]
+ MemOrderRelease -> panic $ "Unexpected MemOrderRelease on an AtomicRead: " ++ show mo
dst = getRegisterReg platform (CmmLocal dst_reg)
+ moDescr = (text . show) mo
code =
- code_p `snocOL`
- instr (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)
+ code_p `appOL`
+ instrs
return (code, Nothing)
| otherwise -> panic "mal-formed AtomicRead"
- MO_AtomicWrite w ord
+ mo@(MO_AtomicWrite w ord)
| [p_reg, val_reg] <- arg_regs -> do
(p, _fmt_p, code_p) <- getSomeReg p_reg
(val, fmt_val, code_val) <- getSomeReg val_reg
- let instr = case ord of
- MemOrderRelaxed -> STR
- _ -> panic "no proper atomic write support" -- STLR
+ -- See __atomic_store_n (in C)
+ let instrs = case ord of
+ MemOrderRelaxed -> unitOL $ ann moDescr (STR fmt_val (OpReg w val) (OpAddr $ AddrReg p))
+ MemOrderSeqCst -> toOL [
+ ann moDescr (DMBSY DmbReadWrite DmbWrite),
+ STR fmt_val (OpReg w val) (OpAddr $ AddrReg p)
+ ]
+ MemOrderRelease -> toOL [
+ ann moDescr (DMBSY DmbReadWrite DmbWrite),
+ STR fmt_val (OpReg w val) (OpAddr $ AddrReg p)
+ ]
+ MemOrderAcquire -> panic $ "Unexpected MemOrderAcquire on an AtomicWrite" ++ show mo
+ moDescr = (text . show) mo
code =
code_p `appOL`
- code_val `snocOL`
- instr fmt_val (OpReg w val) (OpAddr $ AddrReg p)
+ code_val `appOL`
+ instrs
return (code, Nothing)
| otherwise -> panic "mal-formed AtomicWrite"
MO_AtomicRMW w amop -> mkCCall (atomicRMWLabel w amop)
=====================================
compiler/GHC/CmmToAsm/RV64/Cond.hs
=====================================
@@ -65,4 +65,4 @@ data Cond
| NEVER -- b.nv
| VS -- oVerflow set
| VC -- oVerflow clear
- deriving Eq
+ deriving (Eq, Show)
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -132,7 +132,7 @@ regUsageOfInstr platform instr = case instr of
-- LDP _ dst1 dst2 src -> usage (regOp src, regOp dst1 ++ regOp dst2)
-- 8. Synchronization Instructions -------------------------------------------
- DMBSY _ -> usage ([], [])
+ DMBSY _ _ -> usage ([], [])
-- 9. Floating Point Instructions --------------------------------------------
FCVT dst src -> usage (regOp src, regOp dst)
@@ -268,7 +268,7 @@ patchRegsOfInstr instr env = case instr of
-- LDP f o1 o2 o3 -> LDP f (patchOp o1) (patchOp o2) (patchOp o3)
-- 8. Synchronization Instructions -----------------------------------------
- DMBSY op -> DMBSY op
+ DMBSY o1 o2 -> DMBSY o1 o2
-- 9. Floating Point Instructions ------------------------------------------
FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2)
@@ -654,7 +654,7 @@ data Instr
| BCOND Cond Operand Operand Target -- branch with condition. b.<cond>
-- 8. Synchronization Instructions -----------------------------------------
- | DMBSY DmbType
+ | DMBSY DmbType DmbType
-- 9. Floating Point Instructions
-- Float ConVerT
| FCVT Operand Operand
@@ -665,7 +665,7 @@ data Instr
-- Float ABSolute value
| FABS Operand Operand
-data DmbType = DmbRead | DmbWrite
+data DmbType = DmbRead | DmbWrite | DmbReadWrite
instrCon :: Instr -> String
instrCon i =
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -561,6 +561,7 @@ pprInstr platform instr = case instr of
ULE -> line $ text "\tbgeu" <+> pprOp platform r <> comma <+> pprOp platform l <> comma <+> getLabel platform t
UGE -> line $ text "\tbgeu" <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
UGT -> line $ text "\tbltu" <+> pprOp platform r <> comma <+> pprOp platform l <> comma <+> getLabel platform t
+ _ -> panic $ "RV64.ppr: unhandled BCOND conditional: " ++ show c
BCOND _ _ _ (TReg _) -> panic "RV64.ppr: No conditional branching to registers!"
@@ -583,7 +584,7 @@ pprInstr platform instr = case instr of
UGE -> lines_ [ sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r
, text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1" ]
UGT -> lines_ [ sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l ]
- _ -> panic "RV64.ppr: unhandled CSET conditional"
+ _ -> panic $ "RV64.ppr: unhandled CSET conditional: " ++ show c
where
subFor l r | (OpImm _) <- r = text "\taddi" <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform (negOp r)
| (OpImm _) <- l = panic "RV64.ppr: Cannot SUB IMM _"
@@ -649,8 +650,7 @@ pprInstr platform instr = case instr of
-- LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3
-- 8. Synchronization Instructions -------------------------------------------
- DMBSY DmbRead -> line $ text "\tfence r,r"
- DMBSY DmbWrite -> line $ text "\tfence w,w"
+ DMBSY r w -> line $ text "\tfence" <+> pprDmbType r <> char ',' <+> pprDmbType w
-- 9. Floating Point Instructions --------------------------------------------
FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2
@@ -664,6 +664,9 @@ pprInstr platform instr = case instr of
-- op_ldr o1 rest = line $ text "\tld" <+> pprOp platform o1 <> comma <+> rest <+> text "(" <> pprOp platform o1 <> text ")"
-- op_adrp o1 rest = line $ text "\tauipc" <+> pprOp platform o1 <> comma <+> rest
-- op_add o1 rest = line $ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> rest
+ pprDmbType DmbRead = text "r"
+ pprDmbType DmbWrite = text "w"
+ pprDmbType DmbReadWrite = text "rw"
pprBcond :: IsLine doc => Cond -> doc
pprBcond c = text "b." <> pprCond c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b3c11e1935acb269023329105284605aab8f7a5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b3c11e1935acb269023329105284605aab8f7a5
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/20230611/51778604/attachment-0001.html>
More information about the ghc-commits
mailing list