clash-lib-1.10.0: data-files/tcl/clashConnector.tcl
# Copyright : (C) 2021-2022, QBayLogic B.V.,
# 2022 , Google Inc.,
# License : BSD2 (see the file LICENSE)
# Maintainer : QBayLogic B.V. <devops@qbaylogic.com>
#
# Script to parse output generated by Clash to use in the synthesis tool.
#
# TODO: More user documentation
package require json
namespace eval clash {
variable metadata {}
variable topEntity
# Set verbosity level. Range is 0-4, where 0 means "silent". Example:
# set clash::verbosity 3
variable verbosity 1
# Dry run can be enabled by
# set clash::dryRun true
variable dryRun false
# Invoke with $topEntityDir set to the path where the manifest file of
# your top entity is. Read all the metadata generated by Tcl: manifests
# and Tcl interface scripts, for the top entity and its dependencies.
proc readMetadata topEntityDir {
variable metadata
variable topEntity
# If we are called multiple times, we will remove the results of
# earlier invocations.
set metadata [dict create]
if {[namespace exists tclIface]} {
namespace delete tclIface
}
set topEntity [ParseManifest $topEntityDir true]
Log 1 "Top entity is $topEntity"
return
}
# Issue "read_vhdl" / "read_verilog" for all HDL files generated by Clash
proc readHdl {} {
variable metadata
variable topEntity
CheckMetadataExists
set libs [dict get $metadata $topEntity dependencies]
lappend libs $topEntity
foreach lib $libs {
foreach hdlFile [dict get $metadata $lib hdlFiles] {
if {[string match {*.vhdl} $hdlFile]} {
PerformAction {
read_vhdl -library } -var lib { } -var hdlFile
} elseif {[string match {*.v} $hdlFile]} {
PerformAction {
read_verilog } -var hdlFile
} elseif {[string match {*.sv} $hdlFile]} {
PerformAction {
read_verilog -sv } -var hdlFile
} else {
error "Error: Unknown extension on HDL file $hdlFile"
}
}
}
return
}
# Issue "read_xdc" for all constraint files generated by Clash for the top
# entity, and all constraint files managed by the Clash<->Tcl API (not just
# for the top entity, but for all libraries).
proc readXdc orders {
variable metadata
variable topEntity
CheckMetadataExists
foreach order $orders {
if {$order ni {early normal late}} {
error "Error: readXdc: Invalid order $order"
}
}
unset order
set early {}
set normal {}
set late {}
foreach tclIface [GetAllTclIfaces {purposes readXdc}] {
namespace upvar ${tclIface} order order
lappend $order $tclIface
}
if {{early} in $orders} {
foreach tclIface $early {
ReadManagedXdc $tclIface
}
}
if {{normal} in $orders} {
ReadUnmanagedXdc
foreach tclIface $normal {
ReadManagedXdc $tclIface
}
}
if {{late} in $orders} {
foreach tclIface $late {
ReadManagedXdc $tclIface
}
}
return
}
# Invoke all Clash-generated Tcl interfaces that specify a "createIp"
# purpose, which will call Vivado's "create_ip" with any additional
# arguments passed to this function (hint: "createIp -dir yourdir" will
# create the IP in the subdirectory named "yourdir"). Following that, the
# IP is configured.
#
# Also see "createAndReadIp" below; call it or use its code as
# inspiration. It is suggested to call it like "createAndReadIp -dir ip"
# so you keep the files in a separate directory named "ip". The directory
# will need to exist already.
proc createIp args {
CheckMetadataExists
# Identical names means identical IP, only one run needed even if it
# occurs in multiple HDL directories.
set seen {}
foreach tclIface [GetAllTclIfaces {purposes createIp}] {
namespace upvar ${tclIface} ipName ipName
if {$ipName in $seen} {
continue
}
PerformAction -var tclIface {::createIp } -var ipName { } \
-varexpand args
LogProc 3 { } ${tclIface}::createIp
lappend seen $ipName
}
return $seen
}
# Convenience method to create the IP in a temporary in-memory project and
# then read in the results in non-project mode. Finally, targets are
# created for the IP.
#
# NOTE WELL: since this switches into and out of project mode, it should
# probably be the very first thing you call in setting up the design.
proc createAndReadIp args {
CheckMetadataExists
if {![llength [GetAllTclIfaces {purposes createIp}]]} {
return
}
PerformAction {
create_project -in_memory
}
set ips [createIp {*}$args]
PerformAction {
set ipFiles [get_property IP_FILE [get_ips } -var ips {]]
close_project
read_ip $ipFiles
set_property GENERATE_SYNTH_CHECKPOINT false [get_files $ipFiles]
generate_target {synthesis simulation} [get_ips } -var ips {]
}
return
}
#---------------------------------------------------------------------------
# Private definitions
#---------------------------------------------------------------------------
proc Log {level msg} {
variable verbosity
if {$verbosity >= $level} {
puts "Clash \[$level\]: $msg"
}
return
}
proc LogDry {level msg} {
variable dryRun
if {$dryRun} {
puts "Clash \[$level\]: \[DRY-RUN\] $msg"
} else {
Log $level $msg
}
return
}
# Remove leading and trailing lines with just spaces
proc TrimLines msg {
return [regsub {^( *\n)*(.*?)\n?( *\n?)*$} $msg {\2}]
}
proc GetCommonIndent msg {
set indent -1
foreach line [split $msg \n] {
regexp -indices {^ *} $line blanks
if {[lindex $blanks 1] == [string length $line] - 1} {
# Empty line or line of all blanks; ignore
continue
}
set leader [expr {[lindex $blanks 1] - [lindex $blanks 0] + 1}]
if {$indent < 0 || $leader < $indent} {
set indent $leader
}
}
if {$indent < 0} {
return 0
}
return $indent
}
proc LogProc {level leader procName} {
Log $level "${leader}proc [namespace tail $procName]\
{[info args $procName]} \{"
set body [TrimLines [info body $procName]]
set outdent [GetCommonIndent $body]
foreach line [split $body \n] {
Log $level "$leader [string range $line $outdent end]"
}
Log $level $leader\}
return
}
proc PerformAction args {
variable dryRun
set action {}
set trace {}
set argsLen [llength $args]
for {set i 0} {$i < $argsLen} {incr i} {
set fragment [lindex $args $i]
if {$fragment ni {-var -varexpand}} {
set action $action$fragment
set trace $trace$fragment
continue
}
incr i
if {$i == $argsLen} {
error "Error: $fragment requires an argument"
}
set varName [lindex $args $i]
upvar $varName var
switch $fragment {
-var {
set action "$action\${$varName}"
set trace $trace$var
}
-varexpand {
set action "$action{*}\${$varName}"
set trace $trace$var
}
}
}
set trace [TrimLines $trace]
set outdent [GetCommonIndent $trace]
foreach line [split $trace \n] {
LogDry 2 [string range $line $outdent end]
}
if {$dryRun} {
return
}
catch {
uplevel 1 $action
} msg opts
dict incr opts -level
return {*}$opts $msg
}
proc WriteIntVar {def gname name1 _name2 _op} {
upvar $name1 var
if {![string is integer -strict $var]} {
set var $def
error "Error: $gname: Only integer values are accepted;\
reset to default: $def"
}
return
}
proc WriteBoolVar {def gname name1 _name2 _op} {
upvar $name1 var
if {![string is boolean -strict $var]} {
set var $def
error "Error: $gname: Only {0 1 false true no yes off on} are\
accepted; reset to default: $def"
}
return
}
proc TraceWrite {varName cmd args} {
set ns [namespace current]
set commandPrefix [linsert $args 0 ${ns}::$cmd]
lappend commandPrefix ${ns}::$varName
uplevel 1 [list trace remove variable $varName write $commandPrefix]
uplevel 1 [list trace add variable $varName write $commandPrefix]
return
}
proc CheckMetadataExists {} {
variable metadata
if {![dict size $metadata]} {
error "Error: Please invoke clash::readMetadata first."
}
return
}
proc GetNsVar {ns varName} {
if {![llength [uplevel 1 [list info vars ${ns}::$varName]]]} {
error "Error: $ns doesn't provide \"$varName\"\
variable."
}
return [uplevel 1 [list set ${ns}::$varName]]
}
proc ParseManifest {entityDir withDeps} {
variable metadata
set manC [open [file join $entityDir clash-manifest.json] r]
set manifest [json::json2dict [read $manC]]
close $manC
set lib [dict get $manifest top_component name]
Log 1 "New top component: $lib"
# Clash sometimes lists files multiple times, process them only once
set seen {}
set topConstraintName [file join $entityDir "${lib}.sdc"]
dict set metadata $lib hdlFiles {}
dict set metadata $lib constraintFiles {}
foreach fileEntry [dict get $manifest files] {
set name [file join $entityDir [dict get $fileEntry name]]
if {$name in $seen} {
continue
}
lappend seen $name
if {$name eq $topConstraintName} {
dict set metadata $lib topConstraintFile $name
} elseif {
[string match {*.vhdl} $name]
|| [string match {*.v} $name]
|| [string match {*.sv} $name]
} then {
Log 3 "Adding HDL file: $name"
dict with metadata $lib {
lappend hdlFiles $name
}
} elseif {
[string match {*.sdc} $name]
|| [string match {*.xdc} $name]
} then {
Log 3 "Adding constraint file: $name"
dict with metadata $lib {
lappend constraintFiles $name
}
} elseif {[string match {*.clash.tcl} $name]} {
Log 3 "Adding Clash<->Tcl API file: $name"
LoadTclIface $lib $name
}
}
RemoveManagedFiles $lib
if {!$withDeps} {
return $lib
}
set dependencies {}
foreach dependency [dict get $manifest dependencies transitive] {
set dependencyDir [file join [file dirname $entityDir] $dependency]
lappend dependencies [ParseManifest $dependencyDir false]
}
dict set metadata $lib dependencies $dependencies
return $lib
}
# Populate a namespace with a Clash-generated Tcl interface.
# Namespace is clash::tclIface::${lib}::$baseName
proc LoadTclIface {lib tclIfaceFile} {
set fileName [file tail $tclIfaceFile]
# Strip all extensions
set baseName [string range $fileName 0 [string first . $fileName]-1]
set tclIface [namespace current]::tclIface::${lib}::$baseName
# Evaluate script code inside temporary throwaway namespace to
# separate its code from ours and reduce the chance of accidentally
# corrupting our code.
namespace eval tmp {}
set tmp::tclIfaceFile $tclIfaceFile
set tmp::tclIface $tclIface
namespace eval tmp {
# -notrace is a Vivado specific option inhibiting the printing of
# the script to stdout
source -notrace $tclIfaceFile
}
if {![namespace exists $tclIface]} {
error "Error: $tclIfaceFile did not create the requested namespace\
specified by the \$tclIface variable. The Tcl script does\
not conform to the defined Clash<->Tcl API."
}
namespace delete tmp
VerifyTclIface $tclIface $tclIfaceFile true
return
}
# Verify that the read interface file is strictly something we support.
proc VerifyTclIface {tclIface tclIfaceFile isRoot} {
set api [GetNsVar $tclIface api]
if {$api ne {1}} {
error "Error: $tclIface doesn't implement an API we support:\
api = \"$api\"."
}
set purpose [GetNsVar $tclIface scriptPurpose]
Log 3 " API level / purpose: $api/$purpose"
if {$purpose eq {multipleScripts}} {
if {!$isRoot} {
error "Error: ${tclIface}::scriptPurpose = \"multipleScripts\",\
nested use not allowed."
}
if {![namespace exists ${tclIface}::multipleScripts]} {
error "Error: ${tclIface}::multipleScripts does not exist."
}
set children [namespace children ${tclIface}::multipleScripts]
if {![llength $children]} {
error "Error: ${tclIface}::multipleScripts doesn't provide any\
scripts."
}
foreach child $children {
if {[llength [info vars ${child}::api]]} {
error "Error: $child cannot specify api: it is specified by\
parent script."
}
set ${child}::api $api
VerifyTclIface $child $tclIfaceFile false
}
} elseif {$purpose eq {createIp}} {
Log 3 " IP name: [GetNsVar $tclIface ipName]"
# In Tcl, you can call procedures with a partial name. So an
# invocation of "createIp" could call "createIpAlt" if
# "createIp" did not exist. Let's be strict here to prevent
# confusion: only accept the exact name "createIp".
if {![llength [info procs ${tclIface}::createIp]]} {
error "Error: $tclIface doesn't provide \"createIp\"\
procedure."
}
LogProc 4 { } ${tclIface}::createIp
} elseif {$purpose eq {readXdc}} {
set order [GetNsVar $tclIface order]
if {$order ni {early normal late}} {
error "Error: ${tclIface}::order bogus value \"$order\"."
}
set usedIn [GetNsVar $tclIface usedIn]
foreach stage $usedIn {
if {$stage ni {synthesis implementation}} {
error "Error: ${tclIface}::usedIn bogus value \"$stage\"."
}
}
set xdcFile [GetNsVar $tclIface xdcFile]
# "file join" also correctly handles an absolute $xdcFile
set resolvedFile [file join [file dirname $tclIfaceFile] $xdcFile]
# "file isfile" also positively matches a symlink to a regular
# file
if {![file isfile $resolvedFile]} {
error "Error: ${tclIface}::xdcFile = \"$xdcFile\" does not\
refer to an existing file."
}
set ${tclIface}::xdcFile $resolvedFile
Log 3 " Constraint file: $resolvedFile"
Log 4 " Order: $order"
if {[llength [info vars ${tclIface}::scopeRef]]} {
namespace upvar ${tclIface} scopeRef scopeRef
Log 4 " Scoped to ref: $scopeRef"
}
Log 4 " Used in: $usedIn"
} else {
error "Error: ${tclIface}::scriptPurpose bogus value \"$purpose\"."
}
return
}
# Remove constraint files that are managed by a Tcl interface script from
# the list of constraint files for the library.
proc RemoveManagedFiles lib {
variable metadata
foreach tclIface [GetAllTclIfaces {libs $lib purposes readXdc}] {
namespace upvar ${tclIface} xdcFile xdcFile
set constraintFiles [dict get $metadata $lib constraintFiles]
if {[lsearch -exact $constraintFiles $xdcFile] >= 0} {
Log 3 "Marking as managed by the Clash<->Tcl API: $xdcFile"
set filtered [lsearch -all -inline -exact -not \
$constraintFiles $xdcFile]
dict set metadata $lib constraintFiles $filtered
}
}
return
}
# Return all the Tcl interface namespaces
#
# They can optionally be filtered by specifying a list of libraries to
# consider, a list of interface names to consider, or a list of script
# purposes to consider. The sole argument of the function is a dictionary of
# options, with the possible keys "libs", "ifaces" and "purposes".
#
# For example, if these two interfaces exist:
# - ::clash::tclIface::libA::ifaceX
# - ::clash::tclIface::libB::ifaceX
#
# Then "GetAllTclIfaces {libs libA}" would only return the first, but
# "GetAllTclIfaces {ifaces ifaceX}" would return both since the interface
# names both match.
proc GetAllTclIfaces {{opts {}}} {
if {![namespace exists tclIface]} {
# There are no scripts
return
}
if {[dict exists $opts libs]} {
set walkLibs {}
foreach lib [dict get $opts libs] {
if {[namespace exists tclIface::$lib]} {
lappend walkLibs tclIface::$lib
}
}
} else {
set walkLibs [namespace children tclIface]
}
set tclIfaces {}
set hasIfaces [dict exists $opts ifaces]
if {$hasIfaces} {
set ifaces [dict get $opts ifaces]
}
set hasPurposes [dict exists $opts purposes]
if {$hasPurposes} {
set purposes [dict get $opts purposes]
}
foreach libNs $walkLibs {
foreach tclIface [namespace children $libNs] {
if {$hasIfaces && [namespace tail $tclIface] ni $ifaces} {
continue
}
namespace upvar ${tclIface} scriptPurpose purpose
if {$purpose ne {multipleScripts}} {
if {(!$hasPurposes) || $purpose in $purposes} {
lappend tclIfaces $tclIface
}
continue
}
set childIfaces \
[namespace children ${tclIface}::multipleScripts]
foreach childIface $childIfaces {
namespace upvar ${childIface} scriptPurpose purpose
if {(!$hasPurposes) || $purpose in $purposes} {
lappend tclIfaces $childIface
}
}
}
}
return $tclIfaces
}
# If Clash generates constraint files without an accompanying tclIface, they
# fall into two categories. Given $lib as the name of the top component in a
# library, ${lib}.sdc contains the "create_clock" statements. We only read
# that for the top entity. All other constraint files are passed to Vivado
# as-is and should match on unique identifiers in the HDL, such that they
# can be read for all libraries without worrying about `current_instance` or
# similar scoping mechanisms.
proc ReadUnmanagedXdc {} {
variable metadata
variable topEntity
if {[dict exists $metadata $topEntity topConstraintFile]} {
set topConstraintFile \
[dict get $metadata $topEntity topConstraintFile]
PerformAction {
read_xdc } -var topConstraintFile
}
set libs [dict get $metadata $topEntity dependencies]
lappend libs $topEntity
foreach lib $libs {
set constraintFiles [dict get $metadata $lib constraintFiles]
foreach constraintFile $constraintFiles {
PerformAction {
read_xdc } -var constraintFile
}
}
}
proc ReadManagedXdc tclIface {
namespace upvar $tclIface xdcFile xdcFile usedIn usedIn
if {[llength [info vars ${tclIface}::scopeRef]]} {
namespace upvar ${tclIface} scopeRef scopeRef
set scopeRefArg [list -ref $scopeRef]
} else {
set scopeRefArg {}
}
PerformAction {
read_xdc } -varexpand scopeRefArg { } -var xdcFile {
set_property USED_IN } -var usedIn { [get_files } -var xdcFile {]
}
return
}
TraceWrite verbosity WriteIntVar 1
TraceWrite dryRun WriteBoolVar false
}