TIP #254 implementation

Still missing additional tests.

1 files changed, 177 insertions, 2 deletions

diff --git a/generic/tclLink.c b/generic/tclLink.c
index 16910b6..b16a113 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclLink.c,v 1.11 2005/08/26 13:41:23 dkf Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.12 2005/09/08 10:49:19 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -32,9 +32,18 @@ typedef struct Link {
     char *addr;			/* Location of C variable. */
     int type;			/* Type of link (TCL_LINK_INT, etc.). */
     union {
+	char c;
+	unsigned char uc;
 	int i;
-	double d;
+	unsigned int ui;
+	short s;
+	unsigned short us;
+	long l;
+	unsigned long ul;
 	Tcl_WideInt w;
+	Tcl_WideUInt uw;
+	float f;
+	double d;
     } 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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
     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,38 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
 	case TCL_LINK_WIDE_INT:
 	    changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
 	    break;
+	case TCL_LINK_WIDE_UINT:
+	    changed = *(Tcl_WideUInt *)(linkPtr->addr) !=
+		    linkPtr->lastValue.uw;
+	    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 +400,107 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
 	*(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_WIDE_UINT:
+	/*
+	 * FIXME: represent as a bignum.
+	 */
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	    return "variable must have unsigned wide int value";
+	}
+	linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
+	*(Tcl_WideUInt *)(linkPtr->addr) = linkPtr->lastValue.uw;
+	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 +555,36 @@ ObjValue(linkPtr)
     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_WIDE_UINT:
+	linkPtr->lastValue.uw = *(Tcl_WideUInt *)(linkPtr->addr);
+	/*
+	 * FIXME: represent as a bignum.
+	 */
+	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
     case TCL_LINK_STRING:
 	p = *(char **)(linkPtr->addr);
 	if (p == NULL) {