Stop a TCL script from freezing while processing a command

Question

Okay so what I am doing on a high level is scanning a system for all VISA devices connected to it and having them identify themselves.

The problem is that not all VISA devices support the function to identify themselves and the only way I know of to find this out is by telling the device to do just that. This force ones that are not able to identify themselves to rely on the timeout which has a minimum of 1 second. While waiting on the timeout my TCL script and the Wish application freeze until the timeout is complete. With multiple devices this leaves me with an awkward wait time that can be several seconds long where I am unable to update the user on what is happening.

Here's my code:

proc ::VISA::Scan {} {
    # Open a temporary resource manager
    set TemporaryResourceManagerId [::visa::open-default-rm]

    # Get addresses for all devices on system
    foreach address [::visa::find $TemporaryResourceManagerId "?*"] {

        # Create temporary VISA channel
        set TemporaryChannel [visa::open $TemporaryResourceManagerId $address]

        # Have device identify itself while suppressing errors
        if {![catch {puts $TemporaryChannel "*IDN?"}]} {
            if {![catch {gets $TemporaryChannel} result]} {
                if {![string is space $result]} {
                    puts $address
                    puts "$result \n"
                }

                # Clear any potential errors
                puts $TemporaryChannel "*CLS"
            }
        }

        # Destroy temporary channel
        close $TemporaryChannel
        unset TemporaryChannel
    }

    # Destroy temporary resource manager
    close $TemporaryResourceManagerId
    unset TemporaryResourceManagerId
}

I was wondering if there is a way to prevent this on the TCL side since I have no way of knowing what types of devices I will be querying. I've tried using "update" and "update idletasks" at several different places in the script, but it just gives me a moment in between freezes.

Any help would be appreciated. Thanks in advance!

Answer 1

The standard way to do this to to use tcl's event loop by setting the I/O channel to non-blocking and using fileevent or chan event; however, the tclvisa documentation states that fileevent is not supported on visa channels.

So the next best thing is to use non-blocking I/O (which just sets the timeout to 0) and either busyloop reading the channel or reading it after a delay; either of these should be handled with the event loop rather than by sprinkling update around (which has undesirable side effects).

So to busyloop you could do something like this:

proc busyread {v n} {
    if {$::readdone == 1} {set ::$n "Error"}    
    set r [visa::read $v]
    if {$r == ""} {
        after 5 [list busyread $v $n]
    } else {
        set ::$n $r
        set ::readdone 1
    }
}


set f [visa::open ...]
fconfigure $f -blocking 0
after 1000 [list set ::readdone 1]
set ::readdone 0
busyread $f result
vwait ::readdone   
# $result will now be either the result, or "Error"

This continuously reschedules the read as long as it keeps coming back empty.

This will need to be restructured a bit to work within a larger gui program (the vwait and timeouts would need to be done differently), but this shows the basic method.