| Line 1... |
Line 1... |
#! /usr/bin/env tclsh
|
#! /usr/bin/env tclsh
|
# -*- tcl -*-
|
# -*- tcl -*-
|
# $Id: ti_rri 440 2011-12-18 20:08:09Z mueller $
|
# $Id: ti_rri 467 2013-01-02 19:49:05Z mueller $
|
#
|
#
|
# Copyright 2011- by Walter F.J. Mueller
|
# Copyright 2011-2013 by Walter F.J. Mueller
|
#
|
#
|
# This program is free software; you may redistribute and/or modify it under
|
# This program is free software; you may redistribute and/or modify it under
|
# the terms of the GNU General Public License as published by the Free
|
# the terms of the GNU General Public License as published by the Free
|
# Software Foundation, either version 2, or at your option any later version.
|
# Software Foundation, either version 2, or at your option any later version.
|
#
|
#
|
| Line 13... |
Line 13... |
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# for complete details.
|
# for complete details.
|
#
|
#
|
# Revision History:
|
# Revision History:
|
# Date Rev Version Comment
|
# Date Rev Version Comment
|
|
# 2013-01-02 467 1.1.1 call rlc close only when really open
|
|
# 2012-12-27 465 1.1 add --cuff support
|
|
# 2012-02-09 457 1.0.4 disable autoexec
|
# 2011-12-19 440 1.0.3 re-organize option handling for --term and --fifo
|
# 2011-12-19 440 1.0.3 re-organize option handling for --term and --fifo
|
# 2011-12-04 435 1.0.2 add flow attribute to --term
|
# 2011-12-04 435 1.0.2 add flow attribute to --term
|
# 2011-04-22 379 1.0.1 check for RETROBASE; proper exit handling; help text
|
# 2011-04-22 379 1.0.1 check for RETROBASE; proper exit handling; help text
|
# 2011-04-17 376 1.0 Initial version
|
# 2011-04-17 376 1.0 Initial version
|
# 2011-03-19 371 0.1 First draft
|
# 2011-03-19 371 0.1 First draft
|
#
|
#
|
#
|
#
|
# --fifo[=name,opts,...]
|
# --fifo[=name,opts,...]
|
# --term[=name,baud,opts,...]
|
# --term[=name,baud,opts,...]
|
|
# --cuff[=name,...]
|
# --run=command
|
# --run=command
|
# --log=filename ; default "-"
|
# --log=filename ; default "-"
|
# --logl=n ; default 2
|
# --logl=n ; default 2
|
# --dmpl=n ; default 0
|
# --dmpl=n ; default 0
|
# --tiol=n ; default 0
|
# --tiol=n ; default 0
|
| Line 39... |
Line 43... |
array set opts {
|
array set opts {
|
fifo 0
|
fifo 0
|
fifo_ ""
|
fifo_ ""
|
term 0
|
term 0
|
term_ ""
|
term_ ""
|
|
cuff 0
|
|
cuff_ ""
|
run_ ""
|
run_ ""
|
log_ "-"
|
log_ "-"
|
logl_ 2
|
logl_ 2
|
dmpl_ 0
|
dmpl_ 0
|
tiol_ 0
|
tiol_ 0
|
| Line 52... |
Line 58... |
|
|
set clist {}
|
set clist {}
|
set optsendseen 0
|
set optsendseen 0
|
set runpid {}
|
set runpid {}
|
|
|
|
# disable autoexec
|
|
set auto_noexec 1
|
|
|
#
|
#
|
# cleanup handler
|
# cleanup handler
|
# must be in a proc so that it can be called from tclreadline
|
# must be in a proc so that it can be called from tclreadline
|
# must be defined before ::tclreadline::Loop called (all after ignored...)
|
# must be defined before ::tclreadline::Loop called (all after ignored...)
|
#
|
#
|
proc exit_cleanup {} {
|
proc exit_cleanup {} {
|
global opts
|
global opts
|
global runpid
|
global runpid
|
|
|
# now close rlink connection
|
# now close rlink connection
|
if { $opts(fifo) || $opts(term) } {
|
if { $opts(fifo) || $opts(term) || $opts(cuff) } {
|
rlc close
|
if { [rlc open] ne "" } { rlc close }
|
}
|
}
|
|
|
# FIXME_code: should sync here with -run process run-down
|
# FIXME_code: should sync here with -run process run-down
|
# but no wait available in tcl (grr...)
|
# but no wait available in tcl (grr...)
|
if { "$runpid" ne "" } {
|
if { "$runpid" ne "" } {
|
| Line 82... |
Line 91... |
continue
|
continue
|
}
|
}
|
switch -regexp -- $arg {
|
switch -regexp -- $arg {
|
^--?fifo=?.*$ { set opts(fifo) 1; regexp -- {=(.*)} $arg dummy opts(fifo_) }
|
^--?fifo=?.*$ { set opts(fifo) 1; regexp -- {=(.*)} $arg dummy opts(fifo_) }
|
^--?term=?.*$ { set opts(term) 1; regexp -- {=(.*)} $arg dummy opts(term_) }
|
^--?term=?.*$ { set opts(term) 1; regexp -- {=(.*)} $arg dummy opts(term_) }
|
|
^--?cuff=?.*$ { set opts(cuff) 1; regexp -- {=(.*)} $arg dummy opts(cuff_) }
|
^--?run=.+$ { regexp -- {=(.*)} $arg dummy opts(run_) }
|
^--?run=.+$ { regexp -- {=(.*)} $arg dummy opts(run_) }
|
^--?log=.+$ { regexp -- {=(.*)} $arg dummy opts(log_) }
|
^--?log=.+$ { regexp -- {=(.*)} $arg dummy opts(log_) }
|
^--?logl=.+$ { regexp -- {=(.*)} $arg dummy opts(logl_) }
|
^--?logl=.+$ { regexp -- {=(.*)} $arg dummy opts(logl_) }
|
^--?dmpl=.+$ { regexp -- {=(.*)} $arg dummy opts(dmpl_) }
|
^--?dmpl=.+$ { regexp -- {=(.*)} $arg dummy opts(dmpl_) }
|
^--?tiol=.+$ { regexp -- {=(.*)} $arg dummy opts(tiol_) }
|
^--?tiol=.+$ { regexp -- {=(.*)} $arg dummy opts(tiol_) }
|
| Line 105... |
Line 115... |
puts {}
|
puts {}
|
puts {Options:}
|
puts {Options:}
|
puts { --run=CMD exec's CMD as subprocess before the rlink port opened}
|
puts { --run=CMD exec's CMD as subprocess before the rlink port opened}
|
puts { useful to start test benches, usually via 'tbw'}
|
puts { useful to start test benches, usually via 'tbw'}
|
puts { --fifo[=ARGS] open fifo type rlink port. Optional arguments are:}
|
puts { --fifo[=ARGS] open fifo type rlink port. Optional arguments are:}
|
puts { --fifo=[NAME[,KEEP]]}
|
puts { --fifo=[NAME[,OPTS]]}
|
puts { NAME fifo name prefix, default 'rlink_cext_fifo'}
|
puts { NAME fifo name prefix, default 'rlink_cext_fifo'}
|
puts { OPTS further options (comma separated list):}
|
puts { OPTS further options (comma separated list):}
|
puts { keep fifo is kept open on exit}
|
puts { keep fifo is kept open on exit}
|
puts { --term[=ARGS] open term type rlink port. Optional arguments are:}
|
puts { --term[=ARGS] open term type rlink port. Optional arguments are:}
|
puts { --term=[NAME[,BAUD[,OPTS]]]}
|
puts { --term=[NAME[,BAUD[,OPTS]]]}
|
| Line 126... |
Line 136... |
puts { 3000000, 3000k, 3M, 4000000, 4000k, 4M}
|
puts { 3000000, 3000k, 3M, 4000000, 4000k, 4M}
|
puts { OPTS further options (comma separated list):}
|
puts { OPTS further options (comma separated list):}
|
puts { break send a break, do autobaud}
|
puts { break send a break, do autobaud}
|
puts { cts hardware flow control (cts/rts)}
|
puts { cts hardware flow control (cts/rts)}
|
puts { xon software flow control (xon/xoff)}
|
puts { xon software flow control (xon/xoff)}
|
|
puts { --cuff[=ARGS] open cuff type rlink port. Optional arguments are:}
|
|
puts { --cuff=[NAME[,OPTS]]}
|
|
puts { NAME USB path, default derived from environment}
|
|
puts { variables RETRO_FX2_VID and RETRO_FX2_PID}
|
|
puts { OPTS further options (comma separated list):}
|
|
puts { trace trace USB activities}
|
puts { --log=FILE set log file name. Default is to write to stdout.}
|
puts { --log=FILE set log file name. Default is to write to stdout.}
|
puts { --logl=LVL set log level, default is '2' allowed values:}
|
puts { --logl=LVL set log level, default is '2' allowed values:}
|
puts { 0 no logging}
|
puts { 0 no logging}
|
puts { 1 log rlink commands with communication errors}
|
puts { 1 log rlink commands with communication errors}
|
puts { 2 log rlink commands with failed checks}
|
puts { 2 log rlink commands with failed checks}
|
| Line 155... |
Line 171... |
if {![info exists env(RETROBASE)]} {
|
if {![info exists env(RETROBASE)]} {
|
puts "-E: RETROBASE environment variable not defined"
|
puts "-E: RETROBASE environment variable not defined"
|
return 1
|
return 1
|
}
|
}
|
|
|
if { $opts(fifo) && $opts(term) } {
|
set nopen 0;
|
puts "-E: both --fifo and --term given, only one allowed"
|
if { $opts(fifo) } { incr nopen }
|
|
if { $opts(term) } { incr nopen }
|
|
if { $opts(cuff) } { incr nopen }
|
|
|
|
if { $nopen > 1 } {
|
|
puts "-E: more than one of --fifo,--term,--cuff given, only one allowed"
|
return 1
|
return 1
|
}
|
}
|
|
|
lappend auto_path [file join $env(RETROBASE) tools tcl]
|
lappend auto_path [file join $env(RETROBASE) tools tcl]
|
lappend auto_path [file join $env(RETROBASE) tools lib]
|
lappend auto_path [file join $env(RETROBASE) tools lib]
|
| Line 217... |
Line 238... |
}
|
}
|
# puts "-I: $url"
|
# puts "-I: $url"
|
rlc open $url
|
rlc open $url
|
}
|
}
|
|
|
|
# handle --cuff
|
|
if { $opts(cuff) } {
|
|
set nlist [split $opts(cuff_) ","]
|
|
set path [lindex $nlist 0]
|
|
set url "cuff:$path"
|
|
set delim "?"
|
|
foreach opt [lrange $nlist 1 end] {
|
|
if {$opt ne ""} {append url "$delim$opt"}
|
|
set delim ";"
|
|
}
|
|
# puts "-I: $url"
|
|
rlc open $url
|
|
}
|
|
|
# setup simulation mode default
|
# setup simulation mode default
|
set rlink::sim_mode [rlink::isfifo]
|
set rlink::sim_mode [rlink::isfifo]
|
|
|
foreach cmd $clist {
|
foreach cmd $clist {
|
# handle @filename commands
|
# handle @filename commands
|
