mirror of https://github.com/zachjs/sv2v.git
hacky, preliminary support for port declarations in module header
This commit is contained in:
Zachary Snow
parent
0f2638075b
commit
ebd7ae67b1
|
|
@ -2,6 +2,8 @@ module Language.SystemVerilog.AST
|
|||
( Identifier
|
||||
, Module (..)
|
||||
, ModuleItem (..)
|
||||
, Direction (..)
|
||||
, Type (..)
|
||||
, Stmt (..)
|
||||
, LHS (..)
|
||||
, Expr (..)
|
||||
|
|
@ -17,14 +19,25 @@ module Language.SystemVerilog.AST
|
|||
import Data.Bits
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Semigroup
|
||||
import Text.Printf
|
||||
|
||||
import Data.BitVec
|
||||
|
||||
type Identifier = String
|
||||
|
||||
data Module = Module Identifier [Identifier] [ModuleItem] deriving Eq
|
||||
-- Note: Verilog allows modules to be declared with either a simple list of
|
||||
-- ports _identifiers_, or a list of port _declarations_. If only the
|
||||
-- identifiers are used, they must be declared with a type and direction
|
||||
-- (potentially separately!) within the module itself.
|
||||
|
||||
-- Note: This AST will allow for the representation of syntactically invalid
|
||||
-- things, like input regs. We might want to have a function for doing some
|
||||
-- basing invariant checks. I want to avoid making a full type-checker though,
|
||||
-- as we should only be given valid SystemVerilog input files.
|
||||
|
||||
data Module
|
||||
= Module Identifier [Identifier] [ModuleItem]
|
||||
deriving Eq
|
||||
|
||||
instance Show Module where
|
||||
show (Module name ports items) = unlines
|
||||
|
|
@ -33,15 +46,38 @@ instance Show Module where
|
|||
, "endmodule"
|
||||
]
|
||||
|
||||
data Direction
|
||||
= Input
|
||||
| Output
|
||||
| Inout
|
||||
deriving Eq
|
||||
|
||||
instance Show Direction where
|
||||
show Input = "input"
|
||||
show Output = "output"
|
||||
show Inout = "inout"
|
||||
|
||||
-- TODO: Support for arrays (multi-dimensional, too!)
|
||||
data Type
|
||||
= Reg (Maybe Range)
|
||||
| Wire (Maybe Range)
|
||||
deriving Eq
|
||||
|
||||
instance Show Type where
|
||||
show (Reg r) = "reg " ++ (showRange r)
|
||||
show (Wire r) = "wire " ++ (showRange r)
|
||||
|
||||
data ModuleItem
|
||||
= Comment String
|
||||
| Parameter (Maybe Range) Identifier Expr
|
||||
| Localparam (Maybe Range) Identifier Expr
|
||||
| Input (Maybe Range) [Identifier]
|
||||
| Output (Maybe Range) [Identifier]
|
||||
| Inout (Maybe Range) [Identifier]
|
||||
| Wire (Maybe Range) [(Identifier, Maybe Expr)]
|
||||
| Reg (Maybe Range) [(Identifier, Maybe Range)]
|
||||
| PortDecl Direction (Maybe Range) Identifier
|
||||
| LocalNet Type Identifier (Maybe Expr)
|
||||
-- | Input (Maybe Range) [Identifier]
|
||||
-- | Output (Maybe Range) [Identifier]
|
||||
-- | Inout (Maybe Range) [Identifier]
|
||||
-- | Wire (Maybe Range) [(Identifier, Maybe $ Either Range Expr)]
|
||||
-- | Reg (Maybe Range) [(Identifier, Maybe $ Either Range Expr)]
|
||||
| Integer [Identifier]
|
||||
| Initial Stmt
|
||||
| Always (Maybe Sense) Stmt
|
||||
|
|
@ -52,15 +88,22 @@ data ModuleItem
|
|||
type PortBinding = (Identifier, Maybe Expr)
|
||||
|
||||
instance Show ModuleItem where
|
||||
show a = case a of
|
||||
Comment a -> "// " ++ a
|
||||
show thing = case thing of
|
||||
Comment c -> "// " ++ c
|
||||
Parameter r n e -> printf "parameter %s%s = %s;" (showRange r) n (showExprConst e)
|
||||
Localparam r n e -> printf "localparam %s%s = %s;" (showRange r) n (showExprConst e)
|
||||
Input r a -> printf "input %s%s;" (showRange r) (commas a)
|
||||
Output r a -> printf "output %s%s;" (showRange r) (commas a)
|
||||
Inout r a -> printf "inout %s%s;" (showRange r) (commas a)
|
||||
Wire r a -> printf "wire %s%s;" (showRange r) (commas [ a ++ showAssign r | (a, r) <- a ])
|
||||
Reg r a -> printf "reg %s%s;" (showRange r) (commas [ a ++ showRange r | (a, r) <- a ])
|
||||
PortDecl d r x -> printf "%s %s%s;" (show d) (showRange r) x
|
||||
LocalNet t x v -> (show t) ++ " " ++ x ++ assignment ++ ";"
|
||||
where
|
||||
assignment =
|
||||
if v == Nothing
|
||||
then ""
|
||||
else " = " ++ show (fromJust v)
|
||||
-- Input r a -> printf "input %s%s;" (showRange r) (commas a)
|
||||
-- Output r a -> printf "output %s%s;" (showRange r) (commas a)
|
||||
-- Inout r a -> printf "inout %s%s;" (showRange r) (commas a)
|
||||
-- Wire r a -> printf "wire %s%s;" (showRange r) (commas [ a ++ showAssign r | (a, r) <- a ])
|
||||
-- Reg r a -> printf "reg %s%s;" (showRange r) (commas [ a ++ showRange r | (a, r) <- a ])
|
||||
Integer a -> printf "integer %s;" $ commas a
|
||||
Initial a -> printf "initial\n%s" $ indent $ show a
|
||||
Always Nothing b -> printf "always\n%s" $ indent $ show b
|
||||
|
|
@ -72,10 +115,6 @@ instance Show ModuleItem where
|
|||
where
|
||||
showPorts :: (Expr -> String) -> [(Identifier, Maybe Expr)] -> String
|
||||
showPorts s ports = printf "(%s)" $ commas [ printf ".%s(%s)" i (if isJust arg then s $ fromJust arg else "") | (i, arg) <- ports ]
|
||||
showAssign :: Maybe Expr -> String
|
||||
showAssign a = case a of
|
||||
Nothing -> ""
|
||||
Just a -> printf " = %s" $ show a
|
||||
|
||||
showRange :: Maybe Range -> String
|
||||
showRange Nothing = ""
|
||||
|
|
@ -85,9 +124,9 @@ indent :: String -> String
|
|||
indent a = '\t' : f a
|
||||
where
|
||||
f [] = []
|
||||
f (a : rest)
|
||||
| a == '\n' = "\n\t" ++ f rest
|
||||
| otherwise = a : f rest
|
||||
f (x : xs)
|
||||
| x == '\n' = "\n\t" ++ f xs
|
||||
| otherwise = x : f xs
|
||||
|
||||
unlines' :: [String] -> String
|
||||
unlines' = intercalate "\n"
|
||||
|
|
@ -171,7 +210,7 @@ showExprConst :: Expr -> String
|
|||
showExprConst = showExpr showBitVecConst
|
||||
|
||||
showExpr :: (BitVec -> String) -> Expr -> String
|
||||
showExpr bv a = case a of
|
||||
showExpr bv x = case x of
|
||||
String a -> printf "\"%s\"" a
|
||||
Number a -> bv a
|
||||
ConstBool a -> printf "1'b%s" (if a then "1" else "0")
|
||||
|
|
@ -227,11 +266,10 @@ data LHS
|
|||
deriving Eq
|
||||
|
||||
instance Show LHS where
|
||||
show a = case a of
|
||||
LHS a -> a
|
||||
LHSBit a b -> printf "%s[%s]" a (showExprConst b)
|
||||
LHSRange a (b, c) -> printf "%s[%s:%s]" a (showExprConst b) (showExprConst c)
|
||||
LHSConcat a -> printf "{%s}" (commas $ map show a)
|
||||
show (LHS a ) = a
|
||||
show (LHSBit a b ) = printf "%s[%s]" a (showExprConst b)
|
||||
show (LHSRange a (b, c)) = printf "%s[%s:%s]" a (showExprConst b) (showExprConst c)
|
||||
show (LHSConcat a ) = printf "{%s}" (commas $ map show a)
|
||||
|
||||
data Stmt
|
||||
= Block (Maybe Identifier) [Stmt]
|
||||
|
|
@ -251,21 +289,20 @@ commas :: [String] -> String
|
|||
commas = intercalate ", "
|
||||
|
||||
instance Show Stmt where
|
||||
show a = case a of
|
||||
Block Nothing b -> printf "begin\n%s\nend" $ indent $ unlines' $ map show b
|
||||
Block (Just a) b -> printf "begin : %s\n%s\nend" a $ indent $ unlines' $ map show b
|
||||
StmtReg a b -> printf "reg %s%s;" (showRange a) (commas [ a ++ showRange r | (a, r) <- b ])
|
||||
StmtInteger a -> printf "integer %s;" $ commas a
|
||||
Case a b Nothing -> printf "case (%s)\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b)
|
||||
Case a b (Just c) -> printf "case (%s)\n%s\n\tdefault:\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) (indent $ indent $ show c)
|
||||
BlockingAssignment a b -> printf "%s = %s;" (show a) (show b)
|
||||
NonBlockingAssignment a b -> printf "%s <= %s;" (show a) (show b)
|
||||
For (a, b) c (d, e) f -> printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) $ indent $ show f
|
||||
If a b Null -> printf "if (%s)\n%s" (show a) (indent $ show b)
|
||||
If a b c -> printf "if (%s)\n%s\nelse\n%s" (show a) (indent $ show b) (indent $ show c)
|
||||
StmtCall a -> printf "%s;" (show a)
|
||||
Delay a b -> printf "#%s %s" (showExprConst a) (show b)
|
||||
Null -> ";"
|
||||
show (Block Nothing b ) = printf "begin\n%s\nend" $ indent $ unlines' $ map show b
|
||||
show (Block (Just a) b ) = printf "begin : %s\n%s\nend" a $ indent $ unlines' $ map show b
|
||||
show (StmtReg a b ) = printf "reg %s%s;" (showRange a) (commas [ x ++ showRange r | (x, r) <- b ])
|
||||
show (StmtInteger a ) = printf "integer %s;" $ commas a
|
||||
show (Case a b Nothing ) = printf "case (%s)\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b)
|
||||
show (Case a b (Just c) ) = printf "case (%s)\n%s\n\tdefault:\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) (indent $ indent $ show c)
|
||||
show (BlockingAssignment a b ) = printf "%s = %s;" (show a) (show b)
|
||||
show (NonBlockingAssignment a b ) = printf "%s <= %s;" (show a) (show b)
|
||||
show (For (a, b) c (d, e) f) = printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) $ indent $ show f
|
||||
show (If a b Null ) = printf "if (%s)\n%s" (show a) (indent $ show b)
|
||||
show (If a b c ) = printf "if (%s)\n%s\nelse\n%s" (show a) (indent $ show b) (indent $ show c)
|
||||
show (StmtCall a ) = printf "%s;" (show a)
|
||||
show (Delay a b ) = printf "#%s %s" (showExprConst a) (show b)
|
||||
show (Null ) = ";"
|
||||
|
||||
type Case = ([Expr], Stmt)
|
||||
|
||||
|
|
@ -285,11 +322,10 @@ data Sense
|
|||
deriving Eq
|
||||
|
||||
instance Show Sense where
|
||||
show a = case a of
|
||||
Sense a -> show a
|
||||
SenseOr a b -> printf "%s or %s" (show a) (show b)
|
||||
SensePosedge a -> printf "posedge %s" (show a)
|
||||
SenseNegedge a -> printf "negedge %s" (show a)
|
||||
show (Sense a ) = show a
|
||||
show (SenseOr a b) = printf "%s or %s" (show a) (show b)
|
||||
show (SensePosedge a ) = printf "posedge %s" (show a)
|
||||
show (SenseNegedge a ) = printf "negedge %s" (show a)
|
||||
|
||||
type Range = (Expr, Expr)
|
||||
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ import Language.SystemVerilog.Parser.Tokens
|
|||
%tokentype { Token }
|
||||
%error { parseError }
|
||||
|
||||
%expect 0
|
||||
-- %expect 0
|
||||
|
||||
%token
|
||||
|
||||
|
|
@ -157,6 +157,7 @@ Modules :: { [Module] }
|
|||
|
||||
Module :: { Module }
|
||||
: "module" Identifier ModulePortList ";" ModuleItems "endmodule"{ Module $2 $3 $5 }
|
||||
| "module" Identifier ListOfPortDeclarations ";" ModuleItems "endmodule" { uncurry (Module $2) $ combinePortDeclsAndModuleItems $3 $5 }
|
||||
|
||||
Identifier :: { Identifier }
|
||||
: simpleIdentifier { tokenString $1 }
|
||||
|
|
@ -174,22 +175,58 @@ ModulePortList1 :: { [Identifier] }
|
|||
|
||||
ModuleItems :: { [ModuleItem] }
|
||||
: { [] }
|
||||
| ModuleItems ModuleItem { $1 ++ [$2] }
|
||||
| ModuleItems ModuleItem { $1 ++ $2 }
|
||||
|
||||
ModuleItem :: { ModuleItem }
|
||||
: "parameter" MaybeRange Identifier "=" Expr ";" { Parameter $2 $3 $5 }
|
||||
| "localparam" MaybeRange Identifier "=" Expr ";" { Localparam $2 $3 $5 }
|
||||
| "input" MaybeRange Identifiers ";" { Input $2 $3 }
|
||||
| "output" MaybeRange Identifiers ";" { Output $2 $3 }
|
||||
| "inout" MaybeRange Identifiers ";" { Inout $2 $3 }
|
||||
| "reg" MaybeRange RegDeclarations ";" { Reg $2 $3 }
|
||||
| "wire" MaybeRange WireDeclarations ";" { Wire $2 $3 }
|
||||
| "integer" Identifiers ";" { Integer $2 }
|
||||
| "assign" LHS "=" Expr ";" { Assign $2 $4 }
|
||||
| "initial" Stmt { Initial $2 }
|
||||
| "always" Stmt { Always Nothing $2 }
|
||||
| "always" "@" "(" Sense ")" Stmt { Always (Just $4) $6 }
|
||||
| Identifier ParameterBindings Identifier Bindings ";" { Instance $1 $2 $3 $4 }
|
||||
ListOfPortDeclarations
|
||||
: "(" PortDeclarations ")" { $2 }
|
||||
|
||||
PortDeclarations
|
||||
: PortDeclaration { [$1] }
|
||||
| PortDeclaration2 PortDeclarations { $1 : $2 }
|
||||
|
||||
PortDeclaration2 :: { (Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)]) }
|
||||
: "inout" opt(NetType) opt(Range) Identifiers "," { toPortDeclaration Inout $2 $3 $4 }
|
||||
| "input" opt(NetType) opt(Range) Identifiers "," { toPortDeclaration Input $2 $3 $4 }
|
||||
| "output" opt(NetType) opt(Range) Identifiers "," { toPortDeclaration Output $2 $3 $4 }
|
||||
| "output" "reg" opt(Range) VarPortIdentifiers "," { (Output, Left (Reg $3), $4) }
|
||||
|
||||
PortDeclaration :: { (Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)]) }
|
||||
: "inout" opt(NetType) opt(Range) Identifiers { toPortDeclaration Inout $2 $3 $4 }
|
||||
| "input" opt(NetType) opt(Range) Identifiers { toPortDeclaration Input $2 $3 $4 }
|
||||
| "output" opt(NetType) opt(Range) Identifiers { toPortDeclaration Output $2 $3 $4 }
|
||||
| "output" "reg" opt(Range) VarPortIdentifiers { (Output, Left (Reg $3), $4) }
|
||||
|
||||
VarPortIdentifiers :: { [(Identifier, Maybe Expr)] }
|
||||
: VarPortIdentifier { [$1] }
|
||||
| VarPortIdentifiers "," VarPortIdentifier { $1 ++ [$3] }
|
||||
|
||||
VarPortIdentifier :: { (Identifier, Maybe Expr) }
|
||||
: Identifier { ($1, Nothing) }
|
||||
| Identifier "=" Expr { ($1, Just $3) }
|
||||
|
||||
opt(p) : p { Just $1 }
|
||||
| { Nothing }
|
||||
|
||||
NetType
|
||||
: "wire" { Wire }
|
||||
|
||||
MaybeTypeOrRange :: { Either Type (Maybe Range) }
|
||||
: MaybeRange { Right $1 }
|
||||
| "reg" MaybeRange { Left $ Reg $2 }
|
||||
| "wire" MaybeRange { Left $ Wire $2 }
|
||||
|
||||
ModuleItem :: { [ModuleItem] }
|
||||
: "parameter" MaybeRange Identifier "=" Expr ";" { [Parameter $2 $3 $5] }
|
||||
| "localparam" MaybeRange Identifier "=" Expr ";" { [Localparam $2 $3 $5] }
|
||||
| PortDeclaration ";" { portDeclToModuleItems $1 }
|
||||
| "reg" MaybeRange WireDeclarations ";" { map (uncurry $ LocalNet $ Reg $2) $3 }
|
||||
| "wire" MaybeRange WireDeclarations ";" { map (uncurry $ LocalNet $ Wire $2) $3 }
|
||||
| "integer" Identifiers ";" { [Integer $2] }
|
||||
| "assign" LHS "=" Expr ";" { [Assign $2 $4] }
|
||||
| "initial" Stmt { [Initial $2] }
|
||||
| "always" Stmt { [Always Nothing $2] }
|
||||
| "always" "@" "(" Sense ")" Stmt { [Always (Just $4) $6] }
|
||||
| Identifier ParameterBindings Identifier Bindings ";" { [Instance $1 $2 $3 $4] }
|
||||
|
||||
Identifiers :: { [Identifier] }
|
||||
: Identifier { [$1] }
|
||||
|
|
@ -362,5 +399,49 @@ toNumber = number . tokenString
|
|||
| isPrefixOf "'b" a = foldl (\ n b -> shiftL n 1 .|. (if b == '1' then 1 else 0)) 0 (drop 2 a)
|
||||
| otherwise = error $ "Invalid number format: " ++ a
|
||||
|
||||
|
||||
toPortDeclaration
|
||||
:: Direction
|
||||
-> (Maybe ((Maybe Range) -> Type))
|
||||
-> Maybe Range
|
||||
-> [Identifier]
|
||||
-> (Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)])
|
||||
toPortDeclaration dir tfm mr ids =
|
||||
(dir, t, vals)
|
||||
where
|
||||
t =
|
||||
case tfm of
|
||||
Nothing -> Right mr
|
||||
Just tf -> Left (tf mr)
|
||||
vals = zip ids (repeat Nothing)
|
||||
|
||||
|
||||
portDeclToModuleItems :: (Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)]) -> [ModuleItem]
|
||||
portDeclToModuleItems (dir, Right r, l) =
|
||||
map (PortDecl dir r) $ map toIdentifier $ l
|
||||
where
|
||||
toIdentifier (x, Just _) = error "Incomplete port decl cannot have initialization"
|
||||
toIdentifier (x, Nothing) = x
|
||||
portDeclToModuleItems (dir, Left t, l) =
|
||||
foldr (++) [] $
|
||||
map toItems l
|
||||
where
|
||||
r = case t of
|
||||
Reg mr -> mr
|
||||
Wire mr -> mr
|
||||
toItems (x, e) =
|
||||
[ PortDecl dir r x
|
||||
, LocalNet t x e ]
|
||||
|
||||
combinePortDeclsAndModuleItems
|
||||
:: [(Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)])]
|
||||
-> [ModuleItem]
|
||||
-> ([Identifier], [ModuleItem])
|
||||
combinePortDeclsAndModuleItems portDecls items =
|
||||
(declIdents, declItems ++ items)
|
||||
where
|
||||
declIdents = concat $ map (\(_, _, idsAndExprs) -> map fst idsAndExprs) portDecls
|
||||
declItems = concat $ map portDeclToModuleItems portDecls
|
||||
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,171 +0,0 @@
|
|||
module Language.SystemVerilog.Simulator
|
||||
( Simulator
|
||||
, SimCommand (..)
|
||||
, SimResponse (..)
|
||||
, simulator
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Data.Array.IO
|
||||
import Data.Bits
|
||||
import Data.IORef
|
||||
import Data.Monoid
|
||||
import System.IO
|
||||
|
||||
import Data.VCD hiding (Var, step)
|
||||
import qualified Data.VCD as VCD
|
||||
|
||||
import Data.BitVec
|
||||
import Language.SystemVerilog.Netlist
|
||||
|
||||
--check msg = putStrLn msg >> hFlush stdout
|
||||
|
||||
-- | A Simulator executes 'SimCommand's.
|
||||
type Simulator = SimCommand -> IO (Maybe SimResponse)
|
||||
|
||||
-- | Simulation commands.
|
||||
data SimCommand
|
||||
= Init (Maybe FilePath)
|
||||
| Step
|
||||
| GetSignalId Path
|
||||
| GetSignal NetId
|
||||
| Close
|
||||
|
||||
-- | Simulation responses.
|
||||
data SimResponse
|
||||
= Id NetId -- ^ Response to GetSignalId.
|
||||
| Value BitVec -- ^ Response to GetSignal.
|
||||
|
||||
-- | Builds a 'Simulator' given a 'Netlist'.
|
||||
simulator :: Netlist BlackBoxInit -> IO Simulator
|
||||
simulator netlist' = do
|
||||
let netlist = sortTopo netlist'
|
||||
memory <- memory netlist
|
||||
vcd <- newIORef Nothing
|
||||
sample <- newIORef $ return ()
|
||||
step <- newIORef $ return ()
|
||||
return $ \ cmd -> case cmd of
|
||||
Init file -> initialize netlist memory vcd file sample step
|
||||
Step -> readIORef step >>= id >> return Nothing
|
||||
GetSignalId path -> return $ getSignalId netlist path
|
||||
GetSignal id -> readArray memory id >>= return . Just . Value
|
||||
Close -> close vcd sample step >> return Nothing
|
||||
|
||||
getSignalId :: Netlist BlackBoxInit -> Path -> Maybe SimResponse
|
||||
getSignalId netlist path = case lookup path paths' of
|
||||
Nothing -> Nothing
|
||||
Just i -> Just $ Id i
|
||||
where
|
||||
paths = [ (paths, id) | Reg id _ paths _ <- netlist ] ++ [ (paths, id) | Var id _ paths _ <- netlist ]
|
||||
paths' = [ (path, id) | (paths, id) <- paths, path <- paths ]
|
||||
|
||||
type Memory = IOArray Int BitVec
|
||||
|
||||
memory :: Netlist BlackBoxInit -> IO Memory
|
||||
memory netlist
|
||||
| null netlist = error "Empty netlist, nothing to simulate."
|
||||
| otherwise = newArray (0, maximum ids) 0
|
||||
where
|
||||
ids = concatMap f netlist
|
||||
f a = case a of
|
||||
Var a _ _ _ -> [a]
|
||||
Reg a _ _ _ -> [a]
|
||||
BBox _ _ _ -> []
|
||||
|
||||
initialize :: Netlist BlackBoxInit -> Memory -> IORef (Maybe VCDHandle) -> Maybe FilePath -> IORef (IO ()) -> IORef (IO ()) -> IO (Maybe SimResponse)
|
||||
initialize netlist memory vcd file sample step = do
|
||||
close vcd sample step
|
||||
mapM_ (initializeNet memory) netlist
|
||||
case file of
|
||||
Nothing -> return ()
|
||||
Just file -> do
|
||||
h <- openFile file WriteMode
|
||||
vcd' <- newVCD h S
|
||||
writeIORef vcd $ Just vcd'
|
||||
writeIORef sample $ VCD.step vcd' 1
|
||||
mapM_ (f memory vcd' sample) netlist
|
||||
netlist <- mapM initializeBBox netlist
|
||||
initializeStep netlist memory sample step
|
||||
return Nothing
|
||||
where
|
||||
f :: Memory -> VCDHandle -> IORef (IO ()) -> Net BlackBoxInit -> IO ()
|
||||
f memory vcd sample a = case a of
|
||||
BBox _ _ _ -> return ()
|
||||
_ -> mapM_ (\ signal -> do
|
||||
sample' <- var vcd signal $ bitVec width 0
|
||||
modifyIORef sample (>> (readArray memory i >>= sample'))
|
||||
) signals
|
||||
where
|
||||
(i, width, signals) = case a of
|
||||
Reg i w p _ -> (i, w, p)
|
||||
Var i w p _ -> (i, w, p)
|
||||
BBox _ _ _ -> undefined
|
||||
|
||||
initializeNet :: Memory -> Net BlackBoxInit -> IO ()
|
||||
initializeNet memory a = case a of
|
||||
Var i w _ _ -> writeArray memory i $ bitVec w 0
|
||||
Reg i w _ _ -> writeArray memory i $ bitVec w 0
|
||||
BBox _ _ _ -> return ()
|
||||
|
||||
initializeBBox :: Net BlackBoxInit -> IO (Net BlackBoxStep)
|
||||
initializeBBox a = case a of
|
||||
Var a b c d -> return $ Var a b c d
|
||||
Reg a b c d -> return $ Reg a b c d
|
||||
BBox i o init -> init >>= return . BBox i o
|
||||
|
||||
initializeStep :: Netlist BlackBoxStep -> Memory -> IORef (IO ()) -> IORef (IO ()) -> IO ()
|
||||
initializeStep netlist memory sample step = do
|
||||
let steps = map stepNet netlist
|
||||
writeIORef step $ do
|
||||
sequence_ steps
|
||||
readIORef sample >>= id
|
||||
where
|
||||
read = readArray memory
|
||||
write' = writeMemory memory
|
||||
stepNet :: Net BlackBoxStep -> IO ()
|
||||
stepNet a = case a of
|
||||
BBox inputs outputs f -> do
|
||||
outs <- mapM read inputs >>= f
|
||||
sequence_ [ write' a b | (a, b) <- zip outputs outs ]
|
||||
Reg q _ _ d -> read d >>= write' q
|
||||
Var i _ _ expr -> case expr of
|
||||
AInput -> return ()
|
||||
AVar a -> read a >>= write
|
||||
AConst a -> write a
|
||||
ASelect a b c -> do { a <- read a; b <- read b; c <- read c; write $ select a (b, c) }
|
||||
ABWNot a -> read a >>= write . complement
|
||||
ABWAnd a b -> do { a <- read a; b <- read b; write $ a .&. b }
|
||||
ABWXor a b -> do { a <- read a; b <- read b; write $ a `xor` b }
|
||||
ABWOr a b -> do { a <- read a; b <- read b; write $ a .|. b }
|
||||
AMul a b -> do { a <- read a; b <- read b; write $ a * b }
|
||||
AAdd a b -> do { a <- read a; b <- read b; write $ a + b }
|
||||
ASub a b -> do { a <- read a; b <- read b; write $ a - b }
|
||||
AShiftL a b -> do { a <- read a; b <- read b; write $ shiftL a $ fromIntegral $ value b }
|
||||
AShiftR a b -> do { a <- read a; b <- read b; write $ shiftR a $ fromIntegral $ value b }
|
||||
AEq a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a == value b then 1 else 0) }
|
||||
ANe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a /= value b then 1 else 0) }
|
||||
ALt a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a < value b then 1 else 0) }
|
||||
ALe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a <= value b then 1 else 0) }
|
||||
AGt a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a > value b then 1 else 0) }
|
||||
AGe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a >= value b then 1 else 0) }
|
||||
AMux a b c -> do { a <- read a; b <- read b; c <- read c; write (if value a /= 0 then b else c) }
|
||||
AConcat a b -> do { a <- read a; b <- read b; write $ mappend a b }
|
||||
where
|
||||
write = write' i
|
||||
|
||||
writeMemory :: Memory -> Int -> BitVec -> IO ()
|
||||
writeMemory memory i a = do
|
||||
b <- readArray memory i
|
||||
when (width b /= width a) $ error $ "Memory update with different bit-vector width: index: " ++ show i ++ " old: " ++ show b ++ " new: " ++ show a
|
||||
writeArray memory i a
|
||||
|
||||
close :: IORef (Maybe VCDHandle) -> IORef (IO ()) -> IORef (IO ()) -> IO ()
|
||||
close vcd sample step = do
|
||||
vcd' <- readIORef vcd
|
||||
case vcd' of
|
||||
Nothing -> return ()
|
||||
Just vcd -> hClose $ handle vcd
|
||||
writeIORef vcd $ Nothing
|
||||
writeIORef sample $ return ()
|
||||
writeIORef step $ return ()
|
||||
|
||||
Loading…
Reference in New Issue