# $Id: DMH_forward.tcl,v 1.2 2004/10/13 18:32:23 hume Exp $
#
# $Log: DMH_forward.tcl,v $
# Revision 1.2  2004/10/13 18:32:23  hume
# Improved comments.
#
# Revision 1.1.1.1  2004/09/07 19:03:13  hume
# First checkin.
#
#

############################# DMH_forward ###########################################
############################# DMH_forward ###########################################
############################# DMH_forward ###########################################
# Forward a received SECS message to a DMH mailbox for remote handling.
# This procedure is used by either Host or Equipment logic.
#
# message format - a Tcl list 
#
# for inbound primary messages:
#  <stream> <function> <reply_wanted> <transactionID> <TSN_data>  <header>
#     int      int        1|0             int            string    {10 ints}
#
# <transactionID> is also known as "system bytes" - a 4 byte integer
# <header> is needed in case you want to send a Stream 9 message with the header data
#
proc DMH_forward {spname {destbox {}}} {
    global $spname
    # forward SECS message to DMH client mailbox
    # need system bytes (transaction ID)
    set lastheader [$spname lastheader]
    set s3 [lindex $lastheader 6]
    set s2 [lindex $lastheader 7]
    set s1 [lindex $lastheader 8]
    set s0 [lindex $lastheader 9]
    set system [expr {($s3 << 24) | ($s2 << 16) | ($s1 << 8) | $s0}]
    # this winds up being signed 32 bit 
    set SFR [set ${spname}(lastrSFR)] ;# S1F1R
    if { [string first R $SFR] > 0 } { set R 1 } else {set R 0}
    scan $SFR "S%dF%d" stream function
    set msg [set ${spname}(lastrmsg)]

    # destination mailbox - optional argument
    if { $destbox == {}} { set destbox ${spname}_SECS_RECV }

    # SECS MESSAGES SENT TO DMH MAILBOX 
    mbx put $destbox [list $stream $function $R $system $msg $lastheader] 
    }

################################# DMH_reply #########################################
################################# DMH_reply #########################################
################################# DMH_reply #########################################
#
# Send a SECS reply message where the caller provides the transaction ID/SYSTEM bytes
# This call supports usage of DMH_forward - the client has a way to specify which
# message instance he is replying to, which in the general case is not always the
# latest one received.
#
# If the <transactionID> is passed as 0, the logic will send the reply for the
# latest matching inbound message.
#
# In SECS, the reply function is an even value, the inbound value +1
# If you call this procedure with an odd function value, we will add 1 for the reply
#
# This procedure is used by either Host or Equipment logic.
# Equipment reply messages are not spooled so for either the host or the
# equipment, we can put the reply out on the wire.
#
proc DMH_reply {spname stream function transactionID {tsndata {}}} {
    global $spname
    # make sure function is for the reply and not the primary
    if { $function & 0x01 } { incr function }
    set sfr S${stream}F${function}
    if { $transactionID != 0 } {  ;# caller specifying SYSTEM bytes
        set subscript RH_$sfr
        set ${spname}($subscript) $transactionID
        }
    # a new developer is going to make formatting mistakes so trap errors and give feedback
    if { [catch {$spname put $sfr $tsndata}] } {
        mbx put TCL_ERROR "ERROR in Tcl procedure DMH_reply called by SecsPort SendReply()\n$::errorInfo"
        }
    }


################################ DMH_trace ##################################
################################ DMH_trace ##################################
################################ DMH_trace ##################################
#
# monitor array items such as (state), (strace), (rtrace),
# (trace) - send notification messages
# to a DMH mailbox when the values changes
#
# This procedure is used by either Host or Equipment logic.
#
proc DMH_trace {spname subscripts destbox} {
    global ${spname} 
    # to pass the destbox argument into a variable trace, 
    # we create a procedure with the destbox value as a default 
    set procname DMH_trace_${spname}_${destbox}
    proc $procname [list spname subscript op [list destbox $destbox]] {
        # Tcl list format:
        # set <name> <value>
        if { $op != "w" } return
        global $spname DMH_trace_lasttime
        set value [set ${spname}($subscript)]
        # eliminate multiple notifications of same value
        if { [info exists DMH_trace_lasttime($spname,$subscript)] && \
          $value == $DMH_trace_lasttime($spname,$subscript) } { return }
        set DMH_trace_lasttime($spname,$subscript) $value
        catch {mbx put $destbox [list set $subscript $value]}
        }
    foreach subscript $subscripts {
        if { ![info exists ${spname}($subscript)] } { 
            set ${spname}($subscript) {}
            }
        trace variable ${spname}($subscript) w $procname 
        # send the current value
        set ${spname}($subscript) [set ${spname}($subscript)]
        }
    }