module Lava.Vhdl
( writeVhdl
, writeVhdlForPart
, Part(..)
, v5110t
) where
import Lava.Bit
import Lava.Binary
import System
vhdlGumpth :: String
vhdlGumpth = unlines $
[ "-- Generated by York Lava for the XST"
, ""
, "library IEEE;"
, "use IEEE.STD_LOGIC_1164.ALL;"
, "use IEEE.STD_LOGIC_ARITH.ALL;"
, "use IEEE.STD_LOGIC_UNSIGNED.ALL;"
, ""
, "library unisim;"
, "use unisim.vcomponents.all;"
, ""
, "use work.all;"
, ""
]
vhdlEntity :: String -> Netlist -> String
vhdlEntity name nl =
"entity " ++ name ++ " is port (\n"
++ consperse ";\n"
([ v ++ " : out std_logic" | v <- outs] ++
[ "clock : in std_logic" ] ++
[ v ++ " : in std_logic" | v <- inps])
++ "\n);\nend entity " ++ name ++ ";\n"
where
inps = [ lookupParam (netParams net) "name"
| net <- nets nl, netName net == "name"]
outs = map fst (namedOutputs nl)
data Part =
Part {
partName :: String
, partFamily :: String
, partPackage :: String
, partSpeedGrade :: String
}
v5110t :: Part
v5110t =
Part {
partName = "xc5vlx110t"
, partFamily = "virtex5"
, partPackage = "ff1136"
, partSpeedGrade = "-1"
}
ramFile :: Part -> String -> String -> [Parameter] -> String
ramFile part name ramType params = unlines commands
where
init = read (lookupParam params "init") :: [Integer]
dwidth = read (lookupParam params "dwidth") :: Int
awidth = read (lookupParam params "awidth") :: Int
primType = lookupParam params "primtype"
coeFile = if null init then "no_coe_file_loaded"
else "init_" ++ name ++ ".txt"
commands =
[ "SET addpads = False"
, "SET asysymbol = True"
, "SET busformat = BusFormatAngleBracketNotRipped"
, "SET createndf = False"
, "SET designentry = VHDL"
, "SET device = " ++ partName part
, "SET devicefamily = " ++ partFamily part
, "SET package = " ++ partPackage part
, "SET speedgrade = " ++ partSpeedGrade part
, "SET flowvendor = Foundation_iSE"
, "SET formalverification = False"
, "SET foundationsym = False"
, "SET implementationfiletype = Ngc"
, "SET removerpms = False"
, "SET simulationfiles = Behavioral"
, "SET verilogsim = False"
, "SET vhdlsim = True"
, "# END Project Options"
, "# BEGIN Select"
, "SELECT Block_Memory_Generator family Xilinx,_Inc. 2.8"
, "# END Select"
, "# BEGIN Parameters"
, if null primType then "CSET algorithm=Minimum_Area"
else "CSET algorithm=Fixed_Primitives"
, "CSET assume_synchronous_clk=false"
, "CSET byte_size=9"
, "CSET coe_file=" ++ coeFile
, "CSET collision_warnings=ALL"
, "CSET component_name=" ++ name
, "CSET disable_collision_warnings=false"
, "CSET disable_out_of_range_warnings=false"
, "CSET ecc=false"
, "CSET enable_a=Always_Enabled"
, "CSET enable_b=Always_Enabled"
, "CSET fill_remaining_memory_locations=true"
, "CSET load_init_file=" ++
(if coeFile == "no_coe_file_loaded" then "false" else "true")
, "CSET memory_type=" ++
(if ramType == "ram" then "Single_Port_RAM"
else "True_Dual_Port_RAM")
, "CSET operating_mode_a=WRITE_FIRST"
, "CSET operating_mode_b=WRITE_FIRST"
, "CSET output_reset_value_a=0"
, "CSET output_reset_value_b=0"
, "CSET pipeline_stages=0"
, "CSET primitive=" ++ if null primType then "8kx2" else primType
, "CSET read_width_a=" ++ show dwidth
, "CSET read_width_b=" ++ show dwidth
, "CSET register_porta_output_of_memory_core=false"
, "CSET register_porta_output_of_memory_primitives=false"
, "CSET register_portb_output_of_memory_core=false"
, "CSET register_portb_output_of_memory_primitives=false"
, "CSET remaining_memory_locations=0"
, "CSET single_bit_ecc=false"
, "CSET use_byte_write_enable=false"
, "CSET use_ramb16bwer_reset_behavior=false"
, "CSET use_regcea_pin=false"
, "CSET use_regceb_pin=false"
, "CSET use_ssra_pin=false"
, "CSET use_ssrb_pin=false"
, "CSET write_depth_a=" ++ show (2^awidth)
, "CSET write_width_a=" ++ show dwidth
, "CSET write_width_b=" ++ show dwidth
, "# END Parameters"
, "GENERATE"
]
vhdlDecls :: Netlist -> String
vhdlDecls nl =
(consperse ",\n"
[ consperse ",\n" $ map (wireStr . (,) (netId net))
[0..netNumOuts net1]
| net <- nets nl ])
++ " : std_logic;\n"
++ "attribute INIT: string;\n"
++ concat [ init (netId net) (netParams net)
| net <- nets nl
, netName net == "delay" || netName net == "fde" ]
where
init c params =
"attribute INIT of " ++ compStr c ++ ": label is \""
++ lookupParam params "init" ++ "\";\n"
type Instantiator = String -> [Parameter] -> InstanceId -> [Wire] -> String
vhdlInsts :: Instantiator -> Netlist -> String
vhdlInsts f nl =
concat [ f (netName net)
(netParams net)
(netId net)
(netInputs net)
| net <- nets nl ] ++
concat [ s ++ " <= " ++ wireStr w ++ ";\n"
| (s, w) <- namedOutputs nl ]
vhdlInst :: Instantiator
vhdlInst "low" = constant "'0'"
vhdlInst "high" = constant "'1'"
vhdlInst "inv" = gate 1 "inv"
vhdlInst "and2" = gate 1 "and2"
vhdlInst "or2" = gate 1 "or2"
vhdlInst "xor2" = gate 1 "xor2"
vhdlInst "eq2" = gate 1 "xnor2"
vhdlInst "xorcy" = gate 1 "xorcy"
vhdlInst "muxcy" = gate 1 "muxcy"
vhdlInst "name" = assignName
vhdlInst "delay" = delay "fd"
vhdlInst "delayEn" = delay "fde"
vhdlInst "ram" = instRam
vhdlInst "dualRam" = instRam2
vhdlInst s = error ("Vhdl: unknown component '" ++ s ++ "'")
vhdlArch :: Instantiator -> String -> Netlist -> String
vhdlArch f name nl =
"architecture structural of " ++ name ++ " is\n"
++ "signal " ++ vhdlDecls nl
++ "begin\n"
++ vhdlInsts f nl
++ "end structural;\n"
ramFiles :: Part -> Netlist -> [(String, String)]
ramFiles part nl =
[ ( "init_ram_" ++ compStr (netId net) ++ ".txt"
, genCoeFile $ netParams net)
| net <- nets nl
, netName net == "ram" || netName net == "dualRam"
, nonEmpty (netParams net)
]
++ [ ( "ram_" ++ compStr (netId net) ++ ".xco"
, ramFile part
("ram_" ++ compStr (netId net))
(netName net)
(netParams net))
| net <- nets nl
, netName net == "ram" || netName net == "dualRam"
]
where
nonEmpty params = not (null init)
where init = read (lookupParam params "init") :: [Integer]
genCoeFile params =
"memory_initialization_radix = 10;\n"
++ "memory_initialization_vector = "
++ (unwords $ map show init)
++ ";\n"
where init = read (lookupParam params "init") :: [Integer]
vhdl :: Part -> String -> Netlist -> [(String, String)]
vhdl part name nl =
[ (name ++ ".vhd", vhdlGumpth
++ vhdlEntity name nl
++ vhdlArch vhdlInst name nl) ] ++ ramFiles part nl
writeVhdl ::
Generic a => String
-> a
-> a
-> IO ()
writeVhdl = writeVhdlForPart v5110t
writeVhdlForPart ::
Generic a => Part
-> String
-> a
-> a
-> IO ()
writeVhdlForPart part name a b =
do putStrLn ("Creating directory '" ++ name ++ "/'")
system ("mkdir -p " ++ name)
nl <- netlist a b
mapM_ gen (vhdl part name nl)
putStrLn "Done."
where
gen (file, content) =
do putStrLn $ "Writing to '" ++ name ++ "/" ++ file ++ "'"
writeFile (name ++ "/" ++ file) content
compStr :: InstanceId -> String
compStr i = "c" ++ show i
wireStr :: Wire -> String
wireStr (i, j) = "w" ++ show i ++ "_" ++ show j
consperse :: String -> [String] -> String
consperse s [] = ""
consperse s [x] = x
consperse s (x:y:ys) = x ++ s ++ consperse s (y:ys)
argList :: [String] -> String
argList = consperse ","
gate n str params comp inps =
compStr comp ++ " : " ++ str ++ " port map (" ++ argList (xs ++ ys) ++ ");\n"
where xs = map (\i -> wireStr (comp, i)) [0..n1]
ys = map wireStr inps
assignName params comp inps =
wireStr (comp, 0) ++ " <= " ++ lookupParam params "name" ++ ";\n"
muxBit params comp [b, a, sel] =
"with " ++ wireStr sel ++ " select "
++ wireStr (comp, 0) ++ " <= " ++ wireStr a ++ " when '0',"
++ wireStr b ++ " when '1';\n"
constant str params comp inps =
wireStr (comp, 0) ++ " <= " ++ str ++ ";\n"
delay str params comp inps =
compStr comp ++ " : " ++ str
++ " generic map (INIT => '"
++ lookupParam params "init" ++ "') "
++ "port map ("
++ argList (wireStr (comp, 0) :
"clock" : map wireStr (tail inps))
++ ");\n"
busMap :: String -> [Wire] -> [String]
busMap port signals =
zipWith (\i s -> port ++ "(" ++ show i ++ ") => " ++ wireStr s) [0..] signals
instRam params comp (we:sigs) =
compStr comp ++ " : entity ram_" ++ compStr comp ++ " "
++ " port map ("
++ " clka => clock, "
++ argList (busMap "dina" dbus1) ++ ","
++ argList (busMap "addra" abus1) ++ ","
++ " wea(0) => " ++ wireStr we ++ ","
++ argList (busMap "douta" outs1)
++ ");\n"
where
init = read (lookupParam params "init") :: [Integer]
dwidth = read (lookupParam params "dwidth") :: Int
awidth = read (lookupParam params "awidth") :: Int
primType = lookupParam params "primtype"
(dbus1, abus1) = splitAt dwidth sigs
outs1 = map ((,) comp) [0..dwidth1]
instRam2 params comp (we1:we2:sigs) =
compStr comp ++ " : entity ram_" ++ compStr comp ++ " "
++ " port map ("
++ " clka => clock, "
++ argList (busMap "dina" dbus1) ++ ","
++ argList (busMap "addra" abus1) ++ ","
++ " wea(0) => " ++ wireStr we1 ++ ","
++ argList (busMap "douta" outs1) ++ ","
++ " clkb => clock, "
++ argList (busMap "dinb" dbus2) ++ ","
++ argList (busMap "addrb" abus2) ++ ","
++ " web(0) => " ++ wireStr we2 ++ ","
++ argList (busMap "doutb" outs2)
++ ");\n"
where
init = read (lookupParam params "init") :: [Integer]
dwidth = read (lookupParam params "dwidth") :: Int
awidth = read (lookupParam params "awidth") :: Int
primType = lookupParam params "primtype"
(dbus, abus) = splitAt (2*dwidth) sigs
(abus1, abus2) = splitAt awidth abus
(dbus1, dbus2) = splitAt dwidth dbus
outs1 = map ((,) comp) [0..dwidth1]
outs2 = map ((,) comp) [dwidth..dwidth*21]