Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.143
diff -u -r1.143 tcl.decls
--- generic/tcl.decls	21 Aug 2008 21:35:37 -0000	1.143
+++ generic/tcl.decls	17 Sep 2008 16:45:58 -0000
@@ -2146,6 +2146,13 @@
 	                     Tcl_Obj *CONST objv[])
 }
 
+# TIP#312 New Tcl_LinkArray() function
+declare 589 generic {
+    int Tcl_LinkArray(Tcl_Interp *interp, CONST char *varName, char *addr,
+            int type, int size)
+}
+
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.270
diff -u -r1.270 tcl.h
--- generic/tcl.h	3 Sep 2008 05:43:31 -0000	1.270
+++ generic/tcl.h	17 Sep 2008 16:45:58 -0000
@@ -1078,6 +1078,8 @@
 #define TCL_LINK_ULONG		12
 #define TCL_LINK_FLOAT		13
 #define TCL_LINK_WIDE_UINT	14
+#define TCL_LINK_CHARS          15
+#define TCL_LINK_BINARY         16
 #define TCL_LINK_READ_ONLY	0x80
 
 /*
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.145
diff -u -r1.145 tclDecls.h
--- generic/tclDecls.h	21 Aug 2008 21:35:38 -0000	1.145
+++ generic/tclDecls.h	17 Sep 2008 16:45:59 -0000
@@ -3566,6 +3566,13 @@
 				ClientData clientData, int objc, 
 				Tcl_Obj *CONST objv[]);
 #endif
+#ifndef Tcl_LinkArray_TCL_DECLARED
+#define Tcl_LinkArray_TCL_DECLARED
+/* 589 */
+EXTERN int		Tcl_LinkArray (Tcl_Interp * interp, 
+				CONST char * varName, char * addr, int type, 
+				int size);
+#endif
 
 typedef struct TclStubHooks {
     CONST struct TclPlatStubs *tclPlatStubs;
@@ -4214,6 +4221,7 @@
     int (*tcl_NRCmdSwap) (Tcl_Interp * interp, Tcl_Command cmd, int objc, Tcl_Obj *CONST objv[], int flags); /* 586 */
     void (*tcl_NRAddCallback) (Tcl_Interp * interp, Tcl_NRPostProc * postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */
     int (*tcl_NRCallObjProc) (Tcl_Interp * interp, Tcl_ObjCmdProc * objProc, ClientData clientData, int objc, Tcl_Obj *CONST objv[]); /* 588 */
+    int (*tcl_LinkArray) (Tcl_Interp * interp, CONST char * varName, char * addr, int type, int size); /* 589 */
 } TclStubs;
 
 #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
@@ -6642,6 +6650,10 @@
 #define Tcl_NRCallObjProc \
 	(tclStubsPtr->tcl_NRCallObjProc) /* 588 */
 #endif
+#ifndef Tcl_LinkArray
+#define Tcl_LinkArray \
+	(tclStubsPtr->tcl_LinkArray) /* 589 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
Index: generic/tclLink.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLink.c,v
retrieving revision 1.25
diff -u -r1.25 tclLink.c
--- generic/tclLink.c	27 Apr 2008 22:21:30 -0000	1.25
+++ generic/tclLink.c	17 Sep 2008 16:45:59 -0000
@@ -30,6 +30,9 @@
 				 * actual variable may be aliased at that time
 				 * via upvar. */
     char *addr;			/* Location of C variable. */
+    int bytes;			/* Size of C variable array.
+				 * 0 when single variables
+				 * >0 used for array variables */
     int type;			/* Type of link (TCL_LINK_INT, etc.). */
     union {
 	char c;
@@ -44,6 +47,18 @@
 	Tcl_WideUInt uw;
 	float f;
 	double d;
+	char *pc;
+	unsigned char *puc;
+	int *pi;
+	unsigned int *pui;
+	short *ps;
+	unsigned short *pus;
+	long *pl;
+	unsigned long *pul;
+	Tcl_WideInt *pw;
+	Tcl_WideUInt *puw;
+	float *pf;
+	double *pd;
     } lastValue;		/* Last known value of C variable; used to
 				 * avoid string conversions. */
     int flags;			/* Miscellaneous one-bit values; see below for
@@ -57,10 +72,14 @@
  * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar is
  *				in progress for this variable, so trace
  *				callbacks on the variable should be ignored.
+ * LINK_ALLOC_ADDR -		1 means linkPtr->addr was allocated on the heap
+ * LINK_ALLOC_LAST -		1 means linkPtr->valueLast.p was allocated on the heap
  */
 
 #define LINK_READ_ONLY		1
 #define LINK_BEING_UPDATED	2
+#define LINK_ALLOC_ADDR		4
+#define LINK_ALLOC_LAST		8
 
 /*
  * Forward references to functions defined later in this file:
@@ -69,6 +88,7 @@
 static char *		LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
 			    const char *name1, const char *name2, int flags);
 static Tcl_Obj *	ObjValue(Link *linkPtr);
+static void		LinkFree(Link *linkPtr);
 
 /*
  * Convenience macro for accessing the value of the C variable pointed to by a
@@ -125,18 +145,161 @@
     } else {
 	linkPtr->flags = 0;
     }
+    linkPtr->bytes = 0;
     objPtr = ObjValue(linkPtr);
     if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
 	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
 	Tcl_DecrRefCount(linkPtr->varName);
-	ckfree((char *) linkPtr);
+	LinkFree(linkPtr);
 	return TCL_ERROR;
     }
     code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
 	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
     if (code != TCL_OK) {
 	Tcl_DecrRefCount(linkPtr->varName);
-	ckfree((char *) linkPtr);
+	LinkFree(linkPtr);
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LinkArray --
+ *
+ *	Link a C variable array to a Tcl variable so that changes to either one
+ *	causes the other to change.
+ *
+ * Results:
+ *	The return value is TCL_OK if everything went well or TCL_ERROR if an
+ *	error occurred (the interp's result is also set after errors).
+ *
+ * Side effects:
+ *	The value at *addr is linked to the Tcl variable "varName", using
+ *	"type" to convert between string values for Tcl and binary values for
+ *	*addr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LinkArray(
+    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
+    CONST char *varName,	/* Name of a global variable in interp. */
+    char *addr,			/* Address of a C variable to be linked to
+				 * varName. If NULL then the necessary space
+				 * will be allocated and returned as the
+				 * interpreter result. */
+    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
+				 * may have TCL_LINK_READ_ONLY and
+				 * TCL_LINK_ALLOC OR'ed in. */
+    int size)			/* Size of C variable array, >1 if array */
+{
+    Tcl_Obj *objPtr;
+    Link *linkPtr;
+    int code;
+
+    if (size < 1) {
+	Tcl_SetResult(interp, "wrong array size given", TCL_STATIC);
+	return TCL_ERROR;
+    }
+
+    linkPtr = (Link *) ckalloc(sizeof(Link));
+    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
+    if (type & TCL_LINK_READ_ONLY) {
+	linkPtr->flags = LINK_READ_ONLY;
+    } else {
+	linkPtr->flags = 0;
+    }
+    switch (linkPtr->type) {
+    case TCL_LINK_INT:
+    case TCL_LINK_BOOLEAN:
+	linkPtr->bytes = size * sizeof(int);
+	break;
+    case TCL_LINK_DOUBLE:
+	linkPtr->bytes = size * sizeof(double);
+	break;
+    case TCL_LINK_WIDE_INT:
+	linkPtr->bytes = size * sizeof(Tcl_WideInt);
+	break;
+    case TCL_LINK_WIDE_UINT:
+	linkPtr->bytes = size * sizeof(Tcl_WideUInt);
+	break;
+    case TCL_LINK_CHAR:
+	linkPtr->bytes = size * sizeof(char);
+	break;
+    case TCL_LINK_UCHAR:
+	linkPtr->bytes = size * sizeof(unsigned char);
+	break;
+    case TCL_LINK_SHORT:
+	linkPtr->bytes = size * sizeof(short);
+	break;
+    case TCL_LINK_USHORT:
+	linkPtr->bytes = size * sizeof(unsigned short);
+	break;
+    case TCL_LINK_UINT:
+	linkPtr->bytes = size * sizeof(unsigned int);
+	break;
+    case TCL_LINK_LONG:
+	linkPtr->bytes = size * sizeof(long);
+	break;
+    case TCL_LINK_ULONG:
+	linkPtr->bytes = size * sizeof(unsigned long);
+	break;
+    case TCL_LINK_FLOAT:
+	linkPtr->bytes = size * sizeof(float);
+	break;
+    case TCL_LINK_STRING:
+	linkPtr->bytes = size * sizeof(char);
+	size = 1;/* this is a variable length string, no need to check last value */
+	/* if no address is given create one and use as address the
+         * not needed linkPtr->lastValue */
+	if (addr == NULL) {
+	    linkPtr->lastValue.pc = ckalloc(linkPtr->bytes);
+	    linkPtr->flags |= LINK_ALLOC_LAST;
+	    addr = (char *)&linkPtr->lastValue.pc;
+	}
+	break;
+    case TCL_LINK_CHARS:
+    case TCL_LINK_BINARY:
+	linkPtr->bytes = size * sizeof(char);
+	break;
+    default:
+	LinkFree(linkPtr);
+	Tcl_SetResult(interp, "bad linked array variable type", TCL_STATIC);
+	return TCL_ERROR;
+    }
+    /* allocate C variable space in case no address is given */
+    if (addr==NULL) {
+	linkPtr->addr = ckalloc(linkPtr->bytes);
+	linkPtr->flags |= LINK_ALLOC_ADDR;
+    } else {
+	linkPtr->addr = addr;
+    }
+    /* if necessary create space for last used value */
+    if (size > 1) {
+	linkPtr->lastValue.pc = ckalloc(linkPtr->bytes);
+	linkPtr->flags |= LINK_ALLOC_LAST;
+    }
+    /* set common structure values */
+    linkPtr->interp = interp;
+    linkPtr->varName = Tcl_NewStringObj(varName, -1);
+    Tcl_IncrRefCount(linkPtr->varName);
+    objPtr = ObjValue(linkPtr);
+    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
+	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+	Tcl_DecrRefCount(linkPtr->varName);
+	LinkFree(linkPtr);
+	return TCL_ERROR;
+    }
+    code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
+	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
+	    (ClientData) linkPtr);
+    if (code != TCL_OK) {
+	Tcl_DecrRefCount(linkPtr->varName);
+	LinkFree(linkPtr);
+    } else {
+	Tcl_SetObjResult(interp,Tcl_NewIntObj((int)linkPtr->addr));
     }
     return code;
 }
