[Git][ghc/ghc][wip/supersven/ghc-9.10-riscv-ncg] 5 commits: Formatting
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sat Jul 20 14:47:17 UTC 2024
Sven Tennie pushed to branch wip/supersven/ghc-9.10-riscv-ncg at Glasgow Haskell Compiler / GHC
Commits:
c33a4b60 by Sven Tennie at 2024-07-19T16:56:41+02:00
Formatting
- - - - -
4a3fa150 by Sven Tennie at 2024-07-19T17:02:22+02:00
Formatting
- - - - -
ec0465d5 by Sven Tennie at 2024-07-19T17:06:45+02:00
Use reg constant (less magical)
- - - - -
a7c3c209 by Sven Tennie at 2024-07-19T17:23:49+02:00
Checked memory barriers
- - - - -
288b25fd by Sven Tennie at 2024-07-20T13:17:57+02:00
Check memory fences
- - - - -
2 changed files:
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1374,12 +1374,12 @@ genCCall target@(ForeignTarget expr _cconv) dest_regs arg_regs = do
, DELTA (-16) ]
moveStackDown i | odd i = moveStackDown (i + 1)
moveStackDown i = toOL [ PUSH_STACK_FRAME
- , SUB (OpReg W64 (regSingle 2)) (OpReg W64 (regSingle 2)) (OpImm (ImmInt (8 * i)))
+ , SUB (OpReg W64 (spMachReg)) (OpReg W64 (spMachReg)) (OpImm (ImmInt (8 * i)))
, DELTA (-8 * i - 16) ]
moveStackUp 0 = toOL [ POP_STACK_FRAME
, DELTA 0 ]
moveStackUp i | odd i = moveStackUp (i + 1)
- moveStackUp i = toOL [ ADD (OpReg W64 (regSingle 2)) (OpReg W64 (regSingle 2)) (OpImm (ImmInt (8 * i)))
+ moveStackUp i = toOL [ ADD (OpReg W64 (spMachReg)) (OpReg W64 (spMachReg)) (OpImm (ImmInt (8 * i)))
, POP_STACK_FRAME
, DELTA 0 ]
@@ -1427,7 +1427,7 @@ genCCall target@(ForeignTarget expr _cconv) dest_regs arg_regs = do
passArguments [] [] ((r, format, hint, code_r) : args) stackSpaceWords accumRegs accumCode = do
let w = formatToWidth format
spOffet = 8 * stackSpaceWords
- str = STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 2) (ImmInt spOffet)))
+ str = STR format (OpReg w r) (OpAddr (AddrRegImm (spMachReg) (ImmInt spOffet)))
stackCode =
if hint == SignedHint
then
@@ -1443,7 +1443,7 @@ genCCall target@(ForeignTarget expr _cconv) dest_regs arg_regs = do
passArguments [] fpRegs ((r, format, _hint, code_r):args) stackSpaceWords accumRegs accumCode | isIntFormat format = do
let w = formatToWidth format
spOffet = 8 * stackSpaceWords
- str = STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 2) (ImmInt spOffet)))
+ str = STR format (OpReg w r) (OpAddr (AddrRegImm (spMachReg) (ImmInt spOffet)))
stackCode = code_r `snocOL`
ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) str
passArguments [] fpRegs args (stackSpaceWords + 1) accumRegs (stackCode `appOL` accumCode)
@@ -1587,13 +1587,11 @@ genCCall (PrimTarget mop) dest_regs arg_regs = do
MO_U_Mul2 _w -> unsupported mop
-- Memory Ordering
- -- The concrete encoding is copied from load_load_barrier() and write_barrier() (SMP.h)
- -- TODO: This needs to be changed for https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10628
-- The related C functions are:
+ -- #include <stdatomic.h>
-- 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)
+ -- atomic_thread_fence(memory_order_seq_cst);
MO_AcquireFence -> pure (unitOL (DMBSY DmbRead DmbReadWrite))
MO_ReleaseFence -> pure (unitOL (DMBSY DmbReadWrite DmbWrite))
MO_SeqCstFence -> pure (unitOL (DMBSY DmbReadWrite DmbReadWrite))
@@ -1631,8 +1629,11 @@ genCCall (PrimTarget mop) dest_regs arg_regs = do
, [dst_reg] <- dest_regs -> do
(p, _fmt_p, code_p) <- getSomeReg p_reg
platform <- getPlatform
- -- TODO: Check if these fence usages are correct.
- -- See __atomic_load_n (in C)
+ -- Analog to the related MachOps (above)
+ -- The related C functions are:
+ -- #include <stdatomic.h>
+ -- __atomic_load_n(&a, __ATOMIC_ACQUIRE);
+ -- __atomic_load_n(&a, __ATOMIC_SEQ_CST);
let instrs = case ord of
MemOrderRelaxed -> unitOL $ ann moDescr (LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p))
MemOrderAcquire -> toOL [
@@ -1654,12 +1655,17 @@ genCCall (PrimTarget mop) dest_regs arg_regs = do
| [p_reg, val_reg] <- arg_regs -> do
(p, _fmt_p, code_p) <- getSomeReg p_reg
(val, fmt_val, code_val) <- getSomeReg val_reg
- -- See __atomic_store_n (in C)
+ -- Analog to the related MachOps (above)
+ -- The related C functions are:
+ -- #include <stdatomic.h>
+ -- __atomic_store_n(&a, 23, __ATOMIC_SEQ_CST);
+ -- __atomic_store_n(&a, 23, __ATOMIC_RELEASE);
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)
+ STR fmt_val (OpReg w val) (OpAddr $ AddrReg p),
+ DMBSY DmbReadWrite DmbReadWrite
]
MemOrderRelease -> toOL [
ann moDescr (DMBSY DmbReadWrite DmbWrite),
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -132,18 +132,21 @@ regUsageOfInstr platform instr = case instr of
-- filtering the usage is necessary, otherwise the register
-- allocator will try to allocate pre-defined fixed stg
-- registers as well, as they show up.
- usage (src, dst) = RU (filter (interesting platform) src)
- (filter (interesting platform) dst)
+ usage :: ([Reg], [Reg]) -> RegUsage
+ usage (srcRegs, dstRegs) = RU (filter (interesting platform) srcRegs)
+ (filter (interesting platform) dstRegs)
regAddr :: AddrMode -> [Reg]
- regAddr (AddrRegImm r1 _) = [r1]
+ regAddr (AddrRegImm r1 _imm) = [r1]
regAddr (AddrReg r1) = [r1]
+
regOp :: Operand -> [Reg]
- regOp (OpReg _ r1) = [r1]
+ regOp (OpReg _w r1) = [r1]
regOp (OpAddr a) = regAddr a
- regOp (OpImm _) = []
+ regOp (OpImm _imm) = []
+
regTarget :: Target -> [Reg]
- regTarget (TBlock _) = []
+ regTarget (TBlock _bid) = []
regTarget (TReg r1) = [r1]
-- Is this register interesting for the register allocator?
@@ -228,13 +231,16 @@ patchRegsOfInstr instr env = case instr of
patchOp :: Operand -> Operand
patchOp (OpReg w r) = OpReg w (env r)
patchOp (OpAddr a) = OpAddr (patchAddr a)
- patchOp op = op
+ patchOp opImm = opImm
+
patchTarget :: Target -> Target
patchTarget (TReg r) = TReg (env r)
- patchTarget t = t
+ patchTarget tBlock = tBlock
+
patchAddr :: AddrMode -> AddrMode
- patchAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i
+ patchAddr (AddrRegImm r1 imm) = AddrRegImm (env r1) imm
patchAddr (AddrReg r) = AddrReg (env r)
+
patchReg :: Reg -> Reg
patchReg = env
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d691cd4f53f51c62c10adcbaf81af5d54a92c9da...288b25fd25bdbf30c1cadbb688768711f7e07b9c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d691cd4f53f51c62c10adcbaf81af5d54a92c9da...288b25fd25bdbf30c1cadbb688768711f7e07b9c
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/20240720/361163fd/attachment-0001.html>
More information about the ghc-commits
mailing list