packages/hal/synth/arch/v2_0/host/console.tcl

   1 # {{{  Banner
   2
   3 # ============================================================================
   4 #
   5 #      console.tcl
   6 #
   7 #      Console output support for the eCos synthetic target I/O auxiliary
   8 #
   9 # ============================================================================
  10 # ####COPYRIGHTBEGIN####
  11 #
  12 #  ----------------------------------------------------------------------------
  13 #  Copyright (C) 2002 Bart Veer
  14 #
  15 #  This file is part of the eCos host tools.
  16 #
  17 #  This program is free software; you can redistribute it and/or modify it
  18 #  under the terms of the GNU General Public License as published by the Free
  19 #  Software Foundation; either version 2 of the License, or (at your option)
  20 #  any later version.
  21 #
  22 #  This program is distributed in the hope that it will be useful, but WITHOUT
  23 #  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  24 #  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  25 #  more details.
  26 #
  27 #  You should have received a copy of the GNU General Public License along with
  28 #  this program; if not, write to the Free Software Foundation, Inc.,
  29 #  59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  30 #
  31 #  ----------------------------------------------------------------------------
  32 #
  33 # ####COPYRIGHTEND####
  34 # ============================================================================
  35 # #####DESCRIPTIONBEGIN####
  36 #
  37 #  Author(s):   bartv
  38 #  Contact(s):  bartv
  39 #  Date:        2002/08/07
  40 #  Version:     0.01
  41 #  Description:
  42 #      Implementation of the console device. This script should only ever
  43 #      be run from inside the ecosynth auxiliary.
  44 #
  45 # ####DESCRIPTIONEND####
  46 # ============================================================================
  47
  48 # }}}
  49
  50 # The console device is pretty simple. There can only ever be one
  51 # instance of the console, and it does not take any initialization
  52 # data from the target or from command-line arguments. It does
  53 # look for entries in the target definition file, to set up
  54 # colours for console output, and to install additional regexp-based
  55 # filters. The only type of request that can go to the console device
  56 # is to write some text.
  57
  58 namespace eval ::console {
  59
  60     variable _pending_output ""
  61     variable filter_count 0
  62     array set filters [list]
  63
  64     proc instantiate { id name data } {
  65         # There is only console so no name is expected, and the target
  66         # cannot provide any initialization data.
  67         if { ("" != $name) || ("" != $data) } {
  68             synth::report_error "The target has passed invalid data when instantiating the console device.\n"
  69             return ""
  70         }
  71
  72         # There are no command line arguments to be processed and consumed.
  73
  74         # Look for and consume target definition entries related to the console.
  75         # These are only actually applicable when running in GUI mode, but
  76         # should always be consumed.
  77         set console_appearance ""
  78
  79         if { [synth::tdf_has_device "console"] } {
  80             if { [synth::tdf_has_option "console" "appearance"] } {
  81                 set console_appearance [synth::tdf_get_option "console" "appearance"]
  82             }
  83
  84             if { [synth::tdf_has_option "console" "filter"] } {
  85                 set tdf_filters [synth::tdf_get_options "console" "filter"]
  86                 foreach filter $tdf_filters {
  87                     if { 2 > [llength $filter] } {
  88                         set msg "Invalid entry in target definition file $synth::target_definition\n"
  89                         append msg "  Device console, option filter takes at least two arguments, a name and a regular expression.\n"
  90                         synth::report_error $msg
  91                     } else {
  92                         # Attempt some minimal validation of the regexp
  93                         set name [lindex $filter 0]
  94                         set regexp [lindex $filter 1]
  95                         set error ""
  96                         if { [catch { regexp -- $regexp "Hello world\n" } error] } {
  97                             set msg "Invalid entry in target definition file $synth::target_definition\n"
  98                             append msg "  Device console, filter $name, invalid regular expression\n    $error\n"
  99                             synth::report_error $msg
 100                         } else {
 101                             set ::console::filters($::console::filter_count,name)       $name
 102                             set ::console::filters($::console::filter_count,regexp)     $regexp
 103                             set ::console::filters($::console::filter_count,appearance) [lrange $filter 2 end]
 104                             incr ::console::filter_count
 105                         }
 106                     }
 107                 }
 108             }
 109         }
 110
 111         # If the GUI is enabled then set up a filter for the console, and
 112         # any additional filters specified in the target definition file
 113         # for e.g. trace output.
 114         if { $synth::flag_gui } {
 115             if { [synth::filter_exists "console" ] } {
 116                 synth::report_warning "The console device script [info script] cannot create a filter for \"console\".\nThis filter already exists.\n"
 117             } elseif { "" == $console_appearance } {
 118                 synth::filter_add "console"
 119             } else {
 120                 array set parsed_options [list]
 121                 set message ""
 122                 if { ![synth::filter_parse_options $console_appearance parsed_options message] } {
 123                     synth::report_error \
 124                         "Invalid entry in target definition file $synth::target_definition\
 125                          \n  synth_device \"console\", entry \"appearance\"\n$message"
 126                 } else {
 127                     synth::filter_add_parsed "console" parsed_options
 128                 }
 129             }
 130
 131             for { set i 0 } { $i < $::console::filter_count } { incr i } {
 132                 set name $::console::filters($i,name)
 133                 set appearance $::console::filters($i,appearance)
 134                 array unset parsed_options
 135                 array set parsed_options [list]
 136
 137                 if { [synth::filter_exists $name] } {
 138                     synth::report_warning "The console device script [info script] cannot create a filter for \"$name\".\nThis filter already exists.\n"
 139                 } else {
 140                     set message ""
 141                     if { ![synth::filter_parse_options $appearance parsed_options message] } {
 142                         synth::report_error \
 143                                 "Invalid entry in target definition file $synth::target_definition\
 144                                 \n  synth_device \"console\", entry filter $name\n$message"
 145                     } else {
 146                         synth::filter_add_parsed $name parsed_options
 147                     }
 148                 }
 149             }
 150         }
 151
 152         # An instantiation function should return a handler for further requests
 153         # to this device instance.
 154         return console::handle_request
 155     }
 156
 157     proc handle_request { id reqcode arg1 arg2 reqdata reqlen reply_len } {
 158         # Unfortunately the main eCos diagnostic code assumes it is
 159         # talking to a tty in raw mode, since typically the output
 160         # will go via the gdb output window. Hence it will have inserted
 161         # carriage returns which are best filtered out here.
 162         set reqdata [string map {"\r" " "} $reqdata]
 163
 164         # The output should be processed one line at a time, to make it
 165         # easier to write the regexp filters.
 166         append console::_pending_output $reqdata
 167         while { -1 != [string first "\n" $console::_pending_output] } {
 168             set regexp_matched 0
 169             set index [string first "\n" $console::_pending_output]
 170             set line [string range $console::_pending_output 0 $index]
 171             set ::console::_pending_output [string range $console::_pending_output [expr $index + 1] end]
 172
 173             for { set i 0 } { !$regexp_matched && ($i < $console::filter_count) } { incr i } {
 174                 if { [regexp -- $console::filters($i,regexp) $line] } {
 175                     synth::output $line $console::filters($i,name)
 176                     set regexp_matched 1
 177                 }
 178             }
 179             if { ! $regexp_matched } {
 180                 synth::output $line "console"
 181             }
 182         }
 183     }
 184
 185     # Deal with the case where eCos has exited after sending only part
 186     # of a line, which is still pending. In practice this has no
 187     # effect at present because the data is still buffered inside
 188     # eCos.
 189     proc _flush { arg_list } {
 190         if { "" != $console::_pending_output } {
 191             synth::output "$console::_pending_output\n" "console"
 192         }
 193     }
 194     synth::hook_add "ecos_exit" console::_flush
 195
 196 }
 197
 198 return console::instantiate