@@ -174,7 +337,7 @@
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    LinkTraceProc, linkPtr);
     Tcl_DecrRefCount(linkPtr->varName);
-    ckfree((char *) linkPtr);
+    LinkFree(linkPtr);
 }
 
 /*
@@ -259,6 +422,9 @@
     int valueInt;
     Tcl_WideInt valueWide;
     double valueDouble;
+    int objc;
+    Tcl_Obj **objv;
+    int i;
 
     /*
      * If the variable is being unset, then just re-create it (with a trace)
@@ -268,7 +434,7 @@
     if (flags & TCL_TRACE_UNSETS) {
 	if (Tcl_InterpDeleted(interp)) {
 	    Tcl_DecrRefCount(linkPtr->varName);
-	    ckfree((char *) linkPtr);
+	    LinkFree(linkPtr);
 	} else if (flags & TCL_TRACE_DESTROYED) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
@@ -295,6 +461,11 @@
      */
 
     if (flags & TCL_TRACE_READS) {
+	/* variable arrays */
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    changed = memcmp(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	/* single variables */
+	} else {
 	switch (linkPtr->type) {
 	case TCL_LINK_INT:
 	case TCL_LINK_BOOLEAN:
@@ -334,10 +505,13 @@
 	    changed = (LinkedVar(float) != linkPtr->lastValue.f);
 	    break;
 	case TCL_LINK_STRING:
+	case TCL_LINK_CHARS:
+	case TCL_LINK_BINARY:
 	    changed = 1;
 	    break;
 	default:
-	    return "internal error: bad linked variable type";
+	    changed = 0;
+	}
 	}
 	if (changed) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -349,7 +523,7 @@
     /*
      * For writes, first make sure that the variable is writable. Then convert
      * the Tcl value to C if possible. If the variable isn't writable or can't
-     * be converted, then restore the varaible's old value and return an
+     * be converted, then restore the variable's old value and return an
      * error. Another tricky thing: we have to save and restore the interp's
      * result, since the variable access could occur when the result has been
      * partially set.
@@ -371,6 +545,21 @@
 
     switch (linkPtr->type) {
     case TCL_LINK_INT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(int)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetIntFromObj(NULL,objv[i],&linkPtr->lastValue.pi[i])!= TCL_OK) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have integer value";
+		}
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
 		!= TCL_OK) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -381,16 +570,53 @@
 	break;
 
     case TCL_LINK_WIDE_INT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(Tcl_WideInt)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetWideIntFromObj(NULL,objv[i],&linkPtr->lastValue.pw[i])!= TCL_OK) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have wide integer value";
+		}
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
 		!= TCL_OK) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
-	    return "variable must have integer value";
+	    return "variable must have wide integer value";
 	}
 	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
 	break;
 
     case TCL_LINK_DOUBLE:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(double)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetDoubleFromObj(NULL,objv[i],&linkPtr->lastValue.pd[i])!= TCL_OK) {
+#ifdef ACCEPT_NAN
+	    if (valueObj->typePtr != &tclDoubleType) {
+#endif
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have real value";
+#ifdef ACCEPT_NAN
+	    }
+	    linkPtr->lastValue.pdi[i] = valueObj->internalRep.doubleValue;
+#endif
+		}
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
 		!= TCL_OK) {
 #ifdef ACCEPT_NAN
@@ -408,6 +634,21 @@
 	break;
 
     case TCL_LINK_BOOLEAN:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(int)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetBooleanFromObj(NULL,objv[i],&linkPtr->lastValue.pi[i])!= TCL_OK) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have boolean value";
+		}
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
 		!= TCL_OK) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -418,6 +659,23 @@
 	break;
 
     case TCL_LINK_CHAR:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(char)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetIntFromObj(NULL,objv[i],&valueInt)!= TCL_OK
+			|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have char value";
+		}
+		linkPtr->lastValue.pc[i] = (char)valueInt;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
 		|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -429,6 +687,23 @@
 	break;
 
     case TCL_LINK_UCHAR:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(unsigned char)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetIntFromObj(NULL,objv[i],&valueInt)!= TCL_OK
+			|| valueInt < 0 || valueInt > UCHAR_MAX) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have unsigned char value";
+		}
+		linkPtr->lastValue.puc[i] = (unsigned char)valueInt;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
 		|| valueInt < 0 || valueInt > UCHAR_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -440,6 +715,23 @@
 	break;
 
     case TCL_LINK_SHORT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(short)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetIntFromObj(NULL,objv[i],&valueInt)!= TCL_OK
+			|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have short value";
+		}
+		linkPtr->lastValue.ps[i] = (short)valueInt;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
 		|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -451,6 +743,23 @@
 	break;
 
     case TCL_LINK_USHORT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(unsigned short)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetIntFromObj(NULL,objv[i],&valueInt)!= TCL_OK
+			|| valueInt < 0 || valueInt > USHRT_MAX) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have unsigned short value";
+		}
+		linkPtr->lastValue.pus[i] = (unsigned short)valueInt;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
 		|| valueInt < 0 || valueInt > USHRT_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -462,6 +771,23 @@
 	break;
 
     case TCL_LINK_UINT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(unsigned int)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetWideIntFromObj(NULL,objv[i],&valueWide)!= TCL_OK
+			|| valueWide < 0 || valueWide > UINT_MAX) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have unsigned int value";
+		}
+		linkPtr->lastValue.pui[i] = (unsigned int)valueWide;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
 		|| valueWide < 0 || valueWide > UINT_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -473,6 +799,23 @@
 	break;
 
     case TCL_LINK_LONG:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(long)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetWideIntFromObj(NULL,objv[i],&valueWide)!= TCL_OK
+			|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have long value";
+		}
+		linkPtr->lastValue.pl[i] = (long)valueWide;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
 		|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -484,6 +827,23 @@
 	break;
 
     case TCL_LINK_ULONG:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(unsigned long)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetWideIntFromObj(NULL,objv[i],&valueWide)!= TCL_OK
+			|| valueWide < 0 || valueWide > ULONG_MAX) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have unsigned long value";
+		}
+		linkPtr->lastValue.pul[i] = (unsigned long)valueWide;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
 		|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -498,7 +858,25 @@
 	/*
 	 * FIXME: represent as a bignum.
 	 */
-	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(Tcl_WideUInt)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetWideIntFromObj(NULL,objv[i],&valueWide)!= TCL_OK
+			|| valueWide < 0) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have unsigned wide int value";
+		}
+		linkPtr->lastValue.puw[i] = (Tcl_WideUInt)valueWide;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
+		|| valueWide < 0) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	    return "variable must have unsigned wide int value";
@@ -508,6 +886,23 @@
 	break;
 
     case TCL_LINK_FLOAT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    if (Tcl_ListObjGetElements(interp,valueObj,&objc,&objv)==TCL_ERROR
+		|| objc != linkPtr->bytes/sizeof(float)) {
+		return "wrong dimension";
+	    }
+	    for (i=0; i < objc; i++) {
+		if (Tcl_GetDoubleFromObj(interp,objv[i],&valueDouble)!= TCL_OK
+			|| valueDouble < FLT_MIN || valueDouble > FLT_MAX) {
+	        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+		    TCL_GLOBAL_ONLY);
+	            return "variable array must have float value";
+		}
+		linkPtr->lastValue.pf[i] = (float)valueDouble;
+	    }
+	    memcpy(linkPtr->addr,linkPtr->lastValue.pc,linkPtr->bytes);
+	    break;
+	}
 	if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
 		|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -522,11 +917,39 @@
 	value = Tcl_GetStringFromObj(valueObj, &valueLength);
 	valueLength++;
 	pp = (char **) linkPtr->addr;
