##############################################################################
#
# Design unit: HECTOR TCL language extension
#
# File name: HECTOR_data_acq.tcl
#
# Description: TCL language extension providing high-level access to
# communication interface with HECTOR evaluation boards.
#
# System: TCL v. 8.5 and higher
#
# Author: O. Petura - Hubert Curien Laboratory
#
# Copyright: Hubert Curien Laboratory, 2016
#
# Revision: Version 1.00, April 2016
#
##############################################################################
# Timeout for the UART response in seconds
set UART_timeout 5
# Timeout between two consequent checks of UART input buffer
set uart_check_timeout 100
# Opens a connection to HECTOR evaluation board
proc openDevice {dev {baudrate 460800} {verbose 0}} {
global tcl_platform
# Append \\.\ to serial port number when we are running on Windows
if {[string first "Win" $tcl_platform(os)] != -1} {
set dev "\\\\.\\$dev"
}
# Open the serial device
if { [catch { open $dev "r+" } fd ] } {
if {$verbose != 0} {
puts "Error opening device '$dev'\n Error description: $::errorInfo"
}
puts "Error opening device '$dev'"
set ret -1
} else {
# Configure communication parameters
fconfigure $fd -blocking 0 -buffering none -mode "$baudrate,n,8,1" -translation binary -eofchar {}
# Update the application status
puts "Connection to '$dev' opened"
# Create device handle
set ret [list $dev $fd]
}
return $ret
}
# Disconnect from the HECTOR evaluation board
proc disconnect {device} {
# Close the connection to the serial device
close [lindex $device 1]
# Update the application status
puts "Connection to '[lindex $device 0]' closed"
}
# Poll the serial device for input data
proc pollDevice {device {verbose 0}} {
# Read the input serial buffer
set data [read [lindex $device 1]]
# If there is something, process it
if {[string length $data] != 0} {
if {$verbose != 0} {
puts "Received data: [binToHEX $data]"
}
# Get the MSS status packet header offset
set offset [string first "\x13\x57\x00\x00" $data]
if {$offset != -1} {
# Get the status fields
set response [string range $data [expr $offset + 11] [expr $offset + 11]]
set progress [string range $data [expr $offset + 8] [expr $offset + 8]]
set aq_state [string range $data [expr $offset + 9] [expr $offset + 9]]
set gpio [string range $data [expr $offset + 10] [expr $offset + 10]]
binary scan $response c1 ret(response)
binary scan $progress c1 ret(progress)
binary scan $aq_state c1 ret(aq_state)
set ret(gpio) [binToHEX $gpio]
return [list $ret(response) $ret(progress) $ret(aq_state) $ret(gpio)]
} else {
# Get the FPGA status packet header offset
set offset [string first "\x13\xF5\x00\x00" $data]
if {$offset != -1} {
# Get the status fields
set fpga_data [string range $data [expr $offset + 4] [expr $offset + 7]]
set fpga_status [string range $data [expr $offset + 8] [expr $offset + 11]]
set ret(fpga_data) [binToHEX $fpga_data]
set ret(fpga_status) [binToHEX $fpga_status]
return [list $ret(fpga_status) $ret(fpga_data)]
}
}
} else {
set ret(response) -1
set ret(appError) 1
return [list $ret(response) $ret(appError)]
}
}
# Wait for a specified time
proc wait_ms {ms} {
# Create a variable name
set varName finished_[clock clicks]
global $varName
# Set the variable after a specified timeout
after $ms set $varName 1
# Wait for the variable to be set
vwait $varName
# Clear the variable from memory
unset $varName
}
# Convert a binary string to HEX
proc binToHEX {in} {
set ret ""
for {set i 0} {$i < [string length $in]} {incr i} {
binary scan [string index $in $i] c1 byte
if {$byte < 0} {set byte [expr 256 + $byte]}
set HI [expr $byte >> 4]
set LO [expr $byte & 15]
switch $HI {
0 {append ret "0"}
1 {append ret "1"}
2 {append ret "2"}
3 {append ret "3"}
4 {append ret "4"}
5 {append ret "5"}
6 {append ret "6"}
7 {append ret "7"}
8 {append ret "8"}
9 {append ret "9"}
10 {append ret "A"}
11 {append ret "B"}
12 {append ret "C"}
13 {append ret "D"}
14 {append ret "E"}
15 {append ret "F"}
}
switch $LO {
0 {append ret "0"}
1 {append ret "1"}
2 {append ret "2"}
3 {append ret "3"}
4 {append ret "4"}
5 {append ret "5"}
6 {append ret "6"}
7 {append ret "7"}
8 {append ret "8"}
9 {append ret "9"}
10 {append ret "A"}
11 {append ret "B"}
12 {append ret "C"}
13 {append ret "D"}
14 {append ret "E"}
15 {append ret "F"}
}
}
return $ret
}
# Convert DEC to HEX
proc toHEX {in} {
set ret ""
set dec $in
while { $dec > 0 } {
set rest [expr $dec % 16]
switch $rest {
0 {set ret "0$ret"}
1 {set ret "1$ret"}
2 {set ret "2$ret"}
3 {set ret "3$ret"}
4 {set ret "4$ret"}
5 {set ret "5$ret"}
6 {set ret "6$ret"}
7 {set ret "7$ret"}
8 {set ret "8$ret"}
9 {set ret "9$ret"}
10 {set ret "A$ret"}
11 {set ret "B$ret"}
12 {set ret "C$ret"}
13 {set ret "D$ret"}
14 {set ret "E$ret"}
15 {set ret "F$ret"}
}
set dec [expr $dec / 16]
}
return $ret
}
# Function to convert HEX to DEC
proc fromHEX {in} {
set in_end [expr [string length $in] - 1]
set ret 0
for {set i $in_end} {$i >= 0} {incr i -1} {
switch [string index $in $i] {
"0" {set val 0}
"1" {set val 1}
"2" {set val 2}
"3" {set val 3}
"4" {set val 4}
"5" {set val 5}
"6" {set val 6}
"7" {set val 7}
"8" {set val 8}
"9" {set val 9}
"A" {set val 10}
"B" {set val 11}
"C" {set val 12}
"D" {set val 13}
"E" {set val 14}
"F" {set val 15}
}
set ret [expr $ret + ($val * (16**($in_end - $i)))]
}
return $ret
}
# Function to read bit value from a specific bit field in decimal value
proc getBitValue {decNumber bitFieldIndex} {
return [expr ( $decNumber & (2**$bitFieldIndex) ) >> $bitFieldIndex]
}
##############
## COMMANDS ##
##############
proc getStatus {device {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xC0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending: [binToHEX $data]"
}
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
set st1 $resp
set data "\x13\xFB\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
set st2 $resp
set status [list [lindex $st1 0] [lindex $st1 1] [lindex $st1 2] [lindex $st1 3] [lindex $st2 0] [lindex $st2 1]]
return $status
}
proc sendFabricCommand {device command data {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xFB\x00\x00[binary format I1 $data][binary format I1 $command]"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc sendFabricReset {device {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xC0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc sendDaughterReset {device {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xC0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc mountDisk {device {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xC0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc createFileSystem {device {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xC0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc beginAcquisition {device filename size {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xFD\x00\x00$filename [binary format I1 $size]"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending command: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc loadInputFile {device filename size {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\x3D\x00\x00$filename [binary format I1 $size]"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending command: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc configureGPIO {device GPIO {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xC0\x00\x00\x00\x00\x00\x00\x00\x00[binary format c1 $GPIO]\x09"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending command: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc setGPIO {device GPIO {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xC0\x00\x00\x00\x00\x00\x00\x00\x00[binary format c1 $GPIO]\x0A"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending command: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
proc softReset {device {verbose 0}} {
global UART_timeout
global uart_check_timeout
set data "\x13\xC0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0B"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending command: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
# board =
# 1 - HDMI
# 2 - SATA
proc selectDaughterBoard {device board {verbose 0}} {
global UART_timeout
global uart_check_timeout
if { $board == 1 } {
set command 2
} elseif { $board == 2 } {
set command 3
} else {
set command 0
}
set data "\x13\xFB\x00\x00\x00\x00\x00\x00[binary format I1 $command]"
puts -nonewline [lindex $device 1] $data
if {$verbose != 0} {
puts "Sending command: [binToHEX $data]"
}
# Return the response of the command
set resp "-1 1"
set start [clock seconds]
while { [string match $resp "-1 1"] } {
set resp [pollDevice $device $verbose]
if { [clock seconds] > [expr $start + $UART_timeout] } {
break
}
wait_ms $uart_check_timeout
}
return $resp
}
###########################
## Application functions ##
###########################
# Find the connected disk drives
proc findDiskDrives {} {
global tcl_platform
set drives ""
if {[string match $tcl_platform(os) "Linux"]} {
if { [catch {exec blkid} disks] } {
puts "blkid is not available. Automatic disk recognition is impossible."
return -1
} else {
set disks [split $disks "\n"]
foreach disk $disks {
set uuid_offset [string first "UUID=" $disk]
set device [string range $disk 0 [expr [string first ":" $disk] - 1]]
# Get the mountpoint
set mountpoint ""
set f [open "/proc/mounts" "r"]
while { [gets $f line] >= 0} {
if {[string first $device $line] != -1} {
set mountpoint [lindex $line 1]
break
}
}
close $f
if { $uuid_offset != -1 } {
set uuidStart [expr $uuid_offset + 5]
set uuidEnd [string first "\"" $disk [expr $uuidStart + 1]]
set uuidString [string range $disk [expr $uuidStart + 1] [expr $uuidEnd - 1]]
lappend drives [list $device $uuidString $mountpoint]
}
}
}
} elseif {[string first "Win" $tcl_platform(os)] != -1} {
set disks [file volumes]
foreach disk $disks {
set disk [string range $disk 0 end-1]
if {[catch {exec cmd /c vol $disk} resp]} {
continue
} else {
set disk [string range $disk 0 end-1]
set uuidString [string range $resp end-8 end]
lappend drives [list $disk $uuidString "$disk:/"]
}
}
} else {
puts "Only linux and windows platforms are supported for the moment"
return -1
}
return $drives
}
# Find HECTOR disk
proc findHECTOR {{timeout 5}} {
set start [clock seconds]
set hectorDrive 0
while { $hectorDrive == 0 && [expr [clock seconds] - $start] < $timeout} {
set disks [findDiskDrives]
foreach disk $disks {
if { [string match "48A1-0000" [lindex $disk 1]] } {
set hectorDrive $disk
break
}
}
wait_ms 100
}
return $hectorDrive
}
# Sync filesystem
proc syncDrives {} {
global tcl_platform
if {[string match $tcl_platform(os) "Linux"]} {
if { [catch {exec sync} ret] } {
puts "Disk sync failed."
return -1
} else {
return 0
}
} elseif {[string first "Win" $tcl_platform(os)] != -1} {
if { [catch {exec "sync.exe"} ret] } {
puts "Disk sync failed."
return -1
} else {
return 0
}
} else {
puts "Only linux and windows platforms are supported for the moment"
return -1
}
}
proc acquireData {device filename filesize {interface 0} {debug 0}} {
global tcl_platform
# Reset the FPGA controller
set err [softReset $device $debug]
if {[lindex $err 0] != 0} {
puts "Soft reset failed with code $err"
return $err
}
# Set the right interface
# 0 = SATA
# 1 = HDMI
if { $interface == 0 } {
set err [sendFabricCommand $device 3]
if { [lindex $err 0] != 0 } {
puts "Interface set error. Code: $err"
}
} elseif { $interface == 1 } {
set err [sendFabricCommand $device 4]
if { [lindex $err 0] != 0 } {
puts "Interface set error. Code: $err"
}
}
# Reset the daugther module
set err [sendDaughterReset $device $debug]
if {[lindex $err 0] != 0} {
puts "Daughter reset failed with code $err"
return $err
}
# Create filesystem
set err [createFileSystem $device $debug]
if {[lindex $err 0] != 0 } {
puts "Filesystem creation failed with code $err"
return $err
}
## Create a progressbar
# set progressbar {[=====|=====|=====|=====]}
# puts $progressbar
# set progressStep [expr 100.0 / ([string length $progressbar] - 2)]
# Start the measurement
set err [beginAcquisition $device ACQ $filesize]
if {[lindex $err 0] != 0 } {
puts "Acquisition failed to start. Error code: $err"
return $err
}
# set progress 0
# puts -nonewline {[}
# flush stdout
while {[lindex $err 2] != 0} {
set err [getStatus $device $debug]
if {[lindex $err 0] != 0 } {
puts "An error occured during data acquisition. Error code: $err"
return $err
} else {
puts -nonewline "[lindex $err 1] %\r"
flush stdout
#if { [lindex $err 1] > $progress } {
# set steps [expr ([lindex $err 1] - $progress) / $progressStep]
# if { $steps >= 1 } {
# set progress [expr $progress + ( floor($steps) * $progressStep)]
# #puts "$progress - $steps"
# for {set i 0} {$i < [expr floor($steps)]} {incr i} {
# puts -nonewline "#"
# flush stdout
# }
# }
#}
}
}
puts {}
flush stdout
# Mount the disk
set err [mountDisk $device $debug]
if {[lindex $err 0] != 0} {
puts "Mounting disk failed with error code $err"
return $err
}
# Search for the hector disk
set hectorDrive [findHECTOR 5]
if { $hectorDrive == 0 } {
puts "Hector disk drive not found. You will have to search for it manually."
return 1
}
# Check for the mountpoint
if { [string length [lindex $hectorDrive 2]] == 0 } {
puts "Hector disk drive is not mounted. Please mount the device [lindex $hectorDrive 0]."
return 1
}
# Copy the file from hector disk to the PC
if { [string match $tcl_platform(os) "Linux"] } {
puts [lindex $hectorDrive 2]/ACQ
file copy -force [lindex $hectorDrive 2]/ACQ $filename
} elseif { [string first $tcl_platform(os) "Win"] != -1 } {
file copy -force {"[lindex $hectorDrive 2]/ACQ"} $filename
}
puts "Acquired data are available in the file $filename"
return 0
}
proc hex2bin {hexIn {spaceSeparated 0}} {
set outStr ""
for {set i 0} {$i < [string length $hexIn]} {incr i} {
set char [string index $hexIn $i]
switch -glob $char {
"0" {set outStr "$outStr 0000"}
"1" {set outStr "$outStr 0001"}
"2" {set outStr "$outStr 0010"}
"3" {set outStr "$outStr 0011"}
"4" {set outStr "$outStr 0100"}
"5" {set outStr "$outStr 0101"}
"6" {set outStr "$outStr 0110"}
"7" {set outStr "$outStr 0111"}
"8" {set outStr "$outStr 1000"}
"9" {set outStr "$outStr 1001"}
"A" {set outStr "$outStr 1010"}
"a" {set outStr "$outStr 1010"}
"B" {set outStr "$outStr 1011"}
"b" {set outStr "$outStr 1011"}
"C" {set outStr "$outStr 1100"}
"c" {set outStr "$outStr 1100"}
"D" {set outStr "$outStr 1101"}
"d" {set outStr "$outStr 1101"}
"E" {set outStr "$outStr 1110"}
"e" {set outStr "$outStr 1110"}
"F" {set outStr "$outStr 1111"}
"f" {set outStr "$outStr 1111"}
default {}
}
}
if { $spaceSeparated == 0 } {
set outStr [string map {" " {}} $outStr]
}
return $outStr
}
proc bin2hex {binIn} {
set outStr ""
for {set i 0} {$i < [string length $binIn]} {set i [expr $i+4]} {
set char4 [string range $binIn [expr $i] [expr $i+3] ]
switch -glob $char4 {
"0000" {set outStr "$outStr 0"}
"0001" {set outStr "$outStr 1"}
"0010" {set outStr "$outStr 2"}
"0011" {set outStr "$outStr 3"}
"0100" {set outStr "$outStr 4"}
"0101" {set outStr "$outStr 5"}
"0110" {set outStr "$outStr 6"}
"0111" {set outStr "$outStr 7"}
"1000" {set outStr "$outStr 8"}
"1001" {set outStr "$outStr 9"}
"1010" {set outStr "$outStr A"}
"1011" {set outStr "$outStr B"}
"1100" {set outStr "$outStr C"}
"1101" {set outStr "$outStr D"}
"1110" {set outStr "$outStr E"}
"1111" {set outStr "$outStr F"}
default {}
}
}
set outStr [string map {" " {}} $outStr]
return $outStr
}