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 :: String -> Netlist -> IO ()
putXilinxVHDL circuitName state
= do putStr ("Generating " ++ filename ++ " ...")
file <- openFile (circuitName++".vhd") WriteMode
ds <- dateString
hPutStrLn file (replicate 79 '-')
hPutStrLn file ("-- Automatically generated by Lava version " ++
versionStr)
hPutStrLn file ("-- Generated on " ++ ds)
hPutStrLn file (replicate 79 '-')
hPutStrLn file ""
vhdlEntity file circuitName circuitPorts
vhdlArchitecture file circuitName circuitPorts circuitInstances nC
(computedShifts state) (xilinxArchitecture state)
hClose file
putStrLn " [done]"
where
filename = circuitName++".vhd"
circuitPorts = ports state
circuitInstances = instances state
nC = netCount state
(major1, major2, minor, patch) = lavaVersion
versionStr = show major1 ++ "." ++ show major2 ++ "." ++ show minor ++
"." ++ show patch
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 intf)
vhdlPort :: PortDeclaration -> String
vhdlPort (Port name InputPort typ net)
= name ++ " : in " ++ showType typ
vhdlPort (Port name OutputPort typ net)
= name ++ " : out " ++ showType typ
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 -> [PortDeclaration] -> [Instance] -> Int ->
(Array Int Int, Array Int Int) -> XilinxArchitecture ->
IO ()
vhdlArchitecture file name ports gates netCount shifts architecture
= do hPutStr file
(unlines ["library ieee, unisim ;",
"use ieee.std_logic_1164.all ;",
"use unisim.vcomponents.all ;",
"architecture lava of " ++ name ++ " is ",
" attribute rloc : string ;",
netDefs])
writeRLOCs file architecture shifts gates
hPutStr file "begin\n"
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) ++ ") ;"
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 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]
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 ";")
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 == NoPlacement || pos == Unplaced then
return ()
else
hPutStrLn file (" attribute rloc of " ++ instName ++ " : label is \""
++ showRLOC arch (x+dx!i,y+dy!i) ++ "\" ;")
where
pos = position inst
At (x,y) = pos
i = instanceNumber inst
instName = componentName inst ++ "_" ++ show i