-
 	*pp = ckrealloc(*pp, valueLength);
 	memcpy(*pp, value, (unsigned) valueLength);
 	break;
 
+    case TCL_LINK_CHARS:
+	value = (char *)Tcl_GetStringFromObj(valueObj, &valueLength);
+	valueLength++;/* include end of string char */
+	if (valueLength > linkPtr->bytes) {
+	    return "wrong size of char* value";
+	}
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, value, (unsigned) valueLength);
+	    memcpy(linkPtr->addr, value, (unsigned) valueLength);
+	} else {
+	    linkPtr->lastValue.c = '\0';
+	    LinkedVar(char) = linkPtr->lastValue.c;
+	}
+	break;
+
+    case TCL_LINK_BINARY:
+	value = (char *)Tcl_GetByteArrayFromObj(valueObj, &valueLength);
+	if (valueLength != linkPtr->bytes) {
+	    return "wrong size of binary value";
+	}
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, value, (unsigned) valueLength);
+	    memcpy(linkPtr->addr, value, (unsigned) valueLength);
+	} else {
+	    linkPtr->lastValue.uc = (unsigned char) *value;
+	    LinkedVar(unsigned char) = linkPtr->lastValue.uc;
+	}
+	break;
+
     default:
 	return "internal error: bad linked variable type";
     }
