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.

Answer 2

You have to use after and fileevent to handle timeout asynchronously. It's not that easy, especially in pre-Tcl8.6: you have to split a procedure into a bunch of event handlers, passing all necessary information to them.

Schedule a timeout handler:

proc handleTimeout {channel} {
    ....
    close $channel
    .... # or do some other thing, 
    .... # but don't forget to remove fileevent handler if not closing!
}
....
after 1000 [list handleTimeout $TemporaryChannel]

Make channel non-blocking, install a fileevent handler:

proc tryGetsIDN {channel} {
    if {[gets line]!=-1} {
        # We have an answer!
        # Cancel timeout handler
        after cancel [list handleTimeout $TemporaryChannel]
        ....
    }
}
....
fconfigure $TemporaryChannel -blocking 0
fileevent $TemporaryChannel readable [list tryGetsIDN $TemporaryChannel]

The hardest part: make sure you handle GUI events appropriately, e.g. if there is a "cancel" button to cancel all asynchronous handlers, make sure to close channels and cancel timeout handlers (additional bookkeeping of channels and handlers may be required here).

With Tcl 8.6, you can use coroutines to make your procedure work as a cooperative "background thread": it's easy to implement "gets with timeout" which yields from a coroutine and reenters it upon completion or timeout. No ready-to-use solution out of box yet, though.

Answer 3

I actually found a solution on the tclvisa side of my problem. I found a better way to specify the timeout for the channel rather than using the built in tclvisa command which I incorrectly assumed I had to use.

fconfigure $TemporaryChannel -timeout 100

Setting this timeout doesn't completely solve the problem, but it reduces it to the point of obscurity. Thanks for all the responses!