931 lines
30 KiB
C++
931 lines
30 KiB
C++
// a CDEV access interface for tcl
|
|
// Johannes van Zeijts, March 95, first version
|
|
// May 95, second version, using Walt Akers callback example
|
|
// Dec 95, added arbitrary dimensional array output and context
|
|
// Jan 96, added handling of strings with spaces
|
|
// Aug 96, deleted callbackinfo when we are not monitoring
|
|
// Aug 96, converted to tcl7.5
|
|
// Nov 1, 96, moved to cdev 1.4
|
|
// March, 97, overhaul, allowed multiple devices
|
|
// Feb, 98 Make it work with select event handling
|
|
// For generic services this works only in cdev/1.6.2
|
|
// January 1999: Complete rewrite using Tcl_Obj model
|
|
|
|
#include <tcl.h>
|
|
#include <math.h>
|
|
#include <cdevData.h>
|
|
#include <cdevSystem.h>
|
|
#include <cdevRequestObject.h>
|
|
|
|
const int VALUE = cdevData::addTag("value");
|
|
static int cdevdebug = 0;
|
|
|
|
/** Handle double *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
@author Johannes van Zeijts
|
|
*/
|
|
Tcl_Obj* HandleLevel(double *res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewDoubleObj(res[count]);
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/// Handle float *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
Tcl_Obj* HandleLevel(float *res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewDoubleObj((double)res[count]);
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/// Handle short *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
Tcl_Obj* HandleLevel(short *res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewIntObj((int)res[count]);
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/// Handle uint *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
Tcl_Obj* HandleLevel(unsigned short *res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewIntObj((int)res[count]);
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/// Handle long *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
Tcl_Obj* HandleLevel(long *res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewLongObj(res[count]);
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/// Handle ulong *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
Tcl_Obj* HandleLevel(unsigned long *res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewLongObj((long)res[count]);
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/// Handle uchar (byte) *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
Tcl_Obj* HandleLevel(unsigned char *res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewIntObj((int)res[count]);
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/** Handle Timestamp *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
Each entry is a list of length 2 (seconds / nseconds)
|
|
*/
|
|
Tcl_Obj* HandleLevel(cdev_TS_STAMP *res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
Tcl_Obj *ts[2];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) {
|
|
ts[0] = Tcl_NewLongObj(res[count].secPastEpoch);
|
|
ts[1] = Tcl_NewLongObj(res[count].nsec);
|
|
list[i] = Tcl_NewListObj(2,ts);
|
|
}
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/// Handle char* *data, recursively if dimension > 1. Result is a Tcl_ListObj
|
|
Tcl_Obj* HandleLevel(char **res, int &count, int level, cdevBounds *bounds, int dim) {
|
|
int len = bounds[level].length;
|
|
Tcl_Obj *list[len];
|
|
if (level == dim-1) {
|
|
for (int i=0; i<len; ++i, ++count) list[i] = Tcl_NewStringObj(res[count],-1);
|
|
} else {
|
|
for (int i=0; i<len; ++i) list[i] = HandleLevel(res, count, level+1, bounds, dim);
|
|
}
|
|
return Tcl_NewListObj(len, list);
|
|
}
|
|
|
|
/// Convert a tagged entry inside a cdevData to a Tcl_Obj
|
|
Tcl_Obj* Tcl_ObjFromcdevData(int tag, cdevData* data) {
|
|
int type = data->getType(tag);
|
|
if (type == CDEV_INVALID) {
|
|
Tcl_Obj* obj = Tcl_NewObj();
|
|
Tcl_AppendStringsToObj(obj,NULL);
|
|
return obj;
|
|
}
|
|
size_t dim;
|
|
data->getDim(tag, &dim);
|
|
if (dim == 0) {
|
|
if (type == CDEV_DOUBLE || type == CDEV_FLOAT) {
|
|
double res;
|
|
data->get(tag, &res);
|
|
return Tcl_NewDoubleObj(res);
|
|
} else if (type == CDEV_INT32) {
|
|
long res;
|
|
data->get(tag, &res);
|
|
return Tcl_NewLongObj(res);
|
|
} else if (type == CDEV_STRING) {
|
|
char *s;
|
|
data->find(tag, (void*&) s);
|
|
return Tcl_NewStringObj(s,-1);
|
|
} else if (type == CDEV_INT16) {
|
|
int res;
|
|
data->get(tag, &res);
|
|
return Tcl_NewIntObj(res);
|
|
} else if (type == CDEV_UINT16) {
|
|
int res;
|
|
data->get(tag, &res);
|
|
return Tcl_NewIntObj(res);
|
|
} else if (type == CDEV_UINT32) {
|
|
unsigned long res;
|
|
data->get(tag, &res);
|
|
return Tcl_NewLongObj((long)res);
|
|
} else if (type == CDEV_BYTE) {
|
|
unsigned char res;
|
|
data->get(tag, &res);
|
|
return Tcl_NewIntObj((int)res);
|
|
} else if (type == CDEV_TIMESTAMP) {
|
|
cdev_TS_STAMP t;
|
|
data->get(tag, &t);
|
|
Tcl_Obj *ts[2];
|
|
ts[0] = Tcl_NewLongObj(t.secPastEpoch);
|
|
ts[1] = Tcl_NewLongObj(t.nsec);
|
|
return Tcl_NewListObj(2, ts);
|
|
} else {
|
|
Tcl_Obj *obj = Tcl_NewStringObj("unknown tag: ",-1);
|
|
char *s; cdevData::tagI2C(tag, s);
|
|
Tcl_AppendStringsToObj(obj,s,NULL);
|
|
return obj;
|
|
}
|
|
} else {
|
|
// dim > 0
|
|
cdevBounds Bounds[dim];
|
|
data->getBounds(tag, Bounds, dim);
|
|
int count = 0;
|
|
if (type == CDEV_DOUBLE) {
|
|
double *res;
|
|
data->find(tag, (void*&)res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else if (type == CDEV_FLOAT) {
|
|
float *res;
|
|
data->find(tag, (void*&)res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else if (type == CDEV_INT32) {
|
|
long *res;
|
|
data->find(tag, (void*&)res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else if (type == CDEV_STRING) {
|
|
char **res;
|
|
data->find(tag, (void*&) res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else if (type == CDEV_INT16) {
|
|
short *res;
|
|
data->find(tag, (void*&)res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else if (type == CDEV_UINT16) {
|
|
unsigned short *res;
|
|
data->find(tag, (void*&)res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else if (type == CDEV_UINT32) {
|
|
unsigned long *res;
|
|
data->find(tag, (void*&) res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else if (type == CDEV_BYTE) {
|
|
unsigned char *res;
|
|
data->find(tag, (void*&)res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else if (type == CDEV_TIMESTAMP) {
|
|
cdev_TS_STAMP *res;
|
|
data->find(tag, (void*&)res);
|
|
return HandleLevel(res, count, 0, Bounds, dim);
|
|
} else {
|
|
Tcl_Obj *obj = Tcl_NewStringObj("unknown tag: ",-1);
|
|
char *s; cdevData::tagI2C(tag, s);
|
|
Tcl_AppendStringsToObj(obj,s,NULL);
|
|
return obj;
|
|
}
|
|
}
|
|
}
|
|
/// Keeps parsed command line data, and contains callback information
|
|
class Tcl_cdevData {
|
|
public:
|
|
Tcl_cdevData(Tcl_Interp*, int, char**);
|
|
~Tcl_cdevData();
|
|
int unroll, status, taglen, *statuss, *taglist;
|
|
cdevData *out, *context;
|
|
Tcl_Obj *cbtag, *tags, *devices;
|
|
int hasContext(), hasData(), isAsynch();
|
|
|
|
static void ObjIniter();
|
|
static Tcl_Obj *arrayname;
|
|
static Tcl_Obj *statusname;
|
|
static Tcl_Obj *donename;
|
|
static Tcl_Interp *interp;
|
|
|
|
static Tcl_Obj* getCdevErrorCode(int);
|
|
};
|
|
|
|
/// Need to incr the refcount of the static Tcl_Obj, otherwise they may be removed by the tcl memory manager
|
|
void Tcl_cdevData::ObjIniter() {
|
|
Tcl_IncrRefCount(arrayname);
|
|
Tcl_IncrRefCount(statusname);
|
|
Tcl_IncrRefCount(donename);
|
|
}
|
|
|
|
Tcl_Obj *Tcl_cdevData::arrayname = Tcl_NewStringObj("Control",-1);
|
|
Tcl_Obj *Tcl_cdevData::statusname = Tcl_NewStringObj("CdevStatus",-1);
|
|
Tcl_Obj *Tcl_cdevData::donename = Tcl_NewStringObj("CdevDone",-1);
|
|
|
|
Tcl_Interp *Tcl_cdevData::interp;
|
|
|
|
Tcl_cdevData::~Tcl_cdevData() {
|
|
delete out;
|
|
delete context;
|
|
delete taglist;
|
|
delete statuss;
|
|
if (tags != NULL) Tcl_DecrRefCount(tags);
|
|
if (cbtag != NULL) Tcl_DecrRefCount(cbtag);
|
|
if (devices != NULL) Tcl_DecrRefCount(devices);
|
|
}
|
|
|
|
/// Convert int into a CDEV error string
|
|
Tcl_Obj *Tcl_cdevData::getCdevErrorCode(int code) {
|
|
static Tcl_Obj *objm2= Tcl_NewStringObj("CDEV_WARNING",-1);
|
|
static Tcl_Obj *objm1= Tcl_NewStringObj("CDEV_ERROR",-1);
|
|
static Tcl_Obj *obj0 = Tcl_NewStringObj("CDEV_SUCCESS",-1);
|
|
static Tcl_Obj *obj1 = Tcl_NewStringObj("CDEV_INVALIDOBJ",-1);
|
|
static Tcl_Obj *obj2 = Tcl_NewStringObj("CDEV_INVALIDARG",-1);
|
|
static Tcl_Obj *obj3 = Tcl_NewStringObj("CDEV_INVALIDSVC",-1);
|
|
static Tcl_Obj *obj4 = Tcl_NewStringObj("CDEV_INVALIDOP",-1);
|
|
static Tcl_Obj *obj5 = Tcl_NewStringObj("CDEV_NOTCONNECTED",-1);
|
|
static Tcl_Obj *obj6 = Tcl_NewStringObj("CDEV_IOFAILED",-1);
|
|
static Tcl_Obj *obj7 = Tcl_NewStringObj("CDEV_CONFLICT",-1);
|
|
static Tcl_Obj *obj8 = Tcl_NewStringObj("CDEV_NOTFOUND",-1);
|
|
static Tcl_Obj *obj9 = Tcl_NewStringObj("CDEV_TIMEOUT",-1);
|
|
static Tcl_Obj *obj10= Tcl_NewStringObj("CDEV_CONVERT",-1);
|
|
static Tcl_Obj *obj11= Tcl_NewStringObj("CDEV_OUTOFRANGE",-1);
|
|
static Tcl_Obj *obj12= Tcl_NewStringObj("CDEV_NOACCESS",-1);
|
|
static Tcl_Obj *obj13= Tcl_NewStringObj("CDEV_ACCESSCHANGED",-1);
|
|
static Tcl_Obj *obj60= Tcl_NewStringObj("CDEV_DISCONNECTED",-1);
|
|
static Tcl_Obj *obj61= Tcl_NewStringObj("CDEV_RECONNECTED",-1);
|
|
static Tcl_Obj *obj70= Tcl_NewStringObj("CDEV_DELETE_CALLBACK",-1);
|
|
static Tcl_Obj *obj80= Tcl_NewStringObj("CDEV_NOTCONSERVER",-1);
|
|
static Tcl_Obj *obj81= Tcl_NewStringObj("CDEV_NOTFOUNDSERVER",-1);
|
|
static Tcl_Obj *obj82= Tcl_NewStringObj("CDEV_CONN_TIMEOUT",-1);
|
|
static Tcl_Obj *obj86= Tcl_NewStringObj("CDEV_BADIO",-1);
|
|
static Tcl_Obj *obj87= Tcl_NewStringObj("CDEV_OVERFLOW",-1);
|
|
static Tcl_Obj *obj88= Tcl_NewStringObj("CDEV_INCOMPLETE",-1);
|
|
static Tcl_Obj *obj89= Tcl_NewStringObj("CDEV_CBK_FINISHED",-1);
|
|
static Tcl_Obj *obj90= Tcl_NewStringObj("CDEV_PAUSED",-1);
|
|
static Tcl_Obj *obj91= Tcl_NewStringObj("CDEV_MSG_ERR",-1);
|
|
static Tcl_Obj *objdefault= Tcl_NewStringObj("UNKNOWN",-1);
|
|
|
|
Tcl_Obj *obj;
|
|
switch (code) {
|
|
case -2: obj = objm2; break;
|
|
case -1: obj = objm1; break;
|
|
case 0: obj = obj0; break;
|
|
case 1: obj = obj1; break;
|
|
case 2: obj = obj2; break;
|
|
case 3: obj = obj3; break;
|
|
case 4: obj = obj4; break;
|
|
case 5: obj = obj5; break;
|
|
case 6: obj = obj6; break;
|
|
case 7: obj = obj7; break;
|
|
case 8: obj = obj8; break;
|
|
case 9: obj = obj9; break;
|
|
case 10: obj = obj10; break;
|
|
case 11: obj = obj11; break;
|
|
case 12: obj = obj12; break;
|
|
case 13: obj = obj13; break;
|
|
case 60: obj = obj60; break;
|
|
case 61: obj = obj61; break;
|
|
case 70: obj = obj70; break;
|
|
case 80: obj = obj80; break;
|
|
case 81: obj = obj81; break;
|
|
case 82: obj = obj82; break;
|
|
case 86: obj = obj86; break;
|
|
case 87: obj = obj87; break;
|
|
case 88: obj = obj88; break;
|
|
case 89: obj = obj89; break;
|
|
case 90: obj = obj90; break;
|
|
case 91: obj = obj91; break;
|
|
default: obj = objdefault;
|
|
}
|
|
Tcl_IncrRefCount(obj);
|
|
return obj;
|
|
}
|
|
|
|
int Tcl_cdevData::hasContext() {
|
|
if (context == NULL) return 0;
|
|
cdevDataIterator iterator(context);
|
|
return iterator.init();
|
|
}
|
|
|
|
int Tcl_cdevData::hasData() {
|
|
cdevDataIterator iterator(out);
|
|
return iterator.init();
|
|
}
|
|
|
|
int Tcl_cdevData::isAsynch() {
|
|
return (cbtag != NULL);
|
|
}
|
|
|
|
/// Parses its arguments into a cdevData result, context, and switches
|
|
Tcl_cdevData::Tcl_cdevData(Tcl_Interp*, int argc, char** argv) {
|
|
int tag, i, j, len, objc;
|
|
Tcl_Obj *obj = Tcl_NewObj();
|
|
Tcl_Obj **objv;
|
|
out = new cdevData();
|
|
context = NULL;
|
|
cdevData *ptr = out;
|
|
status = TCL_OK;
|
|
statuss = NULL;
|
|
taglen = 0;
|
|
unroll = 0;
|
|
taglist = NULL;
|
|
cbtag = NULL;
|
|
tags = NULL;
|
|
devices = NULL;
|
|
for(i=0; i<argc; ++i) {
|
|
Tcl_SetStringObj(obj, argv[i], -1);
|
|
Tcl_ListObjGetElements(interp, obj, &objc, &objv);
|
|
if (objc == 2) { // most often the case
|
|
tag = cdevData::addTag(Tcl_GetStringFromObj(objv[0], &len));
|
|
Tcl_ListObjGetElements(interp, objv[1], &objc, &objv);
|
|
if (objc == 1) { // scalar
|
|
long l; double d;
|
|
if (Tcl_GetLongFromObj(NULL, objv[0], &l) == TCL_OK) {
|
|
ptr->insert(tag, l);
|
|
} else if (Tcl_GetDoubleFromObj(NULL, objv[0], &d) == TCL_OK) {
|
|
ptr->insert(tag, d);
|
|
} else {
|
|
ptr->insert(tag, Tcl_GetStringFromObj(objv[0], &len));
|
|
}
|
|
} else if (objc > 1) {
|
|
long l; double d;
|
|
if (Tcl_GetLongFromObj(NULL, objv[0], &l) == TCL_OK) {
|
|
long lv[objc];
|
|
lv[0] = l;
|
|
for (int ic=1; ic<objc ; ++ic) {
|
|
if (Tcl_GetLongFromObj(interp, objv[ic], &lv[ic]) != TCL_OK) {
|
|
status = TCL_ERROR;
|
|
break;
|
|
}
|
|
}
|
|
ptr->insert(tag, lv, objc);
|
|
} else if (Tcl_GetDoubleFromObj(NULL, objv[0], &d) == TCL_OK) {
|
|
double dv[objc];
|
|
dv[0] = d;
|
|
for (int ic=1; ic<objc ; ++ic) {
|
|
if (Tcl_GetDoubleFromObj(interp, objv[ic], &dv[ic]) != TCL_OK) {
|
|
status = TCL_ERROR;
|
|
break;
|
|
}
|
|
}
|
|
ptr->insert(tag, dv, objc);
|
|
} else {
|
|
char *s[objc];
|
|
for(j=0; j<objc; ++j) s[j] = Tcl_GetStringFromObj(objv[j], &len);
|
|
ptr->insert(tag, s, objc);
|
|
}
|
|
}
|
|
} else if (objc == 1) {
|
|
char *s = Tcl_GetStringFromObj(obj, &len);
|
|
if (strcmp(s, "-context") == 0) {
|
|
context = new cdevData();
|
|
ptr = context;
|
|
} else if (strcmp(s, "-tags") == 0) {
|
|
if (++i == argc) {
|
|
Tcl_AppendResult(interp, " expecting tags", NULL);
|
|
status = TCL_ERROR;
|
|
break;
|
|
}
|
|
Tcl_SetStringObj(obj, argv[i], -1);
|
|
Tcl_ListObjGetElements(interp, obj, &objc, &objv);
|
|
taglen = objc; taglist = new int[taglen];
|
|
tags = Tcl_DuplicateObj(obj);
|
|
for (j=0; j<objc; ++j) {
|
|
taglist[j] = cdevData::addTag(Tcl_GetStringFromObj(objv[j], &len));
|
|
}
|
|
} else if (strcmp(s, "-unroll") == 0) {
|
|
if (++i == argc) {
|
|
Tcl_AppendResult(interp, " expecting number", NULL);
|
|
status = TCL_ERROR;
|
|
break;
|
|
}
|
|
Tcl_SetStringObj(obj, argv[i], -1);
|
|
if (Tcl_GetIntFromObj(interp, obj, &unroll) != TCL_OK) {
|
|
status = TCL_ERROR;
|
|
break;
|
|
}
|
|
} else {
|
|
if (i != argc-1) {
|
|
Tcl_AppendResult(interp, " expecting callbacktag at end", NULL);
|
|
status = TCL_ERROR;
|
|
break;
|
|
}
|
|
cbtag = Tcl_NewStringObj(argv[i],-1);
|
|
}
|
|
} else { // This is a string with spaces
|
|
tag = cdevData::addTag(Tcl_GetStringFromObj(objv[0], &len));
|
|
Tcl_Obj *concat = Tcl_ConcatObj(objc-1, objv+1);
|
|
ptr->insert(tag, Tcl_GetStringFromObj(concat, &len));
|
|
Tcl_DecrRefCount(concat);
|
|
}
|
|
}
|
|
Tcl_DecrRefCount(obj);
|
|
}
|
|
|
|
/// Based on the list of tags in the Tcl_cdevData, return a Tcl_List with the converted cdevData
|
|
Tcl_Obj* Cdev_HandleResult(Tcl_cdevData *data, cdevData &result) {
|
|
if (data->taglen == 0) {
|
|
return Tcl_ObjFromcdevData(VALUE, &result);
|
|
} else {
|
|
Tcl_Obj *objv[data->taglen+1];
|
|
objv[0] = Tcl_ObjFromcdevData(VALUE, &result);
|
|
for (int i=0; i<data->taglen; ++i) {
|
|
objv[i+1] = Tcl_ObjFromcdevData(data->taglist[i], &result);
|
|
}
|
|
return Tcl_NewListObj(data->taglen+1, objv);
|
|
}
|
|
}
|
|
/** entry point for cdev callbacks
|
|
results are put in the global array 'Control'
|
|
the '-tags' and '-unroll' options determine what is put it.
|
|
the VALUE tag is always returned (even if is empty/not in the result cdevData)
|
|
*/
|
|
void Cdev_CallbackFunction(int status, void *userarg, cdevRequestObject&, cdevData &result) {
|
|
Tcl_cdevData *data = (Tcl_cdevData *)userarg;
|
|
if (data == NULL) return;
|
|
if (cdevdebug == 1) {
|
|
int lenl;
|
|
printf("callback %d %s\n", status, Tcl_GetStringFromObj(data->cbtag, &lenl));
|
|
result.asciiDump();
|
|
}
|
|
Tcl_Obj *obj; int len;
|
|
if (data->status != status) {
|
|
data->status = status;
|
|
obj = Tcl_NewObj();
|
|
Tcl_SetIntObj(obj, status);
|
|
obj = Tcl_ObjSetVar2(data->interp, data->statusname, data->cbtag, obj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
}
|
|
cdevDataIterator iterator(&result);
|
|
if (iterator.init()) { // there are entries available
|
|
if (data->unroll == 0) {
|
|
obj = Cdev_HandleResult( data, result);
|
|
obj = Tcl_ObjSetVar2(data->interp, data->arrayname, data->cbtag, obj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
} else if (data->unroll == 1) {
|
|
obj = Tcl_ObjFromcdevData(VALUE, &result);
|
|
obj = Tcl_ObjSetVar2(data->interp, data->arrayname, data->cbtag, obj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
for (int i=0; i<data->taglen; ++i) {
|
|
obj = Tcl_ObjFromcdevData(data->taglist[i], &result);
|
|
Tcl_Obj *tag; Tcl_ListObjIndex(data->interp, data->tags, i, &tag);
|
|
Tcl_Obj *tagobj = Tcl_DuplicateObj(data->cbtag);
|
|
Tcl_AppendStringsToObj(tagobj,".",Tcl_GetStringFromObj(tag, &len),NULL);
|
|
obj = Tcl_ObjSetVar2(data->interp, data->arrayname, tagobj, obj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
Tcl_DecrRefCount(tagobj);
|
|
}
|
|
} else if (data->unroll == 2) {
|
|
Tcl_Obj **names, **values, *vtag = Tcl_ObjFromcdevData(VALUE, &result);
|
|
int nameslen;
|
|
Tcl_ListObjGetElements(data->interp, vtag, &nameslen, &names);
|
|
Tcl_ObjSetVar2(data->interp, data->arrayname, data->cbtag, vtag, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
for (int i=0; i<data->taglen; ++i) {
|
|
Tcl_Obj *tag, *listobj = Tcl_ObjFromcdevData(data->taglist[i], &result); // This better be a list of length len
|
|
Tcl_ListObjGetElements(data->interp, listobj, &len, &values);
|
|
if (len != nameslen) { Tcl_DecrRefCount(listobj); continue;}
|
|
Tcl_ListObjIndex(data->interp, data->tags, i, &tag);
|
|
for (int j=0; j<len; ++j) {
|
|
int slen;
|
|
Tcl_Obj *tagobj = Tcl_DuplicateObj(data->cbtag);
|
|
Tcl_AppendStringsToObj(tagobj,".",Tcl_GetStringFromObj(names[j], &slen),".",Tcl_GetStringFromObj(tag, &slen),NULL);
|
|
Tcl_ObjSetVar2(data->interp, data->arrayname, tagobj, values[j], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
Tcl_DecrRefCount(tagobj);
|
|
}
|
|
Tcl_DecrRefCount(listobj);
|
|
}
|
|
}
|
|
}
|
|
if ((cdevCallback::isTransactionDone() == 1) || (status == CDEV_CBK_FINISHED)) {
|
|
Tcl_Obj *sobj = Tcl_NewObj();
|
|
Tcl_SetIntObj(sobj, status);
|
|
Tcl_ObjSetVar2(data->interp, data->donename, data->cbtag, sobj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
/// The multi device callback reuses the same data for each request. Do not delete it in that case
|
|
if (data->statuss == NULL) delete data;
|
|
}
|
|
}
|
|
|
|
/** Multi device callback, passes work to regular callback function
|
|
The index into the device array is carried in the private data of the cdevRequestObject*
|
|
*/
|
|
void Cdev_MultiCallbackFunction(int status, void *userarg, cdevRequestObject& req, cdevData &result) {
|
|
Tcl_cdevData *data = (Tcl_cdevData *)userarg;
|
|
int index = (int) req.getPrivate();
|
|
data->status = data->statuss[index];
|
|
Tcl_Obj *obj, *savecb = data->cbtag;
|
|
Tcl_ListObjIndex(data->interp, data->devices, index, &obj);
|
|
data->cbtag = Tcl_DuplicateObj(obj);
|
|
int len;
|
|
Tcl_AppendStringsToObj(data->cbtag,".",Tcl_GetStringFromObj(savecb,&len),NULL);
|
|
Cdev_CallbackFunction(status, userarg, req, result);
|
|
data->statuss[index] = data->status;
|
|
Tcl_DecrRefCount(data->cbtag);
|
|
data->cbtag = savecb;
|
|
}
|
|
|
|
typedef cdevRequestObject *cdevRequestObjectPtr;
|
|
|
|
/// Letter/Envelope class for (device/message) and (N devices/message)
|
|
class TclRequest {
|
|
public:
|
|
TclRequest(Tcl_Interp *interp, int argc, char** argv);
|
|
virtual ~TclRequest();
|
|
/// forwarded to the letter
|
|
virtual int send(Tcl_cdevData *data, Tcl_Obj *&obj) {return Req->send(data, obj);}
|
|
/// forwarded to the letter pointer
|
|
virtual int sendCallback(Tcl_cdevData *data) {return Req->sendCallback(data);}
|
|
/// forwarded to the letter pointer
|
|
virtual int getStatus() {return Req->getStatus();}
|
|
protected:
|
|
TclRequest(Tcl_Obj*, Tcl_Obj*);
|
|
Tcl_Obj *device, *message;
|
|
/// The pointer to the letter
|
|
TclRequest *Req;
|
|
};
|
|
|
|
/// device/message for a single device
|
|
class TclSingleDeviceRequest : public TclRequest {
|
|
public:
|
|
TclSingleDeviceRequest(Tcl_Interp *interp, Tcl_Obj *dev, Tcl_Obj* m);
|
|
~TclSingleDeviceRequest();
|
|
int getStatus() {return status;}
|
|
int send(Tcl_cdevData *data, Tcl_Obj *&);
|
|
int sendCallback(Tcl_cdevData *data);
|
|
protected:
|
|
int status;
|
|
cdevRequestObjectPtr request;
|
|
};
|
|
|
|
/** devices/message for multiple devices
|
|
If the collection code ever matures, this code would try to use that.
|
|
*/
|
|
class TclMultiDeviceRequest : public TclRequest {
|
|
public:
|
|
TclMultiDeviceRequest(Tcl_Interp *interp, Tcl_Obj *dev, Tcl_Obj* m);
|
|
~TclMultiDeviceRequest();
|
|
int send(Tcl_cdevData *data, Tcl_Obj *&);
|
|
int getStatus() {return status;}
|
|
int sendCallback(Tcl_cdevData *data);
|
|
protected:
|
|
int number, status, *statuss;
|
|
cdevRequestObjectPtr *requests;
|
|
};
|
|
|
|
/// Constructor of the envelope class
|
|
/// Create a letter class based on the length of the devices in argv[1]
|
|
TclRequest::TclRequest(Tcl_Interp *interp, int argc, char** argv) {
|
|
device = Tcl_NewStringObj(argv[1],-1);
|
|
message = Tcl_NewStringObj(argv[2],-1);
|
|
int objc;
|
|
Tcl_ListObjLength(interp, device, &objc);
|
|
if (objc == 1) {
|
|
Req = new TclSingleDeviceRequest(interp, device, message);
|
|
} else {
|
|
Req = new TclMultiDeviceRequest(interp, device, message);
|
|
}
|
|
}
|
|
|
|
/// Constructor for the letter class
|
|
TclRequest::TclRequest(Tcl_Obj* dev, Tcl_Obj*m) : device(dev), message(m) {
|
|
Req = NULL;
|
|
}
|
|
|
|
TclRequest::~TclRequest() {
|
|
delete Req;
|
|
if (device != NULL) Tcl_DecrRefCount(device);
|
|
if (message != NULL) Tcl_DecrRefCount(message);
|
|
}
|
|
|
|
TclSingleDeviceRequest::TclSingleDeviceRequest(Tcl_Interp *interp, Tcl_Obj *dev, Tcl_Obj* m) : TclRequest(dev,m) {
|
|
int len;
|
|
status = CDEV_SUCCESS;
|
|
request = cdevRequestObject::attachPtr(Tcl_GetStringFromObj(device, &len), Tcl_GetStringFromObj(message, &len));
|
|
if (request == NULL) {
|
|
status = CDEV_INVALIDOBJ;
|
|
Tcl_Obj *listv[3];
|
|
listv[0] = Tcl_NewStringObj("Cannot find service for: ",-1);
|
|
listv[1] = device;
|
|
Tcl_IncrRefCount(device);
|
|
listv[2] = message;
|
|
Tcl_IncrRefCount(message);
|
|
Tcl_SetObjResult(interp, Tcl_NewListObj(3, listv));
|
|
}
|
|
}
|
|
|
|
TclSingleDeviceRequest::~TclSingleDeviceRequest() {
|
|
device = NULL;
|
|
message = NULL;
|
|
}
|
|
|
|
TclMultiDeviceRequest::TclMultiDeviceRequest(Tcl_Interp *interp, Tcl_Obj *dev, Tcl_Obj* m) : TclRequest(dev,m) {
|
|
Tcl_Obj *obj, **objv;
|
|
Tcl_ListObjGetElements(NULL, device, &number, &objv);
|
|
int len;
|
|
requests = new cdevRequestObjectPtr[number];
|
|
statuss = new int[number];
|
|
status = CDEV_SUCCESS;
|
|
for (int i=0; i<number; ++i) {
|
|
statuss[i] = CDEV_SUCCESS;
|
|
requests[i] = cdevRequestObject::attachPtr(Tcl_GetStringFromObj(objv[i], &len), Tcl_GetStringFromObj(message, &len));
|
|
if (requests[i] == NULL) {
|
|
statuss[i] = CDEV_INVALIDOBJ;
|
|
if (status == CDEV_SUCCESS) {
|
|
status = CDEV_INVALIDOBJ;
|
|
obj = Tcl_NewObj();
|
|
}
|
|
Tcl_ListObjAppendElement(interp, obj, objv[i]);
|
|
}
|
|
}
|
|
if (status != CDEV_SUCCESS) {
|
|
Tcl_Obj *listv[3];
|
|
listv[0] = Tcl_NewStringObj("Cannot find service for: ",-1);
|
|
listv[1] = obj;
|
|
listv[2] = message;
|
|
Tcl_IncrRefCount(message);
|
|
Tcl_SetObjResult(interp, Tcl_NewListObj(3, listv));
|
|
}
|
|
}
|
|
|
|
TclMultiDeviceRequest::~TclMultiDeviceRequest() {
|
|
delete requests;
|
|
delete statuss;
|
|
device = NULL;
|
|
message = NULL;
|
|
}
|
|
|
|
/// synchronous send
|
|
int TclSingleDeviceRequest::send(Tcl_cdevData *data, Tcl_Obj *&obj) {
|
|
if (status == CDEV_INVALIDOBJ) return status;
|
|
if (data->hasContext()) request->setContext(*(data->context));
|
|
cdevData result;
|
|
status = request->send(data->out, result);
|
|
obj = Cdev_HandleResult( data, result);
|
|
return status;
|
|
}
|
|
|
|
/// asynchronous send
|
|
int TclSingleDeviceRequest::sendCallback(Tcl_cdevData *data) {
|
|
if (status == CDEV_INVALIDOBJ) {
|
|
Tcl_Obj *sobj = Tcl_NewObj();
|
|
Tcl_SetIntObj(sobj, status);
|
|
sobj = Tcl_ObjSetVar2(data->interp, data->statusname, data->cbtag, sobj, TCL_GLOBAL_ONLY);
|
|
return status;
|
|
}
|
|
if (data->hasContext()) request->setContext(*(data->context));
|
|
int len;
|
|
cdevCallback *cb;
|
|
data->status = 1000; // preset it to "UNKNOWN"
|
|
// initialize the status
|
|
Tcl_Obj *sobj = Tcl_NewObj();
|
|
Tcl_SetIntObj(sobj, data->status);
|
|
sobj = Tcl_ObjSetVar2(data->interp, data->statusname, data->cbtag, sobj, TCL_GLOBAL_ONLY);
|
|
if (strncmp(Tcl_GetStringFromObj(message, &len), "monitorOff", 10) == 0) {
|
|
cb = new cdevCallback(Cdev_CallbackFunction, NULL);
|
|
} else {
|
|
cb = new cdevCallback(Cdev_CallbackFunction, (void *) data);
|
|
}
|
|
if (request->sendCallback(data->out, *cb) != CDEV_SUCCESS) {
|
|
return CDEV_ERROR;
|
|
}
|
|
return CDEV_SUCCESS;
|
|
}
|
|
|
|
/// synchronous send
|
|
int TclMultiDeviceRequest::send(Tcl_cdevData *data, Tcl_Obj *&obj) {
|
|
cdevData result;
|
|
Tcl_Obj *objv[number];
|
|
int oldstatus = status;
|
|
status = CDEV_SUCCESS;
|
|
for (int i=0; i<number; ++i) {
|
|
if (statuss[i] == CDEV_SUCCESS) {
|
|
if (data->hasContext()) requests[i]->setContext(*data->context);
|
|
statuss[i] = requests[i]->send(data->out, result);
|
|
if (statuss[i] != CDEV_SUCCESS) {
|
|
status = statuss[i];
|
|
}
|
|
}
|
|
objv[i] = Cdev_HandleResult( data, result);
|
|
}
|
|
obj = Tcl_NewListObj(number, objv);
|
|
if (oldstatus != CDEV_SUCCESS) status = oldstatus;
|
|
return status;
|
|
}
|
|
|
|
/// asynchronous send
|
|
int TclMultiDeviceRequest::sendCallback(Tcl_cdevData *data) {
|
|
Tcl_Obj **objv;
|
|
Tcl_ListObjGetElements(NULL, device, &number, &objv);
|
|
int len;
|
|
cdevCallback *cb;
|
|
data->devices = device;
|
|
Tcl_IncrRefCount(device);
|
|
data->statuss = new int[number];
|
|
for (int j=0; j<number; ++j) {
|
|
if (statuss[j] == CDEV_SUCCESS) {
|
|
if (data->hasContext()) requests[j]->setContext(*(data->context));
|
|
requests[j]->setPrivate((void*) j);
|
|
data->statuss[j] = 1000; // preset it to "UNKNOWN"
|
|
Tcl_Obj *sobj = Tcl_NewObj();
|
|
Tcl_SetIntObj(sobj, data->statuss[j]);
|
|
Tcl_Obj *st = Tcl_DuplicateObj(objv[j]);
|
|
Tcl_AppendStringsToObj(st, ".", Tcl_GetStringFromObj(data->cbtag,&len), NULL);
|
|
Tcl_ObjSetVar2(data->interp, data->statusname, st, sobj, TCL_GLOBAL_ONLY);
|
|
Tcl_DecrRefCount(st);
|
|
if (strncmp(Tcl_GetStringFromObj(message, &len), "monitorOff", 10) == 0) {
|
|
cb = new cdevCallback(Cdev_MultiCallbackFunction, NULL);
|
|
} else {
|
|
cb = new cdevCallback(Cdev_MultiCallbackFunction, (void *) data);
|
|
}
|
|
if (requests[j]->sendCallback(data->out, *cb) != CDEV_SUCCESS) {
|
|
}
|
|
} else { // RequestObj was invalid
|
|
Tcl_Obj *sobj = Tcl_NewObj();
|
|
Tcl_SetIntObj(sobj, statuss[j]);
|
|
Tcl_Obj *st = Tcl_DuplicateObj(objv[j]);
|
|
Tcl_AppendStringsToObj(st, ".", Tcl_GetStringFromObj(data->cbtag,&len), NULL);
|
|
Tcl_ObjSetVar2(data->interp, data->statusname, st, sobj, TCL_GLOBAL_ONLY);
|
|
Tcl_DecrRefCount(st);
|
|
}
|
|
}
|
|
return CDEV_SUCCESS;
|
|
}
|
|
|
|
static int Finished = 0;
|
|
|
|
void Cdev_FileProc(ClientData clientData, int mask) {
|
|
int fd = (int) clientData;
|
|
if (mask == TCL_EXCEPTION) {
|
|
Tcl_DeleteFileHandler(fd);
|
|
return;
|
|
}
|
|
cdevSystem::defaultSystem().poll();
|
|
}
|
|
|
|
void Cdev_RegisterFD(int fd, int condition, void *) {
|
|
if (Finished == 1) {
|
|
return;
|
|
}
|
|
if (condition == 1) {
|
|
Tcl_CreateFileHandler(fd, TCL_READABLE|TCL_EXCEPTION, Cdev_FileProc, (ClientData) fd);
|
|
} else {
|
|
Tcl_DeleteFileHandler(fd);
|
|
}
|
|
}
|
|
|
|
void Cdev_ExitProc(ClientData) {
|
|
Finished = 1; // cdev filehandler crashes when its deleted twice (at least that what I think is the problem)
|
|
}
|
|
|
|
/**
|
|
Entry point for tcl command
|
|
Steps:
|
|
Attach to a RequestObject. Return TCL_ERROR if not valid (attachPtr returns NULL).
|
|
Parse the command line arguments into a cdevData and switches.
|
|
send or sendCallback the request.
|
|
*/
|
|
int CdevCmd(ClientData, Tcl_Interp *interp, int argc, char **argv) {
|
|
if (argc < 3) {
|
|
Tcl_AppendResult(interp,"usage: cdev $device $message \"$tag $value\" ...", NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
TclRequest request(interp, argc, argv);
|
|
|
|
if (request.getStatus() != CDEV_SUCCESS) {
|
|
return TCL_ERROR;
|
|
}
|
|
Tcl_cdevData *data = new Tcl_cdevData(interp, argc-3, argv+3);
|
|
if (data->status != TCL_OK) {
|
|
delete data;
|
|
return TCL_ERROR;
|
|
}
|
|
Tcl_Obj *obj;
|
|
if (data->isAsynch()) {
|
|
request.sendCallback(data);
|
|
cdevSystem::defaultSystem().flush();
|
|
cdevSystem::defaultSystem().poll();
|
|
// keep data around
|
|
} else {
|
|
request.send(data, obj);
|
|
}
|
|
if (request.getStatus() != CDEV_SUCCESS) {
|
|
delete data;
|
|
if (!data->isAsynch()) {
|
|
Tcl_SetObjResult(interp, obj);
|
|
}
|
|
return TCL_ERROR;
|
|
}
|
|
if (!data->isAsynch()) {
|
|
Tcl_SetObjResult(interp, obj);
|
|
delete data;
|
|
}
|
|
return TCL_OK;
|
|
}
|
|
|
|
int CdevErrorCodeCmd(ClientData, Tcl_Interp *interp, int argc, char **argv) {
|
|
if (argc < 2) {
|
|
Tcl_AppendResult(interp,"usage: cdeverrorcode $error", NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
Tcl_Obj *obj = Tcl_NewStringObj(argv[1], -1);
|
|
int status;
|
|
if (Tcl_GetIntFromObj(interp, obj, &status) != TCL_OK) {
|
|
return TCL_ERROR;
|
|
}
|
|
Tcl_DecrRefCount(obj);
|
|
Tcl_SetObjResult(interp, Tcl_cdevData::getCdevErrorCode(status));
|
|
return TCL_OK;
|
|
}
|
|
|
|
int CdevDebugCmd(ClientData, Tcl_Interp *, int, char **) {
|
|
if (cdevdebug == 0) {
|
|
cdevdebug = 1;
|
|
} else {
|
|
cdevdebug = 0;
|
|
}
|
|
return TCL_OK;
|
|
}
|
|
|
|
#ifdef SUN
|
|
#include <cdevCns/cdevCns.hxx>
|
|
#endif
|
|
// Old way of polling, superseded by FileHandler calls, but since FD's are not working yet, still in use
|
|
|
|
void Cdev_UpdateProc(ClientData dummy) {
|
|
cdevSystem::defaultSystem().poll();
|
|
Tcl_CreateTimerHandler(200, Cdev_UpdateProc, dummy);
|
|
}
|
|
|
|
//extern "C" int Cdev_Init(Tcl_Interp *interp) {
|
|
extern"C"int Tclcdev_Init(Tcl_Interp *interp) {
|
|
int i, numFD = 20;
|
|
int fds[numFD];
|
|
#ifdef SUN
|
|
cdevCnsInit(); // Hook into the BNL ADO Nameserver
|
|
#endif
|
|
Tcl_cdevData::interp = interp;
|
|
Tcl_cdevData::ObjIniter();
|
|
|
|
// This installs cdev into the tcl FD select.
|
|
cdevSystem::defaultSystem().getFd(fds, numFD);
|
|
for (i=0;i<numFD;i++) {
|
|
Cdev_RegisterFD(fds[i],1,NULL);
|
|
}
|
|
cdevSystem::defaultSystem().addFdChangedCallback(Cdev_RegisterFD, NULL);
|
|
if(Tcl_PkgProvide(interp, "Cdev", "8.0") != TCL_OK) {
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
// Alternatively call poll periodically
|
|
// Cdev_UpdateProc(ClientData dummy);
|
|
|
|
Tcl_CreateCommand(interp, "cdev", CdevCmd, (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
|
|
Tcl_CreateCommand(interp, "cdeverrorcode", CdevErrorCodeCmd, (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
|
|
Tcl_CreateCommand(interp, "cdevdebug", CdevDebugCmd, (ClientData *) NULL, (Tcl_CmdDeleteProc *) NULL);
|
|
Tcl_CreateExitHandler(Cdev_ExitProc, NULL);
|
|
return TCL_OK;
|
|
}
|
|
|