Dave,
So I modified your script to more closely match the one generated by export_hw_tcl in Quartus 14.0. I am new to Quartus, new to Tcl, and have only tested it on one system so there are likely a number of issues. I did find a bug with your script though where you print the exported interfaces. Your regexp for finding the type should be {_[^_]*$} instead of {_[^_]*}. I agree it would be nice to have an API for that rather than being forced to guess based on the naming. Next I am going to add hooks so I can set some module parameters from the command line which is the whole reason for going down this rabbit hole in the first place.
I don't know how to attach a file to this thread so I will just include the script inline below.
Thanks,
-Pete
#
# This script saves the current system as a qsys hw.tcl file. The
# intent is to emulate the export_hw_tcl command but give greater
# control over the results. The resulting file should be able to be
# imported into Qsys.
#
# This script is based heavily on the script Save_script.tcl written
# by David Hawkins and found at
#
http://www.alterawiki.com/wiki/qsys_scripts #
# Usage: qsys-script --script=export_hw_tcl.tcl --system-file=my_system.qsys
#
# The script writes:
# * module properties
# * instances in the system, with parameters
# * connections in the system, with parameters
# * exported interfaces
# * interconnect requirements
#
# Known limitations:
# * Disabled modules are culled.
#
# * No diagnostics if the system contains instances of unknown components.
#
# * there's no API to get the real system name for a system loaded from
# a .qsys file ("$${FILENAME}" ain't it!).
#
# * I haven't tested any fancy quoting for parameters with tcl special
# characters in them.
#
# * There is no api to query an interface type and direction.
# We're extracting it from the interface "CLASS_NAME". It works for
# now, but would be cleaner if we had direct API for these queries.
#
# * There is no API to manage:
# * UI sort-order
# * Custom (SOPC-compatible) exported signal names
package require -exact qsys 14.0
# procedure to quote stuff. If we need to make the escaping better,
# this is the place to do it.
proc quote { stuff } {
return "{$stuff}"
}
# determine the system name
if {[expr ! [info exists system_name]]} {
set system_name [ get_module_property NAME ]
if { [string equal $system_name "\$\${FILENAME}" ]} {
set system_name "new_system"
}
}
# determine th eoutput file name
if {[expr ! [info exists hw_tcl_file]]} {
set hw_tcl_file "${system_name}_hw.tcl"
}
set script_file [ open "$hw_tcl_file" w ]
# write the API version this script is writing
puts $script_file "package require -exact qsys 14.0"
send_message Info "Writing system script to $hw_tcl_file"
# write all the top-level system properties
send_message Info "Writing module properties"
puts $script_file "# module properties ('module' here means 'system' or 'top level module')"
set properties [ get_module_properties ]
foreach property $properties {
set value [ quote [ get_module_property $property ] ]
puts $script_file "set_module_property $property $value"
}
puts $script_file ""
puts $script_file "# default module properties"
array set default_module_properties
[ list
{AUTHOR} {author}
{DESCRIPTION} {default description}
{GROUP} {default group}
{VERSION} {1.0}
]
foreach module_property [array names default_module_properties] {
set property_value [ quote $default_module_properties($module_property) ]
puts $script_file "set_module_property $module_property $property_value"
}
puts $script_file ""
puts $script_file "set_module_property COMPOSITION_CALLBACK compose"
puts $script_file "set_module_property opaque_address_map false"
puts $script_file ""
puts $script_file "proc compose { } {"
# write instances and instance parameters
send_message Info "Writing instances"
puts $script_file " # Instances and instance parameters"
puts $script_file " # (disabled instances are intentionally culled)"
set instances [ get_instances ]
foreach instance $instances {
set enabled [ get_instance_property $instance ENABLED ]
if { [string equal -nocase "$enabled" true]} {
set type [ get_instance_property $instance CLASS_NAME ]
set version [ get_instance_property $instance VERSION ]
puts $script_file " add_instance $instance $type $version"
set parameters [ get_instance_parameters $instance ]
foreach parameter $parameters {
set parameter_value [ quote [ get_instance_parameter_value $instance $parameter ] ]
puts $script_file " set_instance_parameter_value $instance [ quote $parameter ] $parameter_value"
}
puts $script_file ""
}
}
# write connections and connection parameters
send_message Info "Writing connections"
puts $script_file " # connections and connection parameters"
set connections [ get_connections ]
foreach connection $connections {
set type [ get_connection_property $connection TYPE ]
set start [ get_connection_property $connection START ]
set end [ get_connection_property $connection END ]
puts $script_file " add_connection $start $end $type"
set parameters [ get_connection_parameters $connection ]
foreach parameter $parameters {
set value [ quote [ get_connection_parameter_value $connection $parameter ] ]
puts $script_file " set_connection_parameter_value $connection $parameter $value"
}
puts $script_file ""
}
# write top-level interface exports
send_message Info "Writing exports"
puts $script_file " # exported interfaces"
foreach export_interface [ get_interfaces ] {
set inner_interface [ get_interface_property $export_interface EXPORT_OF ]
regsub {\.[^.]*} $inner_interface "" instance
regsub {^.*\.} $inner_interface "" instance_interface
set classname [ get_instance_interface_property $instance $instance_interface CLASS_NAME ]
regsub {_[^_]*$} $classname "" type
regsub {^.*_} $classname "" direction
puts $script_file " add_interface $export_interface $type $direction"
puts $script_file " set_interface_property $export_interface EXPORT_OF $inner_interface"
}
puts $script_file ""
send_message Info "Writing interconnect requirements"
puts $script_file " # interconnect requirements"
set requirement_list [ get_interconnect_requirements ]
foreach { element_id name value } $requirement_list {
puts $script_file " set_interconnect_requirement [ quote $element_id ] [ quote $name ] [ quote $value ]"
}
puts $script_file "}"
close $script_file
send_message Info "Saved $hw_tcl_file"
Honored Contributor
