Skip to content

S
sv2v
Commit ebd7ae67 by Zachary Snow
Options

hacky, preliminary support for port declarations in module header

parent 0f263807
Showing with 183 additions and 236 deletions
Language/SystemVerilog/AST.hs
......@@ -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)
Language/SystemVerilog/Parser/Parse.y
......@@ -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] }
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 }
| ModuleItems ModuleItem { $1 ++ $2 }
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
}
Language/SystemVerilog/Simulator.hs deleted 100644 → 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 ()
sv2v.hs
......@@ -19,6 +19,7 @@ main = do
case res of
Left err -> do
hPrint stderr err
exitFailure
exitSuccess
--exitFailure
Right _ -> do
exitSuccess
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment