ecosynth.tcl

eCos操作系统源码

	# --version is specified.
	puts "ecosynth: version $synth::_ecosynth_version"
	puts "        : install location [file dirname [info script]]"
	exit 0
    }

    if { [synth::argv_defined "-l="] } {
	set synth::logfile [synth::argv_get_value "-l="]
    } elseif { [synth::argv_defined "-logfile="] } {
	set synth::logfile [synth::argv_get_value "-logfile="]
    }
    if { "" != $synth::logfile } {
	synth::logfile_open
    }

    # -h/--help would normally also result in an immediate exit. However,
    # the device-specific scripts have not yet been loaded so there
    # is no way of reporting their options. Hence the usage information
    # is delayed until later. Suppressing GUI mode as a side effect is
    # probably a good idea as well, that way the output appears in the
    # current console window.
    if { [synth::argv_defined "-h"] || [synth::argv_defined "-help"] } {
	set synth::flag_help 1
	set synth::flag_gui 0
    }
    
    if { [synth::argv_defined "-debug"] } {
	set synth::flag_debug 1
    }
    
    if { [synth::argv_defined "-k"] || [synth::argv_defined "-keep-going"] } {
	set synth::flag_keep_going 1
    }

    if { [synth::argv_defined "-nr"] || [synth::argv_defined "-no-rc"]} {
	set synth::flag_no_rc 1
    }

    if { [synth::argv_defined "-x"] || [synth::argv_defined "-exit"] } {
	set synth::flag_immediate_exit 1
    } elseif { [synth::argv_defined "-nx"] || [synth::argv_defined "-no-exit"] } {
	set synth::flag_immediate_exit 0
    }

    if { [synth::argv_defined "-V"] || [synth::argv_defined "-verbose"] } {
	set synth::flag_verbose 1
    }

    if { [synth::argv_defined "-t="] } {
	set synth::target_definition [synth::argv_get_value "-t="]
    } elseif { [synth::argv_defined "-target="] } {
	set synth::target_definition [synth::argv_get_value "-target="]
    }

    # Arguably -geometry should only be checked when the GUI is enabled,
    # but doing so at all times is harmless.
    # Note that '-geometry ""' means that any value held in the
    # preferences file should be ignored. Hence the regexp below 
    # accepts the empty string, and treats it separately from
    # uninitialized.
    if { [synth::argv_defined "-geometry="] } {
	set synth::geometry [synth::argv_get_value "-geometry="]

	if { ![regexp -- {^([0-9]+x[0-9]+)?([+-][0-9]+[+-][0-9]+)?$} $synth::geometry] } {
	    synth::report_warning "Invalid geometry string $synth::geometry\n"
	    set synth::geometry "<none>"
	}
    }

    if { $synth::flag_debug } {
	synth::report \
	    "Results of initial command-line parsing:\n   \
	          --help            $synth::flag_help\n   \
	          --keep-going      $synth::flag_keep_going\n   \
	          --no-rc           $synth::flag_no_rc\n   \
	          --exit            $synth::flag_immediate_exit\n   \
	          --verbose         $synth::flag_verbose\n   \
	          logfile           $synth::logfile\n   \
	          target definition $synth::target_definition\n   \
	          geometry          $synth::geometry\n   \
	          unconsumed        [synth::get_unconsumed_args]\n"
    }
}

# }}}
# {{{  Create and populate ~/.ecos/synth                        

# ----------------------------------------------------------------------------
# If the per-user configuration directories do not exist yet, create them.
# Also install default initrc.tcl and mainrc.tcl files which do nothing, but
# which can be edited. If problems occur then the user gets a warning
# but execution proceeds.
#
# Some people may object to this automatic creation of directories and
# configuration files. However there is plenty of precedent, and the
# files involved are small. Messages are generated so that the user
# knows what has happened.
#
# Currently the default target definition file is not copied from
# the install tree into the per-user tree. Although some users will
# be happy having this file in ~/.ecos/synth, others may prefer it
# to be more visible in the current directory.

if { ![file exists "~/.ecos"] } {
    synth::report "Creating new directory ~/.ecos for eCos configuration files.\n"
    if { 0 != [catch { file mkdir "~/.ecos" }] } {
	synth::report_warning "failed to create directory ~/.ecos\n"
    }
}
if { [file exists "~/.ecos"] && [file isdirectory "~/.ecos"] && ![file exists "~/.ecos/synth"] } {
    synth::report "Creating new directory ~/.ecos/synth for synthetic target configuration files.\n"
    if { 0 != [catch { file mkdir "~/.ecos/synth" } ] } {
	synth::report_warning "failed to create directory ~/.ecos/synth\n"
    } else {
	# initrc and mainrc are only copied when the directory is first created,
	# so that users can delete them if unwanted - even though the
	# default versions do nothing.
	synth::report "Installing default configuration files ~/.ecos/synth/initrc.tcl and ~/.ecos/synth/mainrc.tcl\n"
	catch { file copy -- [file join $synth::install_dir "user_initrc.tcl"] "~/.ecos/synth/initrc.tcl"}
	catch { file copy -- [file join $synth::install_dir "user_mainrc.tcl"] "~/.ecos/synth/mainrc.tcl"}
    }
}

# }}}
# {{{  Read target definition file                              

# ----------------------------------------------------------------------------
# Once the GUI is up and running it is possible to start reading in some
# configuration files. The first of these is the target definition file.
# Typically this would be ~/.ecos/synth/default.tdf. An alternative
# definition file can be specified on the command line with the
# -t argument, and the code will look in the current directory,
# in ~/.ecos/synth, and in the install tree.
#
# The purpose of the target definition file is to specify exactly
# how I/O gets implemented. For example the eCos application may
# want to access a network device eth0, but that device could be
# implemented in a variety of ways (e.g. a real ethernet device
# on the Linux host, or a fake device provided by the ethertap
# facility). It is the target definition file that provides
# this information.
#
# The file is of course just another Tcl script, running in the
# current interpreter. There seems little point in using a safe
# interpreter given the considerable number of other Tcl scripts
# that are being used, some of which need the ability to e.g.
# run other programs. The main command is synth_device which
# takes two arguments, a device name and some options for that
# device, e.g.:
#
#    synth_device eth0 {
#        use eth1    
#    }
#
#    synth_device eth1 {
#        use tap0
#    }    
#
# When the eCos device driver looks up eth0 this will cause a
# device-specific Tcl script to be loaded, which can examine
# this data.
#
# This code has no way of knowing what constitutes valid or invalid
# contents for an eth0 device, especially since the Tcl script that
# could provide such knowledge has not been loaded. Instead it is
# assumed that the contents is another set of Tcl commands such as
# "physical", which will of course not be defined so the Tcl interpreter
# will invoke "unknown" which is temporarily redefined here. This makes
# it possible for the device-specific commands to have arbitrary number
# of arguments, or to define Tcl fragments for hooks, or whatever.
#
# As with argument processing, the code attempts to keep track of
# which devices and options have been "consumed" and can issue
# warnings about any unused devices or options. This helps to track
# down typos and similar problems. These warnings are only output
# when running at verbose mode, since it is fairly normal practice
# to have a single target definition file which supports 
# a number of different eCos applications with different I/O
# requirements.

namespace eval synth {
    # A list of all devices specified in the target definition file.
    # For now assume that a given device will only be specified once.
    variable _tdf_devices [list]
    
    # An array with additional details of each device. This will have
    # entries such as _tdf_device_options(eth0,4), where the second
    # argument is a per-device index. The value of each entry is
    # a list of the actual command and its arguments. This use of
    # an index allows for multiple instances of a per-device
    # option.
    array set _tdf_device_options [list]

    # While reading in the device details it is necessary to keep track
    # of the current device, if any. Otherwise the implementation of
    # "unknown" will not be able to update _tdf_device_options. An index
    # is needed as well.
    variable _tdf_current_device ""
    variable _tdf_current_index  0

    # Keep track of which devices and options have been consumed
    variable _tdf_consumed_devices [list]
    variable _tdf_consumed_options [list]
    
    proc tdf_has_device { name } {
	return [expr -1 != [lsearch -exact $synth::_tdf_devices $name]]
    }

    proc tdf_get_devices { } {
	return $synth::_tdf_devices
    }
    
