PSI sics-cvs-psi-2006
This commit is contained in:
Douglas Clowes
128
tcl/makedriveskel
Executable file
128
tcl/makedriveskel
Executable file
@@ -0,0 +1,128 @@
|
||||
#!/usr/bin/tclsh
|
||||
#---------------------------------------------------------------
|
||||
# Create the skeleton of a drivable object with the correct
|
||||
# interface functions and some more.
|
||||
#
|
||||
# Mark Koennecke, September 2005
|
||||
#---------------------------------------------------------------
|
||||
|
||||
if { [llength $argv] < 2} {
|
||||
puts stdout "usage:\n\tmakedriveskel prefix datastuctname"
|
||||
exit 1
|
||||
}
|
||||
|
||||
set prefix [lindex $argv 0]
|
||||
set structname [lindex $argv 1]
|
||||
|
||||
#------------- GetInterface function
|
||||
puts stdout "/*---------------------------------------------------------------*/"
|
||||
puts stdout "static void *${prefix}GetInterface(void *data, int iD){"
|
||||
puts stdout " $structname self = NULL; "
|
||||
puts stdout " "
|
||||
puts stdout " self = ($structname)data;"
|
||||
puts stdout " if(self != NULL && iD == DRIVEID){"
|
||||
puts stdout " return self->pDriv;"
|
||||
puts stdout " } else {"
|
||||
puts stdout " return NULL;"
|
||||
puts stdout " }"
|
||||
puts stdout " return NULL;"
|
||||
puts stdout "}"
|
||||
|
||||
#------------------- Halt
|
||||
puts stdout "/*----------------------------------------------------------------"
|
||||
puts stdout " This routine can return either OKOK or HWFault when thing"
|
||||
puts stdout " go wrong. However, the return value of Halt is usually ignored!"
|
||||
puts stdout "------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}Halt(void *data) {"
|
||||
puts stdout " $structname self = NULL; "
|
||||
puts stdout " "
|
||||
puts stdout " self = ($structname)data;"
|
||||
puts stdout ""
|
||||
puts stdout " return OKOK; "
|
||||
puts stdout "}"
|
||||
|
||||
#------------------ CheckLimits
|
||||
puts stdout "/*----------------------------------------------------------------"
|
||||
puts stdout " This routine can return either 1 or 0. 1 means the position can "
|
||||
puts stdout " be reached, 0 NOT"
|
||||
puts stdout " If 0, error shall contain up to errlen characters of information"
|
||||
puts stdout " about which limit was violated"
|
||||
puts stdout "------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}CheckLimits(void *data, float val,"
|
||||
puts stdout " char *error, int errlen){"
|
||||
puts stdout " $structname self = NULL; "
|
||||
puts stdout " "
|
||||
puts stdout " self = ($structname)data;"
|
||||
puts stdout ""
|
||||
puts stdout " return 1; "
|
||||
puts stdout "}"
|
||||
|
||||
#----------------- SetValue
|
||||
puts stdout "/*----------------------------------------------------------------"
|
||||
puts stdout " This routine can return 0 when a limit problem occurred "
|
||||
puts stdout " OKOK when the motor was successfully started "
|
||||
puts stdout " HWFault when a problem occured starting the device"
|
||||
puts stdout " Possible errors shall be printed to pCon"
|
||||
puts stdout " For real motors, this is supposed to try at least three times"
|
||||
puts stdout " to start the motor in question"
|
||||
puts stdout " val is the value to drive the motor too"
|
||||
puts stdout "------------------------------------------------------------------*/"
|
||||
puts stdout "static long ${prefix}SetValue(void *data, SConnection *pCon, float val){"
|
||||
puts stdout " $structname self = NULL; "
|
||||
puts stdout " "
|
||||
puts stdout " self = ($structname)data;"
|
||||
puts stdout ""
|
||||
puts stdout " return 1; "
|
||||
puts stdout "}"
|
||||
|
||||
#-------------- CheckStatus
|
||||
puts stdout "/*----------------------------------------------------------------"
|
||||
puts stdout " Checks the status of a running motor. Possible return values"
|
||||
puts stdout " HWBusy The motor is still running"
|
||||
puts stdout " OKOK or HWIdle when the motor finished driving"
|
||||
puts stdout " HWFault when a hardware problem ocurred"
|
||||
puts stdout " HWPosFault when the hardware cannot reach a position"
|
||||
puts stdout " Errors are duly to be printed to pCon"
|
||||
puts stdout " For real motors CheckStatus again shall try hard to fix any "
|
||||
puts stdout " issues with the motor "
|
||||
puts stdout "------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}CheckStatus(void *data, SConnection *pCon){"
|
||||
puts stdout " $structname self = NULL; "
|
||||
puts stdout " "
|
||||
puts stdout " self = ($structname)data;"
|
||||
puts stdout ""
|
||||
puts stdout " return 1; "
|
||||
puts stdout "}"
|
||||
|
||||
#----------------- GetValue
|
||||
puts stdout "/*----------------------------------------------------------------"
|
||||
puts stdout " GetValue is supposed to read a motor position"
|
||||
puts stdout " On errors, -99999999.99 is returned and messages printed to pCon"
|
||||
puts stdout "------------------------------------------------------------------*/"
|
||||
puts stdout "static float ${prefix}GetValue(void *data, SConnection *pCon){"
|
||||
puts stdout " $structname self = NULL; "
|
||||
puts stdout " float val = -99999999.99;"
|
||||
puts stdout " "
|
||||
puts stdout " self = ($structname)data;"
|
||||
puts stdout ""
|
||||
puts stdout " return val; "
|
||||
puts stdout "}"
|
||||
|
||||
#---------------MakeObject
|
||||
puts stdout "/*----------------------------------------------------------------"
|
||||
puts stdout " returns NULL on failure, a new datastructure else"
|
||||
puts stdout "------------------------------------------------------------------*/"
|
||||
puts stdout "static $structname ${prefix}MakeObject(){"
|
||||
puts stdout " $structname self = NULL; "
|
||||
puts stdout ""
|
||||
puts stdout " self->pDes->GetInterface = ${prefix}GetInterface;"
|
||||
puts stdout " self->pDriv->Halt = ${prefix}Halt;"
|
||||
puts stdout " self->pDriv->CheckLimits = ${prefix}CheckLimits;"
|
||||
puts stdout " self->pDriv->SetValue = ${prefix}SetValue;"
|
||||
puts stdout " self->pDriv->CheckStatus = ${prefix}CheckStatus;"
|
||||
puts stdout " self->pDriv->GetValue = ${prefix}GetValue;"
|
||||
puts stdout ""
|
||||
puts stdout " return self;"
|
||||
puts stdout "}"
|
||||
puts stdout ""
|
||||
|
||||
252
tcl/makehmskel
Executable file
252
tcl/makehmskel
Executable file
@@ -0,0 +1,252 @@
|
||||
#!/usr/bin/tclsh
|
||||
#-----------------------------------------------------------------------
|
||||
# script which creates the skeleton of a histogram memory driver
|
||||
#
|
||||
# Mark Koennecke, October 2005
|
||||
#-----------------------------------------------------------------------
|
||||
|
||||
if { [llength $argv] < 2} {
|
||||
puts stdout "Usage:\n\tmakehmskel prefix datastruct\n"
|
||||
exit 1
|
||||
}
|
||||
|
||||
set prefix [lindex $argv 0]
|
||||
set ds [lindex $argv 1]
|
||||
|
||||
#------------------ preamble
|
||||
puts stdout "#include <sics.h>"
|
||||
puts stdout "#include <countdriv.h>"
|
||||
puts stdout "#include <counter.h>"
|
||||
puts stdout "#include <HistMem.h>"
|
||||
puts stdout "#include <stringdict.h>"
|
||||
puts stdout "#include <HistDriv.i>"
|
||||
puts stdout ""
|
||||
puts stdout "typedef struct { }*${ds};"
|
||||
puts stdout ""
|
||||
#-------------------Configure
|
||||
puts stdout "/*-------------------------------------------------------------------"
|
||||
puts stdout " Configures the HM from the options in pOpt and the HM data structure"
|
||||
puts stdout " Returns 1 on success, 0 on failure"
|
||||
puts stdout "---------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}Configure(pHistDriver self, SConnection *pCon,"
|
||||
puts stdout " pStringDict pOpt, SicsInterp *pSics){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
#----------------Start
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Start histogramming, Returns HWFault on failure, 1 on success"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}Start(pHistDriver self,SConnection *pCon){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
#--------------- Halt
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Stops histogramming, Returns HWFault on failure, 1 on success"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}Halt(pHistDriver self){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
#--------------- Status
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Checks histogramming status, Returns HWFault on failure, "
|
||||
puts stdout " HWIdle when finished, HWBusy when counting "
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}CountStatus(pHistDriver self,SConnection *pCon){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return HWIdle;"
|
||||
puts stdout "}"
|
||||
|
||||
|
||||
#------------ GetError
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Get info on error after last HWFault, returns 1 always."
|
||||
puts stdout " Puts an int error code into *code and errLen chars of"
|
||||
puts stdout " error description into error"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}GetError(pHistDriver self,int *code, "
|
||||
puts stdout " char *error, int errLen){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
|
||||
#-------- FixIt
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Try to fix the HM error in code. Returns COREDO when the last"
|
||||
puts stdout " operation needs to be redone, COTERM when the error cannot be"
|
||||
puts stdout " fixed."
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}FixIt(pHistDriver self,int code){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return COTERM;"
|
||||
puts stdout "}"
|
||||
|
||||
|
||||
#------------- GetData
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " GetData reads updates the internal cache of monitor values"
|
||||
puts stdout " from the hardware, Returns 1 or HWFault"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}GetData(pHistDriver self,SConnection *pCon){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
#------------- GetMonitor
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " GetMonitor reads the monitor value i. Returns either the monitor "
|
||||
puts stdout " value or -9999 if no such monitor exists or an error occurred"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static long ${prefix}GetMonitor(pHistDriver self,int i, SConnection *pCon){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return -9999;"
|
||||
puts stdout "}"
|
||||
|
||||
#------------- GetTime
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " GetTime reads the total counting time. Returns either the "
|
||||
puts stdout " value or -9999.99 if no such value exists or an error occurred"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static float ${prefix}GetTime(pHistDriver self,SConnection *pCon){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return -9999.99;"
|
||||
puts stdout "}"
|
||||
|
||||
|
||||
#--------------- Pause
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Pause histogramming, Returns HWFault on failure, 1 on success"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}Pause(pHistDriver self,SConnection *pCon){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
#--------------- Continue
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Continue histogramming, Returns HWFault on failure, 1 on success"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}Continue(pHistDriver self,SConnection *pCon){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
|
||||
#--------------- Free
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Free the data associated with the private data structure of the driver"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}Free(pHistDriver self){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout "}"
|
||||
|
||||
#------------ SetHistogram
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Set The HM data or a subset of it. Returns HWFault or 1"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}SetHistogram(pHistDriver self,"
|
||||
puts stdout " SConnection *pCon,"
|
||||
puts stdout " int i, int iStart, int iEnd, HistInt *pData){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
|
||||
#--------------- Preset
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Set HM to a preset value, Returns HWFault on failure, 1 on success"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}Preset(pHistDriver self,SConnection *pCon,"
|
||||
puts stdout " HistInt value){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
#------------ GetHistogram
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " get The HM data or a subset of it. Returns HWFault or 1"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "static int ${prefix}GetHistogram(pHistDriver self,"
|
||||
puts stdout " SConnection *pCon,"
|
||||
puts stdout " int i, int iStart, int iEnd, HistInt *pData){"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout " "
|
||||
puts stdout " pPriv =($ds)self->pPriv;"
|
||||
puts stdout " return 1;"
|
||||
puts stdout "}"
|
||||
|
||||
#-------------- MkeHM
|
||||
puts stdout "/*--------------------------------------------------------------------"
|
||||
puts stdout " Make the HMDriver, returns a driver or NULL on failure"
|
||||
puts stdout "----------------------------------------------------------------------*/"
|
||||
puts stdout "pHistDriver Make${prefix}HM(pStringDict pOption){"
|
||||
puts stdout " pHistDriver pNew = NULL;"
|
||||
puts stdout " $ds pPriv = NULL;"
|
||||
puts stdout ""
|
||||
puts stdout " /* create the general driver */"
|
||||
puts stdout " pNew = CreateHistDriver(pOption);"
|
||||
puts stdout " if(!pNew){"
|
||||
puts stdout " return NULL;"
|
||||
puts stdout " }"
|
||||
puts stdout ""
|
||||
puts stdout " /*Create private data structure*/"
|
||||
puts stdout " pPriv = NULL; "
|
||||
puts stdout " pNew->pPriv = pPriv;"
|
||||
puts stdout " "
|
||||
puts stdout " /* add our options */"
|
||||
puts stdout " StringDictAddPair(pOption,\"example\",\"example\");"
|
||||
puts stdout ""
|
||||
puts stdout " /* configure all those functions */"
|
||||
puts stdout " pNew->Configure = ${prefix}Configure;"
|
||||
puts stdout " pNew->Start = ${prefix}Start;"
|
||||
puts stdout " pNew->Halt = ${prefix}Halt;"
|
||||
puts stdout " pNew->GetCountStatus = ${prefix}CountStatus;"
|
||||
puts stdout " pNew->GetError = ${prefix}GetError;"
|
||||
puts stdout " pNew->TryAndFixIt = ${prefix}FixIt;"
|
||||
puts stdout " pNew->GetData = ${prefix}GetData;"
|
||||
puts stdout " pNew->GetHistogram = ${prefix}GetHistogram;"
|
||||
puts stdout " pNew->SetHistogram = ${prefix}SetHistogram;"
|
||||
puts stdout " pNew->GetMonitor = ${prefix}GetMonitor;"
|
||||
puts stdout " pNew->GetTime = ${prefix}GetTime;"
|
||||
puts stdout " pNew->Preset = ${prefix}Preset; "
|
||||
puts stdout " pNew->FreePrivate = ${prefix}Free;"
|
||||
puts stdout " pNew->Pause = ${prefix}Pause;"
|
||||
puts stdout " pNew->Continue = ${prefix}Continue;"
|
||||
puts stdout ""
|
||||
puts stdout " return pNew;"
|
||||
puts stdout "}"
|
||||
|
||||
39
tcl/sicstcldebug.tcl
Normal file
39
tcl/sicstcldebug.tcl
Normal file
@@ -0,0 +1,39 @@
|
||||
#------------------------------------------------------------------
|
||||
# This is a helper file in order to debug SICS Tcl scripts. The idea
|
||||
# is that a connection to a SICS interpreter at localhost:2911 is opened.
|
||||
# Then unknown is reimplemented to send unknown commands (which must be
|
||||
# SICS commands) to the SICS interpreter for evaluation. This is done
|
||||
# with transact in order to figure out when SICS finished processing.
|
||||
# Thus is should be possible to debug SICS Tcl scripts in a normal
|
||||
# standalone interpreter without the overhead of restarting SICS
|
||||
# all the time. It may even be possible to use one of the normal
|
||||
# Tcl debugfgers then....
|
||||
#
|
||||
# Mark Koennecke, February 2006
|
||||
#------------------------------------------------------------------
|
||||
|
||||
set socke [socket localhost 2911]
|
||||
gets $socke
|
||||
puts $socke "Spy 007"
|
||||
flush $socke
|
||||
gets $socke
|
||||
#------------------------------------------------------------------
|
||||
proc unknown args {
|
||||
global socke
|
||||
append com "transact " [join $args]
|
||||
puts $socke $com
|
||||
flush $socke
|
||||
set reply ""
|
||||
while {1} {
|
||||
set line [gets $socke]
|
||||
if {[string first TRANSACTIONFINISHED $line] >= 0} {
|
||||
return $reply
|
||||
} else {
|
||||
append reply $line
|
||||
}
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------
|
||||
proc clientput args {
|
||||
puts stdout [join $args]
|
||||
}
|
||||
Reference in New Issue
Block a user