@@ -557,49 +980,169 @@
 {
     char *p;
     Tcl_Obj *resultObj;
+    int objc;
+    static Tcl_Obj **objv = NULL;
+    int i;
 
     switch (linkPtr->type) {
     case TCL_LINK_INT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(int);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.pi[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.i = LinkedVar(int);
 	return Tcl_NewIntObj(linkPtr->lastValue.i);
     case TCL_LINK_WIDE_INT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(Tcl_WideInt);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.pw[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
 	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
     case TCL_LINK_DOUBLE:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(double);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.pd[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.d = LinkedVar(double);
 	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
     case TCL_LINK_BOOLEAN:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(int);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.pi[i] != 0);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.i = LinkedVar(int);
 	return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
     case TCL_LINK_CHAR:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(char);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.pc[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.c = LinkedVar(char);
 	return Tcl_NewIntObj(linkPtr->lastValue.c);
     case TCL_LINK_UCHAR:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(unsigned char);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.puc[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.uc = LinkedVar(unsigned char);
 	return Tcl_NewIntObj(linkPtr->lastValue.uc);
     case TCL_LINK_SHORT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(short);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.ps[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.s = LinkedVar(short);
 	return Tcl_NewIntObj(linkPtr->lastValue.s);
     case TCL_LINK_USHORT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(unsigned short);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.pus[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.us = LinkedVar(unsigned short);
 	return Tcl_NewIntObj(linkPtr->lastValue.us);
     case TCL_LINK_UINT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(unsigned int);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.pui[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.ui = LinkedVar(unsigned int);
 	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
     case TCL_LINK_LONG:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(long);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.pl[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.l = LinkedVar(long);
 	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
     case TCL_LINK_ULONG:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(unsigned long);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.pul[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.ul = LinkedVar(unsigned long);
 	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
     case TCL_LINK_FLOAT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(float);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.pf[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
 	linkPtr->lastValue.f = LinkedVar(float);
 	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
     case TCL_LINK_WIDE_UINT:
-	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
 	/*
 	 * FIXME: represent as a bignum.
 	 */
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    objc = linkPtr->bytes/sizeof(Tcl_WideUInt);
+	    objv = (Tcl_Obj **) ckrealloc((char *)objv, objc*sizeof(Tcl_Obj*));
+	    for (i=0; i < objc; i++) {
+		objv[i] = Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.puw[i]);
+	    }
+	    return Tcl_NewListObj(objc,objv);
+	}
+	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
 	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
     case TCL_LINK_STRING:
 	p = LinkedVar(char *);
@@ -609,6 +1152,23 @@
 	}
 	return Tcl_NewStringObj(p, -1);
 
+    case TCL_LINK_CHARS:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    linkPtr->lastValue.pc[linkPtr->bytes-1] = '\0';/* take care of proper string end */
+	    return Tcl_NewStringObj(linkPtr->lastValue.pc,linkPtr->bytes);
+	}
+	linkPtr->lastValue.c = '\0';
+	return Tcl_NewStringObj(&linkPtr->lastValue.c,1);
+
+    case TCL_LINK_BINARY:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.pc, linkPtr->addr, linkPtr->bytes);
+	    return Tcl_NewByteArrayObj((unsigned char *)linkPtr->addr,linkPtr->bytes);
+	}
+	linkPtr->lastValue.uc = LinkedVar(unsigned char);
+	return Tcl_NewByteArrayObj(&linkPtr->lastValue.uc,1);
+
     /*
      * This code only gets executed if the link type is unknown (shouldn't
      * ever happen).
@@ -621,6 +1181,31 @@
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * LinkFree --
+ *
+ *	Free's allocated space of given link and link structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+LinkFree(
+    Link *linkPtr)		/* Structure describing linked variable. */
+{
+    if (linkPtr->flags & LINK_ALLOC_ADDR) ckfree(linkPtr->addr);
+    if (linkPtr->flags & LINK_ALLOC_LAST) ckfree(linkPtr->lastValue.pc);
+    ckfree((char *) linkPtr);
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.162
diff -u -r1.162 tclStubInit.c
--- generic/tclStubInit.c	29 Jul 2008 05:30:38 -0000	1.162
+++ generic/tclStubInit.c	17 Sep 2008 16:45:59 -0000
@@ -1114,6 +1114,7 @@
     Tcl_NRCmdSwap, /* 586 */
     Tcl_NRAddCallback, /* 587 */
     Tcl_NRCallObjProc, /* 588 */
+    Tcl_LinkArray, /* 589 */
 };
 
 /* !END!: Do not edit above this line. */
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.124
diff -u -r1.124 tclTest.c
--- generic/tclTest.c	20 Aug 2008 13:14:41 -0000	1.124
+++ generic/tclTest.c	17 Sep 2008 16:45:59 -0000
@@ -273,6 +273,9 @@
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestlinkCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestlinkarrayCmd(ClientData dummy,
+                            Tcl_Interp *interp, int objc,
+                            Tcl_Obj *const objv[]);
 static int		TestlocaleCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -616,6 +619,8 @@
     Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
 	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0, NULL);
+    Tcl_CreateObjCommand(interp, "testlinkarray", TestlinkarrayCmd,
+            (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0,
 	    NULL);
     Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0, NULL);
@@ -3057,6 +3062,118 @@
 /*
  *----------------------------------------------------------------------
  *
+ * TestlinkarrayCmd --
+ *
+ *      This function is invoked to process the "testlinkarray" Tcl command.
+ *      It is used to test the 'Tcl_LinkArray' function.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *	Creates, deletes, and invokes variable links.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestlinkarrayCmd(
+    ClientData dummy,           /* Not used. */
+    Tcl_Interp *interp,         /* Current interpreter. */
+    int objc,                   /* Number of arguments. */
+    Tcl_Obj *const objv[])      /* Argument objects. */
+{
+    static const char *LinkOption[] = {
+    "update", "remove", "create", NULL
+    };
+    enum LinkOption { LINK_UPDATE, LINK_REMOVE, LINK_CREATE };
+    static const char *LinkType[] = {
+    "char", "uchar", "short", "ushort", "int", "uint", "long", "ulong",
+    "wide", "uwide", "float", "double", "string", "char*", "binary", NULL
+    };
+    /* all values after TCL_LINK_CHARS_ARRAY are used as arrays (see below) */
+    static int LinkTypes[] = { TCL_LINK_CHAR, TCL_LINK_UCHAR,
+    TCL_LINK_SHORT, TCL_LINK_USHORT, TCL_LINK_INT, TCL_LINK_UINT,
+    TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT,
+    TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS, TCL_LINK_BINARY
+    };
+    int optionIndex;
+    int typeIndex;
+    int readonly;
+    int i;
+    char *name;
+    int addr;
+    int size;
+    char *arg;
+    int length;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option args");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], LinkOption, "option", 0,
+	&optionIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    switch ((enum LinkOption) optionIndex) {
+    case LINK_UPDATE:
+	for (i=2;i<objc;i++) {
+	    Tcl_UpdateLinkedVar(interp, Tcl_GetString(objv[i]));
+	}
+	return TCL_OK;
+    case LINK_REMOVE:
+	for (i=2;i<objc;i++) {
+	    Tcl_UnlinkVar(interp, Tcl_GetString(objv[i]));
+	}
+	return TCL_OK;
+    case LINK_CREATE:
+	if (objc < 4) {
+	    goto wrongArgs;
+	}
+	readonly = 0;
+	i = 2;
+	/* test on switch -r... */
+	arg = Tcl_GetStringFromObj(objv[i],&length);
+	if (length < 2) {
+	    goto wrongArgs;
+	}
+	if (arg[0] == '-') {
+	    if (arg[1] != 'r') {
+	        goto wrongArgs;
+	    }
+	    readonly = TCL_LINK_READ_ONLY;
+	    i++;
+	}
+	if (Tcl_GetIndexFromObj(interp, objv[i++], LinkType, "type", 0,
+	    &typeIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
+	    Tcl_SetResult(interp, "wrong size value", NULL);
+	    return TCL_ERROR;
+	}
+	name = Tcl_GetString(objv[i++]);
+	/* if no address is given request one in the underlying function */
+	if (i <objc) {
+	    if (Tcl_GetIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
+	        Tcl_SetResult(interp, "wrong address value", NULL);
+	        return TCL_ERROR;
+	    }
+	} else {
+	    addr = 0;
+	}
+	return Tcl_LinkArray(interp,name,(char *)addr,LinkTypes[typeIndex] | readonly,size);
+    }
+    return TCL_OK;
+
+  wrongArgs:
+    Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? type size name ?address?");
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestlocaleCmd --
  *
  *	This procedure implements the "testlocale" command.  It is used
Index: tests/link.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/link.test,v
retrieving revision 1.17
diff -u -r1.17 link.test
--- tests/link.test	13 Dec 2007 15:26:06 -0000	1.17
+++ tests/link.test	17 Sep 2008 16:46:00 -0000
@@ -19,6 +19,7 @@
 }
 
 testConstraint testlink [llength [info commands testlink]]
+testConstraint testlinkarray [llength [info commands testlinkarray]]
 
 foreach i {int real bool string} {
     catch {unset $i}
@@ -79,7 +80,7 @@
     testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set wide gorp} msg] $msg $bool
-} {1 {can't set "wide": variable must have integer value} 1}
+} {1 {can't set "wide": variable must have wide integer value} 1}
 
 test link-3.1 {read-only variables} {testlink} {
     testlink delete
@@ -234,7 +235,7 @@
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $wide
-} {1 {can't set "y": variable must have integer value} 778899}
+} {1 {can't set "y": variable must have wide integer value} 778899}
 
 test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
     proc x args {
@@ -269,6 +270,296 @@
 	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
     } msg] $msg $int
 } {0 {} 47}
+test link-9.1 {linkarray usage messages} {
+  set mylist [list]
+  catch {testlinkarray} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {testlinkarray x} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {testlinkarray update} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {testlinkarray remove} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {testlinkarray create} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {testlinkarray create xx 1 my} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {testlinkarray create char* 0 my} my(msg); lappend mylist $my(msg);unset my(msg)
+  join $mylist "\n"
+} {wrong # args: should be "testlinkarray option args"
+bad option "x": must be update, remove, or create
+
+
+wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?"
+bad type "xx": must be char, uchar, short, ushort, int, uint, long, ulong, wide, uwide, float, double, string, char*, or binary
+wrong array size given}
+test link-10.1 {linkarray char*} {
+  set mylist [list]
+  testlinkarray create char* 1 ::my(var)
+  lappend mylist [set ::my(var) ""]
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create char* 4 ::my(var)
+  set ::my(var) x
+  catch {set ::my(var) xyzz} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r char* 4 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {
+can't set "::my(var)": wrong size of char* value
+can't set "::my(var)": wrong size of char* value
+can't set "::my(var)": linked variable is read-only}
+test link-11.1 {linkarray char} {
+  set mylist [list]
+  testlinkarray create char 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 1234} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create char 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r char 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have char value
+120
+can't set "::my(var)": variable must have char value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-12.1 {linkarray unsigned char} {
+  set mylist [list]
+  testlinkarray create uchar 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 1234} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {set ::my(var) -1} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create uchar 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r uchar 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have unsigned char value
+120
+can't set "::my(var)": variable must have unsigned char value
+can't set "::my(var)": variable must have unsigned char value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-13.1 {linkarray short} {
+  set mylist [list]
+  testlinkarray create short 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 123456} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create short 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r short 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have short value
+120
+can't set "::my(var)": variable must have short value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-14.1 {linkarray unsigned short} {
+  set mylist [list]
+  testlinkarray create ushort 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 123456} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {set ::my(var) -1} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create ushort 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r ushort 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have unsigned short value
+120
+can't set "::my(var)": variable must have unsigned short value
+can't set "::my(var)": variable must have unsigned short value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-15.1 {linkarray int} {
+  set mylist [list]
+  testlinkarray create int 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 1e3} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create int 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r int 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have integer value
+120
+can't set "::my(var)": variable must have integer value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-16.1 {linkarray unsigned int} {
+  set mylist [list]
+  testlinkarray create uint 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 1e33} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {set ::my(var) -1} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create uint 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r uint 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have unsigned int value
+120
+can't set "::my(var)": variable must have unsigned int value
+can't set "::my(var)": variable must have unsigned int value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-17.1 {linkarray long} {
+  set mylist [list]
+  testlinkarray create long 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 1e33} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create long 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r long 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have long value
+120
+can't set "::my(var)": variable must have long value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-18.1 {linkarray unsigned long} {
+  set mylist [list]
+  testlinkarray create ulong 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 1e33} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {set ::my(var) -1} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create ulong 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r ulong 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have unsigned long value
+120
+can't set "::my(var)": variable must have unsigned long value
+can't set "::my(var)": variable must have unsigned long value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-19.1 {linkarray wide} {
+  set mylist [list]
+  testlinkarray create wide 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 1e33} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create wide 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r wide 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have wide integer value
+120
+can't set "::my(var)": variable must have wide integer value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-20.1 {linkarray unsigned wide} {
+  set mylist [list]
+  testlinkarray create uwide 1 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist [set ::my(var) 120]
+  catch {set ::my(var) 1e33} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {set ::my(var) -1} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var)
+  testlinkarray create uwide 4 ::my(var)
+  catch {set ::my(var) {1 2 3}} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) {1 2 3 4}
+  lappend mylist $my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r uwide 2 ::my(var)
+  catch {set ::my(var) {1 2}} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": variable must have unsigned wide int value
+120
+can't set "::my(var)": variable must have unsigned wide int value
+can't set "::my(var)": variable must have unsigned wide int value
+can't set "::my(var)": wrong dimension
+1 2 3 4
+can't set "::my(var)": linked variable is read-only}
+test link-21.1 {linkarray string} {
+  set mylist [list]
+  testlinkarray create string 1 ::my(var)
+  lappend mylist [set ::my(var) ""]
+  lappend mylist [set ::my(var) "xyz"]
+  lappend mylist $::my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r string 4 ::my(var)
+  catch {set ::my(var) x} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {
+xyz
+xyz
+can't set "::my(var)": linked variable is read-only}
+test link-22.1 {linkarray binary} {
+  set mylist [list]
+  testlinkarray create binary 1 ::my(var)
+  set ::my(var) x
+  catch {set ::my(var) xy} my(msg); lappend mylist $my(msg);unset my(msg)
+  lappend mylist $::my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create binary 4 ::my(var)
+  catch {set ::my(var) abc} my(msg); lappend mylist $my(msg);unset my(msg)
+  catch {set ::my(var) abcde} my(msg); lappend mylist $my(msg);unset my(msg)
+  set ::my(var) abcd
+  lappend mylist $::my(var)
+  testlinkarray remove ::my(var)
+  testlinkarray create -r binary 4 ::my(var)
+  catch {set ::my(var) xyzv} my(msg); lappend mylist $my(msg);unset my(msg)
+  testlinkarray remove ::my(var); unset my; join $mylist "\n"
+} {can't set "::my(var)": wrong size of binary value
+x
+can't set "::my(var)": wrong size of binary value
+can't set "::my(var)": wrong size of binary value
+abcd
+can't set "::my(var)": linked variable is read-only}
 
 catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0}
 catch {testlink delete}
