{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}

-- | The interpreter's side of the boundary with native code: the C
-- functions in cbits/jit_rt.c that the Haskell runtime calls, and nothing
-- else. See unison-runtime/src/Unison/Runtime/JIT/design.md, "How the interpreter interacts
-- with native code". With the JIT off nothing here is reached, because no
-- cell ever holds code.
--
-- Three jobs, in three sections below:
--
-- 1. /Entering native code./ 'enterNative' is the one call the trampoline
--    (Machine.runNative) makes per entry; it hands over the stacks and
--    the pool and gets a status back. Everything else native code returns
--    is read afterwards out of the stacks' out-areas with 'outAp' and the
--    rest, as 'FrameRecord's for the frames of native callers.
--
-- 2. /Startup./ 'configureNative' passes the stress settings down,
--    'ctxLayout' and 'rtsFacts' fetch the numbers the code generator bakes
--    into every function (the offsets of the C @Ctx@ struct, the RTS's
--    info pointers and layout constants).
--
-- 3. /Addresses./ The names generated code and the IR helpers call, with
--    their addresses, which the JIT defines as absolute symbols before any
--    module is added ('helperAddresses', 'tableAddresses'), and the C
--    copies of the two helpers whose IR definition must shadow them.
--
-- The startup checks that run each C helper family against the
-- interpreter are in "Unison.Runtime.JIT.Native.Probes".
module Unison.Runtime.JIT.Native
  ( -- * Entering native code
    NativeFn,
    Status,
    statusOK,
    statusError,
    enterNative,
    FrameRecord (..),
    outAp,
    outFp,
    outSp,
    outFrameCount,
    outFrames,

    -- * Startup
    configureNative,
    ctxLayout,
    rtsFacts,
    hplimValue,

    -- * Addresses
    helperAddresses,
    tableAddresses,
    murmurCAddress,
    ucmpCAddress,
  )
where

