StgToCmm.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}

module GHC.Driver.Config.StgToCmm
  ( initStgToCmmConfig
  ) where

import GHC.Prelude.Basic

import GHC.StgToCmm.Config

import GHC.Cmm.MachOp ( FMASign(..))
import GHC.Driver.Backend
import GHC.Driver.Session
import GHC.Platform
import GHC.Platform.Profile
import GHC.Platform.Regs
import GHC.Utils.Error
import GHC.Unit.Module
import GHC.Utils.Outputable

initStgToCmmConfig :: DynFlags -> Module -> StgToCmmConfig
initStgToCmmConfig dflags mod = StgToCmmConfig
  -- settings
  { stgToCmmProfile       = profile
  , stgToCmmThisModule    = mod
  , stgToCmmTmpDir        = tmpDir          dflags
  , stgToCmmContext       = initSDocContext dflags defaultDumpStyle
  , stgToCmmEmitDebugInfo = debugLevel      dflags > 0
  , stgToCmmBinBlobThresh = b_blob
  , stgToCmmMaxInlAllocSize = maxInlineAllocSize           dflags
  -- ticky options
  , stgToCmmDoTicky       = gopt Opt_Ticky                 dflags
  , stgToCmmTickyAllocd   = gopt Opt_Ticky_Allocd          dflags
  , stgToCmmTickyLNE      = gopt Opt_Ticky_LNE             dflags
  , stgToCmmTickyDynThunk = gopt Opt_Ticky_Dyn_Thunk       dflags
  , stgToCmmTickyTag      = gopt Opt_Ticky_Tag             dflags
  -- flags
  , stgToCmmLoopification = gopt Opt_Loopification         dflags
  , stgToCmmAlignCheck    = gopt Opt_AlignmentSanitisation dflags
  , stgToCmmFastPAPCalls  = gopt Opt_FastPAPCalls          dflags
  , stgToCmmSCCProfiling  = sccProfilingEnabled            dflags
  , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling     dflags
  , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo         dflags
  , stgToCmmInfoTableMap  = gopt Opt_InfoTableMap          dflags
  , stgToCmmInfoTableMapWithFallback = gopt Opt_InfoTableMapWithFallback dflags
  , stgToCmmInfoTableMapWithStack = gopt Opt_InfoTableMapWithStack dflags
  , stgToCmmOmitYields    = gopt Opt_OmitYields            dflags
  , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas  dflags
  , stgToCmmPIC           = gopt Opt_PIC                   dflags
  , stgToCmmPIE           = gopt Opt_PIE                   dflags
  , stgToCmmExtDynRefs    = gopt Opt_ExternalDynamicRefs   dflags
  , stgToCmmDoBoundsCheck = gopt Opt_DoBoundsChecking      dflags
  , stgToCmmDoTagCheck    = gopt Opt_DoTagInferenceChecks  dflags
  , stgToCmmObjectDeterminism = gopt Opt_ObjectDeterminism dflags

  -- backend flags:

    -- LLVM, C, and some 32-bit NCG backends can also handle some 64-bit primops
  , stgToCmmAllowArith64              = w64 || not ncg || platformArch platform == ArchWasm32 || platformArch platform == ArchX86
  , stgToCmmAllowQuot64               = w64 || not ncg || platformArch platform == ArchWasm32
  , stgToCmmAllowQuotRemInstr         = ncg  && (x86ish || ppc)
  , stgToCmmAllowQuotRem2             = (ncg && (x86ish || ppc)) || llvm
  , stgToCmmAllowExtendedAddSubInstrs = (ncg && (x86ish || ppc)) || llvm
  , stgToCmmAllowFMAInstr =
      if
        | not (isFmaEnabled dflags)
        || not (ncg || llvm)
        -- If we're not using the native code generator or LLVM,
        -- fall back to the generic implementation.
        || platformArch platform == ArchWasm32
        -- WASM doesn't support native FMA instructions (at the time of writing).
        -> const False

        -- FNMSub and FNMAdd have different semantics on PowerPC,
        -- so we avoid using them.
        | ppc
        -> \ case { FMAdd -> True; FMSub -> True; _ -> False }

        | otherwise
        -> const True

  , stgToCmmAllowIntMul2Instr         = (ncg && (x86ish || aarch64)) || llvm
  , stgToCmmAllowWordMul2Instr        = (ncg && (x86ish || ppc || aarch64)) || llvm
  , stgToCmmAllowIntWord64X2MinMax    = (ncg && x86ish && isSse4_2Enabled dflags) || llvm
  -- SIMD flags
  , stgToCmmVecInstrsErr  = vec_err
  , stgToCmmAvx           = isAvxEnabled                   dflags
  , stgToCmmAvx2          = isAvx2Enabled                  dflags
  , stgToCmmAvx512f       = isAvx512fEnabled               dflags
  , stgToCmmTickyAP       = gopt Opt_Ticky_AP dflags
  -- See Note [Saving foreign call target to local]
  , stgToCmmSaveFCallTargetToLocal = any (callerSaves platform) $ activeStgRegs platform
  } where profile  = targetProfile dflags
          platform = profilePlatform profile
          bk_end  = backend dflags
          w64 = platformWordSize platform == PW8
          b_blob  = if not ncg then Nothing else binBlobThreshold dflags
          (ncg, llvm) = case backendPrimitiveImplementation bk_end of
                          GenericPrimitives -> (False, False)
                          JSPrimitives      -> (False, False)
                          NcgPrimitives     -> (True, False)
                          LlvmPrimitives    -> (False, True)
          aarch64 = case platformArch platform of
                      ArchAArch64  -> True
                      _            -> False
          x86ish  = case platformArch platform of
                      ArchX86    -> True
                      ArchX86_64 -> True
                      _          -> False
          ppc     = case platformArch platform of
                      ArchPPC      -> True
                      ArchPPC_64 _ -> True
                      _            -> False
          vec_err = case backendSimdValidity (backend dflags) of
                      IsValid -> Nothing
                      NotValid msg -> Just msg