Tcl Source Code

Just some more detail about GPIB. It is a different beast compared to a TCP stream and I truly need an exception script to manage the 1980s-era hardware I'm talking with.

The Theory of Serial Polling

"Because these bit definitions are not consistent among instrument vendors, the method for determining the cause of a service request varies with each device."

An example of my use would be the following:

 # Set up the exception script to manage STB from the incoming
 # SRQ/RQS alerts on the bus.
 #
 fileevent $dmm exception \
        [list dmm_stb $dmm [subst -noc {[fconfigure $dmm -pop_stb]}]]

 # Our exception (STB - status byte) handler script
 #
 proc dmm_stb {chan stb} {

    # Split the STB byte into the informational components as described on
    # page 3-24 of the Tektronix DM 5010 manual
    # https://w140.com/tekwiki/images/5/5e/070-2994-01.pdf
    #
    binary scan [binary format c $stb] B8 bstr
    lassign [list [string index $bstr 0] \
              [string index $bstr 1] \
              [string index $bstr 2] \
              [string index $bstr 3] \
              [string range $bstr 4 end]] class RQS abnormal busy event

    # Ignore $RQS as we already know this will be set, as this is where we
    # came from as an SPOLL response to the SRQ interrupt that has now
    # been cleared.

    if {$class} {
        # DEVICE STATUS

        # split event bits
        lassign [list [string index $event 0] \
                [string index $event 1] \
                [string range $event 2 end]] trigger readable statusCode

        # alert for a readable condition interrupt happens here
        if {$readable} {
            set acv [format %f [string trimright [read $chan] {;}]]
            puts ">DM5010: ${acv} Vrms"
        }

        # fall through ->

        # $trigger is available, but serves no purpose for us here.
        # Maybe untrigger now because we got a readable notification, too?

        set code [expr "0b$statusCode"]    ;# [scan] doesn't do this
        switch -- $code {
            0 {
                #no errors or events
            }
            1 {puts ">DM5010: Below limits device status"}
            3 {puts ">DM5010: Above limits device status"}
            default { puts ">DM5010: Unhandled device status code: $code" }
        }
        
    } else {
        # EVENT CLASS

        if {$abnormal} {
            # ask what error
            puts $chan {err?}
            set errCode [string trimright [read $chan] {;}]

            switch -- $errCode {
                101 {set err "Invalid command header"}
                102 {set err "Header delimiter error"}
                103 {set err "Argument error"}
                104 {set err "Argument delimiter error"}
                106 {set err "Missing argument"}
                107 {set err "Invalid message unit delimiter"}
                201 {set err "Not executable in local mode"}
                202 {set err "Settings lost due to RTL"}
                203 {set err "Input and output buffers full"}
                205 {set err "Argument out of range"}
                206 {set err "Group Execute Trigger ignored"}
                231 {set err "Not in calibrate mode"}
                232 {set err "Beyond calibration or null capability"}
                301 {set err "Interrupt fault"}
                302 {set err "System error"}
                303 {set err "Math pack error"}
                311 {set err "Converter time-out"}
                317 {set err "Front panel time-out"}
                318 {set err "Bad ohms calibration constant"}
                351 {set err "Calibration checksum error"}
                default {set err "Unknown instrument error"}
            }
            puts ">DM5010: ERROR $errCode: $err"
            return
        }

        # normal events

        # $busy would indicate the message processor is in a busy
        # state, at the moment.  Why would we care to know?
        
        set code [expr "0b$event"]    ;# [scan] doesn't do this
        
        switch -- $code {
            1 {puts ">DM5010: Power-on initialization detected."; dmm_init $chan}
            2 {puts ">DM5010: Operation complete."}
            3 {puts ">DM5010: You pressed the 'inst id' key."}
            6 {puts ">DM5010: Over-range condition detected."}
            default { puts ">DM5010: Unhandled normal event code: $code" }
        }
    }
 }

I've been pondering this change. exception events on, say a TCP socket, could not only include the OOB byte, but could be used to receive QOS changes, and even nameserver lookups. Maybe something like this:

chan event $sock exception [list socket_except $chan [subst -noc {[chan configure $chan -pop_except_type]}]]

proc socket_except {chan type} {
    switch -- $type {
        qos {
             set qos_data [chan configure $chan -pop_qos]
        }
        oob {
             set byte [binary scan c [chan configure $chan -pop_oob]]
        }
    }
}

From the Tcl_EventProc queued in from the prior Tcl_EventSetupProc of my channel driver's event source, when it calls Tcl_NotifyChannel(..,TCL_EXCEPTION), what happens?

Absolutely nothing because [fileevent] is missing the "exception" event type. I create the channel with TCL_EXCEPTION as a valid mask:

    return Tcl_CreateChannel(&AgpibChannelType, channelName,
        (ClientData)infoPtr, TCL_EXCEPTION);

int mask (in) An OR-ed combination of TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION that indicates events that have occurred on this channel.