<commit_before>{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
module Feldspar.Multicore.Compile.Parallella.Host where

import qualified Data.Map as Map
import qualified Data.Set as Set

import Feldspar.Multicore.Compile.Parallella.Channel
import Feldspar.Multicore.Compile.Parallella.Core
import Feldspar.Multicore.Compile.Parallella.Esdk
import Feldspar.Multicore.Compile.Parallella.Imports
import Feldspar.Multicore.Compile.Parallella.State
import Feldspar.Multicore.Compile.Parallella.Util

import Feldspar.Run.Concurrent (forkWithId)
import Feldspar.Run.Compile (env0, ProgC, translate, TargetCMD)

import qualified Language.C.Monad as C (_funUsedVars, _globals, _includes, CEnv, cenvToCUnit, wrapMain)
import Language.C.Quote.C
import qualified Language.C.Syntax as C (Id (..))
import qualified Language.Embedded.Concurrent.CMD as Imp
import qualified Language.Embedded.Imperative.CMD as Imp


--------------------------------------------------------------------------------
-- Forking threads
--------------------------------------------------------------------------------

compThreadCMD :: Imp.ThreadCMD (Param3 RunGen Data PrimType') a -> RunGen a
compThreadCMD (Imp.ForkWithId p) = do
    s <- genState
    let p' = evalGen s . p
    fromRun $ forkWithId p'

instance Interp Imp.ThreadCMD RunGen (Param2 Data PrimType')
  where interp = compThreadCMD


--------------------------------------------------------------------------------
-- Core-local array fetch and flush
--------------------------------------------------------------------------------

compLocalBulkArrCMD :: (BulkArrCMD LArr) (Param3 RunGen exp pred) a -> RunGen a
compLocalBulkArrCMD (WriteArr offset spm range ram) =
    compLocalCopy "host_write_local"  spm ram offset range
compLocalBulkArrCMD (ReadArr  offset spm range ram) =
    compLocalCopy "host_read_local"   spm ram offset range

instance Interp (BulkArrCMD LArr) RunGen (Param2 exp pred)
  where interp = compLocalBulkArrCMD

compLocalCopy :: PrimType a => String
              -> DLArr a -> Arr (Data a)
              -> Data Index -> IndexRange -> RunGen ()
compLocalCopy op spm ram offset (lower, upper) = do
    groupAddr <- gets group
    (r, c) <- gets $ groupCoordsForName (arrayRefName spm)
    lift $ addInclude "<feldspar-parallella.h>"
    lift $ callProc op
        [ groupAddr
        , valArg $ value r
        , valArg $ value c
        , arrArg (unwrapArr spm)
        , arrArg ram
        , valArg offset
        , valArg lower
        , valArg upper
        ]


--------------------------------------------------------------------------------
-- Shared array fetch and flush
--------------------------------------------------------------------------------

compSharedBulkArrCMD :: (BulkArrCMD SArr) (Param3 RunGen exp pred) a -> RunGen a
compSharedBulkArrCMD (WriteArr offset spm range ram) =
    compSharedCopy "host_write_shared" spm ram offset range
compSharedBulkArrCMD (ReadArr  offset spm range ram) =
    compSharedCopy "host_read_shared"  spm ram offset range

instance Interp (BulkArrCMD SArr) RunGen (Param2 exp pred)
  where interp = compSharedBulkArrCMD

compSharedCopy :: PrimType a => String
               -> DSArr a -> Arr (Data a)
               -> Data Index -> IndexRange -> RunGen ()
compSharedCopy op spm ram offset (lower, upper) = do
    shmRef <- gets $ shmRefForName $ arrayRefName spm
    lift $ addInclude "<feldspar-parallella.h>"
    lift $ callProc op
        [ shmRef
        , arrArg ram
        , valArg offset
        , valArg lower
        , valArg upper
        ]


--------------------------------------------------------------------------------
-- Halting cores
--------------------------------------------------------------------------------

compHostHaltCMD :: CoreHaltCMD (Param3 RunGen exp pred) a -> RunGen a
compHostHaltCMD (HaltCore (CoreRefComp coreId)) = do
    groupAddr <- gets group
    let (r, c) = groupCoord coreId
    lift $ callProc "e_halt" [ groupAddr, valArg $ value r, valArg $ value c ]

instance Interp CoreHaltCMD RunGen (Param2 exp pred)
  where interp = compHostHaltCMD


--------------------------------------------------------------------------------
-- Spawning core programs
--------------------------------------------------------------------------------

moduleName :: CoreId -> String
moduleName = ("core" ++) . show

compMulticoreCMD :: MulticoreCMD (Param3 RunGen exp pred) a -> RunGen a
compMulticoreCMD (OnCore coreId comp) = do
    s <- genState
    let coreRef = CoreRefComp coreId
    compCore coreId
        $ evalGen s
        $ interpretT ((lift :: Run a -> CoreGen a) . liftRun)
        $ unCoreComp
        $ comp coreRef
    groupAddr <- gets group
    let (r, c) = groupCoord coreId
    lift $ addInclude "<e-loader.h>"
    -- TODO:
    --  * split load and start
    --  * insert all core data initializer code between them
    --  * possibily aggregate those in RunGen state on host command compilation
    --    * when an instruction has a core id, and the core is not started
    --    * then do not emit the instruction, just collect it
    --    * then emit the collected code for the current core here!
    lift $ callProc "e_load"
        [ strArg $ moduleName coreId ++ ".srec"
        , groupAddr
        , valArg $ value r
        , valArg $ value c
        , valArg (value 1 :: Data Int32) {- E_TRUE -}
        ]
    return coreRef

instance Interp MulticoreCMD RunGen (Param2 exp pred)
  where interp = compMulticoreCMD


--------------------------------------------------------------------------------
-- Core program alignment transformation<commit_msg>Separating core load and start<commit_after>{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
module Feldspar.Multicore.Compile.Parallella.Host where

import qualified Data.Map as Map
import qualified Data.Set as Set

import Feldspar.Multicore.Compile.Parallella.Channel
import Feldspar.Multicore.Compile.Parallella.Core
import Feldspar.Multicore.Compile.Parallella.Esdk
import Feldspar.Multicore.Compile.Parallella.Imports
import Feldspar.Multicore.Compile.Parallella.State
import Feldspar.Multicore.Compile.Parallella.Util

import Feldspar.Run.Concurrent (forkWithId)
import Feldspar.Run.Compile (env0, ProgC, translate, TargetCMD)

import qualified Language.C.Monad as C (_funUsedVars, _globals, _includes, CEnv, cenvToCUnit, wrapMain)
import Language.C.Quote.C
import qualified Language.C.Syntax as C (Id (..))
import qualified Language.Embedded.Concurrent.CMD as Imp
import qualified Language.Embedded.Imperative.CMD as Imp


--------------------------------------------------------------------------------
-- Forking threads
--------------------------------------------------------------------------------

compThreadCMD :: Imp.ThreadCMD (Param3 RunGen Data PrimType') a -> RunGen a
compThreadCMD (Imp.ForkWithId p) = do
    s <- genState
    let p' = evalGen s . p
    fromRun $ forkWithId p'

instance Interp Imp.ThreadCMD RunGen (Param2 Data PrimType')
  where interp = compThreadCMD


--------------------------------------------------------------------------------
-- Core-local array fetch and flush
--------------------------------------------------------------------------------

compLocalBulkArrCMD :: (BulkArrCMD LArr) (Param3 RunGen exp pred) a -> RunGen a
compLocalBulkArrCMD (WriteArr offset spm range ram) =
    compLocalCopy "host_write_local"  spm ram offset range
compLocalBulkArrCMD (ReadArr  offset spm range ram) =
    compLocalCopy "host_read_local"   spm ram offset range

instance Interp (BulkArrCMD LArr) RunGen (Param2 exp pred)
  where interp = compLocalBulkArrCMD

compLocalCopy :: PrimType a => String
              -> DLArr a -> Arr (Data a)
              -> Data Index -> IndexRange -> RunGen ()
compLocalCopy op spm ram offset (lower, upper) = do
    groupAddr <- gets group
    (r, c) <- gets $ groupCoordsForName (arrayRefName spm)
    lift $ addInclude "<feldspar-parallella.h>"
    lift $ callProc op
        [ groupAddr
        , valArg $ value r
        , valArg $ value c
        , arrArg (unwrapArr spm)
        , arrArg ram
        , valArg offset
        , valArg lower
        , valArg upper
        ]


--------------------------------------------------------------------------------
-- Shared array fetch and flush
--------------------------------------------------------------------------------

compSharedBulkArrCMD :: (BulkArrCMD SArr) (Param3 RunGen exp pred) a -> RunGen a
compSharedBulkArrCMD (WriteArr offset spm range ram) =
    compSharedCopy "host_write_shared" spm ram offset range
compSharedBulkArrCMD (ReadArr  offset spm range ram) =
    compSharedCopy "host_read_shared"  spm ram offset range

instance Interp (BulkArrCMD SArr) RunGen (Param2 exp pred)
  where interp = compSharedBulkArrCMD

compSharedCopy :: PrimType a => String
               -> DSArr a -> Arr (Data a)
               -> Data Index -> IndexRange -> RunGen ()
compSharedCopy op spm ram offset (lower, upper) = do
    shmRef <- gets $ shmRefForName $ arrayRefName spm
    lift $ addInclude "<feldspar-parallella.h>"
    lift $ callProc op
        [ shmRef
        , arrArg ram
        , valArg offset
        , valArg lower
        , valArg upper
        ]


--------------------------------------------------------------------------------
-- Halting cores
--------------------------------------------------------------------------------

compHostHaltCMD :: CoreHaltCMD (Param3 RunGen exp pred) a -> RunGen a
compHostHaltCMD (HaltCore (CoreRefComp coreId)) = do
    groupAddr <- gets group
    let (r, c) = groupCoord coreId
    lift $ callProc "e_halt" [ groupAddr, valArg $ value r, valArg $ value c ]

instance Interp CoreHaltCMD RunGen (Param2 exp pred)
  where interp = compHostHaltCMD


--------------------------------------------------------------------------------
-- Spawning core programs
--------------------------------------------------------------------------------

moduleName :: CoreId -> String
moduleName = ("core" ++) . show

compMulticoreCMD :: MulticoreCMD (Param3 RunGen exp pred) a -> RunGen a
compMulticoreCMD (OnCore coreId comp) = do
    s <- genState
    let coreRef = CoreRefComp coreId
    compCore coreId
        $ evalGen s
        $ interpretT ((lift :: Run a -> CoreGen a) . liftRun)
        $ unCoreComp
        $ comp coreRef
    groupAddr <- gets group
    let (r, c) = groupCoord coreId
    lift $ do
        addInclude "<e-loader.h>"
        callProc "e_load"
            [ strArg $ moduleName coreId ++ ".srec"
            , groupAddr
            , valArg $ value r
            , valArg $ value c
            , valArg (value 0 :: Data Int32) {- E_FALSE -}
            ]
    -- TODO:
    --  * insert all core data initializer code here
    --  * possibily aggregate those in RunGen state on host command compilation
    --    * when an instruction has a core id, and the core is not started
    --    * then do not emit the instruction, just collect it
    --    * then emit the collected code for the current core here!
        callProc "e_start"
            [ groupAddr
            , valArg $ value r
            , valArg $ value c
            ]
    return coreRef

instance Interp MulticoreCMD RunGen (Param2 exp pred)
  where interp = compMulticoreCMD


--------------------------------------------------------------------------------
-- Core program alignment transformation
{'fraction_non_alphanumeric': 0.2234136052030234, 'fraction_numerical': 0.0024608894357532078, 'mean_word_length': 1.6843595187544231, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2488516', 'n_tokens_mistral': 3093, 'n_tokens_neox': 3017, 'n_words': 981}