Restored accidentally removed file.

r1244 | ffr | 2006-11-07 12:57:45 +1100 (Tue, 07 Nov 2006) | 2 lines
2006-11-07 12:57:45 +11:00
parent 3d0bae3859
commit 65d0b79508
8 changed files with 601 additions and 0 deletions
--- a/site_ansto/instrument/deploySICS.sh
+++ b/site_ansto/instrument/deploySICS.sh
@@ -0,0 +1,105 @@
+#!/bin/sh 
+# $Revision: 1.8 $
+# $Date: 2006-11-07 01:45:20 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by $Author: ffr $
+
+# Deploys SICServer and configuration files to
+# an instrument control computer.
+# It requires a MANIFEST.TXT file for each instrument
+
+usage()
+{
+echo deploySICS.sh copies SICS and the files listed
+echo in the MANIFEST.TXT files to the IC host.
+echo -e "Usage:\t./deploySICS.sh INSTRUMENT [TARGET_HOST TARGET_DIR]";
+echo -e "\t./deploySICS.sh test/INSTRUMENT [TARGET_HOST TARGET_DIR]";
+echo -e "\twhere INSTRUMENT can be hrpd, echidna, hipd, wombat ...";
+echo -e "\tTARGET_HOST can be a remote host or 'localhost'";
+echo -e "\twill create last directory in TARGET_DIR if necessary";
+}
+
+if  [ $# -eq 0 -o $# -eq 2 -o $# -gt 3 ]
+then
+  usage
+  exit 1
+fi
+
+
+INSTRUMENT=$1
+
+SRCDIR=./
+DESTDIR=${3:-/usr/local/}
+mkdir -p ~/tmp/$DESTDIR
+rm -fr ~/tmp/$DESTDIR/*
+
+# Set the destination host and the
+# instrument src directory
+case $INSTRUMENT in 
+hrpd|echidna)
+DESTHOST=${2:-ics1-echidna.nbi.ansto.gov.au}
+INSTSRC=hrpd;;
+hipd|wombat)
+DESTHOST=${2:-ics1-wombat.nbi.ansto.gov.au}
+INSTSRC=hipd;;
+qld|koala)
+DESTHOST=${2:-ics1-koala.nbi.ansto.gov.au}
+INSTSRC=qld;;
+reflectometer|platypus)
+DESTHOST=${2:-ics1-platypus.nbi.ansto.gov.au}
+INSTSRC=reflectometer;;
+rsd|kowari)
+DESTHOST=${2:-ics1-kowari.nbi.ansto.gov.au}
+INSTSRC=qld;;
+sans|quokka)
+DESTHOST=${2:-ics1-quokka.nbi.ansto.gov.au}
+INSTSRC=sans;;
+tas|taipan)
+DESTHOST=${2:-ics1-taipan.nbi.ansto.gov.au}
+INSTSRC=tas;;
+test/*)
+#copy TEST_SICS/fakeDMC
+#TESTSRC=TEST_SICS
+cp -a TEST_SICS/* ~/tmp/$DESTDIR
+rm -fr $(find ~/tmp/$DESTDIR -name CVS)
+DESTHOST=$2
+INSTSRC=$(basename $INSTRUMENT);;
+esac
+
+echo $DESTHOST
+if [ $DESTHOST = "localhost" ]
+then
+EXTRACT="tar vxz -C /"
+else
+EXTRACT="ssh $DESTHOST tar vxz -C /"
+fi
+
+if [ ! -e $SRCDIR/MANIFEST.TXT ]
+then
+echo "$SRCDIR/MANIFEST.TXT not found"
+exit 1
+fi
+if [ ! -e $INSTSRC/MANIFEST.TXT ]
+then
+echo "$INSTSRC/MANIFEST.TXT not found"
+echo "You must list the files required for $INSTRUMENT in the manifest"
+exit 1
+fi
+
+# Get list of files to copy 
+COMMON=$(for f in $(cat $SRCDIR/MANIFEST.TXT); do echo -n "$SRCDIR/$f "; done)
+INSTSPEC=$(for f in $(cat $INSTSRC/MANIFEST.TXT); do echo -n "$INSTSRC/$f "; done)
+
+mkdir -p ~/tmp/$DESTDIR/sics/{server,data,log,tmp}
+cp $COMMON $INSTSPEC ~/tmp/$DESTDIR/sics/server
+cp ../SICServer ~/tmp/$DESTDIR/sics/server
+
+# Create a manifest of the files installed on the IC host
+echo "Date: $(date -Iminutes)" > ~/tmp/$DESTDIR/sics/server/MANIFEST.TXT
+echo -e "The following files were installed by $USER\n" >> ~/tmp/$DESTDIR/sics/server/MANIFEST.TXT
+cat $SRCDIR/MANIFEST.TXT $INSTSRC/MANIFEST.TXT >> ~/tmp/$DESTDIR/sics/server/MANIFEST.TXT
+
+cd ~/tmp/
+
+# Strip leading / from DESTDIR and extract to destination
+tar -cz ${DESTDIR:1} | $EXTRACT 
--- a/site_ansto/instrument/dmc2280_util.tcl
+++ b/site_ansto/instrument/dmc2280_util.tcl
@@ -0,0 +1,71 @@
+# $Revision: 1.6 $
+# $Date: 2006-11-07 01:48:22 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by $Author: ffr $
+
+# globals controller, channel
+
+# Open a communications channel to a dmc2280 motor controller
+# contName: controller name, eg dmc2280_controller1
+# The host and port in the SICS configuration file will be used by default
+proc dmc_connect {contName {host ""} {port ""}} {
+  upvar #0 $contName controller;
+  global channel;
+
+  if {$host == ""} {set host $controller(host)}
+  if {$port == ""} {set port $controller(port)}
+
+  if [catch {socket $host $port} con] {
+    error "Failed to connect to $contName IP($host) port($port)\n\
+    $con\n
+    Is the motor controller switched on? Are the network cables plugged in?\n
+    NOTE: You can only have a maximum of eight connections per motor controller.\n
+    If there are other programs (eg SICS) connected to the controller then all\n
+    of the available connections may have been used up."
+  }
+  set controller(socket) $con
+  set channel($contName) $con
+  set channel($con) $contName
+  set channel($controller(host)) $con
+  fconfigure $con -buffering line -translation crlf -blocking true
+}
+
+proc dmc_close {dmc_socket} {
+  close $dmc_socket;
+}
+
+# Send a dmc2280 command
+proc dmc_sendCmd {dmc_socket cmd} {
+  global channel
+  set contName $channel($dmc_socket);
+  upvar #0 $contName controller
+  puts $dmc_socket $cmd
+  set status [read $dmc_socket 1]
+  if {$status == "?"} {
+    puts $dmc_socket "TC 1"
+    set status [read $dmc_socket 1]
+    if {$status == "?"} {
+      error "error: dmc command $cmd failed"
+    } else {
+      set dmcError [dmc_receive $dmc_socket]
+      set errInfo "DM2280 controller $contName
+      host $controller(host)
+      port $controller(port)"
+      error "DMC2280 ERROR $dmcError: when running command $cmd\n$errInfo"
+    }
+  } else {
+    return $status
+  }
+}
+
+# Receive a dmc2280 command
+proc dmc_receive {dmc_socket} {
+  global channel
+  set contName $channel($dmc_socket);
+  upvar #0 $contName controller
+  gets $dmc_socket line
+  # Consume the following colon
+  read $dmc_socket 1
+  return $line
+}
+
--- a/site_ansto/instrument/genCLOSLOOP.tcl
+++ b/site_ansto/instrument/genCLOSLOOP.tcl
@@ -0,0 +1,83 @@
+#TODO Version stamp this code and write the version number to the generated code
+# axis = A B C D E F
+# encodercounts = number of encoder counts per revolution
+# quadcounts = number of quadrature counts per revolution
+# tolquadcounts = tolerance in quadrature counts
+proc genMOVE {axis encodercounts quadcounts tolquadcounts} {
+puts "NO CLOSE MOTION LOOP FOR ${axis} AXIS
+  NO If the motor is within ${axis}TOLQC quadrature counts of the target
+  NO position then adjust it.
+  ${axis}DIFF=${axis}QTARGET - _TP${axis}
+  IF ( ((100*${axis}TOLQC) > @ABS\[${axis}DIFF\]) & (@ABS\[${axis}DIFF\]  > ${axis}TOLQC) )
+    ${axis}SHLDFIX=1
+  ELSE
+    ${axis}SHLDFIX=0
+  ENDIF
+  IF (${axis}FIXPOS=1)
+    ${axis}OLDQT=${axis}QTARGET
+    ${axis}count=10
+    SH${axis}
+#${axis}LOOP
+      NO Abort if target position changes
+      IF (${axis}OLDQT <> ${axis}QTARGET)
+        JP#${axis}ENDCLP
+      ENDIF
+      ${axis}count=${axis}count-1
+      PR${axis}=${encodercounts}*(${axis}DIFF/${quadcounts})
+      IF (_SP${axis}>${axis}MINSP)
+        SP${axis}=@ABS\[_PR${axis}\]/2.0
+        IF (_SP${axis} < ${axis}MINSP)
+          SP${axis}=${axis}MINSP
+        ENDIF
+        IF (_SP${axis} > ${axis}MAXSP)
+          SP${axis}=${axis}MAXSP
+        ENDIF
+      ENDIF
+      BG${axis}
+      MC${axis}
+      ${axis}DIFF=${axis}QTARGET - _TP${axis}
+      IF ( ((100*${axis}TOLQC) > @ABS\[${axis}DIFF\]) & (@ABS\[${axis}DIFF\]  > ${axis}TOLQC) )
+        JP#${axis}LOOP,${axis}count>0
+      ENDIF
+#${axis}ENDCLP
+    NO Restore speed to maximum
+    ${axis}FIXPOS=0
+    ${axis}SHLDFIX=0
+    SP${axis}=${axis}MAXSP
+  ENDIF"
+}
+
+
+# Generate subroutine to start the servo loop thread
+puts "#CLSLOOP"
+set tolquadcounts 1
+set encodercounts 25000
+set quadcounts 8192
+puts "NO Initilise tolerance, max and min speeds
+ATOLQC=100
+AMAXSP=${encodercounts}
+AMINSP=100*(${encodercounts}/93207)
+AFIXPOS=0"
+foreach {axis} {B C D E F} {
+puts "${axis}TOLQC=${tolquadcounts}
+${axis}MAXSP=${encodercounts}
+${axis}MINSP=100*(${encodercounts}/$quadcounts)
+${axis}FIXPOS=0"
+}
+foreach {axis} {A B C D E F} {
+  puts "${axis}DIFF=${axis}QTARGET - _TP${axis}
+  IF ( ((100*${axis}TOLQC) > @ABS\[${axis}DIFF\]) & (@ABS\[${axis}DIFF\]  > ${axis}TOLQC) )
+    ${axis}SHLDFIX=1
+  ELSE
+    ${axis}SHLDFIX=0
+  ENDIF"
+}
+puts "XQ#SERVOLP,1
+EN"
+# Generate servo loop
+puts "#SERVOLP"
+genMOVE A $encodercounts -93165 $tolquadcounts
+foreach {axis} {B C D E F} {
+  genMOVE $axis $encodercounts $quadcounts $tolquadcounts
+}
+puts "JP#SERVOLP"
--- a/site_ansto/instrument/gen_home_slits.tcl
+++ b/site_ansto/instrument/gen_home_slits.tcl
@@ -0,0 +1,30 @@
+proc move_away_from_switch {axis} {
+puts "NOTE Move slit forward 10mm if it is against the reverse limit switch
+IF ((_TS${axis} & 4) = 0)
+SH${axis}
+PR${axis}=200000
+BG${axis}
+ENDIF"
+}
+
+puts "#HOME"
+foreach {axis} {E F G H} {
+move_away_from_switch $axis
+}
+puts "AM"
+puts "NOTE Drive all slits into reverse limit switch"
+puts "SH
+JG ,,,,-25000,-25000,-25000,-25000
+BGEFGH
+AM"
+puts "NOTE Move away from switches by 2mm and drive back slowly"
+puts "PR ,,,,40000,40000,40000,40000
+JG ,,,,-5000,-5000,-5000,-5000
+BGEFGH
+AM"
+puts "NOTE Move forward from switch by 2mm and set zero"
+puts "PR ,,,,40000,40000,40000,40000
+BGEFGH
+AM
+DP ,,,,0,0,0,0"
+puts "EN"
--- a/site_ansto/instrument/motorinfo.tcl
+++ b/site_ansto/instrument/motorinfo.tcl
@@ -0,0 +1,82 @@
+package require Tk
+
+proc unknown {args} {}
+
+# Check that the current position matches the configured home position
+proc checkHome {motor} {
+  global channel
+  upvar #0 $motor motName
+  upvar #0 ${motor}_status motStatus
+  set chan $channel($motName(host))
+  if {[info exists motName(absenc)] && $motName(absenc) == 1} {
+    dmc_sendCmd $chan "TP$motName(axis)"
+    set homeIndex absenchome
+  } else {
+    dmc_sendCmd $chan "TD$motName(axis)"
+    set homeIndex motorhome
+  }
+  set home [dmc_receive $chan]
+  set motStatus(position) $home
+  set motStatus(home) $motName($homeIndex)
+  if {$home == $motName($homeIndex)} {
+    set motStatus(homeTest) TEST_PASSED
+  } else {
+    set motStatus(homeTest) TEST_FAILED
+  }
+   return $motStatus(homeTest)
+}
+
+# This implementation of the "Motor" command stores the
+# configured motor parameters in an array named
+# after the motor.
+proc Motor {name type par} {
+  global motors
+  upvar #0 $par arr
+  upvar #0 $name param_arr
+  upvar #0 ${name}_status status
+  array set param_arr [array get arr]
+  array set status [list position "" home "" upperLim "" lowerLim "" homeTest NOTDONE limitTest NOTDONE]
+  lappend motors $name
+}
+
+# Returns the test result status colour for the gui
+proc color {status} {
+  switch $status {
+    TEST_PASSED {return green} 
+    TEST_FAILED {return red} 
+    default {return lightgrey}
+  }
+}
+
+# You can easily test the home position of individual motors
+# with this gui
+# Click on the button to run the checkHome command, the position
+# (in encoder counts or motor steps) will be displayed with 
+# green if the configured home matches the reported position,
+# red otherwise.
+proc testgui {} {
+  package require Tk
+  global motors 
+  toplevel .w
+  frame .w.top
+
+  foreach m $motors {
+    global ${m}_status
+    set info($m) [frame .w.top.f$m]
+
+    set testResult $info($m).e$m 
+    button $info($m).$m -text $m -command "$testResult configure -background \[color \[checkHome $m\]\]"
+    entry $testResult -textvariable ${m}_status(position)
+    pack $info($m).$m -side left
+    pack $info($m).e$m -side left
+  }
+
+  set n 0
+  foreach m $motors {
+    set r [expr $n % 20]
+    set c [expr $n / 20]
+    grid $info($m) -row $r -column $c
+    incr n
+  }
+  pack .w.top
+}
--- a/site_ansto/instrument/server_config.tcl
+++ b/site_ansto/instrument/server_config.tcl
@@ -0,0 +1,49 @@
+# SICS common configuration
+
+# $Revision: 1.9 $
+# $Date: 2006-11-07 01:55:15 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by $Author: ffr $
+
+#set sicsroot /usr/local/sics
+set sicsroot ../
+ServerOption LogFileBaseName $sicsroot/log/serverlog 
+
+installprotocolhandler 
+
+source utility.tcl
+
+ServerOption statusfile $sicsroot/log/status.tcl 
+ServerOption RedirectFile $sicsroot/log/stdout 
+ServerOption LogFileDir $sicsroot/log 
+ServerOption QuieckPort [portnum $quieckport ]
+ServerOption ServerPort [portnum $serverport ]
+ServerOption InterruptPort [portnum $interruptport ]
+ServerOption TelWord sicslogin 
+ServerOption TelnetPort [portnum $telnetport ]
+ServerOption ReadUserPasswdTimeout 600000 
+ServerOption AcceptTimeOut 10 
+ServerOption ReadTimeOut 10 
+SicsUser manager ansto 1 
+SicsUser user sydney 2 
+SicsUser spy 007 3 
+MakeDataNumber SicsDataNumber $sicsroot/data/DataNumber 
+VarMake SicsDataPath Text Internal 
+SicsDataPath $sicsroot/data/ 
+SicsDataPath lock
+VarMake SicsDataPrefix Text Internal 
+SicsDataPrefix ansto 
+SicsDataPrefix lock
+VarMake SicsDataPostFix Text Internal 
+SicsDataPostFix .hdf 
+SicsDataPostFix lock
+VarMake Title Text User 
+VarMake Sample Text User 
+VarMake User Text User 
+VarMake starttime Text User 
+VarMake currentfile Text User 
+VarMake batchroot Text User 
+MakeDrive
+
+# Useful for making configurable batch files.
+publish set user
--- a/site_ansto/instrument/troubleShoot.tcl
+++ b/site_ansto/instrument/troubleShoot.tcl
@@ -0,0 +1,128 @@
+#!/usr/bin/env tclsh
+
+# $Revision: 1.8 $
+# $Date: 2006-11-07 01:56:50 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by $Author: ffr $
+
+# Load troubleshooting setup
+source dmc2280_util.tcl
+source troubleshoot_setup.tcl
+source motorinfo.tcl
+
+if { $argc > 0 } {
+  set configFileName [lindex $argv 0]
+}
+
+namespace eval sics_config {
+proc loadConfig {fName} {
+  variable ContList
+  if [info exists ContList] {unset ContList}
+# Temporarily define unknown proc to skip undefined procs
+  rename ::unknown _unknown
+  proc ::unknown {args} {} 
+  if [catch {uplevel #0 source $fName} errMsg] {
+    rename ::unknown ""
+    rename _unknown ::unknown
+    error $errMsg
+  } else {
+    rename ::unknown ""
+    rename _unknown ::unknown
+  }
+  if [catch {set ContList [uplevel #0 info vars dmc2280_controller*]} result] {error $result}
+  if {[llength $ContList] == 0} {error "Error: There are no dmc2280_controllerN(host/port) arrays in the $fName configuration file"}
+  #Add the controller to the sics_config namespace
+  foreach c $ContList {upvar #0 $c cont; puts "$c IP:port = $cont(host):$cont(port)"}
+}
+
+proc subExists {contName sub} {
+  upvar #0 $contName controller
+  if [catch {::dmc_sendCmd $controller(socket) "LS $sub,0"} errMsg] {
+    error "Subroutine $sub does not exist on controller $contName"
+  }
+  ::dmc_receive $controller(socket)
+}
+
+# Returns -1 if thread is not running, line number if it is
+proc checkThread {contName thnum} {
+  upvar #0 $contName controller
+  ::dmc_sendCmd $controller(socket) "MG _XQ$thnum"
+  set reply [::dmc_receive $controller(socket) ]
+  if {$reply == -1} {
+  error "Thread $thnum not running on controller $contName"
+  }
+  return $reply
+}
+
+# GUI STUFF
+  package require Tk
+  variable ContList
+  global ldFrame
+  set ldFrameName ".loadFile"
+  set ldFrame(button) $ldFrameName.ldConf
+  set ldFrame(entry) $ldFrameName.ldEntry
+
+
+  proc ::guiLoadC {} {
+    ::sics_config::loadConfig [eval $::sics_config::ldFrame(entry) get]
+  }
+
+  proc ::guiConnect {w cont} {
+  ::dmc_connect $cont
+  $w configure -activebackground green
+  $w configure -background green
+  }
+
+  proc ::guiCheckSubs {w cont} {
+    global contSubs
+    foreach sub $contSubs($cont) {
+      ::sics_config::subExists $cont $sub
+    }
+    $w configure -activebackground green
+    $w configure -background green
+  }
+
+  proc ::guiCheckThreads {w cont} {
+    global contThreads
+    foreach thr $contThreads($cont) {
+      ::sics_config::checkThread $cont $thr
+    }
+    $w configure -activebackground green
+    $w configure -background green
+  }
+
+  frame $ldFrameName
+  pack $ldFrameName
+  button $ldFrame(button) -text "Load config" -command {guiLoadC; ::sics_config::mkGui}
+  entry $ldFrame(entry) -textvariable configFileName -width -1
+  pack $ldFrame(button) -side left
+  pack $ldFrame(entry) -side left
+
+
+  proc mkGui {} {
+  variable ContList
+  lappend Headings $ContList
+  frame .t -bg black
+  table .t $ContList
+  pack .t
+  testgui
+  }
+  proc table {w headings args} {
+    set r 0
+
+        foreach name $headings {
+            lappend Header [label $w.$name -text $name]
+        }
+        foreach name $headings {
+          lappend Connect [button $w.connect$name -text connect -command "guiConnect $w.connect$name $name"]
+          lappend CheckSubs [button $w.chkSubs$name -text "Check subs" -command "guiCheckSubs $w.chkSubs$name $name"]
+          lappend CheckThreads [button $w.chkThrs$name -text "Check threads" -command "guiCheckThreads $w.chkThrs$name $name"]
+        }
+        eval grid $Header -sticky news -padx 1 -pady 1
+        eval grid $Connect -sticky news -padx 1 -pady 1
+        eval grid $CheckSubs -sticky news -padx 1 -pady 1
+        eval grid $CheckThreads -sticky news -padx 1 -pady 1
+
+}
+}
+
--- a/site_ansto/instrument/utility.tcl
+++ b/site_ansto/instrument/utility.tcl
@@ -0,0 +1,53 @@
+# Some useful functions for SICS configuration.
+
+# $Revision: 1.5 $
+# $Date: 2006-11-07 01:57:45 $
+# Author: Ferdi Franceschini (ffr@ansto.gov.au)
+# Last revision by $Author: ffr $
+
+# Utility fucntion for setting the home and upper and lower
+# limits for a motor
+proc setHomeandRange {args} {
+set usage "
+Usage: setHomeandRange -motor motName -home homeVal -lowrange low -uprange high
+eg
+setHomeandRange -motor mchi -home 90 -lowrange 5 -uprange 7
+this sets the home position to 90 degreess for motor mchi
+with the lower limit at 85 and the upper limit at 97
+"
+if {$args == ""} {clientput $usage; return}
+  array set params $args
+  set motor $params(-motor) 
+  set home $params(-home)
+  set lowlim [expr $home - $params(-lowrange)]
+  set uplim [expr $home + $params(-uprange)]
+
+  uplevel 1 "$motor hardlowerlim $lowlim"
+  uplevel 1 "$motor hardupperlim $uplim"
+  uplevel 1 "$motor softlowerlim $lowlim"
+  uplevel 1 "$motor softupperlim $uplim"
+  uplevel 1 "$motor home $home"
+}
+
+# Use this to create an array of named parameters to initialise motors.
+proc params {args} {
+  upvar 1 "" x;
+  if [info exists x] {unset x}
+  foreach {k v} $args {set x([string tolower $k]) $v}
+}
+
+# Parse motor readings for virtual motor scripts.
+proc SplitReply { text } {
+     set l [split $text =]
+     return [lindex $l 1]
+}
+
+# Sets motor position reading to pos by adjusting the softzero
+proc setpos {motor pos} {
+    set currPos [SplitReply [$motor]]
+    set oldZero [SplitReply [$motor softzero]]
+    set newZero [expr $currPos - $pos + $oldZero]
+    uplevel #0 "$motor softzero $newZero"
+}
+publish setpos user
+publish SplitReply user