diff --git a/clash-ffi/README.md b/clash-ffi/README.md index 6c34b3aae9..2b2bc13bae 100644 --- a/clash-ffi/README.md +++ b/clash-ffi/README.md @@ -44,11 +44,12 @@ All interaction with a simulator follows the same general process: setup-depends: base, Cabal, directory, filepath ``` - that uses the `Setup.hs` of this project (copied to your project's - root). This custom setup places the created foreign library into a - `lib` folder created under your project's root and renames the - file accordingly. It is important that the library has a `.vpl` - ending to be used by a VPI simulator in the end. + using the `Setup.hs` of the example project in the `example` + folder (copied to your project's root). This custom setup places + the created foreign library into a `lib` folder created under your + project's root and renames the file accordingly. It is important + that the library has a `.vpl` ending to be used by a VPI simulator + in the end. * From this point on, development of your `foreign-library` works like for a normal Haskell library. For interfacing with the @@ -75,6 +76,13 @@ All interaction with a simulator follows the same general process: vvp -L lib -l libclashffi-iverilog-vpi MODULE.vvp ``` + * The `example` folder contains a minimalistic project utilizing + `clash-ffi`. Check the `run-iverilog.sh` script in the folder for + a quick overview of how to use `clash-ffi`. The script may be + executed within the `examples` folder. If it does not work for you + out-of-the-box, feel free to adapted it according to your local + setup. + ## Supported API Functions ### VPI diff --git a/clash-ffi/example/LICENSE b/clash-ffi/example/LICENSE new file mode 100644 index 0000000000..6ee2532a74 --- /dev/null +++ b/clash-ffi/example/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2022 QBayLogic B.V. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/clash-ffi/Setup.hs b/clash-ffi/example/Setup.hs similarity index 100% rename from clash-ffi/Setup.hs rename to clash-ffi/example/Setup.hs diff --git a/clash-ffi/example/Simulate.hs b/clash-ffi/example/Simulate.hs new file mode 100644 index 0000000000..86e12cebf7 --- /dev/null +++ b/clash-ffi/example/Simulate.hs @@ -0,0 +1,258 @@ +module Simulate where + +import Prelude hiding (Word, print, putStr, putStrLn) + +import Data.Int (Int64) +import Data.Coerce (Coercible) +import Data.Typeable (Typeable) +import Data.Bits (complement) +import Data.List (intercalate, zip5) +import Control.Monad (when, void) +import Control.Monad.IO.Class (liftIO) +import Foreign.C.String (newCString) +import Foreign.Marshal.Alloc (free) + +import qualified Data.ByteString.Char8 as B + +import Clash.Prelude + ( Lift, Generic, BitPack, Signed, Bit, SNat(..) + , low, high, pack, unpack, resize + ) + +import Clash.FFI.Monad +import Clash.FFI.VPI.Info +import Clash.FFI.VPI.IO +import Clash.FFI.VPI.Callback +import Clash.FFI.VPI.Module +import Clash.FFI.VPI.Object +import Clash.FFI.VPI.Port + +type Word = Signed 4 +data OPC a = ADD | MUL | Imm a | Pop | Push + deriving (Show, Lift, Generic, BitPack) + +data State = + State + { top :: Module + , clkIn :: Port + , rstIn :: Port + , enbIn :: Port + , dataIn :: Port + , dataOut :: Port + , steps :: Int + , clock :: Bit + } + +foreign export ccall "clash_ffi_main" + ffiMain :: IO () + +ffiMain :: IO () +ffiMain = runSimAction $ do + -------------------------- + -- print simulator info -- + -------------------------- + putStrLn "[ Simulator Info ]" + Info{..} <- receiveSimulatorInfo + simPutStrLn infoProduct + simPutStrLn infoVersion + putStrLn "" + + ----------------------- + -- print top modules -- + ----------------------- + putStrLn "[ Top Modules ]" + tops <- topModules + topNames <- mapM (receiveProperty Name) tops + mapM_ simPutStrLn topNames + putStrLn "" + + -- iverilog runs into problems if iterated objects are used as a + -- long-term reference. Hence, they only should be used for + -- analyzing the architecture upfront. For long-term references to + -- be reusable during simulation, the objects should be queried via + -- their architectural name reference instead. + top <- getByName (Nothing @Object) $ head topNames + + ----------------- + -- print ports -- + ----------------- + putStrLn "[ Ports ]" + ports <- modulePorts top + -- Note that values of composed types, like `String`/`CString`, must + -- be "received", while value of core types, such as `Int`/`CInt`, + -- can by "get". The reason is that "receivable" types need to be + -- memory copied on the heap, while "gettable" types live on the + -- stack. Clash-FFI only offers to either "receive" or to "get" + -- values for supported types at the moment, so take care that the + -- right methodology is used. + names <- mapM (receiveProperty Name) ports + sizes <- mapM (getProperty Size) ports + indices <- mapM (getProperty PortIndex) ports + dirs <- mapM (getProperty Direction) ports + let realNames = [ "CLK", "RST", "ENB", "OPC", "RESULT" ] + mapM_ printPort $ zip5 (map B.unpack names) sizes indices dirs realNames + putStrLn "" + + -- get long-term references for all input and output ports + [ clkIn, rstIn, enbIn, dataIn, dataOut ] <- mapM (getByName $ Just top) names + + let ?state = State {steps = 7, clock = low, ..} + + --------------------------------- + -- start the actual simulation -- + --------------------------------- + putStrLn "[ Simulation start ]" + putStrLn "" + putStrLn " STEP ; CLK ; RST ; ENB ; OPC ; RESULT" + putStrLn "------;------;------;------;----------------------;----------------------" + + void $ registerCallback + CallbackInfo + { cbReason = EndOfSimulation + , cbRoutine = const $ do + runSimAction (putStrLn "" >> putStrLn "[ Simulation done ]") + return 0 + , cbIndex = 0 + , cbData = B.empty + } + + nextCB ReadWriteSynch 0 assignInputs + + where + printPort (n, s, i, d, r) = + let str = show i <> ": " <> n <> "[" <> show (s - 1) <> ":0]" + in putStrLn $ str <> replicate (14 - length str) ' ' <> printDir d <> " " <> r + + printDir = \case + 1 -> "<=" -- input + 2 -> "=>" -- output + 3 -> "<=>" -- inout + 4 -> "<=>" -- mixed input-output + _ -> "x" -- no direction + +assignInputs :: (?state :: State) => SimAction +assignInputs = do + SimTime time <- receiveTime Sim $ Just top + + clkUpd <- sendV clkIn clock + + (rstUpd, enbUpd) <- + if clock == low && steps == 7 + then (,) <$> sendV rstIn low <*> sendV enbIn high + else (,) <$> return Nothing <*> return Nothing + + inUpd <- + if clock == low + then case steps of + 7 -> sendV dataIn (Imm 1) + 6 -> sendV dataIn Push + 5 -> sendV dataIn (Imm 2) + 4 -> sendV dataIn Push + 3 -> sendV dataIn Pop + 2 -> sendV dataIn Pop + 1 -> sendV dataIn Pop + 0 -> sendV dataIn ADD + _ -> return Nothing + else + return Nothing + + print updates { time, clkUpd, rstUpd, enbUpd, inUpd } + + let ?state = ?state { clock = complement clock } + + if clock == low + then nextCB ReadWriteSynch 1 assignInputs + else nextCB ReadOnlySynch 1 readOutputs + + where + State{..} = ?state + + sendV port v = do + sendValue port (BitVectorVal SNat $ pack v) $ InertialDelay $ SimTime 0 + return $ Just v + +readOutputs :: (?state :: State) => SimAction +readOutputs = do + SimTime time <- receiveTime Sim $ Just top + receiveValue VectorFmt dataOut >>= \case + BitVectorVal SNat v -> + print updates + { time + , outUpd = Just $ unpack $ resize v + } + _ -> return () + + when (steps > 0) $ do + let ?state = ?state { steps = steps - 1 } + nextCB ReadWriteSynch 1 assignInputs + + where + State{..} = ?state + +data Updates = + Updates + { time :: Int64 + , clkUpd :: Maybe Bit + , rstUpd :: Maybe Bit + , enbUpd :: Maybe Bit + , inUpd :: Maybe (OPC Word) + , outUpd :: Maybe (Maybe Word) + } + +instance Show Updates where + show Updates{..} = + intercalate ";" + [ " " <> (if time < 10 then " " else "") <> show time <> " " + , maybe (replicate 6 ' ') printBit clkUpd + , maybe (replicate 6 ' ') printBit rstUpd + , maybe (replicate 6 ' ') printBit enbUpd + , maybe (replicate 22 ' ') (printValue 22 " <= ") inUpd + , maybe (replicate 22 ' ') (printValue 22 " => ") outUpd + ] + where + printBit b + | b == high = " <= 1 " + | otherwise = " <= 0 " + + printValue n dir x = + let + s1 = show x <> ": " + s2 = show (pack x) <> " " + m = n - length s1 - length s2 - 4 + in + dir <> s1 <> replicate m ' ' <> s2 + +updates :: Updates +updates = Updates 0 Nothing Nothing Nothing Nothing Nothing + +nextCB :: + (Maybe Object -> Time -> CallbackReason) -> + Int64 -> + SimAction -> + SimAction +nextCB reason time action = + void $ registerCallback + CallbackInfo + { cbReason = reason Nothing (SimTime time) + , cbRoutine = const (runSimAction action >> return 0) + , cbIndex = 0 + , cbData = B.empty + } + +getByName :: + (Coercible a Object, Show a, Typeable a, Coercible Object b) => + Maybe a -> B.ByteString -> SimCont o b +getByName m name = do + ref <- liftIO $ newCString $ B.unpack name + obj <- getChild ref m + liftIO $ free ref + return obj + +putStr :: String -> SimAction +putStr = simPutStr . B.pack + +putStrLn :: String -> SimAction +putStrLn = simPutStrLn . B.pack + +print :: Show a => a -> SimAction +print = simPutStrLn . B.pack . show diff --git a/clash-ffi/example/cabal.project b/clash-ffi/example/cabal.project new file mode 100644 index 0000000000..b18d1999a1 --- /dev/null +++ b/clash-ffi/example/cabal.project @@ -0,0 +1,6 @@ +packages: + . + .. + ../../clash-ghc + ../../clash-lib + ../../clash-prelude diff --git a/clash-ffi/example/clash-ffi-example.cabal b/clash-ffi/example/clash-ffi-example.cabal new file mode 100644 index 0000000000..2ed7943921 --- /dev/null +++ b/clash-ffi/example/clash-ffi-example.cabal @@ -0,0 +1,60 @@ +cabal-version: 2.4 +name: clash-ffi-example +version: 0.1.0.0 +synopsis: Example Clash-FFI project +description: Example Clash-FFI project +bug-reports: https://github.com/clash-lang/clash-compiler/issues +license: BSD-2-Clause +license-file: LICENSE +author: QBayLogic B.V. +maintainer: devops@qbaylogic.com +copyright: Copyright © 2023, QBayLogic B.V. +category: Hardware + +custom-setup + setup-depends: + base >= 4.11 && < 5, + Cabal >= 2.4 && < 3.7, + directory >= 1.3.6 && < 1.4, + filepath >= 1.4.2 && < 1.5, + +foreign-library clash-ffi-example + default-language: Haskell2010 + other-modules: Simulate + includes: vpi_user.h + include-dirs: ../include + type: native-shared + lib-version-info: 0:1:0 + default-extensions: + DataKinds + DeriveAnyClass + DeriveGeneric + DeriveLift + FlexibleContexts + ImplicitParams + LambdaCase + NamedFieldPuns + RecordWildCards + TupleSections + TypeApplications + ViewPatterns + NoImplicitPrelude + ghc-options: + -Wall -Wcompat + -fplugin GHC.TypeLits.Extra.Solver + -fplugin GHC.TypeLits.Normalise + -fplugin GHC.TypeLits.KnownNat.Solver + build-depends: + base ^>=4.15.1.0, + bytestring, + clash-ffi, + clash-prelude, + ghc-typelits-extra, + ghc-typelits-knownnat, + ghc-typelits-natnormalise, + cpp-options: + -DVERILOG=1 + -DIVERILOG=1 + -DVERILOG_2001=1 + -DVERILOG_2005=1 + -DVPI_VECVAL=1 diff --git a/clash-ffi/example/run-iverilog.sh b/clash-ffi/example/run-iverilog.sh new file mode 100755 index 0000000000..a3734a3b0c --- /dev/null +++ b/clash-ffi/example/run-iverilog.sh @@ -0,0 +1,36 @@ +#!/bin/sh + +# This is just a minimalistic script for demonstrating the process of +# running the clash-ffi example using the Icarus Verilog VVP runtime +# engine. The script is not designed to work in any possible system +# environment and may not work immediatly for you. It is intended to +# serve as an easy starter instead. Adapt it too you needs if it's not +# working out-of-the-box for you. + +############################### + +# adapt these variables, if the tools are not in your PATH already + +# Cabal +# https://www.haskell.org/cabal +CABAL=cabal +# Clash +# https://github.com/clash-lang/clash-compiler +CLASH="${CABAL} run clash --" +# Icarus Verilog VVP runtime engine +# http://iverilog.icarus.com +IVERILOG=iverilog +VVP=vvp +# Clash examples folder +# https://github.com/clash-lang/clash-compiler/tree/master/examples +EXAMPLES=../../examples + +############################### + +${CABAL} build clash-ffi-example +${CLASH} --verilog -i${EXAMPLES} ${EXAMPLES}/Calculator.hs +${IVERILOG} verilog/Calculator.topEntity/topEntity.v -o Calculator.vvp +echo "" +echo "Running Icarus Verilog VVP runtime engine:" +echo "" +${VVP} -Mlib -mlibclash-ffi-example Calculator.vvp