URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [rtos/] [ecos-2.0/] [packages/] [io/] [usb/] [slave/] [v2_0/] [host/] [usbhost.tcl] - Blame information for rev 174

Details | Compare with Previous | View Log


# {{{  Banner                                           
 
#===============================================================================
#
#    usbhost.tcl
#
#    Support for USB testing
#
#===============================================================================
#####ECOSGPLCOPYRIGHTBEGIN####
## -------------------------------------------
## This file is part of eCos, the Embedded Configurable Operating System.
## Copyright (C) 1998, 1999, 2000, 2001, 2002 Red Hat, Inc.
##
## eCos 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 or (at your option) any later version.
##
## eCos 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 eCos; if not, write to the Free Software Foundation, Inc.,
## 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
##
## As a special exception, if other files instantiate templates or use macros
## or inline functions from this file, or you compile this file and link it
## with other works to produce a work based on this file, this file does not
## by itself cause the resulting work to be covered by the GNU General Public
## License. However the source code for this file must still be made available
## in accordance with section (3) of the GNU General Public License.
##
## This exception does not invalidate any other reasons why a work based on
## this file might be covered by the GNU General Public License.
##
## Alternative licenses for eCos may be arranged by contacting Red Hat, Inc.
## at http://sources.redhat.com/ecos/ecos-license/
## -------------------------------------------
#####ECOSGPLCOPYRIGHTEND####
#===============================================================================
######DESCRIPTIONBEGIN####
#
# Author(s):    bartv
# Date:         2001-07-04
# Purpose:      To provide higher-level utility commands for performing
#               USB testing, and to iterate through the various test scripts
#               specified on the command line.
#
#####DESCRIPTIONEND####
#===============================================================================
#
 
# }}}
 
# {{{  Endpoint data                                    
 
# Given the raw endpoint data provided by the C code, turn
# it something more usable from inside Tcl scripts.
namespace eval usbtest {
    array set control {}
 
    variable bulk_in_endpoints [list]
    array set bulk_in {}
    variable bulk_out_endpoints [list]
    array set bulk_out {}
 
    variable isochronous_in_endpoints [list]
    array set isochronous_in {}
    variable isochronous_out_endpoints [list]
    array set isochronous_out {}
 
    variable interrupt_in_endpoints [list]
    array set interrupt_in {}
    variable interrupt_out_endpoints [list]
    array set interrupt_out {}
 
    for { set i 0 } { $i < $usbtest::endpoint_count } { incr i } {
        switch -- $usbtest::endpoint_data($i,type) {
            "control" {
                set usbtest::control(min_size) $usbtest::endpoint_data($i,min_size)
                set usbtest::control(max_size) $usbtest::endpoint_data($i,max_size)
            }
 
            "bulk" {
                set number $usbtest::endpoint_data($i,number)
                if { "in" == $usbtest::endpoint_data($i,direction) } {
                    lappend usbtest::bulk_in_endpoints $number
                    set usbtest::bulk_in($number,min_size)              $usbtest::endpoint_data($i,min_size)
                    set usbtest::bulk_in($number,max_size)              $usbtest::endpoint_data($i,max_size)
                    set usbtest::bulk_in($number,max_in_padding)        $usbtest::endpoint_data($i,max_in_padding)
                    set usbtest::bulk_in($number,devtab)                $usbtest::endpoint_data($i,devtab)
                } else {
                    lappend usbtest::bulk_out_endpoints $number
                    set usbtest::bulk_out($number,min_size)             $usbtest::endpoint_data($i,min_size)
                    set usbtest::bulk_out($number,max_size)             $usbtest::endpoint_data($i,max_size)
                    set usbtest::bulk_out($number,devtab)               $usbtest::endpoint_data($i,devtab)
                }
            }
 
            "isochronous" {
                set number $usbtest::endpoint_data($i,number)
                if { "in" == $usbtest::endpoint_data($i,direction) } {
                    lappend usbtest::isochronous_in_endpoints $number
                    set usbtest::isochronous_in($number,min_size)       $usbtest::endpoint_data($i,min_size)
                    set usbtest::isochronous_in($number,max_size)       $usbtest::endpoint_data($i,max_size)
                    set usbtest::isochronous_in($number,devtab)         $usbtest::endpoint_data($i,devtab)
                } else {
                    lappend usbtest::isochronous_out_endpoints $number
                    set usbtest::isochronous_out($number,min_size)      $usbtest::endpoint_data($i,min_size)
                    set usbtest::isochronous_out($number,max_size)      $usbtest::endpoint_data($i,max_size)
                    set usbtest::isochronous_out($number,devtab)        $usbtest::endpoint_data($i,devtab)
                }
            }
 
            "interrupt" {
                set number $usbtest::endpoint_data($i,number)
                if { "in" == $usbtest::endpoint_data($i,direction) } {
                    lappend usbtest::interrupt_in_endpoints $number
                    set usbtest::interrupt_in($number,min_size)         $usbtest::endpoint_data($i,min_size)
                    set usbtest::interrupt_in($number,max_size)         $usbtest::endpoint_data($i,max_size)
                    set usbtest::interrupt_in($number,devtab)           $usbtest::endpoint_data($i,devtab)
                } else {
                    lappend usbtest::interrupt_out_endpoints $number
                    set usbtest::interrupt_out($number,min_size)        $usbtest::endpoint_data($i,min_size)
                    set usbtest::interrupt_out($number,max_size)        $usbtest::endpoint_data($i,max_size)
                    set usbtest::interrupt_out($number,devtab)          $usbtest::endpoint_data($i,devtab)
                }
            }
 
            default {
                puts stderr "Internal error: invalid endpoint type $usbtest::endpoint_data($i,type)"
                exit 1
            }
        }
    }
}
 
