-- Copyright 2021 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

module LLVM.Shims (
  newTargetMachine, newHostTargetMachine, disposeTargetMachine,
  newDefaultHostTargetMachine
  ) where

import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Short as SBS

import qualified LLVM.Relocation as R
import qualified LLVM.CodeModel as CM
import qualified LLVM.CodeGenOpt as CGO
import qualified LLVM.Internal.Target as Target
import qualified LLVM.Internal.FFI.Target as Target.FFI
import LLVM.Prelude (ShortByteString, ByteString)
import LLVM.Internal.Coding (encodeM)

-- llvm-hs doesn't expose any way to manage target machines in a non-bracketed way

newTargetMachine :: Target.Target
                 -> ShortByteString
                 -> ByteString
                 -> M.Map Target.CPUFeature Bool
                 -> Target.TargetOptions
                 -> R.Model
                 -> CM.Model
                 -> CGO.Level
                 -> IO Target.TargetMachine
newTargetMachine (Target.Target targetFFI) triple cpu features
                 (Target.TargetOptions targetOptFFI)
                 relocModel codeModel cgoLevel = do
  SBS.useAsCString triple \tripleFFI -> do
    BS.useAsCString cpu \cpuFFI -> do
      let featuresStr = BS.intercalate "," $ fmap encodeFeature $ M.toList features
      BS.useAsCString featuresStr \featuresFFI -> do
        relocModelFFI <- encodeM relocModel
        codeModelFFI <- encodeM codeModel
        cgoLevelFFI <- encodeM cgoLevel
        Target.TargetMachine <$> Target.FFI.createTargetMachine
                targetFFI tripleFFI cpuFFI featuresFFI
                targetOptFFI relocModelFFI codeModelFFI cgoLevelFFI
  where encodeFeature (Target.CPUFeature f, on) = (if on then "+" else "-") <> f

-- XXX: We need to use the large code model for macOS, because the libC functions
--      are loaded very far away from the JITed code. This does not prevent the
--      runtime linker from attempting to shove their offsets into 32-bit values
--      which cannot represent them, leading to segfaults that are very fun to debug.
--      It would be good to find a better solution, because larger code models might
--      hurt performance if we were to end up doing a lot of function calls.
-- TODO: Consider changing the linking layer, as suggested in:
--       http://llvm.1065342.n5.nabble.com/llvm-dev-ORC-JIT-Weekly-5-td135203.html
newDefaultHostTargetMachine :: IO Target.TargetMachine
newDefaultHostTargetMachine = LLVM.Shims.newHostTargetMachine R.PIC cm CGO.Aggressive
  where
#if darwin_HOST_OS
    cm = CM.Small
#else
    cm = CM.Large
#endif

newHostTargetMachine :: R.Model -> CM.Model -> CGO.Level -> IO Target.TargetMachine
newHostTargetMachine relocModel codeModel cgoLevel = do
  Target.initializeAllTargets
  triple <- Target.getProcessTargetTriple
  (target, _) <- Target.lookupTarget Nothing triple
  cpu <- Target.getHostCPUName
  features <- Target.getHostCPUFeatures
  Target.withTargetOptions \targetOptions ->
    newTargetMachine target triple cpu features targetOptions relocModel codeModel cgoLevel

disposeTargetMachine :: Target.TargetMachine -> IO ()
disposeTargetMachine (Target.TargetMachine tmFFI) = Target.FFI.disposeTargetMachine tmFFI