    proc _tdf_get_option_index { devname option } {
	synth::_tdf_consume_device $devname
	for { set i 0 } { [info exists synth::_tdf_device_options($devname,$i)] } { incr i } {
	    if { $option == [lindex $synth::_tdf_device_options($devname,$i) 0] } {
		synth::_tdf_consume_option $devname $i
		return $i
	    }
	}
	return -1
    }
    
    proc _tdf_get_option_indices { devname option } {
	synth::_tdf_consume_device $devname
	set result [list]
	for { set i 0 } { [info exists synth::_tdf_device_options($devname,$i)] } { incr i } {
	    if { $option == [lindex $synth::_tdf_device_options($devname,$i) 0] } {
		synth::_tdf_consume_option $devname $i
		lappend result $i
	    }
	}
	return $result
    }
    
    proc tdf_has_option { devname option } {
	return [expr -1 != [synth::_tdf_get_option_index $devname $option]]
    }

    proc tdf_get_option { devname option } {
	set index [synth::_tdf_get_option_index $devname $option]
	if { -1 != $index } {
	    lappend synth::_tdf_consumed_options "$devname,$index"
	    return [lrange $synth::_tdf_device_options($devname,$index) 1 end]
	} else {
	    return [list]
	}
    }

    proc tdf_get_options { devname option } {
	set result [list]
	set indices [synth::_tdf_get_option_indices $devname $option]
	foreach index $indices {
	    lappend result [lrange $synth::_tdf_device_options($devname,$index) 1 end]
	}
	return $result
    }
    
    proc tdf_get_all_options { devname } {
	set result [list]
	for { set i 0 } { [info exists synth::_tdf_device_options($devname,$i)] } { incr i } {
	    lappend synth::_tdf_consumed_options "$devname,$index"
	    lappend result $synth::_tdf_device_options($devname,$i)
	}
	return $result
    }

    proc _tdf_consume_device { name } {
	if { -1 == [lsearch -exact $synth::_tdf_consumed_devices $name] } {
	    lappend synth::_tdf_consumed_devices $name
	}
    }

    proc _tdf_consume_option { devname index } {
	if { -1 == [lsearch -exact $synth::_tdf_consumed_options "$devname,$index"] } {
	    lappend synth::_tdf_consumed_options "$devname,$index"
	}
    }
    
    proc tdf_get_unconsumed_devices { } {
	set result [list]
	foreach devname $synth::_tdf_devices {
	    if { -1 == [lsearch -exact $synth::_tdf_consumed_devices $devname] } {
		lappend result $devname
	    }
	}
	return $result
    }

    proc tdf_get_unconsumed_options { } {
	set result [list]
	foreach devname $synth::_tdf_devices {
	    if { -1 == [lsearch -exact $synth::_tdf_consumed_devices $devname] } {
		# Do not report all the options for a device that has not been consumed at all
		continue
	    }
	    for { set i 0 } { [info exists synth::_tdf_device_options($devname,$i)] } { incr i } {
		if { -1 == [lsearch -exact $synth::_tdf_consumed_options "$devname,$i"] } {
		    lappend result [list $devname $synth::_tdf_device_options($devname,$i)]
		}
	    }
	}
	return $result
    }
}

# Look for the target definition file.
set _tdf $synth::target_definition
if { "" == $_tdf } {
    set _tdf "default"
}
set _config_file ""

set _dirlist [list [pwd] "~/.ecos/synth" $synth::install_dir]
foreach _dir $_dirlist {
    set _candidate "[file join $_dir $_tdf].tdf"  ; # file join does the right thing for absolute paths
    if { [file isfile $_candidate] } {
	set _config_file $_candidate
	break
    } else {
	set _candidate [file join $_dir $_tdf]
	if { [file isfile $_candidate] } {
	    set _config_file $_candidate
	    break
	}
    }
}
if { "" == $_config_file } {
    if { "" != $synth::target_definition } {
	# The user explicitly specified a file, so it must be read in.
	# If it cannot be found then that should be treated as an error.
	set msg "Unable to find target definition file $synth::target_definition\n"
	if { "absolute" !=  [file pathtype $synth::target_definition] } {
	    append msg "    Searched $_dirlist\n"
	}
	synth::report_error $msg
	exit 1
    } else {