diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2012 Gergo Erdi +Copyright (c) 2014 Gergő Érdi All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/ise.template/tcl.mustache b/ise.template/tcl.mustache new file mode 100644 --- /dev/null +++ b/ise.template/tcl.mustache @@ -0,0 +1,256 @@ +set myProject "{{project}}" +set myScript "{{project}}.tcl" + +proc run_process {} { + + global myScript + global myProject + + ## put out a 'heartbeat' - so we know something's happening. + puts "\n$myScript: running ($myProject)...\n" + + if { ! [ open_project ] } { + return false + } + + set_process_props + # + # Remove the comment characters (#'s) to enable the following commands + # process run "Synthesize" + # process run "Translate" + # process run "Map" + # process run "Place & Route" + # + set task "Implement Design" + if { ! [run_task $task] } { + puts "$myScript: $task run failed, check run output for details." + project close + return + } + + set task "Generate Programming File" + if { ! [run_task $task] } { + puts "$myScript: $task run failed, check run output for details." + project close + return + } + + puts "Run completed (successfully)." + project close + +} + +proc rebuild_project {} { + + global myScript + global myProject + + project close + ## put out a 'heartbeat' - so we know something's happening. + puts "\n$myScript: Rebuilding ($myProject)...\n" + + set proj_exts [ list ise xise gise ] + foreach ext $proj_exts { + set proj_name "${myProject}.$ext" + if { [ file exists $proj_name ] } { + file delete $proj_name + } + } + + project new $myProject + set_project_props + add_source_files + create_libraries + puts "$myScript: project rebuild completed." + + run_process + +} + +proc run_task { task } { + + # helper proc for run_process + + puts "Running '$task'" + set result [ process run "$task" ] + # + # check process status (and result) + set status [ process get $task status ] + if { ( ( $status != "up_to_date" ) && \ + ( $status != "warnings" ) ) || \ + ! $result } { + return false + } + return true +} + +proc show_help {} { + + global myScript + + puts "" + puts "usage: xtclsh $myScript " + puts " or you can run xtclsh and then enter 'source $myScript'." + puts "" + puts "options:" + puts " run_process - set properties and run processes." + puts " rebuild_project - rebuild the project from scratch and run processes." + puts " set_project_props - set project properties (device, speed, etc.)" + puts " add_source_files - add source files" + puts " create_libraries - create vhdl libraries" + puts " set_process_props - set process property values" + puts " show_help - print this message" + puts "" +} + +proc open_project {} { + + global myScript + global myProject + + if { ! [ file exists ${myProject}.xise ] } { + ## project file isn't there, rebuild it. + puts "Project $myProject not found. Use project_rebuild to recreate it." + return false + } + + project open $myProject + + return true + +} + +proc set_project_props {} { + + global myScript + + if { ! [ open_project ] } { + return false + } + + puts "$myScript: Setting project properties..." + + project set family "{{targetFamily}}" + project set device "{{targetDevice}}" + project set package "{{targetPackage}}" + project set speed "{{targetSpeed}}" + project set top_level_module_type "HDL" + project set synthesis_tool "XST (VHDL/Verilog)" + project set simulator "ISim (VHDL/Verilog)" + project set "Preferred Language" "VHDL" +} + + +proc findRtfPath { relativePath } { + set xilenv "" + if { [info exists ::env(XILINX) ] } { + if { [info exists ::env(MYXILINX)] } { + set xilenv [join [list $::env(MYXILINX) $::env(XILINX)] $::xilinx::path_sep ] + } else { + set xilenv $::env(XILINX) + } + } + foreach path [ split $xilenv $::xilinx::path_sep ] { + set fullPath [ file join $path $relativePath ] + if { [ file exists $fullPath ] } { + return $fullPath + } + } + return "" +} + +proc add_source_files {} { + + global myScript + + if { ! [ open_project ] } { + return false + } + + source [ findRtfPath "data/projnav/scripts/dpm_cgUtils.tcl" ] + + {{#ipcores}} + if { ! [ file exists "ipcore_dir/{{name}}.vhd" ] } { + puts "$myScript: Regenerating {{name}}" + cd ipcore_dir + run_cg_regen "{{name}}" {{targetDevice}}{{targetSpeed}}{{targetPackage}} VHDL CURRENT + cd .. + } + {{/ipcores}} + + + puts "$myScript: Adding sources to project..." + + {{#srcs}}xfile add "{{fileName}}" + {{/srcs}} + {{#ipcores}}xfile add "ipcore_dir/{{name}}.xco" + {{/ipcores}} + + # Set the Top Module as well... + project set top "rtl" "PET" + + puts "$myScript: project sources reloaded." + +} ; # end add_source_files + +proc create_libraries {} { + + global myScript + + if { ! [ open_project ] } { + return false + } + + puts "$myScript: Creating libraries..." + + + # must close the project or library definitions aren't saved. + project save + +} ; # end create_libraries + +proc set_process_props {} { + + global myScript + + if { ! [ open_project ] } { + return false + } + + puts "$myScript: setting process properties..." + + project set "Compiled Library Directory" "\$XILINX//" + project set "Functional Model Target Language" "VHDL" -process "View HDL Source" + + puts "$myScript: project property values set." + +} ; # end set_process_props + +proc main {} { + + if { [llength $::argv] == 0 } { + show_help + return true + } + + foreach option $::argv { + switch $option { + "show_help" { show_help } + "run_process" { run_process } + "rebuild_project" { rebuild_project } + "set_project_props" { set_project_props } + "add_source_files" { add_source_files } + "create_libraries" { create_libraries } + "set_process_props" { set_process_props } + default { puts "unrecognized option: $option"; show_help } + } + } +} + +if { $tcl_interactive } { + show_help +} else { + if {[catch {main} result]} { + puts "$myScript failed: $result." + } +} diff --git a/ise.template/ut.mustache b/ise.template/ut.mustache deleted file mode 100644 --- a/ise.template/ut.mustache +++ /dev/null @@ -1,21 +0,0 @@ --w --g DebugBitstream:No --g Binary:no --g CRC:Enable --g ConfigRate:1 --g ProgPin:PullUp --g DonePin:PullUp --g TckPin:PullUp --g TdiPin:PullUp --g TdoPin:PullUp --g TmsPin:PullUp --g UnusedPin:PullDown --g UserID:0xFFFFFFFF --g StartUpClk:CClk --g DONE_cycle:4 --g GTS_cycle:5 --g GWE_cycle:6 --g LCK_cycle:NoWait --g Security:None --g DonePipe:Yes --g DriveDone:No diff --git a/ise.template/xise.mustache b/ise.template/xise.mustache deleted file mode 100644 --- a/ise.template/xise.mustache +++ /dev/null @@ -1,28 +0,0 @@ - - - -
- - - - -{{#components}} - - - {{#behavior}}{{/behavior}} - -{{/components}} - - - - - - - - - - - - - - diff --git a/ise.template/xst.mustache b/ise.template/xst.mustache deleted file mode 100644 --- a/ise.template/xst.mustache +++ /dev/null @@ -1,48 +0,0 @@ -set -tmpdir "xst/projnav.tmp" -set -xsthdpdir "xst" -run --ifn {{MAIN}}.prj --ifmt mixed --ofn {{MAIN}} --ofmt NGC --p {{PLATFORM}} --top {{TOP}} --opt_mode Speed --opt_level 1 --iuc NO --keep_hierarchy No --netlist_hierarchy As_Optimized --rtlview Yes --glob_opt AllClockNets --read_cores YES --write_timing_constraints NO --cross_clock_analysis NO --hierarchy_separator / --bus_delimiter <> --case Maintain --slice_utilization_ratio 100 --bram_utilization_ratio 100 --fsm_extract YES -fsm_encoding Auto --safe_implementation No --fsm_style LUT --ram_extract Yes --ram_style Auto --rom_extract Yes --shreg_extract YES --rom_style Auto --auto_bram_packing NO --resource_sharing YES --async_to_sync NO --mult_style Auto --iobuf YES --max_fanout 100000 --bufg 24 --register_duplication YES --register_balancing No --optimize_primitives NO --use_clock_enable Yes --use_sync_set Yes --use_sync_reset Yes --iob Auto --equivalent_register_removal YES --slice_utilization_ratio_maxmargin 5 diff --git a/kansas-lava-shake.cabal b/kansas-lava-shake.cabal --- a/kansas-lava-shake.cabal +++ b/kansas-lava-shake.cabal @@ -1,11 +1,11 @@ name: kansas-lava-shake -version: 0.1.2 +version: 0.2.0 synopsis: Shake rules for building Kansas Lava projects description: Shake rules for building Kansas Lava projects. Currently supports the Xilinx FPGA tooling only. license: BSD3 license-file: LICENSE -copyright: (C) 2014 Gergo Erdi +copyright: (C) 2014 Gergő Érdi author: Gergo Erdi maintainer: Gergo Erdi category: Development @@ -25,16 +25,12 @@ build-depends: base >=4.7 && < 5, kansas-lava >=0.2.4 && < 0.2.5, - filepath, - directory, - temporary, shake >= 0.14, - containers, text, - hastache + hastache >= 0.6 && < 0.7 default-language: Haskell2010 other-extensions: RecordWildCards - Ghc-Options: -Werror -fwarn-unused-imports -fwarn-unused-matches + Ghc-Options: -fwarn-unused-imports -fwarn-unused-matches -fwarn-unused-binds -fwarn-missing-signatures source-repository head @@ -44,4 +40,4 @@ source-repository this type: git location: git://github.com/gergoerdi/kansas-lava-shake - tag: 0.1.2 + tag: 0.2.0 diff --git a/src/Development/KansasLava/Shake.hs b/src/Development/KansasLava/Shake.hs --- a/src/Development/KansasLava/Shake.hs +++ b/src/Development/KansasLava/Shake.hs @@ -5,17 +5,17 @@ import Development.Shake import Development.Shake.FilePath import Language.KansasLava.VHDL (writeVhdlPrelude) +import Control.Monad -lavaRules :: FilePath -> String -> String -> Rules () -lavaRules modName vhdl ucf = do - "gensrc" modName <.> "vhdl" *> \target -> do - alwaysRerun - writeFileChanged target vhdl - "gensrc" modName <.> "ucf" *> \target -> do - alwaysRerun - writeFileChanged target ucf - "gensrc/lava-prelude.vhdl" *> \target -> do +lavaRules :: FilePath -> [(FilePath, String)] -> Rules () +lavaRules outDir genVHDLs = do + outDir "gensrc/lava-prelude.vhdl" %> \out -> do alwaysRerun withTempFile $ \tempFile -> do liftIO $ writeVhdlPrelude tempFile - copyFileChanged tempFile target + copyFileChanged tempFile out + + forM_ genVHDLs $ \(modName, vhdl) -> do + outDir "gensrc" modName <.> "vhdl" %> \out -> do + alwaysRerun + writeFileChanged out vhdl diff --git a/src/Development/KansasLava/Shake/Xilinx.hs b/src/Development/KansasLava/Shake/Xilinx.hs --- a/src/Development/KansasLava/Shake/Xilinx.hs +++ b/src/Development/KansasLava/Shake/Xilinx.hs @@ -1,185 +1,59 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Development.KansasLava.Shake.Xilinx - ( XilinxConfig(..) + ( XilinxConfig(..), XilinxTarget(..) , xilinxRules ) where import Development.Shake import Development.Shake.FilePath -import System.Directory -import Data.Monoid -import Data.List (stripPrefix) -import Data.Maybe (fromJust) -import Data.String (fromString) - import qualified Data.Text.Lazy as TL -import qualified Data.Text as TS import Text.Hastache +import Text.Hastache.Context import Paths_kansas_lava_shake +data XilinxTarget = XilinxTarget{ targetFamily, targetDevice, targetSpeed, targetPackage :: String } + data XilinxConfig = XilinxConfig{ xilinxRoot :: FilePath - , xilinxPlatform :: String + , xilinxTarget :: XilinxTarget } -xilinxRules :: XilinxConfig - -> String - -> [String] - -> Rules () -xilinxRules XilinxConfig{..} mod xaws = do - "*.ut" *> - textTemplate [] - - "*.xst" *> - textTemplate [ ("MAIN", fromString mod) - , ("TOP", fromString mod) - , ("PLATFORM", fromString xilinxPlatform) - ] - - "*.xise" *> - listTemplate "components" xiseFiles - - "*.prj" *> \target -> do - let vhdlWork baseName = mconcat ["vhdl work \"", baseName <.> "vhdl", "\""] - liftIO $ writeFile target . unlines $ - map (vhdlWork . gensrc) vhdls ++ map (vhdlWork . xawsrc) xaws - - xawsrc "*.vhdl" *> \target -> do - let xaw = ".." "xaw" takeFileName target -<.> "xaw" - need [xaw] - removeFilesAfter "." ["xaw2vhdl.log"] - xilinx "xaw2vhdl" [xaw, "-st", "XST", target] - xawsrc "*.ucf" *> \target -> need [target -<.> "vhdl"] - - "*.ngc" *> \target -> do - liftIO $ createDirectoryIfMissing True "xst/projnav.tmp" - need $ - (target -<.> "prj"): - (target -<.> "xst"): - [gensrc $ f <.> "vhdl" | f <- vhdls] ++ - [xawsrc $ f <.> "vhdl" | f <- xaws] - - removeFilesAfter "." - [ "xst//*" - , "_xmsgs//*" - , target -<.> "lso" - , target -<.> "ngr" - , target -<.> "syr" - , "*.xrpt" - ] - xilinx "xst" [ "-ifn", target -<.> "xst" - , "-ofn", target -<.> "syr" - ] - - "*.ngd" *> \target -> do - liftIO $ createDirectoryIfMissing True "xst/projnav.tmp" - let ucf = gensrc $ target -<.> "ucf" - need [ target -<.> "ngc" - , ucf - ] - removeFilesAfter "." - [ target -<.> "bld" - , "ngo//*" - , "xlnx_auto_0_xdb//*" - , "*.xrpt" - ] - xilinx "ngdbuild" [ "-dd", "ngo" - , "-nt", "timestamp" - , "-uc", ucf - , "-p", xilinxPlatform - , target -<.> "ngc" - , target - ] - - "*.pcf" *> \target -> do - liftIO $ createDirectoryIfMissing True "xst/projnav.tmp" - need [ target -<.> "ngc" - , target -<.> "ngd" - ] - removeFilesAfter "." - [ "*_summary.xml" - , "*_usage.xml" - , "xilinx_device_details.xml" - , target -<.> "ngm" - , target -<.> "mrp" - , target -<.> "map" - ] - xilinx "map" [ "-p", xilinxPlatform - , "-ir", "off" - , "-pr", "off" - , "-c", "100" - , "-w" - , "-o", mapFileName (<> "_map") target -<.> "ncd" - , target -<.> "ngd" - , target -<.> "pcf" - ] - - alternatives $ do - "*_map.ncd" *> \target -> need [mapFileName (fromJust . stripSuffix "_map") target -<.> "pcf"] - - "*.ncd" *> \target -> do - liftIO $ createDirectoryIfMissing True "xst/projnav.tmp" - need [target -<.> "pcf"] - removeFilesAfter "." - [ "*_pad.txt" - , "*_pad.xrpt" - , "*_pad.csv" - , "_xmsgs//*" - , "par_usage_statistics.html" - , target -<.> "pad" - , target -<.> "par" - , target -<.> "xpi" - , target -<.> "unroutes" - , target -<.> "ptwx" - ] - - xilinx "par" [ "-w" - , "-ol", "high" - , "-mt", "off" - , mapFileName (<> "_map") target -<.> "ncd" - , target -<.> "ncd" - , target -<.> "pcf" - ] - - "*.bit" *> \target -> do - liftIO $ createDirectoryIfMissing True "xst/projnav.tmp" - need [ target -<.> "ut" - , target -<.> "ncd" - ] - removeFilesAfter "." - [ "*_bitgen.xwbt" - , "usage_statistics_webtalk.html" - , "webtalk.log" - , target -<.> "bgn" - , target -<.> "drc" - ] - xilinx "bitgen" [ "-f", target -<.> "ut" - , target -<.> "ncd" +xilinxRules :: XilinxConfig -> FilePath -> String -> [FilePath] -> [FilePath] -> Rules () +xilinxRules XilinxConfig{..} outDir projName srcs ipcores = do + outDir projName <.> "bit" %> \_out -> do + need . concat $ [ [ outDir src | src <- srcs ] + , [ outDir "ipcore_dir" xco | xco <- ipcores ] + , [ outDir projName <.> "tcl" ] ] - where - xilinx tool args = cmd (xilinxRoot tool) args - gensrc f = "gensrc" f - xawsrc f = gensrc $ "xaw" f + xilinx "xtclsh" [projName <.> "tcl", "rebuild_project"] - vhdls = [mod, "lava-prelude"] + "build" "*.tcl" %> do + hastache projCtxt + where + xilinx tool args = cmd (Cwd outDir) (xilinxRoot tool) args - xiseFiles = map (return .) $ ucf : map vhdl vhdls ++ map xaw xaws + projCtxt = mkStrContext $ \key -> case key of + "project" -> MuVariable projName + "targetFamily" -> MuVariable targetFamily + "targetDevice" -> MuVariable targetDevice + "targetSpeed" -> MuVariable targetSpeed + "targetPackage" -> MuVariable targetPackage + "ipcores" -> MuList [ mkStrContext $ \key -> case key of + "name" -> MuVariable name + _ -> MuNothing + | xco <- ipcores + , let name = dropExtension xco + ] + "srcs" -> MuList [ mkStrContext $ \key -> case key of + "fileName" -> MuVariable src + _ -> MuNothing + | src <- srcs + ] + _ -> MuNothing where - vhdl componentName = \key -> case key of - "type" -> MuVariable ("FILE_VHDL" :: String) - "fileName" -> MuVariable $ componentName <.> "vhdl" - "behavior" -> MuBool True - ucf = \key -> case key of - "type" -> MuVariable ("FILE_UCF" :: String) - "fileName" -> MuVariable $ mod <.> "ucf" - "behavior" -> MuBool False - xaw componentName = \key -> case key of - "type" -> MuVariable ("FILE_XAW" :: String) - "fileName" -> MuVariable $ ".." "xaw" componentName <.> "xaw" - "behavior" -> MuBool True + XilinxTarget{..} = xilinxTarget hastache :: MuContext IO -> FilePath -> Action () hastache ctxt target = do @@ -196,21 +70,3 @@ ext = drop 1 . takeExtension $ target templateName = ext <.> "mustache" - -listTemplate :: TS.Text -> [MuContext IO] -> FilePath -> Action () -listTemplate key0 entities = hastache ctxt - where - ctxt key = return $ if key == key0 then MuList entities else MuNothing - -textTemplate :: [(TS.Text, TL.Text)] -> FilePath -> Action () -textTemplate replacements = hastache ctxt - where - ctxt key = return $ case lookup key replacements of - Just value -> MuVariable value - Nothing -> MuNothing - -mapFileName :: (String -> String) -> FilePath -> FilePath -mapFileName f fp = replaceFileName fp (f (takeFileName fp)) - -stripSuffix :: (Eq a) => [a] -> [a] -> Maybe [a] -stripSuffix suffix = fmap reverse . stripPrefix (reverse suffix) . reverse