1.0 Extending Tcl/Tk with a Vendor Supplied Library
1.1 Overview
This chapter discusses a project that required extending tclsh with a vendor supplied library. The project was to develop a client-server application to control a National Instruments AT-AO-10 digital/analog I/O board. The AT-AO-10 card supports 10 digital-analog ports (refered to as A0 ports by National Instruments, and as DAC ports in my documentation), and 8 digital ports (refered to as DIG ports by National Instruments, and DIO ports in my documentation.)
The library was supplied by National Instruments, as part of their NIDAQ support package for the AT-A0-10 digital and analog interface card. The library provides a set of functions to set voltage levels on the digital to analog (AO) ports, the state of the digital ports (DIG), and to set the configuration options on the cards.
The end goal of the project is to control a set of power supplies used for hardware testing. The environment is several Sun Sparc stations which each control several hardware test platforms. There are several power supplies connected to each test platform, and a single ISA bus computer to control the power supplies. The Sparc stations and the ISA bus computer are all connected by an IP LAN.
This is a classic application for a client-server architecture in which the client systems control the test platforms and the powersupply server modifies the voltage levels and reports status as requested.
It's a more efficient use of hardware to put the power supply controls on a single server rather than putting a power supply controller on each Sparc controlling a test platform. The power supplies require an analog signal to modify the output voltage, and a TTL level digital signal to turn them off and on. The digital-analog and digital I/O cards support more channels than a single test platform requires. In this case, a single ISA bus computer with two of the National Instruments AT-A0-10 cards can support the four Sparc stations that each control 4 test platforms. This would require four (more expensive) sets of control cards if the Suns were to each control the power supplies associated with their test platforms.
The classic language platform for client-server architecture and machine control is "C". I chose to write the client-server pair in Tcl because the implementation time would be shorter. The communication abstraction in Tcl is simpler, which reduces the time developing the socket portion of the code, and the powerful string manipulation commands in Tcl speed the development of the parsing section of the code. The National Instruments hardware control library was easily added to Tcl, to provide a rapid development environment with all the functions necessary for this task.
This technique reduced developing the client-server part of the project from a several day job into a single afternoon's task.
Normally, the project would be complete once the Tcl code was written. In this case, however, the customer required that I write the final product in "C." Nonetheless, it was faster to construct a new Tcl interpreter with support for the National Instruments cards, write the prototypes in Tcl, and then translate the final Tcl code into "C" than it would have been to write the system in "C" to begin with.
Because the tclsh interpreter and Tcl code were an interim step for my own use, I sacrificed a few points of purity and efficiency in the interest of development speed. I will flag these as appropriate in the following discussion.
This technique allowed me to write quick prototypes easily, experiment with the client-server protocol and the behavior of the AT-AO cards, and then use the final Tcl prototype as an implementation design document for the "C" code.
2.0 Requirements
The project had this set of requirements:
- The server software will be named VMServer (Voltage Margining
Server), and the client software will be named VMClient (Voltage
Margining Client).
- The client-server communications will be done in US-ASCII.
The PC controller code will accept textual commands in printable US ASCII via an IP socket, modify a AT-AO card as necessary, and reply with an appropriate textual string. The commands and replies will be terminated with a CarriageReturn LineFeed combination (0x0d, 0x0a).
- The server code will support:
- setting analog output of a DAC port.
- setting digital output of a DIO port.
- reporting the current status of a port.
The VMServer/VMClient combination will support setting Analog output levels (DAC), setting digital I/O lines to ON or OFF conditions (DIO), and requesting the current state of these ports.
- All communications will originate from a client.
The VMClient program will open a socket connection to the PC. The VMServer code will complete the connection, and send a "%" prompt to let the VMClient code know it is ready for a command. The VMClient system will then send a command to the VMServer, which will evaluate the command and reply appropriately. After the reply is received, the VMClient code may send another command, or exit.
- The interaction between the VMServer and VMClient is defined by three
command messages and two replies:
The command messages are:
status,subsystem,card,IOline
return the status of a particular port modify,subsystem,card,IOline,value
set the value of a particular port exit
exit the VMServer The response will be one of:
reply,subsystem,card,IOline,value
Successful return fail,subsystem,card,IOline,failureCode
Failure return The fields in these messages are:
subsystemIdentify subset of card to query: dac or dio. cardThe card number IOlineDIO line or DAC port to query: 0-7 (software will convert DIO lines 4-7 to port 1, line 0-4) valueValue of port/line status (float for DAC, 1/0 for DIO) failureCodeAn integer to define the failure - if failure generated from NADAQ routines, then failureCode will be < 0. If generated by the VMServer parsing, it will be > 0. The responses will echo all of the fields of the original command to provide an unambiguous link between the command and the response.
The
exitcommand has no response. - The system will be resistant to confusion caused by momentary power
failures or reboots.
The VMServer code will maintain a copy of the current DIO/DAC settings on disk. This copy will be loaded to initialize all settings when VMServer starts, and will be rewritten whenever a
modifycommand is received.
2.1 Materials and Equipment
This software was used in the project:
- 8.0 Tcl libraries for Windows 95.
- Microsoft VC++ 4.0
- Microsoft Windows 95 O/S
- National Instruments NIDAQ support library.
This hardware was used in the project:
- National Instruments AT-A0-10 DAC/DIO card.
- National Instruments terminal strip.
- Voltmeter
3.0 Implementing the Project
The project had 2 phases:
- Merge the NIDAQ libraries into the Tcl interpreter.
- Write the client-server pair.
Extending the Tcl interpreter was done with as little effort as possible. I used existing code when possible, modified code as a second alternative, and wrote functions from a simple template when there was no existing code to copy or modify.
The prototype VMServer was built by extending the example from the TclTutor ¹ lesson on sockets. The prototype VMClient was under 50 lines (including comments), so I wrote that one from scratch.
3.1 Extending the Tcl Interpreter
Extending the interpreter consists of a few subtasks:
- Confirming that Tcl could be built on the target platform from the standard
distribution.
This is just a check that all of the required files, compilers, libraries etc have been installed properly.
- Creating a new directory for the new interpreter
Rather than modify the tclsh interpreter in place, I wanted to keep the distribution clean, and make my new interpreter in a separate directory. The
MakefileandtclAppInit.cfiles could be copied from the distribution and modified slightly for my purposes. - Modifying the Makefile to support the new libraries and directories.
The Tcl distribution Makefile can be used to build the new tclsh by modifying a few directory paths and adding new rules for the new files.
- Adding the code to implement the new commands.
The new code is localized in two new "C" language files, one of which is a modified version of a Tcl distribution file, and one of which was modified from one of the NIDAQ include files.
3.1.1 Confirming the Installation
The first step was to install Tcl 8.0p2 and confirm that tclsh could be generated on my platform (100 Mhz 486 / MS Windows 95 / Microsoft Visual C++ 4.0).
I ftp'd the the installation file from ftp://ftp.sunlabs.com/pub/tcl/tcl80p2.zip, unzipped the file, and it installed painlessly. Once I had the Tcl source installed on E:\TCL\tcl8.0, I opened a DOS command window, cd'd to the E:\Tcl\tcl8.0\win directory, copied the makefile.vc to makefile, typed nmake, and everything built.
3.1.2 Creating and populating the Directory for the New tclsh.
I created a new directory for the tclsh I would be creating, and
copied the makefile and tclAppInit.c files to
this directory.
I renamed tclAppInit.c to niAppInit.c, to be
the National Instruments application initialization file.
3.1.3 Modifying the Makefile
The makefile needed to be modified to :
- have the correct paths for Tcl Libraries.
- have the correct paths to Tcl include files.
- include the NIDAQ libraries.
- include paths to NIDAQ include files.
- include new niApplInit object file in link.
- include new nierrstr object file in link.
These changes were localized in five areas of the makefile. The differences between the two makefiles are shown below.
| Original Tcl Distribution | Modified for NIDAQ |
|---|---|
|
|
| |
|
|
|
|
|
|
The first set of modifications was to change the ROOT
directory for the Tcl libraries and files to point to the root of the
Tcl distribution, instead of the parent, and to add variables for the
National Instruments directories.
The second set of modifications changed tclAppInit.obj to
reference niAppInit.obj and added a new file
nierrstr.obj.
The third modification simply added the National Instruments include directory to the search path for include files.
The fourth set of modifications changed the references to tclAppInit to
niAppInit and added rules for making niAppInit.obj
and nierrstr.obj
The final set of modifications added the new files and National Instruments libraries to the link command.
3.1.4 Modifying the AppInit File
Tcl is designed to be extended in this manner, and Dr. Ousterhout and his team have made the process easy and standardized.
The proper method of extending a tclsh interpreter is to add two new
"C" files, and two include files. The new "C" files for an extension
named "ext" would be extAppInit.c and
extCmd.c, and the include files would be named
extCmd.h and extInt.h. These files are
defined as follows:
| extAppInit.c | A file created by modifying tclAppInit.c to install the new
commands into the tclsh interpreter using with the Tcl_CreateObjCommand
or TclCreateCommand subroutines. |
| extCmd.c | A file that contains the "C" code that implements the new commands. |
| extCmd.h | A file that provides forward references for the extCmd.c commands |
| extInt.h | A file that includes the VERSION numbers for this package, definitions of structures used only by the package, etc. |
In this case, because I was going to discard the tclsh interpreter once
I had a working prototype I added all the tclsh extension code to a
modified version of tclAppInit.c
(niAppInit.c) and did not generate the other 3 files.
I started with the distribution copy of niApplInit.c, and performed
these changes:
- added #include for the NIDAQ data types.
- added forward declarations for the new functions.
- changed tclAppInit to niAppInit in the call to Tcl_Main.
- added TclCreateObjCommand calls to include the new Tcl commands.
- renamed tclAppInit function to niApplInit.
- added C functions to implement the new commands.
The NIDAQ libraries use their own variable declarations to ensure that the functions get called with the proper size variables on the various platforms and compilers that they support. To ensure that I didn't get any surprises, I used those variable types when calling the NIDAQ library functions.
The Tcl libraries use standard "C" variable types, so any calls to those functions were done using standard "C" variables.
I let the C compiler worry about converting one variable type to the other. In some cases, I'm certain that the types are the same, and I could have passed the same variable to both functions, but in the interest of development speed I let the compiler take care of any conversions.
The NIDAQ functions use a standardized naming and argument format:
SubSys_Function(devNumber, aChannel, ... value);
| ITEM | DESCRIPTION |
|---|---|
| SubSys | The subsystem of the AT-AO-10 that this command will affect. Either DIG (for the digital system) or AO (for the Digital/Analog Converter). |
| Function | A descriptive name for the function that will be performed. |
| devNumber | An integer that defines which one of possibly several cards with which this command will interact. |
| aChannel | An integer that defines the port with which this command will interact. |
| value | An integer or floating point value that represents the new value for the card/subsystem/port. |
I copied this form for the commands I added to the Tcl interpreter. By doing so I could use the NIDAQ reference documentation when building my tclsh scripts, and could easily convert a tclsh script prototype to "C" code.
For example, the library function to write a value to an analog port is
AO_Write.
Syntax:
| AO_Write(devNumber, aChannel, value);
|
AO_Write
| Set the value for a digital->analog channel.
|
devNumber
| The number of the card that contains the channel to be set.
|
aChannel
| The number of the channel to be set.
|
value
| The value to put in the digital->analog channel control register. |
The new Tcl command is:
Syntax:
| AO_Write devNumber aChannel value
|
AO_Write
| Set the value for a digital->analog channel.
|
devNumber
| The number of the card that contains the channel to be set.
|
aChannel
| The number of the channel to be set.
|
value
| The value to put in the digital->analog channel control register. |
Following the Tcl guidelines, the code that implements the Tcl command
is named by adding Cmd to the new Tcl command. For
example, the AO_Write command is implemented with a "C"
function named AO_WriteCmd.
The code to add the AO_Write command to the tclsh
interpreter looks like this:
Tcl_CreateObjCommand(interp, "AO_Write", (Tcl_ObjCmdProc *)AO_WriteCmd, \
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
The command being created is AO_Write. It
is implemented by the "C" subroutine AO_WriteCmd. It has
no associated client data, and no special delete procedure.
Here's a listing of niAppInit.c. The changes from the original tclAppInit.c are done in bold font.
/*
* niAppInit.c --
*
* Provides a default version of the main program and Tcl_AppInit
* procedure for Tcl applications (without Tk). Note that this
* program must be built in Win32 console mode to work properly.
*
* Copyright (c) 1996 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclAppInit.c 1.12 97/04/30 11:04:50
*/
#include "tcl.h"
#include < windows.h>
#include < locale.h>
/* CHANGE 1
* Add the nidaqex.h include file for definitions of NIDAQ data types.
* and forward declarations of the NIDAQ functions.
*/
#include "nidaqex.h"
/* CHANGE 2
* Add forward declarations of functions to implement the new commands.
*/
int ni_AppInit(Tcl_Interp*);
int AO_CalibrateCmd(ClientData , Tcl_Interp *, int , Tcl_Obj **);
int AO_WriteCmd(ClientData , Tcl_Interp *, int , Tcl_Obj **);
int AO_VWriteCmd(ClientData , Tcl_Interp *, int , Tcl_Obj **);
int AO_NoWriteCmd(ClientData , Tcl_Interp *, int , Tcl_Obj **);
int AO_ConfigureCmd(ClientData, Tcl_Interp *, int, Tcl_Obj **);
int DIG_Out_LineCmd(ClientData, Tcl_Interp *, int, Tcl_Obj **);
int DIG_Prt_ConfigCmd(ClientData, Tcl_Interp *, int, Tcl_Obj **);
char * nierrstr(int );
#ifdef TCL_TEST
#ifdef __cplusplus
extern "C" {
#endif
extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
extern int Wintest_Init _ANSI_ARGS_((Tcl_Interp *interp));
extern int ObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#ifdef __cplusplus
}
#endif
#endif /* TCL_TEST */
static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
/*
*----------------------------------------------------------------------
*
* main --
*
* This is the main program for the application.
*
* Results:
* None: Tcl_Main never returns here, so this procedure never
* returns either.
*
* Side effects:
* Whatever the application does.
*
*----------------------------------------------------------------------
*/
int
#ifdef _USING_PROTOTYPES_
main (int argc, /* Number of command-line arguments. */
char **argv) /* Values of command-line arguments. */
#else
main(argc, argv)
int argc; /* Number of command-line arguments. */
char **argv; /* Values of command-line arguments. */
#endif
{
char *p;
char buffer[MAX_PATH];
/*
* Set up the default locale to be standard "C" locale so parsing
* is performed correctly.
*/
setlocale(LC_ALL, "C");
setargv(&argc, &argv);
/*
* Replace argv[0] with full pathname of executable, and forward
* slashes substituted for backslashes.
*/
GetModuleFileName(NULL, buffer, sizeof(buffer));
argv[0] = buffer;
for (p = buffer; *p != '\0'; p++) {
if (*p == '\\') {
*p = '/';
}
}
/* CHANGE 3
* Change the AppInit from tcl_AppInit to ni_AppInit
*/
/* Tcl_Main(argc, argv, tcl_AppInit); */
Tcl_Main(argc, argv, ni_AppInit);
return 0; /* Needed only to prevent compiler warning. */
}
/*
*----------------------------------------------------------------------
*
CHANGE 4
* Change the AppInit from tcl_AppInit to ni_AppInit
*
* ni_AppInit --
*
* This procedure performs application-specific initialization.
* Most applications, especially those that incorporate additional
* packages, will have their own version of this procedure.
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
* message in interp->result if an error occurs.
*
* Side effects:
* Depends on the startup script.
*
*----------------------------------------------------------------------
*/
/* CHANGE 5
* Change the AppInit from tcl_AppInit to ni_AppInit
*/
int
ni_AppInit(interp)
Tcl_Interp *interp; /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (Objtest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Objtest", Objtest_Init,
(Tcl_PackageInitProc *) NULL);
if (Wintest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Wintest", Wintest_Init,
(Tcl_PackageInitProc *) NULL);
#endif /* TCL_TEST */
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
*/
/* CHANGE 6
* Add the function calls to create the new commands.
*/
Tcl_CreateObjCommand(interp, "AO_Calibrate", \
(Tcl_ObjCmdProc *)AO_CalibrateCmd, (ClientData)NULL, \
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "AO_Write", \
(Tcl_ObjCmdProc *)AO_WriteCmd, (ClientData)NULL, \
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "AO_VWrite", \
(Tcl_ObjCmdProc *)AO_VWriteCmd, (ClientData)NULL, \
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "AO_NoWrite", \
(Tcl_ObjCmdProc *)AO_NoWriteCmd, (ClientData)NULL, \
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "AO_Configure", \
(Tcl_ObjCmdProc *)AO_ConfigureCmd, (ClientData)NULL, \
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "DIG_Out_Line", \
(Tcl_ObjCmdProc *)DIG_Out_LineCmd, (ClientData)NULL, \
(Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "DIG_Prt_Config", \
(Tcl_ObjCmdProc *)DIG_Prt_ConfigCmd, (ClientData)NULL, \
(Tcl_CmdDeleteProc *)NULL);
/*
* Specify a user-specific startup file to invoke if the application
* is run interactively. Typically the startup file is "~/.apprc"
* where "app" is the name of the application. If this line is deleted
* then no user-specific startup file will be run under any conditions.
*/
Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
return TCL_OK;
}
/* CHANGE 7
* Add the code to implement new commands.
*/
int AO_WriteCmd(ClientData dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *objv[]) {
...
Function {
Variable Declaration
Check for proper number of arguments.
If invalid argument count: Generate error and return.
Convert arguments to proper variable types and check syntax for validity.
If syntacticly invalid argument: Generate error and return.
Call National Instruments Library function.
If status != OK: generate error message.
Return results of evaluating this command.
The code that implements the AO_Write command is shown below:
int AO_WriteCmd(ClientData dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *objv[]) {
/* ClientData dummy; /* Not used. */
/* Tcl_Interp *interp; /* Current interpreter. */
/* int objc; /* Number of arguments. */
/* Tcl_Obj *CONST objv[]; /* Argument objects. */
i16 devNumber;
i16 aChannel;
i16 value;
int tmp;
int retval;
Tcl_Obj *returnValue;
char retstr[80];
retval = TCL_OK; /* Assume success */
*retstr = 0; /* No return if OK */
/*
* Check for 4 arguments, return error if not 4 args
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "devNum channel val");
return TCL_ERROR;
}
/*
* Extract the arguments from the Tcl command, and convert them
* to NIDAQ data types.
*
* If error, set retval to TCL_ERROR and copy error message to retstr
*/
if (TCL_OK != Tcl_GetIntFromObj(interp, objv[1], &tmp)) {
strcpy(retstr, "Bad device Number");
retval = TCL_ERROR;
goto done;
} else {
devNumber = tmp;
}
if (TCL_OK != Tcl_GetIntFromObj(interp, objv[2], &tmp)) {
strcpy(retstr, "Bad channel");
retval = TCL_ERROR;
goto done;
} else {
aChannel = tmp;
}
if (TCL_OK != Tcl_GetIntFromObj(interp, objv[3], &tmp)) {
strcpy(retstr, "Bad value");
retval = TCL_ERROR;
goto done;
} else {
value = tmp;
}
/*
* Call the NIDAQ function
*/
tmp = AO_Write(devNumber, aChannel, value);
/*
* If status is bad, set retval to TCL_ERROR, put error message in retval
*/
if (tmp != 0) {
sprintf(retstr, "NI-DAQ Error: %d - ", tmp);
strcat(retstr, nierrstr(tmp));
retval = TCL_ERROR;
}
/*
* Create a return object with the return string
* "" if everything is OK
* Error message if an error occurred.
*/
done:
returnValue = Tcl_NewStringObj(retstr, -1);
Tcl_SetObjResult(interp, returnValue);
/*
* Return TCL_OK if nothing failed, else TCL_ERROR
*/
return retval;
}
3.1.5 Error Reporting
The NIDAQ functions return status as an integer: 0 for success, non-zero for an error. Getting a definitive error number from a function call is a good thing, but integer return codes are not intuitively obvious to the user. The error returns are listed in the documentation, but it's not time effective to have to look up a value in a reference manual.
To make debugging the NIDAQ calls easier. I created a new file that would convert the integer error code to a printable error message.
To get working code quickly I modified the NIDAQ include file
nidaqerr.h to become a "C" function. The file
nidaqerr.h, is a set of #define statements defining
mnemonic strings to represent the error codes. I used a few editor
keystroke macros to convert the #define statements into a switch as
shown below:
Original (nidaqerr.h)
|
|---|
|
Modified (nierrstr.c)
|
|
The return strings are a bit cryptic, but are much more readable than the raw integer returns.
If the new Tcl interpreter were to be the end goal of this project, I would have used more descriptive error messages. Since this was a one-shot interpreter, these strings were enough to save me from having to look up each error return.
3.2 The Client-Server Modules
This portion of the project breaks down into two modules. The VMServer module, which uses the new tclsh to control the AT-AO-10 card, and the VMClient module which can run with any tclsh interpreter.
3.2.1 The Server
The Server pseudocode is fairly simple:
initialize cards
initialize socket to listen for connection requests
while {!exit} {
listen for connection
while {!socket disconnect} {
send prompt
read command
check command syntax
process command
return result
}
}
The actual code is a bit more complex, but most of it is validity checking the input.
#!/usr/local/bin/tclsh8.0
#########################################################################
# VMServer.tcl
# Clif Flynt -- clif@cflynt.com
#
# Listens for connections on port 33000 (by default)
# Accepts commands to modify outputs on AT-AO-10 card.
# Reports success/failure
#
set Revision(VMServer) {$RCSfile: VMServer.tcl,v $ $Revision: 1.8 $}
###########################################################################
# serverOpen {channel addr port} --
# This is called when the server receives a connection request.
# Arguments:
# channel: The channel identifier assigned to the new socket
# connection
# addr: The IP address of the system that requested the
# connection
# port: The socket port assigned to the new connection.
#
# Results:
# Sets a fileevent to be entered when input becomes available
# on the channel.
#
# no Return value.
#
proc serverOpen {channel addr port} {
catch {
global sock
puts "channel: $channel - from Address: $addr Port: $port"
set sock $channel
}
}
###########################################################################
# sendPrompt {channel} --
# Sends a prompt to a channel.
# Arguments:
# channel: The channel for output
#
# Results:
# A prompt is sent to the output channel.
# Errors are ignored.
proc sendPrompt {channel} {
catch {
puts -nonewline $channel "% "
flush $channel
}
}
###########################################################################
# sendLine {channel text} --
# Sends a prompt to a channel.
# Arguments:
# channel: The channel for output
# text: The data to transmit.
#
# Results:
# A string is sent to the output channel.
# Errors are ignored.
proc sendLine {channel text} {
catch {
puts $channel $text
flush $channel
}
}
###########################################################################
# savevalues {} --
# Saves the contents of the variable values.
#
# Arguments:
# *none*
# Results:
# A file "values.tcl" is created.
#
# File creation errors are reported on stdout, but not reported
# to the calling routine.
#
proc savevalues {} {
global values errorInfo
set fail [catch {open "values.tcl" "w"} outfl]
if {$fail} {
puts "FAILED TO OPEN values.tcl."
puts "$outfl"
puts "$errorInfo"
return
}
foreach name [array names values] {
puts $outfl "set values($name) $values($name)"
}
close $outfl
}
###########################################################################
# Mainline Code starts here.
#
#
# Cardcount is the number of AT-AO cards available.
# Only 1 card is installed in the prototype system.
#
set cardcount 1
# Initialize cards.
# DIG digital ports are configured as output only.
# AO analog ports are configured to output voltage from 0-10 volts.
for {set i 1} {$i <= $cardcount} {incr i} {
DIG_Prt_Config $i 0 0 1
DIG_Prt_Config $i 1 0 1
for {set j 0} {$j < 10} {incr j} {
AO_Configure $i $j 1 0 10.0 0
}
}
#
# Restore the previous settings from history file, if it exists.
#
# The values of dac and dio settings are kept in a global associative array
# named values. Values is updated whenever a "modify" command is received,
# and the indices and data contained in values are saved in the file
# values.tcl by the proc savevalues.
#
set fail [catch {source "values.tcl"}]
if {!$fail} {
foreach name [array names values] {
set lst [split $name "."]
set cardno [lindex $lst 1]
set ioPort [lindex $lst 2]
set value $values($name)
switch [lindex $lst 0] {
"dac" {
set fail [catch {AO_VWrite $cardno $ioPort $value} err]
}
"dio" {
set line $ioPort
if {$ioPort < 4} {
set port 0
} {
set port 1
incr line -4
}
set fail [catch {DIG_Out_Line $cardno $port $line $value} err]
}
}
if {$fail} {
puts "Unexpect Failure setting initial values: $name -- $err"
}
}
}
#
# Set up a server to listen on port 33000
#
set server [socket -server serverOpen 33000]
#
# Set done flag to not done, loop on this, to be set when an
# "exit" command is received.
#
set done 0
#
# Loop until an EXIT command is received.
#
while {!$done} {
#
# Wait for a socket connection
#
set sock o
vwait sock
# A socket connection has been made.
#
# Read commands until the socket is closed.
#
while {![eof $sock]} {
sendPrompt $sock
set len [gets $sock inputLine]
#
# The TCL socket sends carriage-return/line feed pair at the
# end of a line, but reads either a <CR> or <NL> as a line terminator,
# leaving an empty line to be read on the next read. If this line is
# empty, just discard it, and continue.
#
if {$len <= 2} {
continue
}
#
# Input has been received. Display the time and input line
# for debugging and tracking purposes.
#
puts "[clock format [clock seconds]]: $inputLine"
#
# Convert to a list for simple parsing.
#
set inputLst [split $inputLine ","]
set cmd [string tolower [lindex $inputLst 0]]
#
# Assume success
#
set fail 0
#
# parse the command
#
#
# Check that there is something close to the proper number
# of fields.
# All commands except "Exit" take more than 3 arguments.
#
if {[llength $inputLst] >= 3} {
set type [string tolower [lindex $inputLst 1]]
set cardno [lindex $inputLst 2]
set ioPort [lindex $inputLst 3]
} {
if {[string match "exit" $cmd]} {
set done 1
break
} {
set type "Error"
set cardno ""
set ioPort ""
set fail 1
}
}
#
# If $cardno is > than the available cards, it's an error.
# set the fail.
#
if {!$fail} {
if {$cardno > $cardcount} {
set fail 2
}
}
#
# If fail == 0, we've had no problems and can continue checking
# Check that the port requested is within range.
#
if {!$fail} {
switch $type {
"dac" {
if {($ioPort > 9) || ($ioPort < 0)} {
set fail 3
}
}
"dio" {
if {($ioPort > 7) || ($ioPort < 0)} {
set fail 4
}
}
default {
set fail 5
}
}
}
#
# If fail is still 0, then we've got a mostly correct command.
# Parse the command field, and call the appropriate subcommand.
#
if {!$fail} {
switch [lindex $inputLst 0] {
"status" {
# If the number of fields != 4, we have a problem.
if {[llength $inputLst] != 4} {
set fail 6
} {
# Number of fields checked OK. Return the
# contents of the saved value, or report failure.
if {[info exists values($type.$cardno.$ioPort)]} {
set value $values($type.$cardno.$ioPort)
set fail 0
} {
set fail 7
}
}
}
"modify" {
# If the number of fields != 5, we have a problem.
if {[llength $inputLst] != 5} {
set fail 8
} {
set value [lindex $inputLst 4]
switch $type {
"dac" {
set fail [catch {AO_VWrite $cardno $ioPort\
$value} err]
}
"dio" {
set line $ioPort
# The AT-AO-10 card has digital I/O
# configured as two 4-line ports
#
# The protocol identifies them as
# line 0-7, treating it as one 8 line
# device.
#
# If the requested line is < 4,
# then it's port 0.
# If the requested line is >= 4,
# then it's port 1, and the line
# number should be reduced by 4.
if {$ioPort < 4} {
set port 0
} {
set port 1
incr line -4
}
set fail [catch {DIG_Out_Line $cardno $port\
$line $value} err]
}
}
# Save the value that was set.
set values($type.$cardno.$ioPort) $value
savevalues
}
}
default {
# Unrecognized command.
set fail 9
}
}
}
if {$fail} {
puts "FAIL: $fail"
if {[info exists err]} {
puts "ERR: $err"
set err [lindex [split $err] 2]
} {
set err $fail
}
set output "fail,$cmd,$type,$cardno,$ioPort,$err"
} {
set output "reply,$cmd,$type,$cardno,$ioPort,$value"
}
sendLine $sock $output
}
#
# The conversation is done, close the socket.
#
close $sock
}
#
# We got an exit command, close the server and quit
close $server
exit
3.2.2 The Client
The software running on the Sparc stations does not have built in support for socket communication. Thus, I needed to write a separate VMClient program to provide that support.
The pseudo code for this program is quite simple:
Extract message from command line
Open socket to VMServer.
Read Prompt.
Send Message.
Read Reply.
The code to implement this is:
#!/usr/local/bin/tclsh8.0
#########################################################################
# VMClient.tcl
# Clif Flynt -- clif@cflynt.com
#
# Expects a message on the command line.
# Opens a connection on port 33000 (by default)
# Waits for a prompt.
# Sends a command to the VMServer
# Waits for reply.
# Reports success/failure
#
set Revision(VMClient) {$RCSfile: VMClient.tcl,v $ $Revision: 1.4 $}
#
# Set the IP port number to the default value 33000,
# examine the command line for modified port, and message to send.
#
set port 33000
for {set i 0} {$i < $argc} {incr i} {
switch -exact -- [lindex $argv $i] {
"-p" {
incr i
set port [lindex $argv $i]
}
"-m" {
incr i
set message [lindex $argv $i]
}
}
}
#
# Using a -m option is required.
#
if {![info exists message]} {
puts "VMClient -m message"
exit
}
#
# Open the socket.
set sock [socket hydra.cflynt.com $port]
#
# Read the prompt
#
set prompt [read $sock 1]
puts "Received prompt: $prompt"
#
# Send the message
#
puts $sock $message
flush $sock
puts "Sent Message: $message"
#
# And get the reply.
#
set len [gets $sock reply]
puts "Reply: $reply"
4.0 Summary
This worked. I shaved several days off my development time by doing the early part of the prototype development in Tcl instead of waiting for "C" code to compile, and this more than made up for the few hours I spent building a tclsh merged with the National Instruments calls.
¹ TclTutor is a Computer Aided Instruction package for learning Tcl,
available at http://www.msen.com/~clif
This chapter reproduced with permission from "Tcl/Tk for Real Programmers" (ISBN: 0122612051) published by Academic Press Professional. No further reproduction is permitted without permission from the author.