[Git][ghc/ghc][wip/ncg-simd] simd fixups
sheaf (@sheaf)
gitlab at gitlab.haskell.org
Thu Jun 20 11:30:02 UTC 2024
sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC
Commits:
09894485 by sheaf at 2024-06-20T13:29:52+02:00
simd fixups
- - - - -
3 changed files:
- compiler/GHC/CmmToAsm/Format.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/Format.hs
=====================================
@@ -25,6 +25,7 @@ module GHC.CmmToAsm.Format (
formatToWidth,
formatInBytes,
isIntScalarFormat,
+ VirtualRegFormat(..),
RegFormat(..),
takeVirtualRegs,
takeRealRegs,
@@ -197,6 +198,12 @@ formatInBytes = widthInBytes . formatToWidth
--------------------------------------------------------------------------------
+data VirtualRegFormat
+ = VirtualRegFormat
+ { virtualRegFormatReg :: {-# UNPACK #-} !VirtualReg
+ , virtualRegFormatFormat :: !Format
+ }
+
-- | A typed register: a register, together with the specific format we
-- are using it at.
data RegFormat
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -135,8 +135,9 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform
+import Data.Containers.ListUtils
import Data.Maybe
-import Data.List (partition, nub)
+import Data.List (partition)
import Control.Monad
-- -----------------------------------------------------------------------------
@@ -501,13 +502,14 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
platform <- getPlatform
case regUsageOfInstr platform instr of { RU read written ->
do
- let real_written = [ rr | RegFormat { regFormatReg = RegReal rr } <- written ] :: [RealReg]
- let virt_written = [ vr | RegFormat { regFormatReg = RegVirtual vr } <- written ]
+ let real_written = [ rr | RegFormat {regFormatReg = RegReal rr} <- written ]
+ let virt_written = [ VirtualRegFormat vr fmt | RegFormat (RegVirtual vr) fmt <- written ]
-- we don't need to do anything with real registers that are
-- only read by this instr. (the list is typically ~2 elements,
-- so using nub isn't a problem).
- let virt_read = nub [ vr | RegFormat { regFormatReg = RegVirtual vr }<- read ] :: [VirtualReg]
+ let virt_read :: [VirtualRegFormat]
+ virt_read = nubOrdOn virtualRegFormatReg [ VirtualRegFormat vr fmt | RegFormat (RegVirtual vr) fmt <- read ]
-- do
-- let real_read = nub [ rr | (RegReal rr) <- read]
@@ -567,9 +569,9 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
= toRegMap $ -- Cast key from VirtualReg to Reg
-- See Note [UniqFM and the register allocator]
listToUFM
- [ (t, RegReal r)
- | (t, r) <- zip virt_read r_allocd
- ++ zip virt_written w_allocd ]
+ [ (virtualRegFormatReg vr, RegReal rr)
+ | (vr, rr) <- zip virt_read r_allocd
+ ++ zip virt_written w_allocd ]
patched_instr :: instr
patched_instr
@@ -800,21 +802,21 @@ data SpillLoc = ReadMem StackSlot -- reading from register only in memory
allocateRegsAndSpill
:: forall freeRegs instr. (FR freeRegs, Instruction instr)
- => Bool -- True <=> reading (load up spilled regs)
- -> [VirtualReg] -- don't push these out
- -> [instr] -- spill insns
- -> [RealReg] -- real registers allocated (accum.)
- -> [VirtualReg] -- temps to allocate
+ => Bool -- True <=> reading (load up spilled regs)
+ -> [VirtualRegFormat] -- don't push these out
+ -> [instr] -- spill insns
+ -> [RealReg] -- real registers allocated (accum.)
+ -> [VirtualRegFormat] -- temps to allocate
-> RegM freeRegs ( [instr] , [RealReg])
allocateRegsAndSpill _ _ spills alloc []
= return (spills, reverse alloc)
-allocateRegsAndSpill reading keep spills alloc (r:rs)
+allocateRegsAndSpill reading keep spills alloc (VirtualRegFormat r fmt:rs)
= do assig <- toVRegMap <$> getAssigR
-- pprTraceM "allocateRegsAndSpill:assig" (ppr (r:rs) $$ ppr assig)
-- See Note [UniqFM and the register allocator]
- let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig
+ let doSpill = allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs assig
case lookupUFM assig r of
-- case (1a): already in a register
Just (InReg my_reg) ->
@@ -859,29 +861,19 @@ findPrefRealReg vreg = do
-- convenient and it maintains the recursive structure of the allocator. -- EZY
allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr)
=> Bool
- -> [VirtualReg]
+ -> [VirtualRegFormat]
-> [instr]
-> [RealReg]
- -> VirtualReg
- -> [VirtualReg]
+ -> VirtualRegFormat
+ -> [VirtualRegFormat]
-> UniqFM VirtualReg Loc
-> SpillLoc
-> RegM freeRegs ([instr], [RealReg])
-allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
+allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs assig spill_loc
= do platform <- getPlatform
freeRegs <- getFreeRegsR
let regclass = classOfVirtualReg r
freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs :: [RealReg]
- vr_fmt = case r of
- VirtualRegV128 {} -> VecFormat 2 FmtDouble
- -- It doesn't really matter whether we use e.g. v2f64 or v4f32
- -- or v4i32 etc here. This is perhaps a sign that 'Format'
- -- is not the right type to use here, but that is a battle
- -- for another day.
- VirtualRegD {} -> FF64
- VirtualRegI {} -> II64
- VirtualRegHi {} -> II64
-
-- Can we put the variable into a register it already was?
pref_reg <- findPrefRealReg r
@@ -895,10 +887,10 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
= reg
| otherwise
= first_free
- spills' <- loadTemp r vr_fmt spill_loc final_reg spills
+ spills' <- loadTemp r fmt spill_loc final_reg spills
setAssigR $ toRegMap
- $ (addToUFM assig r $! newLocation spill_loc $ RealRegUsage final_reg vr_fmt)
+ $ (addToUFM assig r $! newLocation spill_loc $ RealRegUsage final_reg fmt)
setFreeRegsR $ frAllocateReg platform final_reg freeRegs
allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs
@@ -911,7 +903,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
inRegOrBoth _ = False
let candidates' :: UniqFM VirtualReg Loc
candidates' =
- flip delListFromUFM keep $
+ flip delListFromUFM (fmap virtualRegFormatReg keep) $
filterUFM inRegOrBoth $
assig
-- This is non-deterministic but we do not
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -973,10 +973,8 @@ scalarMoveFormat platform fmt
= FF64
| II64 <- fmt
= II64
- | PW4 <- platformWordSize platform
- = II32
| otherwise
- = II64
+ = archWordFormat (target32Bit platform)
-- | Check whether an instruction represents a reg-reg move.
-- The register allocator attempts to eliminate reg->reg moves whenever it can,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09894485b74b5266355e1f153096ea331d3742c9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09894485b74b5266355e1f153096ea331d3742c9
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/20240620/40c95adb/attachment-0001.html>
More information about the ghc-commits
mailing list