content: -- |
  -- Module           : Lang.Crucible.LLVM.Intrinsics
  -- Description      : Override definitions for LLVM intrinsic and basic
  --                    library functions
  -- Copyright        : (c) Galois, Inc 2015-2016
  -- License          : BSD3
  -- Maintainer       : Rob Dockins <rdockins@galois.com>
  -- Stability        : provisional
  ------------------------------------------------------------------------
  
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE ImplicitParams #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE TypeFamilies #-}
  
  module Lang.Crucible.LLVM.Intrinsics
  ( LLVM
  , llvmIntrinsicTypes
  , LLVMOverride(..)
  
  , register_llvm_overrides
  , register_llvm_overrides_
  , llvmDeclToFunHandleRepr
  
  , module Lang.Crucible.LLVM.Intrinsics.Common
  , module Lang.Crucible.LLVM.Intrinsics.Options
  , module Lang.Crucible.LLVM.Intrinsics.Match
  ) where
  
  import           Control.Lens hiding (op, (:>), Empty)
  import           Control.Monad (forM)
  import           Data.Maybe (catMaybes)
  import qualified Text.LLVM.AST as L
  
  import qualified ABI.Itanium as ABI
  import qualified Data.Parameterized.Map as MapF
  
  import           Lang.Crucible.Backend
  import           Lang.Crucible.Types
  import           Lang.Crucible.Simulator.Intrinsics
  import           Lang.Crucible.Simulator.OverrideSim
  
  import           Lang.Crucible.LLVM.Extension (ArchWidth, LLVM)
  import           Lang.Crucible.LLVM.MemModel
  import           Lang.Crucible.LLVM.Translation.Monad
  import           Lang.Crucible.LLVM.Translation.Types
  import           Lang.Crucible.LLVM.TypeContext (TypeContext)
  
  import           Lang.Crucible.LLVM.Intrinsics.Common
  import qualified Lang.Crucible.LLVM.Intrinsics.LLVM as LLVM
  import qualified Lang.Crucible.LLVM.Intrinsics.Libc as Libc
  import qualified Lang.Crucible.LLVM.Intrinsics.Libcxx as Libcxx
  import           Lang.Crucible.LLVM.Intrinsics.Match
  import           Lang.Crucible.LLVM.Intrinsics.Options
  
  llvmIntrinsicTypes :: IsSymInterface sym => IntrinsicTypes sym
  llvmIntrinsicTypes =
     MapF.insert (knownSymbol :: SymbolRepr "LLVM_memory") IntrinsicMuxFn $
     MapF.insert (knownSymbol :: SymbolRepr "LLVM_pointer") IntrinsicMuxFn $
     MapF.empty
  
  -- | Match two sets of 'OverrideTemplate's against the @declare@s and @define@s
  -- in a 'L.Module', registering all the overrides that apply and returning them
  -- as a list.
  register_llvm_overrides ::
    ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr, wptr ~ ArchWidth arch
    , ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions ) =>
    L.Module ->
    [OverrideTemplate p sym LLVM arch] {- ^ Additional \"define\" overrides -} ->
    [OverrideTemplate p sym LLVM arch] {- ^ Additional \"declare\" overrides -} ->
    LLVMContext arch ->
    -- | Applied (@define@ overrides, @declare@ overrides)
    OverrideSim p sym LLVM rtp l a ([SomeLLVMOverride p sym LLVM], [SomeLLVMOverride p sym LLVM])
  register_llvm_overrides llvmModule defineOvrs declareOvrs llvmctx =
    do defOvs <- register_llvm_define_overrides llvmModule defineOvrs llvmctx
       declOvs <- register_llvm_declare_overrides llvmModule declareOvrs llvmctx
       pure (defOvs,  declOvs)
  
  -- | Filter the initial list of templates to only those that could
  -- possibly match the given declaration based on straightforward,
  -- relatively cheap string tests on the name of the declaration.
  --
  -- Any remaining templates will then examine the declaration in
  -- more detail, including examining function arguments
  -- and the structure of C++ demangled names to extract more information.
  filterTemplates ::
    [OverrideTemplate p sym ext arch] ->
    L.Declare ->
    [OverrideTemplate p sym ext arch]
  filterTemplates ts decl = filter (matches nm . overrideTemplateMatcher) ts
   where L.Symbol nm = L.decName decl
  
  -- | Match a set of 'OverrideTemplate's against a single 'L.Declare',
  -- registering all the overrides that apply and returning them as a list.
  match_llvm_overrides ::
    (IsSymInterface sym, HasLLVMAnn sym) =>
    LLVMContext arch ->
    -- | Overrides to attempt to match against this declaration
    [OverrideTemplate p sym ext arch] ->
    -- | Declaration of the function that might get overridden
    L.Declare ->
    OverrideSim p sym ext rtp l a [SomeLLVMOverride p sym ext]
  match_llvm_overrides llvmctx acts decl =
    llvmPtrWidth llvmctx $ \wptr -> withPtrWidth wptr $ do
      let acts' = filterTemplates acts decl
      let L.Symbol nm = L.decName decl
      let declnm = either (const Nothing) Just $ ABI.demangleName nm
      mbOvs <-
        forM (map overrideTemplateAction acts') $ \(MakeOverride act) ->
          case act decl declnm llvmctx of
            Nothing -> pure Nothing
            Just sov@(SomeLLVMOverride ov) -> do
              register_llvm_override ov decl llvmctx
              pure (Just sov)
      pure (catMaybes mbOvs)
  
  -- | Match a set of 'OverrideTemplate's against a set of 'L.Declare's,
  -- registering all the overrides that apply and returning them as a list.
  register_llvm_overrides_ ::
    (IsSymInterface sym, HasLLVMAnn sym) =>
    LLVMContext arch ->
    -- | Overrides to attempt to match against these declarations
    [OverrideTemplate p sym ext arch] ->
    -- | Declarations of the functions that might get overridden
    [L.Declare] ->
    OverrideSim p sym ext rtp l a [SomeLLVMOverride p sym ext]
  register_llvm_overrides_ llvmctx acts decls =
    concat <$> forM decls (\decl -> match_llvm_overrides llvmctx acts decl)
  
  -- | Match a set of 'OverrideTemplate's against all the @declare@s and @define@s
  -- in a 'L.Module', registering all the overrides that apply and returning them
  -- as a list.
  --
  -- Registers a default set of overrides, in addition to the ones passed as an
  -- argument.
  register_llvm_define_overrides ::
    (IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr, wptr ~ ArchWidth arch) =>
    L.Module ->
    -- | Additional (non-default) @define@ overrides
    [OverrideTemplate p sym LLVM arch] ->
    LLVMContext arch ->
    OverrideSim p sym LLVM rtp l a [SomeLLVMOverride p sym LLVM]
  register_llvm_define_overrides llvmModule addlOvrs llvmctx =
    let ?lc = llvmctx^.llvmTypeCtx in
    register_llvm_overrides_ llvmctx (addlOvrs ++ define_overrides) $
       (allModuleDeclares llvmModule)
  
  -- | Match a set of 'OverrideTemplate's against all the @declare@s in a
  -- 'L.Module', registering all the overrides that apply and returning them as
  -- a list.
  --
  -- Registers a default set of overrides, in addition to the ones passed as an
  -- argument.
  register_llvm_declare_overrides ::
    ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr, wptr ~ ArchWidth arch
    , ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions ) =>
    L.Module ->
    -- | Additional (non-default) @declare@ overrides
    [OverrideTemplate p sym LLVM arch] ->
    LLVMContext arch ->
    OverrideSim p sym LLVM rtp l a [SomeLLVMOverride p sym LLVM]
  register_llvm_declare_overrides llvmModule addlOvrs llvmctx =
    let ?lc = llvmctx^.llvmTypeCtx
    in register_llvm_overrides_ llvmctx (addlOvrs ++ declare_overrides) $
         L.modDeclares llvmModule
  
  -- | Register overrides for declared-but-not-defined functions
  declare_overrides ::
    ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr, wptr ~ ArchWidth arch
    , ?lc :: TypeContext, ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions ) =>
    [OverrideTemplate p sym LLVM arch]
  declare_overrides =
    concat
    [ map (\(SomeLLVMOverride ov) -> basic_llvm_override ov) Libc.libc_overrides
    , map (\(SomeLLVMOverride ov) -> basic_llvm_override ov) LLVM.basic_llvm_overrides
    , map (\(pfx, LLVM.Poly1LLVMOverride ov) -> polymorphic1_llvm_override pfx ov) LLVM.poly1_llvm_overrides
    , map (\(pfx, LLVM.Poly1VecLLVMOverride ov) -> polymorphic1_vec_llvm_override pfx ov) LLVM.poly1_vec_llvm_overrides
  
    -- C++ standard library functions
    , [ Libcxx.register_cpp_override Libcxx.endlOverride ]
    ]
  
  
  -- | Register those overrides that should apply even when the corresponding
  -- function has a definition
  define_overrides ::
    (IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr, wptr ~ ArchWidth arch, ?lc :: TypeContext) =>
    [OverrideTemplate p sym LLVM arch]
  define_overrides =
    [ Libcxx.register_cpp_override Libcxx.putToOverride12
    , Libcxx.register_cpp_override Libcxx.putToOverride9
    , Libcxx.register_cpp_override Libcxx.endlOverride
    , Libcxx.register_cpp_override Libcxx.sentryOverride
    , Libcxx.register_cpp_override Libcxx.sentryBoolOverride
    ]
  
  {-
  Note [Overrides involving (unsigned) long]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Registering overrides for functions with `long` argument or result types is
  tricky, as the size of a `long` varies wildly between different operating
  systems and architectures. On Linux and macOS, `long` is 32 or 64 bits on
  32- or 64-bit architectures, respectively. On Windows, however, `long` is
  always 32 bits, regardless of architecture. There is a similar story for the
  `unsigned long` type as well.
  
  To ensure that overrides for functions involving `long` are (at least to some
  degree) portable, we register each override for `long`-using function twice:
  once where `long` is assumed to be 32 bits, and once again where `long` is
  assumed to be 64 bits. This is a somewhat heavy-handed solution, but it avoids
  the need to predict what size `long` will be on a given target ahead of time.
  -}
  