{-# LANGUAGE LambdaCase #-}

-- | Generating C symbol names emitted by the compiler.
module GHC.CmmToAsm.CPrim
    ( atomicReadLabel
    , atomicWriteLabel
    , atomicRMWLabel
    , cmpxchgLabel
    , xchgLabel
    , popCntLabel
    , pdepLabel
    , pextLabel
    , bSwapLabel
    , bRevLabel
    , clzLabel
    , ctzLabel
    , word2FloatLabel
    ) where

import GHC.Cmm.Type
import GHC.Cmm.MachOp
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic

popCntLabel :: Width -> FastString
popCntLabel :: Width -> FastString
popCntLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_popcnt8"
  Width
W16 -> String -> FastString
fsLit String
"hs_popcnt16"
  Width
W32 -> String -> FastString
fsLit String
"hs_popcnt32"
  Width
W64 -> String -> FastString
fsLit String
"hs_popcnt64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"popCntLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

pdepLabel :: Width -> FastString
pdepLabel :: Width -> FastString
pdepLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_pdep8"
  Width
W16 -> String -> FastString
fsLit String
"hs_pdep16"
  Width
W32 -> String -> FastString
fsLit String
"hs_pdep32"
  Width
W64 -> String -> FastString
fsLit String
"hs_pdep64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"pdepLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

pextLabel :: Width -> FastString
pextLabel :: Width -> FastString
pextLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_pext8"
  Width
W16 -> String -> FastString
fsLit String
"hs_pext16"
  Width
W32 -> String -> FastString
fsLit String
"hs_pext32"
  Width
W64 -> String -> FastString
fsLit String
"hs_pext64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"pextLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

bSwapLabel :: Width -> FastString
bSwapLabel :: Width -> FastString
bSwapLabel = \case
  Width
W16 -> String -> FastString
fsLit String
"hs_bswap16"
  Width
W32 -> String -> FastString
fsLit String
"hs_bswap32"
  Width
W64 -> String -> FastString
fsLit String
"hs_bswap64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"bSwapLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

bRevLabel :: Width -> FastString
bRevLabel :: Width -> FastString
bRevLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_bitrev8"
  Width
W16 -> String -> FastString
fsLit String
"hs_bitrev16"
  Width
W32 -> String -> FastString
fsLit String
"hs_bitrev32"
  Width
W64 -> String -> FastString
fsLit String
"hs_bitrev64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"bRevLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

clzLabel :: Width -> FastString
clzLabel :: Width -> FastString
clzLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_clz8"
  Width
W16 -> String -> FastString
fsLit String
"hs_clz16"
  Width
W32 -> String -> FastString
fsLit String
"hs_clz32"
  Width
W64 -> String -> FastString
fsLit String
"hs_clz64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"clzLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

ctzLabel :: Width -> FastString
ctzLabel :: Width -> FastString
ctzLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_ctz8"
  Width
W16 -> String -> FastString
fsLit String
"hs_ctz16"
  Width
W32 -> String -> FastString
fsLit String
"hs_ctz32"
  Width
W64 -> String -> FastString
fsLit String
"hs_ctz64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"ctzLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

word2FloatLabel :: Width -> FastString
word2FloatLabel :: Width -> FastString
word2FloatLabel = \case
  Width
W32 -> String -> FastString
fsLit String
"hs_word2float32"
  Width
W64 -> String -> FastString
fsLit String
"hs_word2float64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"word2FloatLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

atomicRMWLabel :: Width -> AtomicMachOp -> FastString
atomicRMWLabel :: Width -> AtomicMachOp -> FastString
atomicRMWLabel Width
w AtomicMachOp
amop = case AtomicMachOp
amop of
  -- lots of boring cases, but we do it this way to get shared FastString
  -- literals (compared to concatenating strings and allocating FastStrings at
  -- runtime)
  AtomicMachOp
AMO_Add  -> case Width
w of
    Width
W8  -> String -> FastString
fsLit String
"hs_atomic_add8"
    Width
W16 -> String -> FastString
fsLit String
"hs_atomic_add16"
    Width
W32 -> String -> FastString
fsLit String
"hs_atomic_add32"
    Width
W64 -> String -> FastString
fsLit String
"hs_atomic_add64"
    Width
_   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"atomicRMWLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
  AtomicMachOp
AMO_Sub  -> case Width
w of
    Width
W8  -> String -> FastString
fsLit String
"hs_atomic_sub8"
    Width
W16 -> String -> FastString
fsLit String
"hs_atomic_sub16"
    Width
W32 -> String -> FastString
fsLit String
"hs_atomic_sub32"
    Width
W64 -> String -> FastString
fsLit String
"hs_atomic_sub64"
    Width
_   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"atomicRMWLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
  AtomicMachOp
AMO_And  -> case Width
w of
    Width
W8  -> String -> FastString
fsLit String
"hs_atomic_and8"
    Width
W16 -> String -> FastString
fsLit String
"hs_atomic_and16"
    Width
W32 -> String -> FastString
fsLit String
"hs_atomic_and32"
    Width
W64 -> String -> FastString
fsLit String
"hs_atomic_and64"
    Width
_   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"atomicRMWLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
  AtomicMachOp
AMO_Nand  -> case Width
w of
    Width
W8  -> String -> FastString
fsLit String
"hs_atomic_nand8"
    Width
W16 -> String -> FastString
fsLit String
"hs_atomic_nand16"
    Width
W32 -> String -> FastString
fsLit String
"hs_atomic_nand32"
    Width
W64 -> String -> FastString
fsLit String
"hs_atomic_nand64"
    Width
_   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"atomicRMWLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
  AtomicMachOp
AMO_Or  -> case Width
w of
    Width
W8  -> String -> FastString
fsLit String
"hs_atomic_or8"
    Width
W16 -> String -> FastString
fsLit String
"hs_atomic_or16"
    Width
W32 -> String -> FastString
fsLit String
"hs_atomic_or32"
    Width
W64 -> String -> FastString
fsLit String
"hs_atomic_or64"
    Width
_   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"atomicRMWLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
  AtomicMachOp
AMO_Xor  -> case Width
w of
    Width
W8  -> String -> FastString
fsLit String
"hs_atomic_xor8"
    Width
W16 -> String -> FastString
fsLit String
"hs_atomic_xor16"
    Width
W32 -> String -> FastString
fsLit String
"hs_atomic_xor32"
    Width
W64 -> String -> FastString
fsLit String
"hs_atomic_xor64"
    Width
_   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"atomicRMWLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)


xchgLabel :: Width -> FastString
xchgLabel :: Width -> FastString
xchgLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_xchg8"
  Width
W16 -> String -> FastString
fsLit String
"hs_xchg16"
  Width
W32 -> String -> FastString
fsLit String
"hs_xchg32"
  Width
W64 -> String -> FastString
fsLit String
"hs_xchg64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"xchgLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

cmpxchgLabel :: Width -> FastString
cmpxchgLabel :: Width -> FastString
cmpxchgLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_cmpxchg8"
  Width
W16 -> String -> FastString
fsLit String
"hs_cmpxchg16"
  Width
W32 -> String -> FastString
fsLit String
"hs_cmpxchg32"
  Width
W64 -> String -> FastString
fsLit String
"hs_cmpxchg64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"cmpxchgLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

atomicReadLabel :: Width -> FastString
atomicReadLabel :: Width -> FastString
atomicReadLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_atomicread8"
  Width
W16 -> String -> FastString
fsLit String
"hs_atomicread16"
  Width
W32 -> String -> FastString
fsLit String
"hs_atomicread32"
  Width
W64 -> String -> FastString
fsLit String
"hs_atomicread64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"atomicReadLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)

atomicWriteLabel :: Width -> FastString
atomicWriteLabel :: Width -> FastString
atomicWriteLabel = \case
  Width
W8  -> String -> FastString
fsLit String
"hs_atomicwrite8"
  Width
W16 -> String -> FastString
fsLit String
"hs_atomicwrite16"
  Width
W32 -> String -> FastString
fsLit String
"hs_atomicwrite32"
  Width
W64 -> String -> FastString
fsLit String
"hs_atomicwrite64"
  Width
w   -> String -> SDoc -> FastString
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"atomicWriteLabel: Unsupported word width " (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)