# }}}
# {{{  Constants                                        
 
# The C code expects to receive certain data as simple numbers,
# corresponding to #define's in common.c and elsewhere. Strictly
# speaking it would be better to pass strings to the C code and
# have it do the translation, thus ensuring that these constants
# exist in only one place.
 
namespace eval usbtest {
 
    variable _USB_DIR_IN        0x0080
    variable _DATA_NONE              0
    variable _DATA_BYTE_FILL         1
    variable _DATA_WORD_FILL         2
    variable _DATA_BYTE_GEN          3
    variable _DATA_WORD_GEN          4
    variable _IO_MECHANISM_USB       1
    variable _IO_MECHANISM_DEV       2
}
 
# It is also desirable to have some constants corresponding
# to common random number generators.
namespace eval usbtest {
    variable MULTIPLIER        1103515245
    variable INCREMENT              12345
}
 
# }}}
# {{{  Argument processing                              
 
# ----------------------------------------------------------------------------
# Given a list of arguments of the form "xyzzy=123" or "xyzzy 123", and
# an array arguments containing entries such as arguments(xyzzy) and
# already filled in with default values, update the array using the
# actual arguments
namespace eval usbtest {
 
    proc process_arguments { list array_ref } {
        upvar $array_ref array
        array set defined_args [list]
 
        set listlen [llength $list]
        for { set index 0 } { $index < $listlen } { incr index } {
            set arg [lindex $list $index]
            set found 0
            foreach name [array names array] {
                set len [string length $name]
                if { [string equal -length $len $name $arg] } {
                    # Partial match found.
                    if { [string equal $name $arg] } {
                        # Exact match found, The value must be the next arg.
                        if { [info exists defined_args($name)] } {
                            error "Argument $name should be specified only once"
                        }
                        incr index
                        if { $index >= $listlen } {
                            error "Missing value after argument $name"
                        }
                        set array($name) [lindex $list $index]
                        set found 1
                        break
                    }
 
                    # Not an exact match. Try looking for x=y
                    incr len
                    if { [string equal -length $len "$name=" $arg] } {
                        if { [info exists defined_args($name)] } {
                            error "Argument $name should be specified only once"
                        }
                        set array($name) [string range $arg $len end]
                        set found 1
                        break
                    }
                }
            }
            if { ! $found } {
                error "Invalid argument $arg"
            }
        }
    }
}
 
# }}}
# {{{  Starting and ending tests                        
 
# This section deals with starting tests, or cleaning up when the
# tests cannot actually proceed. Also there is some validation,
# for example to make sure that no endpoint number is used for
# multiple tests.
 
namespace eval usbtest {
    variable results
    variable _tests_submitted 0
    variable _control_endpoint_in_use 0
    variable _in_endpoints_in_use [list]
    variable _out_endpoints_in_use [list]
 
    proc reset { } {
        if { 0 != $usbtest::_tests_submitted } {
            usbtest::_cancel
            set usbtest::_tests_submitted 0
 
        }
        set usbtest::_in_endpoints_in_use [list]
        set usbtest::_out_endpoints_in_use [list]
    }
 
    proc use_endpoint { endpoint direction } {
        if { 0 == $endpoint } {
            if { $usbtest::_control_endpoint_in_use } {
                error "Attempt to run multiple tests on the control endpoint"
            }
            set usbtest::_control_endpoint_in_use 1
        } else {
            switch -- $direction {
                "in" {
                    if { -1 != [lsearch -exact $usbtest::_in_endpoints_in_use $endpoint] } {
                        error "Attempt to run multiple IN tests on endpoint $endpoint"
                    }
                    lappend usbtest::_in_endpoints_in_use $endpoint
                }
 
                "out" {
                    if { -1 != [lsearch -exact $usbtest::_out_endpoints_in_use $endpoint] } {
                        error "Attempt to run multiple OUT tests on endpoint $endpoint"
                    }
                    lappend usbtest::_out_endpoints_in_use $endpoint
                }
 
                default {
                    error "Invalid direction passed to usbtest::use_endpoint"
                }
            }
        }
    }
 
    proc test_submitted { } {
        incr usbtest::_tests_submitted
    }
 
    proc start { timeout } {
        set result 0
        if { 0 == $usbtest::_tests_submitted } {
            error "Attempt to start tests when no tests are scheduled to run."
        } elseif { ! [string is integer -strict $timeout] } {
            error "Invalid timeout specified, it should be a simple number."
        } else {
            set usbtest::results [list]
            set result [usbtest::_run $timeout]
            set usbtest::_tests_submitted 0
            set usbtest::_control_endpoint_in_use 0
            array unset _in_endpoints_in_use
            array unset _out_endpoints_in_use
        }
        return $result
    }
}
 
