module Lava.CircuitGraphToVHDL (putXilinxVHDL, vhdlPackage)
where
import System.IO
import Control.Monad.State
import Data.Array.Unboxed
import Lava.Netlist
import Lava.PortRange
import Lava.RPM
import Lava.Utils
import Lava.Version
putXilinxVHDL :: Netlist -> IO ()
putXilinxVHDL netlist
= do putStr ("Generating " ++ filename ++ " ...")
file <- openFile filename WriteMode
ds <- dateString
hPutStrLn file (replicate 79 '-')
hPutStrLn file ("-- Automatically generated by Lava version " ++
versionStr)
hPutStrLn file ("-- Generated on " ++ ds)
hPutStrLn file ("-- Architecture: " ++ show (xilinxArchitecture netlist))
when (wh /= (0,0)) $
hPutStrLn file ("-- Layout (width, height) = " ++ show wh)
hPutStrLn file (replicate 79 '-')
hPutStrLn file ""
circuitToVHDL file netlist
hClose file
putStrLn " [done]"
where
name = circuitName netlist
filename = name++".vhd"
circuitPorts = ports netlist
circuitInstances = instances netlist
nC = netCount netlist
(major1, major2, minor, patch) = lavaVersion
versionStr = show major1 ++ "." ++ show major2 ++ "." ++ show minor ++
"." ++ show patch
wh = if layout netlist == [] then
(0, 0)
else
sizeOfLayout (head (layout netlist))
circuitToVHDL :: Handle -> Netlist -> IO ()
circuitToVHDL file netlist
= do mapM_ (circuitToVHDL file) (subCircuits netlist)
when (wh /= (0,0)) $
hPutStrLn file ("-- Layout (width, height) = " ++ show wh)
vhdlPackage file name circuitPorts (types netlist)
vhdlEntity file name circuitPorts (rlocOrigin netlist)
(xilinxArchitecture netlist)
vhdlArchitecture file name (subCircuits netlist)
circuitPorts (types netlist) circuitInstances nC
(computedShifts netlist) (xilinxArchitecture netlist)
hPutStrLn file ""
hPutStrLn file (replicate 79 '-')
hPutStrLn file ""
where
name = circuitName netlist
filename = name++".vhd"
circuitPorts = ports netlist
circuitInstances = instances netlist
nC = netCount netlist
wh = if layout netlist == [] then
(0, 0)
else
sizeOfLayout (head (layout netlist))
vhdlPackage :: Handle -> String -> [PortDeclaration] -> [(String, NetType)]
-> IO ()
vhdlPackage handle name interface typs
= do hPutStr handle (unlines entity)
where
entity =
["library ieee ;",
"use ieee.std_logic_1164.all ;",
"package " ++ name ++ "_package is"] ++
map (typeDefToVHDL) (reverse typs) ++
[
"",
" component " ++ name ++ " is ",
" port(" ++ vhdlPorts (reverse interface)] ++
[" ) ;",
" end component " ++ name ++ " ;",
"",
"end package " ++ name ++ "_package ;",
""]
typeDefToVHDL :: (String, NetType) -> String
typeDefToVHDL (name, BitType)
= " subtype " ++ name ++ " is " ++ vhdlType BitType
typeDefToVHDL (name, bvt@(BitVec a dir b))
= " type " ++ name ++ " is " ++ vhdlType bvt
typeDefToVHDL (name, atyp@(ArrayType a dir b t))
= " type " ++ name ++ " is " ++ vhdlType atyp
typeDefToVHDL other = error ("typeDefToVHDL: " ++ show other)
vhdlType :: NetType -> String
vhdlType BitType = "std_logic" ;
vhdlType (BitVec a dir b)
= "std_logic_vector (" ++ show a ++ " " ++ showDir dir ++ " " ++ show b
++ ") ;"
vhdlType (ArrayType a dir b typ)
= "array (" ++ show a ++ " " ++ showDir dir ++ " " ++ show b ++ ") of " ++
vhdlType typ
vhdlType (NamedType name) = name
vhdlEntity :: Handle -> String -> [PortDeclaration] -> Maybe (Int, Int)
-> XilinxArchitecture -> IO ()
vhdlEntity handle name interface maybeOrigin arch
= do hPutStr handle (unlines entity)
where
entity =
["library ieee ;",
"use ieee.std_logic_1164.all ;",
"use work." ++ name ++ "_package.all ;",
"entity " ++ name ++ " is ",
" port(" ++ vhdlPorts (reverse interface)] ++
[" ) ;"] ++
(if maybeOrigin == Nothing then
[]
else
[" attribute rloc_origin : string ;",
" attribute rloc_origin of " ++ name ++ " : entity is \"" ++
showRLOC arch (x, y) ++ "\" ;" ]
) ++
["end entity " ++ name ++ " ;",
""]
Just (x, y) = maybeOrigin
vhdlPorts :: [PortDeclaration] -> String
vhdlPorts intf
= insertString " ;\n " (map vhdlPort [p | p <- intf, isNotKept p])
vhdlPort :: PortDeclaration -> String
vhdlPort (Port name InputPort typ net)
= "signal " ++ name ++ " : in " ++ showType typ
vhdlPort (Port name OutputPort typ net)
= "signal " ++ name ++ " : out " ++ showType typ
isNotKept :: PortDeclaration -> Bool
isNotKept (Port _ LocalInput _ _) = False
isNotKept (Port _ LocalOutput _ _) = False
isNotKept other = True
showType :: NetType -> String
showType BitType = "std_logic"
showType (BitVec low dir high)
= "std_logic_vector (" ++ show low ++ " " ++ showDir dir ++ " " ++ show high ++
")"
showType (NamedType typeName) = typeName
showDir :: Dir -> String
showDir To = "to"
showDir Downto = "downto"
vhdlArchitecture :: Handle ->
String -> [Netlist] ->
[PortDeclaration] -> [(String, NetType)] ->
[Instance] -> Int ->
(Array Int Int, Array Int Int) -> XilinxArchitecture ->
IO ()
vhdlArchitecture file name subcirs ports typeDefs
gates netCount shifts architecture
= do hPutStr file
(unlines (["library ieee, unisim ;",
"use ieee.std_logic_1164.all ;",
"use unisim.vcomponents.all ;"] ++
["use work." ++ circuitName nl ++ "_package.all ;" | nl <- subcirs] ++
["architecture lava of " ++ name ++ " is ",
" attribute rloc : string ;",
" attribute keep : string ;",
netDefs]))
declareKeptPorts file ports
writeRLOCs file architecture shifts gates
hPutStr file "begin\n"
wirePorts file typeDefs ports
vhdlInstances file gates
hPutStr file "end architecture lava ;\n"
where
netDefs :: String
netDefs = if netCount == 1 then
" -- no local Lava nets"
else
" signal net : std_logic_vector (0 to " ++
show (netCount1) ++ ") ;"
declareKeptPorts :: Handle -> [PortDeclaration] -> IO ()
declareKeptPorts file [] = return ()
declareKeptPorts file ((Port name LocalOutput typ nets):rest)
= do hPutStrLn file (" signal " ++ name ++ " : " ++ showType typ ++ " ;")
declareKeptPorts file rest
hPutStrLn file (" attribute keep of " ++ name ++ " : signal is \"true\" ;")
declareKeptPorts file ((Port name LocalInput typ nets):rest)
= do hPutStrLn file (" signal " ++ name ++ " : " ++ showType typ ++ " ;")
hPutStrLn file (" attribute keep of " ++ name ++ " : signal is \"true\" ;")
declareKeptPorts file rest
declareKeptPorts file (_:rest)
= declareKeptPorts file rest
wirePorts :: Handle -> [(String, NetType)] -> [PortDeclaration] -> IO ()
wirePorts file typeDefs = mapM_ (wirePort file typeDefs)
wirePort :: Handle -> [(String, NetType)] -> PortDeclaration -> IO ()
wirePort file _ (Port name InputPort BitType [net])
= hPutStrLn file (" net(" ++ show net ++ ") <= " ++ name ++ ";")
wirePort file _ (Port name InputPort (BitVec a dir b) nets)
= sequence_
[hPutStrLn file (" net(" ++ show net ++ ") <= " ++ name ++ "(" ++ show i ++ ")" ++ ";") | (i, net) <- zip (portRange a dir b) nets]
wirePort file _ (Port name InputPort (ArrayType al dir1 ah (BitVec bl dir bh)) nets)
= sequence_
[ hPutStrLn file (" net(" ++ show net ++ ") <= " ++ name ++ "(" ++ show a ++ ")(" ++ show b ++ ");")
| ((a,b),net) <- zip [(a,b) | a <- portRange al dir1 ah, b <- portRange bl dir bh] nets]
wirePort file _ (Port name LocalInput (ArrayType al dir1 ah (BitVec bl dir bh)) nets)
= sequence_
[ hPutStrLn file (" net(" ++ show net ++ ") <= " ++ name ++ "(" ++ show a ++ ")(" ++ show b ++ ");")
| ((a,b),net) <- zip [(a,b) | a <- portRange al dir1 ah, b <- portRange bl dir bh] nets]
wirePort file _ (Port name LocalInput (BitVec a dir b) nets)
= sequence_
[hPutStrLn file (" net(" ++ show net ++ ") <= " ++ name ++ "(" ++ show i ++ ")" ++ ";") | (i, net) <- zip (portRange a dir b) nets]
wirePort file _ (Port name OutputPort BitType [net])
= hPutStrLn file (" " ++ name ++ " <= net(" ++show net ++ ") ;")
wirePort file _ (Port name OutputPort (BitVec a dir b) nets)
= sequence_ [hPutStrLn file (" " ++ name ++ "(" ++ show i ++ ") <= net(" ++show net ++ ") ;")
| (i, net) <- zip (portRange a dir b) nets]
wirePort file _ (Port name LocalOutput (BitVec a dir b) nets)
= sequence_ [hPutStrLn file (" " ++ name ++ "(" ++ show i ++ ") <= net(" ++show net ++ ") ;")
| (i, net) <- zip (portRange a dir b) nets]
wirePort file _ (Port name OutputPort (ArrayType al dir1 ah (BitVec bl dir bh)) nets)
= sequence_
[hPutStrLn file (" " ++ name ++ "(" ++ show a ++ ")(" ++ show b ++ ") <= " ++ " net(" ++ show net ++ ") ; ")
| ((a,b),net) <- zip [(a,b) | a <- portRange al dir1 ah, b <- portRange bl dir bh] nets]
wirePort file _ (Port name LocalOutput (ArrayType al dir1 ah (BitVec bl dir bh)) nets)
= sequence_
[hPutStrLn file (" " ++ name ++ "(" ++ show a ++ ")(" ++ show b ++ ") <= " ++ " net(" ++ show net ++ ") ; ")
| ((a,b),net) <- zip [(a,b) | a <- portRange al dir1 ah, b <- portRange bl dir bh] nets]
wirePort file typeDefs (Port name polarity (NamedType typeName) nets)
= wirePort file typeDefs (Port name polarity def nets)
where
Just def = lookup typeName typeDefs
vhdlInstances :: Handle -> [Instance] -> IO ()
vhdlInstances file gates
= mapM_ (vhdlInstance file) gates
vhdlInstance :: Handle -> Instance -> IO ()
vhdlInstance file inst
= case component inst of
Lut1 opBits i0 o comment ->
hPutStrLn file (" " ++ instName ++ " : lut1 " ++
"generic map (init => \"" ++ showOpBits opBits ++
"\") " ++
"port map (i0 => net(" ++ show i0 ++ "), o => net(" ++
show o ++ ")) " ++
if comment /= "" then "; -- " ++ comment else ";")
Lut2 opBits i0 i1 o comment ->
hPutStrLn file (" " ++ instName ++ " : lut2 " ++
"generic map (init => \"" ++ showOpBits opBits ++
"\") " ++
"port map (i0 => net(" ++ show i0 ++ "), " ++
"i1 => net(" ++ show i1 ++ "), " ++
"o => net(" ++ show o ++ ")) " ++
if comment /= "" then "; -- " ++ comment else ";")
Lut2_l opBits i0 i1 o comment ->
hPutStrLn file (" " ++ instName ++ " : lut2_l " ++
"generic map (init => \"" ++ showOpBits opBits ++
"\") " ++
"port map (i0 => net(" ++ show i0 ++ "), " ++
"i1 => net(" ++ show i1 ++ "), " ++
"lo => net(" ++ show o ++ ")) " ++
if comment /= "" then "; -- " ++ comment else ";")
Lut3 opBits i0 i1 i2 o comment ->
hPutStrLn file (" " ++ instName ++ " : lut3 " ++
"generic map (init => \"" ++ showOpBits opBits ++
"\") " ++
"port map (i0 => net(" ++ show i0 ++ "), " ++
"i1 => net(" ++ show i1 ++ "), " ++
"i2 => net(" ++ show i2 ++ "), " ++
"o => net(" ++ show o ++ ")) " ++
if comment /= "" then "; -- " ++ comment else ";")
Lut4 opBits i0 i1 i2 i3 o comment ->
hPutStrLn file (" " ++ instName ++ " : lut4 " ++
"generic map (init => \"" ++ showOpBits opBits ++
"\") " ++
"port map (i0 => net(" ++ show i0 ++ "), " ++
"i1 => net(" ++ show i1 ++ "), " ++
"i2 => net(" ++ show i2 ++ "), " ++
"i3 => net(" ++ show i3 ++ "), " ++
"o => net(" ++ show o ++ ")) " ++
if comment /= "" then "; -- " ++ comment else ";")
Lut5 opBits i0 i1 i2 i3 i4 o comment ->
hPutStrLn file (" " ++ instName ++ " : lut5 " ++
"generic map (init => \"" ++ showOpBits opBits ++
"\") " ++
"port map (i0 => net(" ++ show i0 ++ "), " ++
"i1 => net(" ++ show i1 ++ "), " ++
"i2 => net(" ++ show i2 ++ "), " ++
"i3 => net(" ++ show i3 ++ "), " ++
"i4 => net(" ++ show i4 ++ "), " ++
"o => net(" ++ show o ++ ")) " ++
if comment /= "" then "; -- " ++ comment else ";")
Lut6 opBits i0 i1 i2 i3 i4 i5 o comment ->
hPutStrLn file (" " ++ instName ++ " : lut6 " ++
"generic map (init => \"" ++ showOpBits opBits ++
"\") " ++
"port map (i0 => net(" ++ show i0 ++ "), " ++
"i1 => net(" ++ show i1 ++ "), " ++
"i2 => net(" ++ show i2 ++ "), " ++
"i3 => net(" ++ show i3 ++ "), " ++
"i4 => net(" ++ show i4 ++ "), " ++
"i5 => net(" ++ show i5 ++ "), " ++
"o => net(" ++ show o ++ ")) " ++
if comment /= "" then "; -- " ++ comment else ";")
PrimitiveGate inputPorts outputs ->
hPutStrLn file (" " ++ instName ++ " : " ++ componentName inst ++
" port map (" ++
insertCommas [p ++ " => net(" ++ show a ++ ")" | (p,a) <- inputPorts ++ outputs] ++
") ; ")
where
instName = componentName inst ++ "_" ++ show (instanceNumber inst)
showOpBits = map intToChar
intToChar 0 = '0'
intToChar 1 = '1'
writeRLOCs :: Handle -> XilinxArchitecture -> (Array Int Int, Array Int Int)
-> [Instance] -> IO ()
writeRLOCs file arch dxy = mapM_ (writeRLOC file arch dxy)
writeRLOC :: Handle -> XilinxArchitecture -> (Array Int Int, Array Int Int)
-> Instance -> IO ()
writeRLOC file arch (dx, dy) inst
= if pos == Unplaced then
return ()
else
hPutStrLn file (" attribute rloc of " ++ instName ++ " : label is \""
++ showRLOC arch (dx!i,dy!i) ++ "\" ;")
where
pos = position inst
i = instanceNumber inst
instName = componentName inst ++ "_" ++ show i