-------------------------------------------------------------------------------
--- $Id: CircuitGraphToVHDL.hs#5 2010/09/21 16:53:24 REDMOND\\satnams $
-------------------------------------------------------------------------------

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

-- * Generating VHDL from a Lava netlist

-------------------------------------------------------------------------------

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)
       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) -> IO ()
vhdlArchitecture file name ports gates netCount shifts
  = 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 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 (netCount-1) ++ ") ;"
 
-------------------------------------------------------------------------------

wirePorts :: Handle -> [PortDeclaration] -> IO ()
wirePorts file = mapM_ (wirePort file)

-------------------------------------------------------------------------------

wirePort :: Handle -> PortDeclaration -> IO ()

-- Wire up a single bit input port.
wirePort file (Port name InputPort BitType [net])
  = hPutStrLn file ("  net(" ++ show net ++ ") <= " ++ name ++ ";")

-- Wire up an input bit-vector
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]

-- Wire up a single bit output port.
wirePort file (Port name OutputPort BitType [net])
  = hPutStrLn file ("  " ++ name ++ " <= net(" ++show  net ++ ") ;")

-- Wire up an output bit-vector
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 ";")
      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 -> (Array Int Int, Array Int Int) -> [Instance] -> IO ()
writeRLOCs file dxy  = mapM_ (writeRLOC file dxy) 

-------------------------------------------------------------------------------

writeRLOC :: Handle -> (Array Int Int, Array Int Int) -> Instance -> IO ()
writeRLOC file (dx, dy) inst
   = if pos == NoPlacement || pos == Unplaced then
       return ()
     else
       hPutStrLn file ("  attribute rloc of " ++ instName ++ " : label is \"" 
                         ++ showSlice (x+dx!i,y+dy!i) ++ "\" ;")
     where
     pos = position inst
     At (x,y) = pos
     i = instanceNumber inst
     instName = componentName inst ++ "_" ++ show i

-------------------------------------------------------------------------------