import Control.Monad (forM)
import Control.Monad.Primitive (PrimState)
import Data.Int (Int64)
import Data.Primitive.Array (MutableArray (..))
import Data.Primitive.ByteArray (MutableByteArray (..), readByteArray)
import Data.Word (Word64)
import Foreign.C.String (CString, peekCString)
import Foreign.Marshal.Alloc (allocaBytes, free)
import Foreign.Ptr (FunPtr, Ptr, WordPtr (..), ptrToWordPtr, wordPtrToPtr)
import Foreign.Storable (peekElemOff)
import GHC.Exts (MutableArray#, MutableByteArray#)
import Unison.Runtime.Stack (Closure)

-- ---------------------------------------------------------------------------
-- Entering native code

-- | The uniform signature of compiled code: @(ctx, ap, fp, sp) -> status@.
data NativeFn

type Status = Int

-- | What a native caller writes down when its callee exits: which @Let@
-- body to continue with (an index into the frame table), and the two sizes
-- a @Push@ frame needs. A negative index, @-1 - i@, is a @Local@ frame
-- instead: the environment to switch back to is in the boxed out-area at
-- @i@ past the first pointer, and the pending-argument count is as for a
-- @Push@.
data FrameRecord = FrameRecord {FrameRecord -> Int
frIndex :: !Int, FrameRecord -> Int
frFrameSize :: !Int, FrameRecord -> Int
frPendingArgs :: !Int}
  deriving (Int -> FrameRecord -> ShowS
[FrameRecord] -> ShowS
FrameRecord -> String
(Int -> FrameRecord -> ShowS)
-> (FrameRecord -> String)
-> ([FrameRecord] -> ShowS)
-> Show FrameRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FrameRecord -> ShowS
showsPrec :: Int -> FrameRecord -> ShowS
$cshow :: FrameRecord -> String
show :: FrameRecord -> String
$cshowList :: [FrameRecord] -> ShowS
showList :: [FrameRecord] -> ShowS
Show)

statusOK, statusError :: Status
statusOK :: Int
statusOK = Int
0
statusError :: Int
statusError = -Int
1

-- 'enterNative' leaves what native code hands back besides its status in
-- the spare words past the last slot of the unboxed stack (see
-- 'Unison.Runtime.Stack.nativeOutWords'): nothing is allocated for a round
-- trip. These read them, given the stack and its size in slots.
outAp, outFp, outSp, outFrameCount :: MutableByteArray (PrimState IO) -> Int -> IO Int
outAp :: MutableByteArray (PrimState IO) -> Int -> IO Int
outAp MutableByteArray (PrimState IO)
ustk Int
size = MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
ustk Int
size
outFp :: MutableByteArray (PrimState IO) -> Int -> IO Int
outFp MutableByteArray (PrimState IO)
ustk Int
size = MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
ustk (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
outSp :: MutableByteArray (PrimState IO) -> Int -> IO Int
outSp MutableByteArray (PrimState IO)
ustk Int
size = MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
ustk (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
outFrameCount :: MutableByteArray (PrimState IO) -> Int -> IO Int
outFrameCount MutableByteArray (PrimState IO)
ustk Int
size = MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
ustk (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
{-# INLINE outAp #-}
{-# INLINE outFp #-}
{-# INLINE outSp #-}
{-# INLINE outFrameCount #-}

-- | The frame records, in the order they were written (innermost caller
-- first). Call at most once per entry: a long list is freed as it is read.
outFrames :: MutableByteArray (PrimState IO) -> Int -> IO [FrameRecord]
outFrames :: MutableByteArray (PrimState IO) -> Int -> IO [FrameRecord]
outFrames = MutableByteArray (PrimState IO) -> Int -> IO [FrameRecord]
frameRecords

foreign import ccall unsafe "unison_jit_enter"
  c_enter ::
    FunPtr NativeFn ->
    MutableByteArray# (PrimState IO) ->
    MutableArray# (PrimState IO) Closure ->
    MutableArray# (PrimState IO) Closure ->
    Int64 ->
    Int64 ->
    Int64 ->
    Int64 ->
    IO Int64

-- | Runs native code with the given stacks (and their size in slots) and
-- pointers, and returns its status. Where it stopped and the frame records
-- it wrote are read with 'outAp' and the rest. The handler environment (an
-- @HEnv@, coerced) goes in and comes back in the boxed stack's out-area
-- (see 'Unison.Runtime.Stack.nativeOutPtrs'), so that the collector keeps
-- the pointer right while Haskell code runs around the call.
enterNative ::
  FunPtr NativeFn ->
  MutableByteArray (PrimState IO) ->
  MutableArray (PrimState IO) Closure ->
  MutableArray (PrimState IO) Closure ->
  Int ->
  Int ->
  Int ->
  Int ->
  IO Status
enterNative :: FunPtr NativeFn
-> MutableByteArray (PrimState IO)
-> MutableArray (PrimState IO) Closure
-> MutableArray (PrimState IO) Closure
-> Int
-> Int
-> Int
-> Int
-> IO Int
enterNative FunPtr NativeFn
fn (MutableByteArray MutableByteArray# (PrimState IO)
ustk) (MutableArray MutableArray# (PrimState IO) Closure
bstk) (MutableArray MutableArray# (PrimState IO) Closure
pool) Int
size Int
ap Int
fp Int
sp = do
  Int64
status <- FunPtr NativeFn
-> MutableByteArray# (PrimState IO)
-> MutableArray# (PrimState IO) Closure
-> MutableArray# (PrimState IO) Closure
-> Int64
-> Int64
-> Int64
-> Int64
-> IO Int64
c_enter FunPtr NativeFn
fn MutableByteArray# (PrimState IO)
ustk MutableArray# (PrimState IO) Closure
bstk MutableArray# (PrimState IO) Closure
pool (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ap) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fp) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sp)
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
status
{-# INLINE enterNative #-}

frameRecords :: MutableByteArray (PrimState IO) -> Int -> IO [FrameRecord]
frameRecords :: MutableByteArray (PrimState IO) -> Int -> IO [FrameRecord]
frameRecords MutableByteArray (PrimState IO)
out Int
size = do
  Int
n <- MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
out (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) :: IO Int
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
inlineFrames
    then (Int -> IO FrameRecord) -> [Int] -> IO [FrameRecord]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Int
i -> Int -> Int -> Int -> FrameRecord
FrameRecord (Int -> Int -> Int -> FrameRecord)
-> IO Int -> IO (Int -> Int -> FrameRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
out (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) IO (Int -> Int -> FrameRecord) -> IO Int -> IO (Int -> FrameRecord)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
out (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) IO (Int -> FrameRecord) -> IO Int -> IO FrameRecord
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
out (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    else do
      Word
addr <- MutableByteArray (PrimState IO) -> Int -> IO Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState IO)
out (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) :: IO Word
      let buf :: Ptr Int64
buf = WordPtr -> Ptr Int64
forall a. WordPtr -> Ptr a
wordPtrToPtr (Word -> WordPtr
WordPtr Word
addr) :: Ptr Int64
          record :: Int -> IO FrameRecord
record Int
i =
            Int -> Int -> Int -> FrameRecord
FrameRecord
              (Int -> Int -> Int -> FrameRecord)
-> IO Int -> IO (Int -> Int -> FrameRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int64 -> Int -> IO Int64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int64
buf (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i))
              IO (Int -> Int -> FrameRecord) -> IO Int -> IO (Int -> FrameRecord)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int64 -> Int -> IO Int64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int64
buf (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
              IO (Int -> FrameRecord) -> IO Int -> IO FrameRecord
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int64 -> Int -> IO Int64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int64
buf (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
      [FrameRecord]
fs <- (Int -> IO FrameRecord) -> [Int] -> IO [FrameRecord]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> IO FrameRecord
record [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
      Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
free Ptr Int64
buf
      pure [FrameRecord]
fs

-- | Must match UNISON_JIT_INLINE_FRAMES in jit_rt.h.
inlineFrames :: Int
inlineFrames :: Int
inlineFrames = Int
8

-- ---------------------------------------------------------------------------
-- Startup

foreign import ccall unsafe "unison_jit_configure" c_configure :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> IO ()

-- | Passes stress settings to the C side: poll every N entries, treat every
-- Nth callee as uncompiled, C stack budget in bytes (0 for the default),
-- allocation budget in words, trace. Called once at startup.
configureNative :: Int -> Int -> Int -> Int -> Bool -> IO ()
configureNative :: Int -> Int -> Int -> Int -> Bool -> IO ()
configureNative Int
pollEvery Int
calleeEvery Int
cstack Int
alloc Bool
tr =
  Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> IO ()
c_configure (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pollEvery) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
calleeEvery) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cstack) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
alloc) (if Bool
tr then Int64
1 else Int64
0)

foreign import ccall unsafe "unison_jit_ctx_layout" c_ctxLayout :: Ptr Int64 -> Int64 -> IO Int64

-- | The offsets of the fields of the C @Ctx@, in the order they are
-- declared, and its total size. The code generator uses these.
ctxLayout :: IO ([Int], Int)
ctxLayout :: IO ([Int], Int)
ctxLayout = Int -> (Ptr Int64 -> IO ([Int], Int)) -> IO ([Int], Int)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32) ((Ptr Int64 -> IO ([Int], Int)) -> IO ([Int], Int))
-> (Ptr Int64 -> IO ([Int], Int)) -> IO ([Int], Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
out -> do
  Int64
size <- Ptr Int64 -> Int64 -> IO Int64
c_ctxLayout Ptr Int64
out Int64
32
  [Int64]
offs <- (Int -> IO Int64) -> [Int] -> IO [Int64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr Int64 -> Int -> IO Int64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int64
out) [Int
0 .. Int
22]
  pure ((Int64 -> Int) -> [Int64] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int64]
offs, Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size)

foreign import ccall unsafe "unison_jit_rts_facts" c_rtsFacts :: Ptr Int64 -> Int64 -> IO Int64

-- | Facts about the runtime that generated code needs: see
-- unison_jit_rts_facts in jit_rt.c for what each entry is.
rtsFacts :: IO [Int]
rtsFacts :: IO [Int]
rtsFacts = Int -> (Ptr Int64 -> IO [Int]) -> IO [Int]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16) ((Ptr Int64 -> IO [Int]) -> IO [Int])
-> (Ptr Int64 -> IO [Int]) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
out -> do
  Int64
n <- Ptr Int64 -> Int64 -> IO Int64
c_rtsFacts Ptr Int64
out Int64
16
  (Int64 -> Int) -> [Int64] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int64] -> [Int]) -> IO [Int64] -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Int64) -> [Int] -> IO [Int64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr Int64 -> Int -> IO Int64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int64
out) [Int
0 .. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

foreign import ccall unsafe "unison_jit_hplim_value" c_hplimValue :: IO Int64

-- | For tracing: what the poll would see right now.
hplimValue :: IO Int
hplimValue :: IO Int
hplimValue = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int64
c_hplimValue

-- ---------------------------------------------------------------------------
-- Addresses

foreign import ccall unsafe "unison_jit_helper_addresses" c_helperAddresses :: Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64

-- | Every C function generated code and the IR modules call by name, with
-- its address, for the JIT to define before any module is added (so that
-- nothing is looked up in the process, which Linux and Windows don't allow
-- without more linker flags).
helperAddresses :: IO [(String, Word64)]
helperAddresses :: IO [(String, Word64)]
helperAddresses = Int
-> (Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64)
-> IO [(String, Word64)]
namedAddresses Int
256 Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64
c_helperAddresses

foreign import ccall unsafe "unison_jit_table_addresses" c_tableAddresses :: Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64

-- | The names the IR helpers refer to the runtime's tables by, with the
-- tables' addresses, for the JIT to define before the helpers are added.
tableAddresses :: IO [(String, Word64)]
tableAddresses :: IO [(String, Word64)]
tableAddresses = Int
-> (Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64)
-> IO [(String, Word64)]
namedAddresses Int
16 Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64
c_tableAddresses

-- | Reads a C table of (name, address) pairs of at most @most@ entries.
namedAddresses :: Int -> (Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64) -> IO [(String, Word64)]
namedAddresses :: Int
-> (Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64)
-> IO [(String, Word64)]
namedAddresses Int
most Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64
fill = Int
-> (Ptr CString -> IO [(String, Word64)]) -> IO [(String, Word64)]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
most) ((Ptr CString -> IO [(String, Word64)]) -> IO [(String, Word64)])
-> (Ptr CString -> IO [(String, Word64)]) -> IO [(String, Word64)]
forall a b. (a -> b) -> a -> b
$ \Ptr CString
names -> Int
-> (Ptr (Ptr ()) -> IO [(String, Word64)]) -> IO [(String, Word64)]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
most) ((Ptr (Ptr ()) -> IO [(String, Word64)]) -> IO [(String, Word64)])
-> (Ptr (Ptr ()) -> IO [(String, Word64)]) -> IO [(String, Word64)]
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
addrs -> do
  Int64
n <- Ptr CString -> Ptr (Ptr ()) -> Int64 -> IO Int64
fill Ptr CString
names Ptr (Ptr ())
addrs (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
most)
  [Int] -> (Int -> IO (String, Word64)) -> IO [(String, Word64)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> IO (String, Word64)) -> IO [(String, Word64)])
-> (Int -> IO (String, Word64)) -> IO [(String, Word64)]
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    String
name <- Ptr CString -> Int -> IO CString
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CString
names Int
i IO CString -> (CString -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
    Ptr ()
addr <- Ptr (Ptr ()) -> Int -> IO (Ptr ())
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr ())
addrs Int
i
    pure (String
name, WordPtr -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr () -> WordPtr
forall a. Ptr a -> WordPtr
ptrToWordPtr Ptr ()
addr))

foreign import ccall "&unison_jit_murmur" c_murmurAddr :: FunPtr (Int64 -> Ptr () -> IO ())

foreign import ccall "&unison_jit_ucmp" c_ucmpAddr :: FunPtr (Int64 -> Ptr () -> Int64 -> Ptr () -> Int64 -> IO ())

-- | Where the C copy of @unison_jit_murmur@ is: what the JIT's own
-- definition of the name (the IR copy) must not be.
murmurCAddress :: FunPtr (Int64 -> Ptr () -> IO ())
murmurCAddress :: FunPtr (Int64 -> Ptr () -> IO ())
murmurCAddress = FunPtr (Int64 -> Ptr () -> IO ())
c_murmurAddr

-- | Where the C copy of @unison_jit_ucmp@ is, for the same check.
ucmpCAddress :: FunPtr (Int64 -> Ptr () -> Int64 -> Ptr () -> Int64 -> IO ())
ucmpCAddress :: FunPtr (Int64 -> Ptr () -> Int64 -> Ptr () -> Int64 -> IO ())
ucmpCAddress = FunPtr (Int64 -> Ptr () -> Int64 -> Ptr () -> Int64 -> IO ())
c_ucmpAddr