Intrinsics.hs

-- |
-- 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_specific_llvm_overrides
, register_llvm_overrides_
, llvmDeclToFunHandleRepr
, declare_overrides

, module Lang.Crucible.LLVM.Intrinsics.Common
, module Lang.Crucible.LLVM.Intrinsics.Options
, module Lang.Crucible.LLVM.Intrinsics.Match
) where

import           Control.Monad (forM)
import           Data.Maybe (catMaybes)
import           Lens.Micro ((^.))
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.Cast as Cast
import qualified Lang.Crucible.LLVM.Intrinsics.Declare as Decl
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.  There are internal pre-determined overrides that will be applied,
-- as well as any additional overrides supplied by the user (internal overrides
-- will supercede user overrides).
--
-- The "define" overrides are applied to *both* the @Define@s and @Declare@s
-- elements found within a module.
--
-- The "declare" overrides are applied only to the @Declare@s found within a
-- module.  The intent is that these overrides should only apply to @Declare@s,
-- whereas the "define" overrides should apply to any matching symbol in the LLVM
-- @Module@.
--
-- If both lists specify an override that matches a declare, the declare override
-- takes precedence over the define override.
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)


-- | Match a set of 'OverrideTemplate's against a provided set of definitions and
-- declarations, registering all the overrides that apply and returning them as a
-- pair of lists: the registered definition overrides and the registered
-- declaration overrides.
--
-- This is an alternative entrypoint for registering overrides.  The
-- functionality here is largely the same as 'register_llvm_overrides' except the
-- list of declares and defines are provided manually by the caller instead of
-- being extracted from the LLVM @Module@.
register_specific_llvm_overrides ::
  IsSymInterface sym =>
  HasLLVMAnn sym =>
  HasPtrWidth wptr =>
  wptr ~ ArchWidth arch =>
  (?intrinsicsOpts :: IntrinsicsOptions) =>
  (?memOpts :: MemOptions) =>
  [L.Define] ->
  [L.Declare] ->
  [OverrideTemplate p sym LLVM arch] {- ^ Additional \"define\" overrides -} ->
  [OverrideTemplate p sym LLVM arch] {- ^ Additional \"declare\" overrides -} ->
  LLVMContext arch ->
  OverrideSim p sym LLVM rtp l a ( [SomeLLVMOverride p sym LLVM] -- ^ def overrides
                                 , [SomeLLVMOverride p sym LLVM] -- ^ decl overrides
                                 )
register_specific_llvm_overrides defs decls addlDefOvrs addlDeclOvrs llvmctx =
  (,)
  <$> register_overrides (declareFromDefine <$> defs) addlDefOvrs llvmctx
  <*> register_overrides decls addlDeclOvrs llvmctx

-- | 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] ->
  Decl.SomeDeclare ->
  [OverrideTemplate p sym ext arch]
filterTemplates ts (Decl.SomeDeclare decl) =
  filter (matches nm . overrideTemplateMatcher) ts
  where L.Symbol nm = Decl.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
  Decl.SomeDeclare ->
  OverrideSim p sym ext rtp l a [SomeLLVMOverride p sym ext]
match_llvm_overrides llvmctx acts someDecl =
  llvmPtrWidth llvmctx $ \wptr -> withPtrWidth wptr $ do
    let acts' = filterTemplates acts someDecl
    Decl.SomeDeclare decl <- pure someDecl
    let L.Symbol nm = Decl.decName decl
    let declnm = either (const Nothing) Just $ ABI.demangleName nm
    mbOvs <-
      forM (map overrideTemplateAction acts') $ \(MakeOverride act) ->
        case act someDecl 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
  [Decl.SomeDeclare] ->
  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.  This should apply the override regardless of whether the override
-- applies to a @Define@ or a @Declare@.
--
-- 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
  , ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions ) =>
  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_overrides (allModuleDeclares llvmModule) (addlOvrs ++ define_overrides)
     llvmctx

-- | 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_overrides (L.modDeclares llvmModule) (addlOvrs ++ declare_overrides)
     llvmctx

register_overrides ::
  ( IsSymInterface sym, HasLLVMAnn sym, HasPtrWidth wptr, wptr ~ ArchWidth arch
  , ?intrinsicsOpts :: IntrinsicsOptions, ?memOpts :: MemOptions ) =>
  [L.Declare] ->
  -- | Additional (non-default) @declare@ overrides
  [OverrideTemplate p sym LLVM arch] ->
  LLVMContext arch ->
  OverrideSim p sym LLVM rtp l a [SomeLLVMOverride p sym LLVM]
register_overrides llvmDecls ovrs llvmctx = do
  let ?lc = llvmctx^.llvmTypeCtx
  decls <- Decl.fromLLVMWithWarnings llvmDecls
  let ovs = map Cast.lowerOverrideTemplate ovrs
  register_llvm_overrides_ llvmctx ovs decls

-- | 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
  , map (\(pfx, LLVM.PolyCmpLLVMOverride ov) -> polymorphic_cmp_llvm_override pfx ov) LLVM.poly_cmp_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.
-}