# }}}
# {{{  Bulk tests                                       
 
# Prepare to run a bulk test.
#
# This test requires rather a lot of parameters, many of which
# will have sensible defaults.
 
namespace eval usbtest {
 
    proc bulktest { endpoint direction number_packets args } {
 
 
        # Parameters to be passed to the C code. Most are
        # held in an array indexed by the option name,
        # facilitating command-line parsing.
        set arguments(format)        "none"
        set arguments(data1)         0
        set arguments(data*)         1
        set arguments(data+)         0
        set arguments(data1*)        1
        set arguments(data1+)        0
        set arguments(data**)        1
        set arguments(data*+)        0
        set arguments(data+*)        1
        set arguments(data++)        0
        set arguments(mechanism)     "usb"
        set arguments(txsize1)       32
        set arguments(txsize>=)      0
        set arguments(txsize<=)      -1
        set arguments(txsize*)       1
        set arguments(txsize/)       1
        set arguments(txsize+)       0
        set arguments(rxsize1)       0
        set arguments(rxsize>=)      0
        set arguments(rxsize<=)      -1
        set arguments(rxsize*)       1
        set arguments(rxsize/)       1
        set arguments(rxsize+)       0
        set arguments(txdelay1)      0
        set arguments(txdelay>=)     0
        set arguments(txdelay<=)     1000000000
        set arguments(txdelay*)      1
        set arguments(txdelay/)      1
        set arguments(txdelay+)      0
        set arguments(rxdelay1)      0
        set arguments(rxdelay>=)     0
        set arguments(rxdelay<=)     1000000000
        set arguments(rxdelay*)      1
        set arguments(rxdelay/)      1
        set arguments(rxdelay+)      0
 
        set endpoint_param                      ""
 
        # Target limits
        set target_min_size                     0
        set target_max_size                     0
        set target_padding                      0
        set target_devtab                       ""
 
        # Start by validating the endpoint and direction arguments.
        # Also check that the specified endpoint is not yet in use.
        if { ![string is integer -strict $endpoint] } {
            error "Invalid endpoint argument \"$endpoint\": should be a number"
        }
        if { ($endpoint < 1) || ($endpoint > 15) } {
            error "Invalid bulk endpoint argument \"$endpoint\": should be between 1 and 15"
        }
        switch -- $direction {
            "in" -
            "In" -
            "IN" {
                set direction "in"
                if { -1 == [lsearch -exact $usbtest::bulk_in_endpoints $endpoint] } {
                    error "Invalid bulk endpoint argument \"$endpoint\": the target does not list that as a bulk IN endpoint"
                }
                set target_min_size      $usbtest::bulk_in($endpoint,min_size)
                set target_max_size      $usbtest::bulk_in($endpoint,max_size)
                set target_padding       $usbtest::bulk_in($endpoint,max_in_padding)
                set target_devtab        $usbtest::bulk_in($endpoint,devtab);
                set endpoint_param [expr $endpoint | $usbtest::_USB_DIR_IN]
            }
 
            "out" -
            "Out" -
            "OUT" {
                set direction "out"
                if { -1 == [lsearch -exact $usbtest::bulk_out_endpoints $endpoint] } {
                    error "Invalid bulk endpoint argument \"$endpoint\": the target does not list that as a bulk OUT endpoint"
                }
                set target_min_size      $usbtest::bulk_out($endpoint,min_size)
                set target_max_size      $usbtest::bulk_out($endpoint,max_size)
                set target_devtab        $usbtest::bulk_out($endpoint,devtab);
                set target_padding       0; # Not applicable
                set endpoint_param       $endpoint
            }
 
            default {
                error "Invalid direction argument \"$direction\": should be \"in\" or \"out\""
            }
        }
 
        # Now parse any remaining arguments
        usbtest::process_arguments $args arguments
 
        # Convert two of the arguments from strings to numbers, for the
        # convenience of the C code
        switch -- $arguments(format) {
            "none"      { set arguments(format) $usbtest::_DATA_NONE }
            "bytefill"  { set arguments(format) $usbtest::_DATA_BYTE_FILL }
            "wordfill"  { set arguments(format) $usbtest::_DATA_WORD_FILL }
            "byteseq"   { set arguments(format) $usbtest::_DATA_BYTE_GEN }
            "wordseq"   { set arguments(format) $usbtest::_DATA_WORD_GEN }
 
            default {
                error "Invalid data format argument \"$arguments(data)\"\n    \
                       Should be \"none\", \"bytefill\", \"wordfill\", \"byteseq\" or \"wordseq\""
            }
        }
        switch -- $arguments(mechanism) {
            "usb"       { set arguments(mechanism) $usbtest::_IO_MECHANISM_USB }
            "devtab"    { set arguments(mechanism) $usbtest::_IO_MECHANISM_DEV }
 
            default {
                error "Invalid mechanism argument \"$arguments(mechanism)\"\n    \
                       Should be \"usb\" or \"devtab\""
            }
        }
 
        puts "validating fields"
        # Validate the remaining fields
        foreach field [list data1 data* data+ data1* data1+ data** data*+ data+* data++ \
                            txsize1 txsize>= txsize<= txsize* txsize/ txsize+           \
                            rxsize1 rxsize>= rxsize<= rxsize* rxsize/ rxsize+           \
                            txdelay1 txdelay>= txdelay<= txdelay* txdelay/ txdelay+     \
                            rxdelay1 rxdelay>= rxdelay<= rxdelay* rxdelay/ rxdelay+] {
            if { ![string is integer -strict $arguments($field)] } {
                error "Invalid value \"$arguments($field)\" for argument $field, should be an integer."
            }
        }
 
        if { $arguments(txsize>=) < $target_min_size } {
            set arguments(txsize>=) $target_min_size
        }
        if { (-1 == $arguments(txsize<=) ) || ($arguments(txsize<=) > $target_max_size) } {
            set arguments(txsize<=) $target_max_size
        }
        if { $arguments(rxsize<=) == -1 } {
            set arguments(rxsize<=) $target_max_size
        }
        if { $arguments(txsize1) < $arguments(txsize>=) } {
            set arguments(txsize1) $arguments(txsize>=)
        }
        # Make sure the endpoint is not already in use
        usbtest::use_endpoint $endpoint $direction
 
        puts "Submitting test"
        # Now submit the test. This is handled by C code.
        usbtest::_test_bulk             \
                $number_packets         \
                $endpoint_param         \
                $arguments(txsize1)     \
                $arguments(txsize>=)    \
                $arguments(txsize<=)    \
                $arguments(txsize*)     \
                $arguments(txsize/)     \
                $arguments(txsize+)     \
                $arguments(rxsize1)     \
                $arguments(rxsize>=)    \
                $arguments(rxsize<=)    \
                $arguments(rxsize*)     \
                $arguments(rxsize/)     \
                $arguments(rxsize+)     \
                $target_padding         \
                $arguments(txdelay1)    \
                $arguments(txdelay>=)   \
                $arguments(txdelay<=)   \
                $arguments(txdelay*)    \
                $arguments(txdelay/)    \
                $arguments(txdelay+)    \
                $arguments(rxdelay1)    \
                $arguments(rxdelay>=)   \
                $arguments(rxdelay<=)   \
                $arguments(rxdelay*)    \
                $arguments(rxdelay/)    \
                $arguments(rxdelay+)    \
                $arguments(mechanism)   \
                $arguments(format)      \
                $arguments(data1)       \
                $arguments(data*)       \
                $arguments(data+)       \
                $arguments(data1*)      \
                $arguments(data1+)      \
                $arguments(data**)      \
                $arguments(data*+)      \
                $arguments(data+*)      \
                $arguments(data++)
 
        test_submitted
    }
}
 
