################################################################################
# package name modbus.tcl
#
# Abstract: serial modbus rtu plc driver
#
# Author: Steve Redler IV 06-1-2008
#
# DB9 female 6P6C 6-pin phone plug - Port 2 on plc
# 2 rxd ------------- 4 txd /--///--/|
# 3 txd ------------- 3 rxd /__[#]__//
# 5 gnd ------------- 1 gnd |123456|/
# --------
# 7 rts --\ jumper
# 8 cts --/
source crc16.tcl
package require crc16
proc modbussendmsg {message responsesize device timeoutms} {
set fh [open $device "RDWR"]
fconfigure $fh -translation binary -mode 9600,e,8,1 -buffering none -blocking 0
flush $fh; set junk [read $fh]; # clear buffer
puts -nonewline $fh $message
flush $fh
set timeoutctr 0
set reply ""
while {[string bytelength $reply] < $responsesize && $timeoutms >= $timeoutctr } {
binary scan [read $fh] H* asciihex
if {$asciihex != ""} {
append reply $asciihex
}
after 5
incr timeoutctr 5
}
if {$timeoutms < $timeoutctr} {set reply "timeout"}
close $fh
return $reply
}
proc modbuscommand {args} {
if {[llength $args] == 7} {
foreach {slaveaddr function startreg pointcount databytes device timeoutms} $args {}
} else {
foreach {slaveaddr function startreg pointcount device timeoutms} $args {}
}
switch $pointcount {
on {set pointcount 65280}
off {set pointcount 0}
}
append message [binary format c $slaveaddr]
append message [binary format c $function]
if {$startreg != {}} {append message [binary format S $startreg]}
switch $function {
12 {if {$pointcount != {}} {append message [binary format S $pointcount]}
}
6 {append message [binary format H* $pointcount]}
15 -
16 {append message [binary format S $pointcount]
append message [binary format c [expr [string length $databytes] /2]]
append message [binary format H* $databytes]
}
22 {#not available in DL05/06
append message [binary format H* $pointcount]
append message [binary format H* $databytes]
}
default {if {$pointcount != {}} {append message [binary format S $pointcount]}
}
}
set checksum [::crc::crc16 -seed 0xFFFF $message]
set checksum [binary format s $checksum]
append message $checksum
#binary scan $message H* msg ; puts "msg=$msg"
switch $function {
1 -
2 {set responsesize [expr $pointcount / 4 +5 *2]}
3 {set responsesize [expr $pointcount * 4 +5 *2]}
4 {set responsesize [expr $pointcount * 4 +5 *2]}
default {set responsesize 12}
}
set result [modbussendmsg $message $responsesize $device $timeoutms]
if {$result == "timeout"} {return $result}
if {[string index $result 2] <= 7} {
if {$function <= 4} {
set result [string range $result 6 end-4]
} else {
set result "ok"
}
} else {
set result "error"
}
return $result
}
#############################################################
# test examples #
#############################################################
set port /dev/ttyUSB0
set timeout 1000
#read discrete outputs 0x ref (returns 1 byte per 8 output bits)
puts [modbuscommand 5 1 2048 8 $port $timeout]
#read disrcete input status 1x ref (returns 1 byte per 8 input bits)
puts [modbuscommand 5 2 2048 8 $port $timeout]
#read holding registers 4x ref (returns 2 bytes per 1 16bit register)
puts [modbuscommand 5 3 2100 8 $port $timeout]
#read input register 3x ref (returns 2 bytes per 1 16bit register)
puts [modbuscommand 5 4 2048 8 $port $timeout]
#force single output coil on
puts [modbuscommand 5 5 2049 on $port $timeout]
#preset a single register 4x ref
puts [modbuscommand 5 6 1 4444 $port $timeout]
puts [modbuscommand 5 3 1 1 $port $timeout]
#force multiple output coils on 8
puts [modbuscommand 5 15 2049 8 ff00 $port $timeout]
#force multiple output coils off 8
puts [modbuscommand 5 15 2049 8 0000 $port $timeout]
#preset multiple registers addr 2048 count 2 datavalues ff00aa33
puts [modbuscommand 5 16 2048 2 ff00aa33 $port $timeout]
puts [modbuscommand 5 16 2100 4 1234567812345678 $port $timeout]
#read exception status
#puts [modbuscommand 5 7 {} {} $port $timeout]
#read slave id
#puts [modbuscommand 5 17 {} {} $port $timeout]
#read comm event counter n/a
#puts [modbuscommand 5 11 {} {} $port $timeout]
#mask write 4x register addr 2049 andmask 00f2 ormask 0025 n/a
#puts [modbuscommand_b 5 22 41089 00f2 0025 $port $timeout]