module Lava.CircuitGraphToVHDL (putXilinxVHDL)
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 (name ++ ".vhd") 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
vhdlEntity file name circuitPorts
vhdlArchitecture file name (subCircuits netlist)
circuitPorts 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] -> IO ()
vhdlPackage handle name interface
= do hPutStr handle (unlines entity)
where
entity =
["library ieee ;",
"use ieee.std_logic_1164.all ;",
"package " ++ name ++ "_package is",
"",
" component " ++ name ++ " is ",
" port(" ++ vhdlPorts (reverse interface)] ++
[" ) ;",
" end component " ++ name ++ " ;",
"",
"end package " ++ name ++ "_package ;",
""]
vhdlEntity :: Handle -> String -> [PortDeclaration] -> IO ()
vhdlEntity handle name interface
= do hPutStr handle (unlines entity)
where
entity =
["library ieee ;",
"use ieee.std_logic_1164.all ;",
"entity " ++ name ++ " is ",
" port(" ++ vhdlPorts (reverse interface)] ++
[" ) ;",
"end entity " ++ name ++ " ;",
""]
vhdlPorts :: [PortDeclaration] -> String
vhdlPorts intf
= insertString " ;\n " (map vhdlPort [p | p <- intf, isNotKept p])
vhdlPort :: PortDeclaration -> String
vhdlPort (Port name InputPort typ net)
= name ++ " : in " ++ showType typ
vhdlPort (Port name OutputPort typ net)
= 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 ++
")"
showDir :: Dir -> String
showDir To = "to"
showDir Downto = "downto"
vhdlArchitecture :: Handle ->
String -> [Netlist] ->
[PortDeclaration] -> [Instance] -> Int ->
(Array Int Int, Array Int Int) -> XilinxArchitecture ->
IO ()
vhdlArchitecture file name subcirs ports 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"
hPutStrLn file " net(0) <= '0' ;"
hPutStrLn file " net(1) <= '1' ;"
wirePorts file 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@(BitVec a dir b) 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@(BitVec a dir b) 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 -> [PortDeclaration] -> IO ()
wirePorts file = mapM_ (wirePort file)
wirePort :: Handle -> 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 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]
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