| Line 1... |
Line 1... |
#! /usr/bin/env tclsh
|
#! /usr/bin/env tclsh
|
# -*- tcl -*-
|
# -*- tcl -*-
|
# $Id: ti_rri 511 2013-04-27 13:51:46Z mueller $
|
# $Id: ti_rri 522 2013-05-24 17:50:29Z mueller $
|
#
|
#
|
# Copyright 2011-2013 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
|
| 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-05-19 521 1.1.6 setup proper interactive handling; add --run reap
|
# 2013-04-26 510 1.1.5 reorganize readline startup
|
# 2013-04-26 510 1.1.5 reorganize readline startup
|
# 2013-04-12 504 1.1.4 add --pack; trailing '-' argv implies --int
|
# 2013-04-12 504 1.1.4 add --pack; trailing '-' argv implies --int
|
# 2013-02-05 482 1.1.3 stop server is rls found
|
# 2013-02-05 482 1.1.3 stop server is rls found
|
# 2013-01-27 478 1.1.2 use 'exec sh -c $cmd &' for --run implementation
|
# 2013-01-27 478 1.1.2 use 'exec sh -c $cmd &' for --run implementation
|
# 2013-01-02 467 1.1.1 call rlc close only when really open
|
# 2013-01-02 467 1.1.1 call rlc close only when really open
|
| Line 90... |
Line 91... |
|
|
# 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 "" } {
|
after 100; # currently just wait 100ms
|
after 100; # currently just wait 100ms
|
|
rutil::waitpid $runpid
|
}
|
}
|
if { $doexit } {
|
if { $doexit } {
|
puts {}; # \n to ensure shell prompt on new line
|
puts {}; # \n to ensure shell prompt on new line
|
exit
|
exit
|
}
|
}
|
| Line 142... |
Line 144... |
puts { PLIST is comma separated list of package names}
|
puts { PLIST is comma separated list of package names}
|
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[,OPTS]]}
|
puts { --fifo=[NAME[,OPTS]]}
|
puts { NAME fifo name prefix, default 'rlink_cext_fifo'}
|
|
puts { OPTS further options (comma separated list):}
|
|
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]]]}
|
puts { NAME tty device name, default 'USB0'}
|
|
puts { if not starting with '/' the name is}
|
|
puts { prefixed with '/dev/tty'}
|
|
puts { BAUD serial port baud rate, default '115k'}
|
|
puts { allowed baud rate settings are:}
|
|
puts { 2400, 4800, 9600, 19200, 19k, 38400, 38k}
|
|
puts { 57600, 57k, 115200, 115k, 230400, 230k}
|
|
puts { 460800, 460k, 500000, 500k, 921600, 921k}
|
|
puts { 1000000, 1000k, 1M, 1500000, 1500k}
|
|
puts { 2000000, 2000k, 2M, 2500000, 2500k}
|
|
puts { 3000000, 3000k, 3M, 4000000, 4000k, 4M}
|
|
puts { OPTS further options (comma separated list):}
|
|
puts { break send a break, do autobaud}
|
|
puts { cts hardware flow control (cts/rts)}
|
|
puts { xon software flow control (xon/xoff)}
|
|
puts { --cuff[=ARGS] open cuff type rlink port. Optional arguments are:}
|
puts { --cuff[=ARGS] open cuff type rlink port. Optional arguments are:}
|
puts { --cuff=[NAME[,OPTS]]}
|
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 0-3.}
|
puts { 0 no logging}
|
|
puts { 1 log rlink commands with communication errors}
|
|
puts { 2 log rlink commands with failed checks}
|
|
puts { 3 log all rlink commands}
|
|
puts { --dmpl=LVL set dump level, default is '0', values like logl}
|
puts { --dmpl=LVL set dump level, default is '0', values like logl}
|
puts { --tiol=LVL set i/o trace level, default is '0', allowed values:}
|
puts { --tiol=LVL set i/o trace level, default is '0', allowed 0-2.}
|
puts { 0 no i/o trace}
|
|
puts { 1 trace buffer activities}
|
|
puts { 2 trace character activities}
|
|
puts { --int enter interactive mode even when commands given}
|
puts { --int enter interactive mode even when commands given}
|
puts { --help display this help and exit}
|
puts { --help display this help and exit}
|
puts { -- all following arguments are treated as tcl commands}
|
puts { -- all following arguments are treated as tcl commands}
|
puts {}
|
puts {}
|
puts {Command handling:}
|
puts {Command handling:}
|
| Line 208... |
Line 181... |
if { $nopen > 1 } {
|
if { $nopen > 1 } {
|
puts "-E: more than one of --fifo,--term,--cuff given, only one allowed"
|
puts "-E: more than one of --fifo,--term,--cuff given, only one allowed"
|
return 1
|
return 1
|
}
|
}
|
|
|
|
# setup auto path
|
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]
|
|
|
package require rlink
|
# setup default packages
|
package require rutiltpp
|
package require rutiltpp
|
package require rlinktpp
|
package require rlinktpp
|
|
package require rlink
|
|
|
|
# setup signal handling
|
|
rutil::sigaction -init
|
|
|
|
# setup connect and server objects
|
rlinkconnect rlc
|
rlinkconnect rlc
|
rlinkserver rls rlc
|
rlinkserver rls rlc
|
|
|
# load additional packages (if -pack given)
|
# load additional packages (if -pack given)
|
if { $opts(pack_) ne "" } {
|
if { $opts(pack_) ne "" } {
|
| Line 299... |
Line 278... |
# if tclsh runs a script given on the command line or is invoked
|
# if tclsh runs a script given on the command line or is invoked
|
# like here via a shebang the tcl_interactive is always set to 0
|
# like here via a shebang the tcl_interactive is always set to 0
|
# so we have to check whether stdin/stdout is a terminal and set
|
# so we have to check whether stdin/stdout is a terminal and set
|
# tcl_interactive accordingly
|
# tcl_interactive accordingly
|
|
|
# FIXME_code: fstat not available (grr...), currently just assume istty
|
set tcl_interactive [rutil::isatty STDIN]
|
set tcl_interactive 1
|
|
|
|
# determine whether interactive mode, if yes, initialize readline
|
# determine whether interactive mode, if yes, initialize readline
|
if {$opts(int) || [llength $clist] == 0 } {
|
if {$tcl_interactive && ($opts(int) || [llength $clist] == 0) } {
|
set tirri_interactive 1
|
set tirri_interactive 1
|
|
|
package require tclreadline
|
package require tclreadline
|
namespace eval tclreadline {
|
namespace eval tclreadline {
|
proc prompt1 {} {
|
proc prompt1 {} {
|
| Line 347... |
Line 325... |
break
|
break
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
|
if { $tcl_interactive && $tirri_interactive } {
|
if { $tirri_interactive } {
|
|
::tclreadline::Loop
|
::tclreadline::Loop
|
} else {
|
} else {
|
tirri_exit 0
|
tirri_exit 0
|
}
|
}
|
|
|
