Attachment "1242844.patch" to
ticket [1242844fff]
added by
dgp
2005-08-31 22:47:49.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.201
diff -u -r1.201 tcl.h
--- generic/tcl.h 7 Jun 2005 20:37:40 -0000 1.201
+++ generic/tcl.h 31 Aug 2005 15:45:24 -0000
@@ -1096,6 +1096,14 @@
#define TCL_LINK_BOOLEAN 3
#define TCL_LINK_STRING 4
#define TCL_LINK_WIDE_INT 5
+#define TCL_LINK_CHAR 6
+#define TCL_LINK_UCHAR 7
+#define TCL_LINK_SHORT 8
+#define TCL_LINK_USHORT 9
+#define TCL_LINK_UINT 10
+#define TCL_LINK_LONG 11
+#define TCL_LINK_ULONG 12
+#define TCL_LINK_FLOAT 13
#define TCL_LINK_READ_ONLY 0x80
Index: generic/tclLink.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLink.c,v
retrieving revision 1.11
diff -u -r1.11 tclLink.c
--- generic/tclLink.c 26 Aug 2005 13:41:23 -0000 1.11
+++ generic/tclLink.c 31 Aug 2005 15:45:24 -0000
@@ -16,6 +16,7 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* For each linked variable there is a data structure of the following type,
@@ -35,6 +36,14 @@
int i;
double d;
Tcl_WideInt w;
+ char c;
+ unsigned char uc;
+ short s;
+ unsigned short us;
+ unsigned int ui;
+ long l;
+ unsigned long ul;
+ float f;
} lastValue; /* Last known value of C variable; used to
* avoid string conversions. */
int flags; /* Miscellaneous one-bit values; see below for
@@ -233,6 +242,9 @@
CONST char *value;
char **pp;
Tcl_Obj *valueObj;
+ int valueInt;
+ Tcl_WideInt valueWide;
+ double valueDouble;
/*
* If the variable is being unset, then just re-create it (with a trace)
@@ -280,6 +292,30 @@
case TCL_LINK_WIDE_INT:
changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
break;
+ case TCL_LINK_CHAR:
+ changed = *(char *)(linkPtr->addr) != linkPtr->lastValue.c;
+ break;
+ case TCL_LINK_UCHAR:
+ changed = *(unsigned char *)(linkPtr->addr) != linkPtr->lastValue.uc;
+ break;
+ case TCL_LINK_SHORT:
+ changed = *(short *)(linkPtr->addr) != linkPtr->lastValue.s;
+ break;
+ case TCL_LINK_USHORT:
+ changed = *(unsigned short *)(linkPtr->addr) != linkPtr->lastValue.us;
+ break;
+ case TCL_LINK_UINT:
+ changed = *(unsigned int *)(linkPtr->addr) != linkPtr->lastValue.ui;
+ break;
+ case TCL_LINK_LONG:
+ changed = *(long *)(linkPtr->addr) != linkPtr->lastValue.l;
+ break;
+ case TCL_LINK_ULONG:
+ changed = *(unsigned long *)(linkPtr->addr) != linkPtr->lastValue.ul;
+ break;
+ case TCL_LINK_FLOAT:
+ changed = *(float *)(linkPtr->addr) != linkPtr->lastValue.f;
+ break;
case TCL_LINK_STRING:
changed = 1;
break;
@@ -356,6 +392,94 @@
*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
break;
+ case TCL_LINK_CHAR:
+ if (Tcl_GetIntFromObj(interp, valueObj, &valueInt)
+ != TCL_OK || valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return "variable must have char value";
+ }
+ linkPtr->lastValue.c = (char)valueInt;
+ *(char *)(linkPtr->addr) = linkPtr->lastValue.c;
+ break;
+
+ case TCL_LINK_UCHAR:
+ if (Tcl_GetIntFromObj(interp, valueObj, &valueInt)
+ != TCL_OK || valueInt < 0 || valueInt > UCHAR_MAX) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return "variable must have unsigned char value";
+ }
+ linkPtr->lastValue.uc = (unsigned char) valueInt;
+ *(unsigned char *)(linkPtr->addr) = linkPtr->lastValue.uc;
+ break;
+
+ case TCL_LINK_SHORT:
+ if (Tcl_GetIntFromObj(interp, valueObj, &valueInt)
+ != TCL_OK || valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return "variable must have short value";
+ }
+ linkPtr->lastValue.s = (short)valueInt;
+ *(short *)(linkPtr->addr) = linkPtr->lastValue.s;
+ break;
+
+ case TCL_LINK_USHORT:
+ if (Tcl_GetIntFromObj(interp, valueObj, &valueInt)
+ != TCL_OK || valueInt < 0 || valueInt > USHRT_MAX) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return "variable must have unsigned short value";
+ }
+ linkPtr->lastValue.us = (unsigned short)valueInt;
+ *(unsigned short *)(linkPtr->addr) = linkPtr->lastValue.us;
+ break;
+
+ case TCL_LINK_UINT:
+ if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide)
+ != TCL_OK || valueWide < 0 || valueWide > UINT_MAX) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return "variable must have unsigned int value";
+ }
+ linkPtr->lastValue.ui = (unsigned int)valueWide;
+ *(unsigned int *)(linkPtr->addr) = linkPtr->lastValue.ui;
+ break;
+
+ case TCL_LINK_LONG:
+ if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide)
+ != TCL_OK || valueWide < LONG_MIN || valueWide > LONG_MAX) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return "variable must have long value";
+ }
+ linkPtr->lastValue.l = (long)valueWide;
+ *(long *)(linkPtr->addr) = linkPtr->lastValue.l;
+ break;
+
+ case TCL_LINK_ULONG:
+ if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide)
+ != TCL_OK || valueWide < 0 || valueWide > ULONG_MAX) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return "variable must have unsigned long value";
+ }
+ linkPtr->lastValue.ul = (unsigned long)valueWide;
+ *(unsigned long *)(linkPtr->addr) = linkPtr->lastValue.ul;
+ break;
+
+ case TCL_LINK_FLOAT:
+ if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble)
+ != TCL_OK || valueDouble < FLT_MIN || valueDouble > FLT_MAX) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return "variable must have float value";
+ }
+ linkPtr->lastValue.f = (float)valueDouble;
+ *(float *)(linkPtr->addr) = linkPtr->lastValue.f;
+ break;
+
case TCL_LINK_STRING:
value = Tcl_GetStringFromObj(valueObj, &valueLength);
valueLength++;
@@ -410,6 +534,30 @@
case TCL_LINK_BOOLEAN:
linkPtr->lastValue.i = *(int *)(linkPtr->addr);
return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
+ case TCL_LINK_CHAR:
+ linkPtr->lastValue.c = *(char *)(linkPtr->addr);
+ return Tcl_NewIntObj(linkPtr->lastValue.c);
+ case TCL_LINK_UCHAR:
+ linkPtr->lastValue.uc = *(unsigned char *)(linkPtr->addr);
+ return Tcl_NewIntObj(linkPtr->lastValue.uc);
+ case TCL_LINK_SHORT:
+ linkPtr->lastValue.s = *(short *)(linkPtr->addr);
+ return Tcl_NewIntObj(linkPtr->lastValue.s);
+ case TCL_LINK_USHORT:
+ linkPtr->lastValue.us = *(unsigned short *)(linkPtr->addr);
+ return Tcl_NewIntObj(linkPtr->lastValue.us);
+ case TCL_LINK_UINT:
+ linkPtr->lastValue.ui = *(unsigned int *)(linkPtr->addr);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.ui);
+ case TCL_LINK_LONG:
+ linkPtr->lastValue.l = *(long *)(linkPtr->addr);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.l);
+ case TCL_LINK_ULONG:
+ linkPtr->lastValue.ul = *(unsigned long *)(linkPtr->addr);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.ul);
+ case TCL_LINK_FLOAT:
+ linkPtr->lastValue.f = *(float *)(linkPtr->addr);
+ return Tcl_NewDoubleObj(linkPtr->lastValue.f);
case TCL_LINK_STRING:
p = *(char **)(linkPtr->addr);
if (p == NULL) {
