# twopass.tcl:
#
# This file is sourced by haltcl when the inifile item HAL:TWOPASS
# is present and it evaluates all inifile HAL:HALFILE items in two passes.
# HALFILE items may be halcmd files (.hal) or .tcl files
#
# pass0:
# All HAL:HALFILEs are read.
# loadrt, loadusr commands are combined and executed at the end
# of pass0 loadrt commands may be invoked multiple times for the
# same mod_name. The "count=", "num_chan=", and "names=" forms for
# loadrt are supported but are mutually exclusive for each module.
# addf commands are deferred to pass1
#
# Some components (viz. pid) support a debug=dbg specifier on the
# loadrt line. dbg values are ORed together.
#
# pass1:
# All HAL:HALFILES are reread, commands (except the loadrt and
# loadusr completed commands) are executed and addf commands
# are executed in order of occurrence.
#
# The inifile item HAL:TWOPASS can be any non-null string. This string
# can be used to pass keywords for supported options:
# verbose -- enables extra reporting
# nodelete -- disables deletion of temporary tcl files that
# are created from .hal files
#
# A few internal procs are useful by HALFILE tcl scripts:
#
# ::tp::passnumber returns 0 | 1 for the current pass number
# ::tp::no_puts disable the tcl "puts" command
# ::tp::alter_puts alters the tcl "puts" command so that it
# reports <pass0> or <pass1>
# ::tp::restore_puts restores the tcl "puts" command
#
#--------------------------------------------------------------------------
# Copyright: 2011
# Author: Dewey Garrett <dgarrett@panix.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#--------------------------------------------------------------------------
namespace eval ::tp {
namespace export passnumber
}
set ::TP(combine_addfs) 0 ;# alternate 1 ==> all addfs at end of pass1
#--------------------------------------------------------------------------
proc ::tp::passnumber {} {
return $::TP(passnumber)
} ;# passnumber
proc ::tp::no_puts {} {
rename puts orig_puts
proc puts {args} {}
} ;# no_puts
proc ::tp::alter_puts {} {
# puts ?-nonewline? ?channelId? string
rename puts orig_puts
switch [passnumber] {
0 { proc puts {args} {
set args [lreplace $args end end "<pass0> [lindex $args end]"]
eval orig_puts "$args"
}
}
1 { proc puts {args} {
set args [lreplace $args end end "<pass1> [lindex $args end]"]
eval orig_puts "$args"
}
}
default {return -code error "alter_puts: unknown passno <$passno>"}
}
} ;# alter_puts
proc ::tp::restore_puts {} {
rename puts {}
rename orig_puts puts
} ;# restore_puts
#--------------------------------------------------------------------------
proc ::tp::loadusr_substitute {args} {
set pass [passnumber]
#puts "loadusr_substitute<$pass> <$args>"
if {$pass == 0} {
#puts "loadusr_substitute<$pass> ignored"
} else {
eval orig_loadusr $args
}
} ;# loadusr_substitute
proc ::tp::loadrt_substitute {args} {
# syntax: loadrt modulename item=value ...
set parms [split $args]
set module [lindex $parms 0]
set pass [passnumber]
#puts "loadrt_substitute<$pass> <$parms>"
# keep track of loadrt for each module in order to detect
# unsupportable loadrt calls in pass1. The ct is the number of
# loadrt calls not the count total module instances
if ![info exists ::TP($module,$pass,ct)] {
set ::TP($module,$pass,ct) 1
} else {
incr ::TP($module,$pass,ct) 1
}
if {[lsearch -exact $::TP(loaded,modules) $module] >= 0} {
if {$pass == 0} {
return -code error "loadrt_substitute: <$module> already loaded"
} else {
if {$::TP($module,1,ct) > $::TP($module,0,ct)} {
puts "loadrt_substitute:<$pass> Ignoring loadrt,\
$module already loaded:"
puts " <loadrt $parms>"
}
return
}
}
if {$pass > 0} {
eval orig_loadrt $parms
return
}
# pass0 only follows ------------------------------------
if ![info exists ::TP(modules)] {
lappend ::TP(modules) $module
} else {
if {[lsearch -exact $::TP(modules) $module] < 0} {
lappend ::TP(modules) $module
}
}
set parms [lreplace $parms 0 0]
foreach pair $parms {
set l [split $pair =]
set item [lindex $l 0]
set value [lindex $l 1]
if {("$item"=="count") || ("$item"=="num_chan") || ("$item"=="names")} {
if ![info exists ::TP($module,form)] {
set ::TP($module,form) $item
} else {
if {$::TP($module,form) != "$item"} {
return -code error \
"loadrt_substitute: cannot mix count=, num_chan= and names= forms\
(module=$module, first used form=$::TP($module,form)"
}
}
}
switch "$item" {
count {
if ![info exists ::TP($module,count)] {
set ::TP($module,count) $value
} else {
incr ::TP($module,count) $value
}
}
num_chan {
if ![info exists ::TP($module,num_chan)] {
set ::TP($module,num_chan) $value
} else {
incr ::TP($module,num_chan) $value
}
}
names {
if ![info exists ::TP($module,names)] {
set ::TP($module,names) $value
} else {
set ::TP($module,names) "$::TP($module,names),$value"
}
}
debug {
if ![info exists ::TP($module,debug)] {
set ::TP($module,debug) $value
} else {
# the pid component uses debug>1 to cause export
# of additional pins (for all instances)
#
# here, logical OR multiple specifiers of debug=
# so any setting of debug=1 will be honored (for
# all instances)
set ::TP($module,debug) [expr $::TP($module,debug) | $value]
}
}
default {
if ![info exists ::TP($module,other)] {
set ::TP($module,other) $pair
} else {
set ::TP($module,other) "$::TP($module,other) $pair"
}
}
}
} ;# foreach pair
} ;# loadrt_substitute
proc ::tp::addf_substitute {args} {
# syntax: addf func thread position
set pass [passnumber]
if {$pass == 0} {
lappend ::TP(addf) $args
#puts "addf_substitute:<$pass> Deferring <$args>"
} else {
#puts "addf_substitute:<$pass> Ignoring <$args>"
}
} ;# addf_substitute
proc ::tp::hide_cmds {} {
set ::TP(cmds) [hal --commands]
set ::TP(nochange,cmds) {addf loadrt loadusr source}
rename loadusr orig_loadusr
rename loadusr_substitute loadusr
rename loadrt orig_loadrt
rename loadrt_substitute loadrt
rename addf orig_addf
rename addf_substitute addf
foreach cmd $::TP(cmds) {
if {[lsearch -exact $::TP(nochange,cmds) $cmd] >= 0} continue
rename $cmd orig_$cmd
#puts "hide_cmds: renamed $cmd"
#proc $cmd {args} [subst {puts "DUMMY $cmd <\$args>"}]
proc $cmd {args} return
}
} ;# hide_cmds
proc ::tp::unhide_cmds {} {
foreach cmd $::TP(cmds) {
if {[lsearch -exact $::TP(nochange,cmds) $cmd] >= 0} continue
rename $cmd {}
rename orig_$cmd $cmd
}
if {!$::TP(combine_addfs)} {
# execute addf in place
rename addf addf_done
rename orig_addf addf
}
} ;# unhide_cmds
proc ::tp::pass0 {} {
verbose "pass0:BEGIN"
if [info exists ::TP(passnumber)] {
return -code error "pass0: unexpected passnumber <$::TP(passnumber)>"
}
set ::TP(passnumber) 0
prep_the_files
set ::TP(loaded,modules) ""
hide_cmds
source_the_files
load_the_modules
unhide_cmds
verbose "pass0:END"
} ;# pass0
proc ::tp::prep_the_files {} {
set passno [passnumber]
if {$passno == 0} {
# first convert if necessary
foreach f $::HAL(HALFILE) {
set suffix [filesuffix $f]
switch -exact $suffix {
tcl {lappend ::TP(runfiles) $f
verbose "tclfile: $f"
}
hal {set ::TP($f,tmp) /tmp/[file tail $f].tmp
verbose "convert $f to $::TP($f,tmp)"
hal_to_tcl $f $::TP($f,tmp)
lappend ::TP(runfiles) $::TP($f,tmp)
set ::TP(origfile,$::TP($f,tmp)) $f
}
default {return -code error \
"source_the_files:unknown file type <$suffix>"}
}
}
}
} ;# prep_the_files
proc ::tp::hal_to_tcl {ifile ofile} {
# When hal files are specified with HAL:HALFILE,
# try to make them work (preferred way is use tcl files).
# This could probably be done with one regularexpression
# Some hal commands conflict with tcl commands.
# Converting a standard hal file here, so a warning is issued
# if the possible use of one of these commands is detected.
# Doubtful these are used much in .hal files to configure.
# I couldn't find any usage examples.
set ::TP(conflictwords) {list gets}
# in a .tcl file, use "hal list" and "hal gets" instead
if [catch {set fdin [open $ifile r]
set fdout [open $ofile w]
} msg
] {
puts "twopass: Error: $msg"
exit 1
}
puts $fdout "# temporary tcl file generated by twopass.tcl"
set lno 0
while 1 {
if [eof $fdin] break
incr lno
set theline [gets $fdin]
set line [string trim $theline]
if {"$line" == ""} continue
if {[string first # $line] == 0} continue
foreach suspect $::TP(conflictwords) {
if { ([string first "$suspect " $line] == 0)
|| ([string first " $suspect " $line] >= 0)
} {
puts "hal_to_tcl:WARNING in file $ifile, line $lno: \"$suspect\"\
conflicts with tcl usage"
puts "$lno:<$theline>"
}
}
set idx 0
while {$idx >= 0} {
set l [string first \[ $line $idx]
if {$l < 0} break
set r [string first \] $line $idx]
if {$r < 0} break
set stanza [string range $line [expr $l + 1] [expr $r -1]]
set new "[string range $line 0 [expr $l -1]]"
set new "${new}\$::$stanza\("
set s [string first " " $line $r]
if {$s <0} {
set item [string range $line [expr $r + 1] end]
set line "${new}${item}\) "
set idx -1
} else {
set item [string range $line [expr $r + 1] [expr $s -1]]
set new "${new}${item}\) "
set idx [expr [string length $new] -1]
set new "${new}[string range $line [expr $s +1] end]"
set line $new
}
}
# Anything following "#" on a line is a comment
set cidx [string first "#" $line]
if {$cidx > 0} {
set notcomment "[string range $line 0 [expr -1 + $cidx]]"
set comment ";[string range $line $cidx end]"
set line "$notcomment$comment"
}
puts $fdout $line
if {[string trim "$theline"] != [string trim "$line"]} {
verbose "converted hal line for tcl from $ifile:"
verbose " hal: $theline"
verbose " tcl: $line"
}
}
close $fdin
close $fdout
return $ofile
} ;# hal_to_tcl
proc ::tp::source_the_files {} {
foreach f $::TP(runfiles) {
verbose "sourcing: $f"
set errct 0
if [catch {source $f} msg] {
if [info exists ::TP(origfile,$f)] {
set f $::TP(origfile,$f)
}
puts "twopass: Error in file $f:\n $msg"
incr errct
}
}
if {$errct} {
exit 1
}
} ;# source_the_files
proc ::tp::filesuffix {f} {
set dot [string last . $f]
if {$dot < 0} {return -code error "filesuffix: no suffix <$f>"}
return [string range $f [expr 1 + $dot ] end]
} ;# filesuffix
proc ::tp::load_the_modules {} {
foreach m $::TP(modules) {
set cmd "orig_loadrt $m" ;# this is the real loadrt
if [info exists ::TP($m,count)] {
set cmd "$cmd count=$::TP($m,count)"
} elseif [info exists ::TP($m,num_chan)] {
set cmd "$cmd num_chan=$::TP($m,num_chan)"
} elseif [info exists ::TP($m,names)] {
set cmd "$cmd names=$::TP($m,names)"
}
if [info exists ::TP($m,debug)] {
set cmd "$cmd debug=$::TP($m,debug)"
}
if [info exists ::TP($m,other)] {
set cmd "$cmd $::TP($m,other)"
}
verbose "[string range $cmd 5 end]" ;# omit leading orig_
eval $cmd
}
set ::TP(loaded,modules) $::TP(modules)
set ::TP(modules) ""
} ;# load_the_modules
proc ::tp::addf_the_funcs {} {
foreach args $::TP(addf) {
eval orig_addf $args
}
} ;# addf_the_funcs
proc ::tp::pass1 {} {
verbose "pass1:BEGIN"
incr ::TP(passnumber)
source_the_files
if {$::TP(combine_addfs)} {
# execute all addf's at end of pass1
addf_the_funcs
}
foreach name [array names ::TP *,tmp] {
if $::tp::nodelete {
verbose "nodelete: $::TP($name)"
} else {
verbose "deleting: $::TP($name)"
file delete $::TP($name)
}
}
verbose "pass1:END"
} ;# pass1
proc ::tp::verbose {msg} {
if !$::tp::verbose return
puts "twopass: $msg"
} ;# verbose
set ::tp::options ""
set ::tp::verbose 0
if {[string first verbose [string tolower $::HAL(TWOPASS)]] >=0} {
set ::tp::verbose 1
lappend ::tp::options verbose
}
set ::tp::nodelete 0
if {[string first nodelete [string tolower $::HAL(TWOPASS)]] >=0} {
set ::tp::nodelete 1
lappend ::tp::options nodelete
}
puts "twopass: invoked with <$::tp::options> options"
::tp::pass0
::tp::pass1