# }}}
# {{{  Execute the specified test script                
 
# Interpret the arguments as a test script plus auxiliary data.
set script [lindex $::argv 0]
set ::argv [lrange $::argv 1 end]
 
set result [catch {
    set path [file join [pwd] $script]
    if { ![file exists $path] } {
        set path "$path.tcl"
        if { ![file exists $path] } {
            set path [file join $usbtest::USBAUXDIR $script]
            if { ![file exists $path] } {
                set path "$path.tcl"
                if { ![file exists $path] } {
                    error "Error: unknown test script $script"
                }
            }
        }
    }
 
    source $path
 
} message]
 
if { 0 != $result } {
    puts $message
}
 
# }}}

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [rtos/] [ecos-2.0/] [packages/] [io/] [usb/] [slave/] [v2_0/] [host/] [usbhost.tcl] - Blame information for rev 174

Line No.	Rev	Author	Line
1	27	unneback	`# {{{ Banner`
2
3			`#===============================================================================`
4			`#`
5			`# usbhost.tcl`
6			`#`
7			`# Support for USB testing`
8			`#`
9			`#===============================================================================`
10			`#####ECOSGPLCOPYRIGHTBEGIN####`
11			`## -------------------------------------------`
12			`## This file is part of eCos, the Embedded Configurable Operating System.`
13			`## Copyright (C) 1998, 1999, 2000, 2001, 2002 Red Hat, Inc.`
14			`##`
15			`## eCos is free software; you can redistribute it and/or modify it under`
16			`## the terms of the GNU General Public License as published by the Free`
17			`## Software Foundation; either version 2 or (at your option) any later version.`
18			`##`
19			`## eCos is distributed in the hope that it will be useful, but WITHOUT ANY`
20			`## WARRANTY; without even the implied warranty of MERCHANTABILITY or`
21			`## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License`
22			`## for more details.`
23			`##`
24			`## You should have received a copy of the GNU General Public License along`
25			`## with eCos; if not, write to the Free Software Foundation, Inc.,`
26			`## 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.`
27			`##`
28			`## As a special exception, if other files instantiate templates or use macros`
29			`## or inline functions from this file, or you compile this file and link it`
30			`## with other works to produce a work based on this file, this file does not`
31			`## by itself cause the resulting work to be covered by the GNU General Public`
32			`## License. However the source code for this file must still be made available`
33			`## in accordance with section (3) of the GNU General Public License.`
34			`##`
35			`## This exception does not invalidate any other reasons why a work based on`
36			`## this file might be covered by the GNU General Public License.`
37			`##`
38			`## Alternative licenses for eCos may be arranged by contacting Red Hat, Inc.`
39			`## at http://sources.redhat.com/ecos/ecos-license/`
40			`## -------------------------------------------`
41			`#####ECOSGPLCOPYRIGHTEND####`
42			`#===============================================================================`
43			`######DESCRIPTIONBEGIN####`
44			`#`
45			`# Author(s): bartv`
46			`# Date: 2001-07-04`
47			`# Purpose: To provide higher-level utility commands for performing`
48			`# USB testing, and to iterate through the various test scripts`
49			`# specified on the command line.`
50			`#`
51			`#####DESCRIPTIONEND####`
52			`#===============================================================================`
53			`#`
54
55			`# }}}`
56
57			`# {{{ Endpoint data`
58
59			`# Given the raw endpoint data provided by the C code, turn`
60			`# it something more usable from inside Tcl scripts.`
61			`namespace eval usbtest {`
62			`array set control {}`
63
64			`variable bulk_in_endpoints [list]`
65			`array set bulk_in {}`
66			`variable bulk_out_endpoints [list]`
67			`array set bulk_out {}`
68
69			`variable isochronous_in_endpoints [list]`
70			`array set isochronous_in {}`
71			`variable isochronous_out_endpoints [list]`
72			`array set isochronous_out {}`
73
74			`variable interrupt_in_endpoints [list]`
75			`array set interrupt_in {}`
76			`variable interrupt_out_endpoints [list]`
77			`array set interrupt_out {}`
78
79			`for { set i 0 } { $i < $usbtest::endpoint_count } { incr i } {`
80			`switch -- $usbtest::endpoint_data($i,type) {`
81			`"control" {`
82			`set usbtest::control(min_size) $usbtest::endpoint_data($i,min_size)`
83			`set usbtest::control(max_size) $usbtest::endpoint_data($i,max_size)`
84			`}`
85
86			`"bulk" {`
87			`set number $usbtest::endpoint_data($i,number)`
88			`if { "in" == $usbtest::endpoint_data($i,direction) } {`
89			`lappend usbtest::bulk_in_endpoints $number`
90			`set usbtest::bulk_in($number,min_size) $usbtest::endpoint_data($i,min_size)`
91			`set usbtest::bulk_in($number,max_size) $usbtest::endpoint_data($i,max_size)`
92			`set usbtest::bulk_in($number,max_in_padding) $usbtest::endpoint_data($i,max_in_padding)`
93			`set usbtest::bulk_in($number,devtab) $usbtest::endpoint_data($i,devtab)`
94			`} else {`
95			`lappend usbtest::bulk_out_endpoints $number`
96			`set usbtest::bulk_out($number,min_size) $usbtest::endpoint_data($i,min_size)`
97			`set usbtest::bulk_out($number,max_size) $usbtest::endpoint_data($i,max_size)`
98			`set usbtest::bulk_out($number,devtab) $usbtest::endpoint_data($i,devtab)`
99			`}`
100			`}`
101
102			`"isochronous" {`
103			`set number $usbtest::endpoint_data($i,number)`
104			`if { "in" == $usbtest::endpoint_data($i,direction) } {`
105			`lappend usbtest::isochronous_in_endpoints $number`
106			`set usbtest::isochronous_in($number,min_size) $usbtest::endpoint_data($i,min_size)`
107			`set usbtest::isochronous_in($number,max_size) $usbtest::endpoint_data($i,max_size)`
108			`set usbtest::isochronous_in($number,devtab) $usbtest::endpoint_data($i,devtab)`
109			`} else {`
110			`lappend usbtest::isochronous_out_endpoints $number`
111			`set usbtest::isochronous_out($number,min_size) $usbtest::endpoint_data($i,min_size)`
112			`set usbtest::isochronous_out($number,max_size) $usbtest::endpoint_data($i,max_size)`
113			`set usbtest::isochronous_out($number,devtab) $usbtest::endpoint_data($i,devtab)`
114			`}`
115			`}`
116
117			`"interrupt" {`
118			`set number $usbtest::endpoint_data($i,number)`
119			`if { "in" == $usbtest::endpoint_data($i,direction) } {`
120			`lappend usbtest::interrupt_in_endpoints $number`
121			`set usbtest::interrupt_in($number,min_size) $usbtest::endpoint_data($i,min_size)`
122			`set usbtest::interrupt_in($number,max_size) $usbtest::endpoint_data($i,max_size)`
123			`set usbtest::interrupt_in($number,devtab) $usbtest::endpoint_data($i,devtab)`
124			`} else {`
125			`lappend usbtest::interrupt_out_endpoints $number`
126			`set usbtest::interrupt_out($number,min_size) $usbtest::endpoint_data($i,min_size)`
127			`set usbtest::interrupt_out($number,max_size) $usbtest::endpoint_data($i,max_size)`
128			`set usbtest::interrupt_out($number,devtab) $usbtest::endpoint_data($i,devtab)`
129			`}`
130			`}`
131
132			`default {`
133			`puts stderr "Internal error: invalid endpoint type $usbtest::endpoint_data($i,type)"`
134			`exit 1`
135			`}`
136			`}`
137			`}`
138			`}`
139
140			`# }}}`
141			`# {{{ Constants`
142
143			`# The C code expects to receive certain data as simple numbers,`
144			`# corresponding to #define's in common.c and elsewhere. Strictly`
145			`# speaking it would be better to pass strings to the C code and`
146			`# have it do the translation, thus ensuring that these constants`
147			`# exist in only one place.`
148
149			`namespace eval usbtest {`
150
151			`variable _USB_DIR_IN 0x0080`
152			`variable _DATA_NONE 0`
153			`variable _DATA_BYTE_FILL 1`
154			`variable _DATA_WORD_FILL 2`
155			`variable _DATA_BYTE_GEN 3`
156			`variable _DATA_WORD_GEN 4`
157			`variable _IO_MECHANISM_USB 1`
158			`variable _IO_MECHANISM_DEV 2`
159			`}`
160
161			`# It is also desirable to have some constants corresponding`
162			`# to common random number generators.`
163			`namespace eval usbtest {`
164			`variable MULTIPLIER 1103515245`
165			`variable INCREMENT 12345`
166			`}`
167
168			`# }}}`
169			`# {{{ Argument processing`
170
171			`# ----------------------------------------------------------------------------`
172			`# Given a list of arguments of the form "xyzzy=123" or "xyzzy 123", and`
173			`# an array arguments containing entries such as arguments(xyzzy) and`
174			`# already filled in with default values, update the array using the`
175			`# actual arguments`
176			`namespace eval usbtest {`
177
178			`proc process_arguments { list array_ref } {`
179			`upvar $array_ref array`
180			`array set defined_args [list]`
181
182			`set listlen [llength $list]`
183			`for { set index 0 } { $index < $listlen } { incr index } {`
184			`set arg [lindex $list $index]`
185			`set found 0`
186			`foreach name [array names array] {`
187			`set len [string length $name]`
188			`if { [string equal -length $len $name $arg] } {`
189			`# Partial match found.`
190			`if { [string equal $name $arg] } {`
191			`# Exact match found, The value must be the next arg.`
192			`if { [info exists defined_args($name)] } {`
193			`error "Argument $name should be specified only once"`
194			`}`
195			`incr index`
196			`if { $index >= $listlen } {`
197			`error "Missing value after argument $name"`
198			`}`
199			`set array($name) [lindex $list $index]`
200			`set found 1`
201			`break`
202			`}`
203
204			`# Not an exact match. Try looking for x=y`
205			`incr len`
206			`if { [string equal -length $len "$name=" $arg] } {`
207			`if { [info exists defined_args($name)] } {`
208			`error "Argument $name should be specified only once"`
209			`}`
210			`set array($name) [string range $arg $len end]`
211			`set found 1`
212			`break`
213			`}`
214			`}`
215			`}`
216			`if { ! $found } {`
217			`error "Invalid argument $arg"`
218			`}`
219			`}`
220			`}`
221			`}`
222
223			`# }}}`
224			`# {{{ Starting and ending tests`
225
226			`# This section deals with starting tests, or cleaning up when the`
227			`# tests cannot actually proceed. Also there is some validation,`
228			`# for example to make sure that no endpoint number is used for`
229			`# multiple tests.`
230
231			`namespace eval usbtest {`
232			`variable results`
233			`variable _tests_submitted 0`
234			`variable _control_endpoint_in_use 0`
235			`variable _in_endpoints_in_use [list]`
236			`variable _out_endpoints_in_use [list]`
237
238			`proc reset { } {`
239			`if { 0 != $usbtest::_tests_submitted } {`
240			`usbtest::_cancel`
241			`set usbtest::_tests_submitted 0`
242
243			`}`
244			`set usbtest::_in_endpoints_in_use [list]`
245			`set usbtest::_out_endpoints_in_use [list]`
246			`}`
247
248			`proc use_endpoint { endpoint direction } {`
249			`if { 0 == $endpoint } {`
250			`if { $usbtest::_control_endpoint_in_use } {`
251			`error "Attempt to run multiple tests on the control endpoint"`
252			`}`
253			`set usbtest::_control_endpoint_in_use 1`
254			`} else {`
255			`switch -- $direction {`
256			`"in" {`
257			`if { -1 != [lsearch -exact $usbtest::_in_endpoints_in_use $endpoint] } {`
258			`error "Attempt to run multiple IN tests on endpoint $endpoint"`
259			`}`
260			`lappend usbtest::_in_endpoints_in_use $endpoint`
261			`}`
262
263			`"out" {`
264			`if { -1 != [lsearch -exact $usbtest::_out_endpoints_in_use $endpoint] } {`
265			`error "Attempt to run multiple OUT tests on endpoint $endpoint"`
266			`}`
267			`lappend usbtest::_out_endpoints_in_use $endpoint`
268			`}`
269
270			`default {`
271			`error "Invalid direction passed to usbtest::use_endpoint"`
272			`}`
273			`}`
274			`}`
275			`}`
276
277			`proc test_submitted { } {`
278			`incr usbtest::_tests_submitted`
279			`}`
280
281			`proc start { timeout } {`
282			`set result 0`
283			`if { 0 == $usbtest::_tests_submitted } {`
284			`error "Attempt to start tests when no tests are scheduled to run."`
285			`} elseif { ! [string is integer -strict $timeout] } {`
286			`error "Invalid timeout specified, it should be a simple number."`
287			`} else {`
288			`set usbtest::results [list]`
289			`set result [usbtest::_run $timeout]`
290			`set usbtest::_tests_submitted 0`
291			`set usbtest::_control_endpoint_in_use 0`
292			`array unset _in_endpoints_in_use`
293			`array unset _out_endpoints_in_use`
294			`}`
295			`return $result`
296			`}`
297			`}`
298
299			`# }}}`
300			`# {{{ Bulk tests`
301
302			`# Prepare to run a bulk test.`
303			`#`
304			`# This test requires rather a lot of parameters, many of which`
305			`# will have sensible defaults.`
306
307			`namespace eval usbtest {`
308
309			`proc bulktest { endpoint direction number_packets args } {`
310
311
312			`# Parameters to be passed to the C code. Most are`
313			`# held in an array indexed by the option name,`
314			`# facilitating command-line parsing.`
315			`set arguments(format) "none"`
316			`set arguments(data1) 0`
317			`set arguments(data*) 1`
318			`set arguments(data+) 0`
319			`set arguments(data1*) 1`
320			`set arguments(data1+) 0`
321			`set arguments(data**) 1`
322			`set arguments(data*+) 0`
323			`set arguments(data+*) 1`
324			`set arguments(data++) 0`
325			`set arguments(mechanism) "usb"`
326			`set arguments(txsize1) 32`
327			`set arguments(txsize>=) 0`
328			`set arguments(txsize<=) -1`
329			`set arguments(txsize*) 1`
330			`set arguments(txsize/) 1`
331			`set arguments(txsize+) 0`
332			`set arguments(rxsize1) 0`
333			`set arguments(rxsize>=) 0`
334			`set arguments(rxsize<=) -1`
335			`set arguments(rxsize*) 1`
336			`set arguments(rxsize/) 1`
337			`set arguments(rxsize+) 0`
338			`set arguments(txdelay1) 0`
339			`set arguments(txdelay>=) 0`
340			`set arguments(txdelay<=) 1000000000`
341			`set arguments(txdelay*) 1`
342			`set arguments(txdelay/) 1`
343			`set arguments(txdelay+) 0`
344			`set arguments(rxdelay1) 0`
345			`set arguments(rxdelay>=) 0`
346			`set arguments(rxdelay<=) 1000000000`
347			`set arguments(rxdelay*) 1`
348			`set arguments(rxdelay/) 1`
349			`set arguments(rxdelay+) 0`
350
351			`set endpoint_param ""`
352
353			`# Target limits`
354			`set target_min_size 0`
355			`set target_max_size 0`
356			`set target_padding 0`
357			`set target_devtab ""`
358
359			`# Start by validating the endpoint and direction arguments.`
360			`# Also check that the specified endpoint is not yet in use.`
361			`if { ![string is integer -strict $endpoint] } {`
362			`error "Invalid endpoint argument \"$endpoint\": should be a number"`
363			`}`
364			`if { ($endpoint < 1) \|\| ($endpoint > 15) } {`
365			`error "Invalid bulk endpoint argument \"$endpoint\": should be between 1 and 15"`
366			`}`
367			`switch -- $direction {`
368			`"in" -`
369			`"In" -`
370			`"IN" {`
371			`set direction "in"`
372			`if { -1 == [lsearch -exact $usbtest::bulk_in_endpoints $endpoint] } {`
373			`error "Invalid bulk endpoint argument \"$endpoint\": the target does not list that as a bulk IN endpoint"`
374			`}`
375			`set target_min_size $usbtest::bulk_in($endpoint,min_size)`
376			`set target_max_size $usbtest::bulk_in($endpoint,max_size)`
377			`set target_padding $usbtest::bulk_in($endpoint,max_in_padding)`
378			`set target_devtab $usbtest::bulk_in($endpoint,devtab);`
379			`set endpoint_param [expr $endpoint \| $usbtest::_USB_DIR_IN]`
380			`}`
381
382			`"out" -`
383			`"Out" -`
384			`"OUT" {`
385			`set direction "out"`
386			`if { -1 == [lsearch -exact $usbtest::bulk_out_endpoints $endpoint] } {`
387			`error "Invalid bulk endpoint argument \"$endpoint\": the target does not list that as a bulk OUT endpoint"`
388			`}`
389			`set target_min_size $usbtest::bulk_out($endpoint,min_size)`
390			`set target_max_size $usbtest::bulk_out($endpoint,max_size)`
391			`set target_devtab $usbtest::bulk_out($endpoint,devtab);`
392			`set target_padding 0; # Not applicable`
393			`set endpoint_param $endpoint`
394			`}`
395
396			`default {`
397			`error "Invalid direction argument \"$direction\": should be \"in\" or \"out\""`
398			`}`
399			`}`
400
401			`# Now parse any remaining arguments`
402			`usbtest::process_arguments $args arguments`
403
404			`# Convert two of the arguments from strings to numbers, for the`
405			`# convenience of the C code`
406			`switch -- $arguments(format) {`
407			`"none" { set arguments(format) $usbtest::_DATA_NONE }`
408			`"bytefill" { set arguments(format) $usbtest::_DATA_BYTE_FILL }`
409			`"wordfill" { set arguments(format) $usbtest::_DATA_WORD_FILL }`
410			`"byteseq" { set arguments(format) $usbtest::_DATA_BYTE_GEN }`
411			`"wordseq" { set arguments(format) $usbtest::_DATA_WORD_GEN }`
412
413			`default {`
414			`error "Invalid data format argument \"$arguments(data)\"\n \`
415			`Should be \"none\", \"bytefill\", \"wordfill\", \"byteseq\" or \"wordseq\""`
416			`}`
417			`}`
418			`switch -- $arguments(mechanism) {`
419			`"usb" { set arguments(mechanism) $usbtest::_IO_MECHANISM_USB }`
420			`"devtab" { set arguments(mechanism) $usbtest::_IO_MECHANISM_DEV }`
421
422			`default {`
423			`error "Invalid mechanism argument \"$arguments(mechanism)\"\n \`
424			`Should be \"usb\" or \"devtab\""`
425			`}`
426			`}`
427
428			`puts "validating fields"`
429			`# Validate the remaining fields`
430			`foreach field [list data1 data* data+ data1* data1+ data** data+ data+ data++ \`
431			`txsize1 txsize>= txsize<= txsize* txsize/ txsize+ \`
432			`rxsize1 rxsize>= rxsize<= rxsize* rxsize/ rxsize+ \`
433			`txdelay1 txdelay>= txdelay<= txdelay* txdelay/ txdelay+ \`
434			`rxdelay1 rxdelay>= rxdelay<= rxdelay* rxdelay/ rxdelay+] {`
435			`if { ![string is integer -strict $arguments($field)] } {`
436			`error "Invalid value \"$arguments($field)\" for argument $field, should be an integer."`
437			`}`
438			`}`
439
440			`if { $arguments(txsize>=) < $target_min_size } {`
441			`set arguments(txsize>=) $target_min_size`
442			`}`
443			`if { (-1 == $arguments(txsize<=) ) \|\| ($arguments(txsize<=) > $target_max_size) } {`
444			`set arguments(txsize<=) $target_max_size`
445			`}`
446			`if { $arguments(rxsize<=) == -1 } {`
447			`set arguments(rxsize<=) $target_max_size`
448			`}`
449			`if { $arguments(txsize1) < $arguments(txsize>=) } {`
450			`set arguments(txsize1) $arguments(txsize>=)`
451			`}`
452			`# Make sure the endpoint is not already in use`
453			`usbtest::use_endpoint $endpoint $direction`
454
455			`puts "Submitting test"`
456			`# Now submit the test. This is handled by C code.`
457			`usbtest::_test_bulk \`
458			`$number_packets \`
459			`$endpoint_param \`
460			`$arguments(txsize1) \`
461			`$arguments(txsize>=) \`
462			`$arguments(txsize<=) \`
463			`$arguments(txsize*) \`
464			`$arguments(txsize/) \`
465			`$arguments(txsize+) \`
466			`$arguments(rxsize1) \`
467			`$arguments(rxsize>=) \`
468			`$arguments(rxsize<=) \`
469			`$arguments(rxsize*) \`
470			`$arguments(rxsize/) \`
471			`$arguments(rxsize+) \`
472			`$target_padding \`
473			`$arguments(txdelay1) \`
474			`$arguments(txdelay>=) \`
475			`$arguments(txdelay<=) \`
476			`$arguments(txdelay*) \`
477			`$arguments(txdelay/) \`
478			`$arguments(txdelay+) \`
479			`$arguments(rxdelay1) \`
480			`$arguments(rxdelay>=) \`
481			`$arguments(rxdelay<=) \`
482			`$arguments(rxdelay*) \`
483			`$arguments(rxdelay/) \`
484			`$arguments(rxdelay+) \`
485			`$arguments(mechanism) \`
486			`$arguments(format) \`
487			`$arguments(data1) \`
488			`$arguments(data*) \`
489			`$arguments(data+) \`
490			`$arguments(data1*) \`
491			`$arguments(data1+) \`
492			`$arguments(data**) \`
493			`$arguments(data*+) \`
494			`$arguments(data+*) \`
495			`$arguments(data++)`
496
497			`test_submitted`
498			`}`
499			`}`
500
501			`# }}}`
502			`# {{{ Execute the specified test script`
503
504			`# Interpret the arguments as a test script plus auxiliary data.`
505			`set script [lindex $::argv 0]`
506			`set ::argv [lrange $::argv 1 end]`
507
508			`set result [catch {`
509			`set path [file join [pwd] $script]`
510			`if { ![file exists $path] } {`
511			`set path "$path.tcl"`
512			`if { ![file exists $path] } {`
513			`set path [file join $usbtest::USBAUXDIR $script]`
514			`if { ![file exists $path] } {`
515			`set path "$path.tcl"`
516			`if { ![file exists $path] } {`
517			`error "Error: unknown test script $script"`
518			`}`
519			`}`
520			`}`
521			`}`
522
523			`source $path`
524
525			`} message]`
526
527			`if { 0 != $result } {`
528			`puts $message`
529			`}`
530
531			`# }}}`