Implement TIP 312

10 files changed, 1746 insertions, 303 deletions

diff --git a/doc/LinkVar.3 b/doc/LinkVar.3
index c80d30d..1e42858 100644
--- a/doc/LinkVar.3
+++ b/doc/LinkVar.3
@@ -9,7 +9,7 @@
 .so man.macros
 .BS
 .SH NAME
-Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
+Tcl_LinkArray, Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -17,27 +17,52 @@ Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variab
 int
 \fBTcl_LinkVar\fR(\fIinterp, varName, addr, type\fR)
 .sp
+.VS "TIP 312"
+int
+\fBTcl_LinkArray\fR(\fIinterp, varName, addr, type, size\fR)
+.VE "TIP 312"
+.sp
 \fBTcl_UnlinkVar\fR(\fIinterp, varName\fR)
 .sp
 \fBTcl_UpdateLinkedVar\fR(\fIinterp, varName\fR)
 .SH ARGUMENTS
-.AS Tcl_Interp writable
+.AS Tcl_Interp varName in
 .AP Tcl_Interp *interp in
 Interpreter that contains \fIvarName\fR.
 Also used by \fBTcl_LinkVar\fR to return error messages.
 .AP "const char" *varName in
 Name of global variable.
-.AP char *addr in
+.AP void *addr in
 Address of C variable that is to be linked to \fIvarName\fR.
+.sp
+.VS "TIP 312"
+In \fBTcl_LinkArray\fR, may be NULL to tell Tcl to create the storage
+for the array in the variable.
+.VE "TIP 312"
 .AP int type in
-Type of C variable.  Must be one of \fBTCL_LINK_INT\fR,
+Type of C variable for \fBTcl_LinkVar\fR or type of array element for
+\fBTcl_LinkArray\fR.  Must be one of \fBTCL_LINK_INT\fR,
 \fBTCL_LINK_UINT\fR, \fBTCL_LINK_CHAR\fR, \fBTCL_LINK_UCHAR\fR,
 \fBTCL_LINK_SHORT\fR, \fBTCL_LINK_USHORT\fR, \fBTCL_LINK_LONG\fR,
 \fBTCL_LINK_ULONG\fR, \fBTCL_LINK_WIDE_INT\fR,
-\fBTCL_LINK_WIDE_UINT\fR, \fBTCL_LINK_FLOAT\fR,
-\fBTCL_LINK_DOUBLE\fR, \fBTCL_LINK_BOOLEAN\fR, or
-\fBTCL_LINK_STRING\fR, optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR
-to make Tcl variable read-only.
+\fBTCL_LINK_WIDE_UINT\fR, \fBTCL_LINK_FLOAT\fR, \fBTCL_LINK_DOUBLE\fR,
+\fBTCL_LINK_BOOLEAN\fR, or one of the extra ones listed below.
+.sp
+In \fBTcl_LinkVar\fR, the additional linked type \fBTCL_LINK_STRING\fR may be
+used.
+.sp
+.VS "TIP 312"
+In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
+\fBTCL_LINK_BYTES\fR may be used.
+.VE "TIP 312"
+.sp
+All the above for both functions may be
+optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl
+variable read-only.
+.AP int size in
+.VS "TIP 312"
+The number of elements in the C array. Must be greater than zero.
+.VE "TIP 312"
 .BE
 .SH DESCRIPTION
 .PP
@@ -52,12 +77,21 @@ while setting up the link (e.g. because \fIvarName\fR is the
 name of array) then \fBTCL_ERROR\fR is returned and the interpreter's result
 contains an error message.
 .PP
+.VS "TIP 312"
+\fBTcl_LinkArray\fR is similar, but for arrays of fixed size (given by
+the \fIsize\fR argument). When asked to allocate the backing C array
+storage (via the \fIaddr\fR argument being NULL), it writes the
+address that it allocated to the Tcl interpreter result.
+.VE "TIP 312"
+.PP
 The \fItype\fR argument specifies the type of the C variable,
+or the type of the elements of the C array,
 and must have one of the following values, optionally OR'ed with
 \fBTCL_LINK_READ_ONLY\fR:
 .TP
 \fBTCL_LINK_INT\fR
-The C variable is of type \fBint\fR.
+.
+The C variable, or each element of the C array, is of type \fBint\fR.
 Any value written into the Tcl variable must have a proper integer
 form acceptable to \fBTcl_GetIntFromObj\fR;  attempts to write
 non-integer values into \fIvarName\fR will be rejected with
@@ -66,7 +100,8 @@ string, '+', '-' or the hex/octal/binary prefix) are accepted
 as if they are valid too.
 .TP
 \fBTCL_LINK_UINT\fR
-The C variable is of type \fBunsigned int\fR.
+.
+The C variable, or each element of the C array, is of type \fBunsigned int\fR.
 Any value written into the Tcl variable must have a proper unsigned
 integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
 platform's defined range for the \fBunsigned int\fR type; attempts to
@@ -76,16 +111,31 @@ representations (like the empty string, '+', '-' or the hex/octal/binary
 prefix) are accepted as if they are valid too.
 .TP
 \fBTCL_LINK_CHAR\fR
-The C variable is of type \fBchar\fR.
+.
+The C variable, or each element of the C array, is of type \fBchar\fR.
 Any value written into the Tcl variable must have a proper integer
 form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
 \fBchar\fR datatype; attempts to write non-integer or out-of-range
 values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
 integer representations (like the empty string, '+', '-' or the
 hex/octal/binary prefix) are accepted as if they are valid too.
+.RS
+.PP
+.VS "TIP 312"
+If using an array of these, consider using \fBTCL_LINK_CHARS\fR instead.
+.VE "TIP 312"
+.RE
+.TP
+\fBTCL_LINK_CHARS\fR
+.VS "TIP 312"
+The C array is of type \fBchar *\fR and is mapped into Tcl as a string.
+Any value written into the Tcl variable must have the same length as
+the underlying storage. Only supported with \fBTcl_LinkArray\fR.
+.VE "TIP 312"
 .TP
 \fBTCL_LINK_UCHAR\fR
-The C variable is of type \fBunsigned char\fR.
+.
+The C variable, or each element of the C array, is of type \fBunsigned char\fR.
 Any value written into the Tcl variable must have a proper unsigned
 integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
 platform's defined range for the \fBunsigned char\fR type; attempts to
@@ -93,9 +143,24 @@ write non-integer values (or values outside the range) into
 \fIvarName\fR will be rejected with Tcl errors. Incomplete integer
 representations (like the empty string, '+', '-' or the hex/octal/binary
 prefix) are accepted as if they are valid too.
+.RS
+.PP
+.VS "TIP 312"
+If using an array of these, consider using \fBTCL_LINK_BYTES\fR instead.
+.VE "TIP 312"
+.RE
+.TP
+\fBTCL_LINK_BYTES\fR
+.VS "TIP 312"
+The C array is of type \fBunsigned char *\fR and is mapped into Tcl
+as a bytearray.
+Any value written into the Tcl variable must have the same length as
+the underlying storage. Only supported with \fBTcl_LinkArray\fR.
+.VE "TIP 312"
 .TP
 \fBTCL_LINK_SHORT\fR
-The C variable is of type \fBshort\fR.
+.
+The C variable, or each element of the C array, is of type \fBshort\fR.
 Any value written into the Tcl variable must have a proper integer
 form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
 \fBshort\fR datatype; attempts to write non-integer or out-of-range
@@ -104,7 +169,8 @@ integer representations (like the empty string, '+', '-' or the
 hex/octal/binary prefix) are accepted as if they are valid too.
 .TP
 \fBTCL_LINK_USHORT\fR
-The C variable is of type \fBunsigned short\fR.
+.
+The C variable, or each element of the C array, is of type \fBunsigned short\fR.
 Any value written into the Tcl variable must have a proper unsigned
 integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
 platform's defined range for the \fBunsigned short\fR type; attempts to
@@ -114,7 +180,8 @@ representations (like the empty string, '+', '-' or the hex/octal/binary
 prefix) are accepted as if they are valid too.
 .TP
 \fBTCL_LINK_LONG\fR
-The C variable is of type \fBlong\fR.
+.
+The C variable, or each element of the C array, is of type \fBlong\fR.
 Any value written into the Tcl variable must have a proper integer
 form acceptable to \fBTcl_GetLongFromObj\fR; attempts to write
 non-integer or out-of-range
@@ -123,7 +190,8 @@ integer representations (like the empty string, '+', '-' or the
 hex/octal/binary prefix) are accepted as if they are valid too.
 .TP
 \fBTCL_LINK_ULONG\fR
-The C variable is of type \fBunsigned long\fR.
+.
+The C variable, or each element of the C array, is of type \fBunsigned long\fR.
 Any value written into the Tcl variable must have a proper unsigned
 integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
 platform's defined range for the \fBunsigned long\fR type; attempts to
@@ -133,7 +201,8 @@ representations (like the empty string, '+', '-' or the hex/octal/binary
 prefix) are accepted as if they are valid too.
 .TP
 \fBTCL_LINK_DOUBLE\fR
-The C variable is of type \fBdouble\fR.
+.
+The C variable, or each element of the C array, is of type \fBdouble\fR.
 Any value written into the Tcl variable must have a proper real
 form acceptable to \fBTcl_GetDoubleFromObj\fR;  attempts to write
 non-real values into \fIvarName\fR will be rejected with
@@ -142,7 +211,8 @@ empty string, '.', '+', '-' or the hex/octal/binary prefix) are
 accepted as if they are valid too.
 .TP
 \fBTCL_LINK_FLOAT\fR
-The C variable is of type \fBfloat\fR.
+.
+The C variable, or each element of the C array, is of type \fBfloat\fR.
 Any value written into the Tcl variable must have a proper real
 form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the
 range acceptable for a \fBfloat\fR; attempts to
@@ -152,7 +222,9 @@ or real representations (like the empty string, '.', '+', '-' or
 the hex/octal/binary prefix) are accepted as if they are valid too.
 .TP
 \fBTCL_LINK_WIDE_INT\fR
-The C variable is of type \fBTcl_WideInt\fR (which is an integer type
+.
+The C variable, or each element of the C array, is of type \fBTcl_WideInt\fR
+(which is an integer type
 at least 64-bits wide on all platforms that can support it.)
 Any value written into the Tcl variable must have a proper integer
 form acceptable to \fBTcl_GetWideIntFromObj\fR;  attempts to write
@@ -162,9 +234,10 @@ string, '+', '-' or the hex/octal/binary prefix) are accepted
 as if they are valid too.
 .TP
 \fBTCL_LINK_WIDE_UINT\fR
-The C variable is of type \fBTcl_WideUInt\fR (which is an unsigned
-integer type at least 64-bits wide on all platforms that can support
-it.)
+.
+The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR
+(which is an unsigned integer type at least 64-bits wide on all platforms that
+can support it.)
 Any value written into the Tcl variable must have a proper unsigned
 integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be
 cast to unsigned);
@@ -175,7 +248,8 @@ the empty string, '+', '-' or the hex/octal/binary prefix) are accepted
 as if they are valid too.
 .TP
 \fBTCL_LINK_BOOLEAN\fR
-The C variable is of type \fBint\fR.
+.
+The C variable, or each element of the C array, is of type \fBint\fR.
 If its value is zero then it will read from Tcl as
 .QW 0 ;
 otherwise it will read from Tcl as
@@ -188,6 +262,7 @@ non-boolean values into \fIvarName\fR will be rejected with
 Tcl errors.
 .TP
 \fBTCL_LINK_STRING\fR
+.
 The C variable is of type \fBchar *\fR.
 If its value is not NULL then it must be a pointer to a string
 allocated with \fBTcl_Alloc\fR or \fBckalloc\fR.
@@ -197,6 +272,7 @@ new value.
 If the C variable contains a NULL pointer then the Tcl variable
 will read as
 .QW NULL .
+This is only supported by \fBTcl_LinkVar\fR.
 .PP
 If the \fBTCL_LINK_READ_ONLY\fR flag is present in \fItype\fR then the
 variable will be read-only from Tcl, so that its value can only be
diff --git a/generic/tcl.decls b/generic/tcl.decls
index d404d25..7d3b535 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -667,7 +667,7 @@ declare 186 {
 	    Tcl_DString *resultPtr)
 }
 declare 187 {
-    int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr,
+    int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, void *addr,
 	    int type)
 }
 
@@ -2379,6 +2379,12 @@ declare 643 {
     int Tcl_IsShared(Tcl_Obj *objPtr)
 }
 
+# TIP#312 New Tcl_LinkArray() function
+declare 644 {
+    int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr,
+	    int type, int size)
+}
+
 # ----- BASELINE -- FOR -- 8.7.0 ----- #
 
 ##############################################################################
diff --git a/generic/tcl.h b/generic/tcl.h
index c287a84..e34a609 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1093,6 +1093,8 @@ typedef struct Tcl_DString {
 #endif
 #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
 
 /*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index c50b41f..3b67796 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -597,7 +597,7 @@ EXTERN char *		Tcl_JoinPath(int argc, const char *const *argv,
 				Tcl_DString *resultPtr);
 /* 187 */
 EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
-				char *addr, int type);
+				void *addr, int type);
 /* Slot 188 is reserved */
 /* 189 */
 EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
@@ -1897,6 +1897,10 @@ EXTERN void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
 EXTERN void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
 /* 643 */
 EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);
+/* 644 */
+EXTERN int		Tcl_LinkArray(Tcl_Interp *interp,
+				const char *varName, void *addr, int type,
+				int size);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2119,7 +2123,7 @@ typedef struct TclStubs {
     int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
     int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
     char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
-    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
+    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, void *addr, int type); /* 187 */
     void (*reserved188)(void);
     Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
     int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
@@ -2576,6 +2580,7 @@ typedef struct TclStubs {
     void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
     void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
     int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
+    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3894,6 +3899,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_DecrRefCount) /* 642 */
 #define Tcl_IsShared \
 	(tclStubsPtr->tcl_IsShared) /* 643 */
+#define Tcl_LinkArray \
+	(tclStubsPtr->tcl_LinkArray) /* 644 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9fc778b..89d7ff9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4514,6 +4514,31 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 
 /*
  *----------------------------------------------------------------
+ * Macro used by the Tcl core to get the bignum out of the bignum
+ * representation of a Tcl_Obj.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE void	TclUnpackBignum(Tcl_Obj *objPtr, mp_int bignum);
+ *----------------------------------------------------------------
+ */
+
+#define TclUnpackBignum(objPtr, bignum) \
+    do {								\
+	register Tcl_Obj *bignumObj = (objPtr);				\
+	register int bignumPayload =					\
+		PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2);	\
+	if (bignumPayload == -1) {					\
+	    (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \
+	} else {							\
+	    (bignum).dp = bignumObj->internalRep.twoPtrValue.ptr1;	\
+	    (bignum).sign = bignumPayload >> 30;			\
+	    (bignum).alloc = (bignumPayload >> 15) & 0x7fff;		\
+	    (bignum).used = bignumPayload & 0x7fff;			\
+	}								\
+    } while (0) 
+
+/*
+ *----------------------------------------------------------------
  * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
  * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
  * "prototype" for this macro is:
diff --git a/generic/tclLink.c b/generic/tclLink.c
index e7dcb8c..57735f8 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -8,12 +8,16 @@
  *
  * Copyright (c) 1993 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2008 Rene Zaumseil
+ * Copyright (c) 2019 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
 #include "tclInt.h"
+#include "tommath.h"
+#include <math.h>
 
 /*
  * For each linked variable there is a data structure of the following type,
@@ -27,7 +31,12 @@ typedef struct Link {
 				 * needed during trace callbacks, since the
 				 * actual variable may be aliased at that time
 				 * via upvar. */
-    char *addr;			/* Location of C variable. */
+    void *addr;			/* Location of C variable. */
+    int bytes;			/* Size of C variable array. This is 0 when
+				 * single variables, and >0 used for array
+				 * variables. */
+    int numElems;		/* Number of elements in C variable array.
+				 * Zero for single variables. */
     int type;			/* Type of link (TCL_LINK_INT, etc.). */
     union {
 	char c;
@@ -44,6 +53,19 @@ typedef struct Link {
 	Tcl_WideUInt uw;
 	float f;
 	double d;
+	void *aryPtr;		/* Generic array. */
+	char *cPtr;		/* char array */
+	unsigned char *ucPtr;	/* unsigned char array */
+	short *sPtr;		/* short array */
+	unsigned short *usPtr;	/* unsigned short array */
+	int *iPtr;		/* int array */
+	unsigned int *uiPtr;	/* unsigned int array */
+	long *lPtr;		/* long array */
+	unsigned long *ulPtr;	/* unsigned long array */
+	Tcl_WideInt *wPtr;	/* wide (long long) array */
+	Tcl_WideUInt *uwPtr;	/* unsigned wide (long long) array */
+	float *fPtr;		/* float array */
+	double *dPtr;		/* double array */
     } lastValue;		/* Last known value of C variable; used to
 				 * avoid string conversions. */
     int flags;			/* Miscellaneous one-bit values; see below for
@@ -57,10 +79,16 @@ typedef struct Link {
  * 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,9 +97,24 @@ typedef struct Link {
 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);
 static int		GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);
-static int		GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
-static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr);
+static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
+			    double *doublePtr);
+static int		SetInvalidRealFromAny(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr);
+
+/*
+ * A marker type used to flag weirdnesses so we can pass them around right.
+ */
+
+static Tcl_ObjType invalidRealType = {
+    "invalidReal",			/* name */
+    NULL,				/* freeIntRepProc */
+    NULL,				/* dupIntRepProc */
+    NULL,				/* updateStringProc */
+    NULL				/* setFromAnyProc */
+};
 
 /*
  * Convenience macro for accessing the value of the C variable pointed to by a
@@ -108,7 +151,7 @@ int
 Tcl_LinkVar(
     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
+    void *addr,			/* Address of a C variable to be linked to
 				 * varName. */
     int type)			/* Type of C variable: TCL_LINK_INT, etc. Also
 				 * may have TCL_LINK_READ_ONLY OR'ed in. */
@@ -144,11 +187,13 @@ Tcl_LinkVar(
     } else {
 	linkPtr->flags = 0;
     }
+    linkPtr->bytes = 0;
+    linkPtr->numElems = 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(linkPtr);
+	LinkFree(linkPtr);
 	return TCL_ERROR;
     }
     code = Tcl_TraceVar2(interp, varName, NULL,
@@ -156,7 +201,172 @@ Tcl_LinkVar(
 	    LinkTraceProc, linkPtr);
     if (code != TCL_OK) {
 	Tcl_DecrRefCount(linkPtr->varName);
-	ckfree(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. */
+    void *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 OR'ed in. */
+    int size)			/* Size of C variable array, >1 if array */
+{
+    Tcl_Obj *objPtr;
+    Link *linkPtr;
+    int code;
+
+    if (size < 1) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"wrong array size given", -1));
+	return TCL_ERROR;
+    }
+
+    linkPtr = ckalloc(sizeof(Link));
+    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
+    linkPtr->numElems = size;
+    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;
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
+    case TCL_LINK_LONG:
+	linkPtr->bytes = size * sizeof(long);
+	break;
+    case TCL_LINK_ULONG:
+	linkPtr->bytes = size * sizeof(unsigned long);
+	break;
+#endif
+    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.aryPtr = ckalloc(linkPtr->bytes);
+	    linkPtr->flags |= LINK_ALLOC_LAST;
+	    addr = (char *) &linkPtr->lastValue.cPtr;
+	}
+	break;
+    case TCL_LINK_CHARS:
+    case TCL_LINK_BINARY:
+	linkPtr->bytes = size * sizeof(char);
+	break;
+    default:
+	LinkFree(linkPtr);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"bad linked array variable type", -1));
+	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.aryPtr = 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_TraceVar2(interp, varName, NULL,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    LinkTraceProc, linkPtr);
+    if (code != TCL_OK) {
+	Tcl_DecrRefCount(linkPtr->varName);
+	LinkFree(linkPtr);
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj((int) linkPtr->addr));
     }
     return code;
 }
@@ -194,7 +404,7 @@ Tcl_UnlinkVar(
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 	    LinkTraceProc, linkPtr);
     Tcl_DecrRefCount(linkPtr->varName);
-    ckfree(linkPtr);
+    LinkFree(linkPtr);
 }
 
 /*
@@ -245,6 +455,241 @@ Tcl_UpdateLinkedVar(
 /*
  *----------------------------------------------------------------------
  *
+ * GetInt, GetWide, GetUWide, GetDouble, EqualDouble, IsSpecial --
+ *
+ *	Helper functions for LinkTraceProc and ObjValue. These are all
+ *	factored out here to make those functions simpler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetInt(
+    Tcl_Obj *objPtr,
+    int *intPtr)
+{
+    return (Tcl_GetIntFromObj(NULL, objPtr, intPtr) != TCL_OK
+	    && GetInvalidIntFromObj(objPtr, intPtr) != TCL_OK);
+}
+
+static inline int
+GetWide(
+    Tcl_Obj *objPtr,
+    Tcl_WideInt *widePtr)
+{
+    if (Tcl_GetWideIntFromObj(NULL, objPtr, widePtr) != TCL_OK) {
+	int intValue;
+
+	if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
+	    return 1;
+	}
+	*widePtr = intValue;
+    }
+    return 0;
+}
+
+static inline int
+GetUWide(
+    Tcl_Obj *objPtr,
+    Tcl_WideUInt *uwidePtr)
+{
+    Tcl_WideInt *widePtr = (Tcl_WideInt *) uwidePtr;
+    ClientData clientData;
+    int type, intValue;
+
+    if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
+	if (type == TCL_NUMBER_INT) {
+	    *widePtr = *((const Tcl_WideInt *) clientData);
+	    return (*widePtr < 0);
+	} else if (type == TCL_NUMBER_BIG) {
+	    mp_int *numPtr = clientData;
+	    Tcl_WideUInt value = 0;
+	    union {
+		Tcl_WideUInt value;
+		unsigned char bytes[sizeof(Tcl_WideUInt)];
+	    } scratch;
+	    unsigned long numBytes = sizeof(Tcl_WideUInt);
+	    unsigned char *bytes = scratch.bytes;
+
+	    if (numPtr->sign || (MP_OKAY != mp_to_unsigned_bin_n(numPtr,
+		    bytes, &numBytes))) {
+		/*
+		 * If the sign bit is set (a negative value) or if the value
+		 * can't possibly fit in the bits of an unsigned wide, there's
+		 * no point in doing further conversion.
+		 */
+		return 1;
+	    }
+#ifdef WORDS_BIGENDIAN
+	    while (numBytes-- > 0) {
+		value = (value << CHAR_BIT) | *bytes++;
+	    }
+#else /* !WORDS_BIGENDIAN */
+	    /*
+	     * Little-endian can read the value directly.
+	     */
+	    value = scratch.value;
+#endif /* WORDS_BIGENDIAN */
+	    *uwidePtr = value;
+	    return 0;
+	}
+    }
+
+    /*
+     * Evil edge case fallback.
+     */
+
+    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
+	return 1;
+    }
+    *uwidePtr = intValue;
+    return 0;
+}
+
+static inline int
+GetDouble(
+    Tcl_Obj *objPtr,
+    double *dblPtr)
+{
+    if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
+	return 0;
+    } else {
+#ifdef ACCEPT_NAN
+	Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclDoubleType);
+
+	if (irPtr != NULL) {
+	    *dblPtr = irPtr->doubleValue;
+	    return 0;
+	}
+#endif /* ACCEPT_NAN */
+	return GetInvalidDoubleFromObj(objPtr, dblPtr) != TCL_OK;
+    }
+}
+
+static inline int
+EqualDouble(
+    double a,
+    double b)
+{
+    return (a == b)
+#ifdef ACCEPT_NAN
+	|| (TclIsNaN(a) && TclIsNaN(b))
+#endif /* ACCEPT_NAN */
+	;
+}
+
+static inline int
+IsSpecial(
+    double a)
+{
+    return TclIsInfinite(a)
+#ifdef ACCEPT_NAN
+	|| TclIsNaN(a)
+#endif /* ACCEPT_NAN */
+	;
+}
+
+/*
+ * Mark an object as holding a weird double.
+ */
+
+static int
+SetInvalidRealFromAny(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr)
+{
+    const char *str;
+    const char *endPtr;
+
+    str = TclGetString(objPtr);
+    if ((objPtr->length == 1) && (str[0] == '.')) {
+	objPtr->typePtr = &invalidRealType;
+	objPtr->internalRep.doubleValue = 0.0;
+	return TCL_OK;
+    }
+    if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr,
+	    TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
+	/*
+	 * If number is followed by [eE][+-]?, then it is an invalid
+	 * double, but it could be the start of a valid double.
+	 */
+
+	if (*endPtr == 'e' || *endPtr == 'E') {
+	    ++endPtr;
+	    if (*endPtr == '+' || *endPtr == '-') {
+		++endPtr;
+	    }
+	    if (*endPtr == 0) {
+		double doubleValue = 0.0;
+
+		Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
+		TclFreeIntRep(objPtr);
+		objPtr->typePtr = &invalidRealType;
+		objPtr->internalRep.doubleValue = doubleValue;
+		return TCL_OK;
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ * This function checks for integer representations, which are valid
+ * when linking with C variables, but which are invalid in other
+ * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
+ * (upperand lowercase). See bug [39f6304c2e].
+ */
+
+static int
+GetInvalidIntFromObj(
+    Tcl_Obj *objPtr,
+    int *intPtr)
+{
+    const char *str = TclGetString(objPtr);
+
+    if ((objPtr->length == 0) || ((objPtr->length == 2) && (str[0] == '0')
+	    && strchr("xXbBoOdD", str[1]))) {
+	*intPtr = 0;
+	return TCL_OK;
+    } else if ((objPtr->length == 1) && strchr("+-", str[0])) {
+	*intPtr = (str[0] == '+');
+	return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+/*
+ * This function checks for double representations, which are valid
+ * when linking with C variables, but which are invalid in other
+ * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
+ * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
+ */
+
+static int
+GetInvalidDoubleFromObj(
+    Tcl_Obj *objPtr,
+    double *doublePtr)
+{
+    int intValue;
+
+    if (TclHasIntRep(objPtr, &invalidRealType)) {
+	goto gotdouble;
+    }
+    if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
+	*doublePtr = (double) intValue;
+	return TCL_OK;
+    }
+    if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
+    gotdouble:
+	*doublePtr = objPtr->internalRep.doubleValue;
+	return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * LinkTraceProc --
  *
  *	This function is invoked when a linked Tcl variable is read, written,
@@ -273,13 +718,17 @@ LinkTraceProc(
 {
     Link *linkPtr = clientData;
     int changed;
-    size_t valueLength;
+    int valueLength;
     const char *value;
     char **pp;
     Tcl_Obj *valueObj;
     int valueInt;
     Tcl_WideInt valueWide;
+    Tcl_WideUInt valueUWide;
     double valueDouble;
+    int objc;
+    Tcl_Obj **objv;
+    int i;
 
     /*
      * If the variable is being unset, then just re-create it (with a trace)
@@ -289,7 +738,7 @@ LinkTraceProc(
     if (flags & TCL_TRACE_UNSETS) {
 	if (Tcl_InterpDeleted(interp)) {
 	    Tcl_DecrRefCount(linkPtr->varName);
-	    ckfree(linkPtr);
+	    LinkFree(linkPtr);
 	} else if (flags & TCL_TRACE_DESTROYED) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
@@ -316,51 +765,64 @@ LinkTraceProc(
      */
 
     if (flags & TCL_TRACE_READS) {
-	switch (linkPtr->type) {
-	case TCL_LINK_INT:
-	case TCL_LINK_BOOLEAN:
-	    changed = (LinkedVar(int) != linkPtr->lastValue.i);
-	    break;
-	case TCL_LINK_DOUBLE:
-	    changed = (LinkedVar(double) != linkPtr->lastValue.d);
-	    break;
-	case TCL_LINK_WIDE_INT:
-	    changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
-	    break;
-	case TCL_LINK_WIDE_UINT:
-	    changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
-	    break;
-	case TCL_LINK_CHAR:
-	    changed = (LinkedVar(char) != linkPtr->lastValue.c);
-	    break;
-	case TCL_LINK_UCHAR:
-	    changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
-	    break;
-	case TCL_LINK_SHORT:
-	    changed = (LinkedVar(short) != linkPtr->lastValue.s);
-	    break;
-	case TCL_LINK_USHORT:
-	    changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
-	    break;
-	case TCL_LINK_UINT:
-	    changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
-	    break;
+	/*
+	 * Variable arrays
+	 */
+
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    changed = memcmp(linkPtr->addr, linkPtr->lastValue.aryPtr,
+		    linkPtr->bytes);
+	} else {
+	    /* single variables */
+	    switch (linkPtr->type) {
+	    case TCL_LINK_INT:
+	    case TCL_LINK_BOOLEAN:
+		changed = (LinkedVar(int) != linkPtr->lastValue.i);
+		break;
+	    case TCL_LINK_DOUBLE:
+		changed = !EqualDouble(LinkedVar(double), linkPtr->lastValue.d);
+		break;
+	    case TCL_LINK_WIDE_INT:
+		changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
+		break;
+	    case TCL_LINK_WIDE_UINT:
+		changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
+		break;
+	    case TCL_LINK_CHAR:
+		changed = (LinkedVar(char) != linkPtr->lastValue.c);
+		break;
+	    case TCL_LINK_UCHAR:
+		changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
+		break;
+	    case TCL_LINK_SHORT:
+		changed = (LinkedVar(short) != linkPtr->lastValue.s);
+		break;
+	    case TCL_LINK_USHORT:
+		changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
+		break;
+	    case TCL_LINK_UINT:
+		changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
+		break;
 #if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
-	case TCL_LINK_LONG:
-	    changed = (LinkedVar(long) != linkPtr->lastValue.l);
-	    break;
-	case TCL_LINK_ULONG:
-	    changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
-	    break;
+	    case TCL_LINK_LONG:
+		changed = (LinkedVar(long) != linkPtr->lastValue.l);
+		break;
+	    case TCL_LINK_ULONG:
+		changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
+		break;
 #endif
-	case TCL_LINK_FLOAT:
-	    changed = (LinkedVar(float) != linkPtr->lastValue.f);
-	    break;
-	case TCL_LINK_STRING:
-	    changed = 1;
-	    break;
-	default:
-	    return (char *) "internal error: bad linked variable type";
+	    case TCL_LINK_FLOAT:
+		changed = !EqualDouble(LinkedVar(float), linkPtr->lastValue.f);
+		break;
+	    case TCL_LINK_STRING:
+	    case TCL_LINK_CHARS:
+	    case TCL_LINK_BINARY:
+		changed = 1;
+		break;
+	    default:
+		changed = 0;
+		/* return (char *) "internal error: bad linked variable type"; */
+	    }
 	}
 	if (changed) {
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -392,170 +854,377 @@ LinkTraceProc(
 	return (char *) "internal error: linked variable couldn't be read";
     }
 
+    /*
+     * Special cases.
+     */
+
+    switch (linkPtr->type) {
+    case TCL_LINK_STRING:
+	value = TclGetString(valueObj);
+	valueLength = valueObj->length + 1;
+	pp = (char **) linkPtr->addr;
+
+	*pp = ckrealloc(*pp, valueLength);
+	memcpy(*pp, value, valueLength);
+	return NULL;
+
+    case TCL_LINK_CHARS:
+	value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength);
+	valueLength++;		/* include end of string char */
+	if (valueLength > linkPtr->bytes) {
+	    return (char *) "wrong size of char* value";
+	}
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
+	    memcpy(linkPtr->addr, value, (size_t) valueLength);
+	} else {
+	    linkPtr->lastValue.c = '\0';
+	    LinkedVar(char) = linkPtr->lastValue.c;
+	}
+	return NULL;
+
+    case TCL_LINK_BINARY:
+	value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength);
+	if (valueLength != linkPtr->bytes) {
+	    return (char *) "wrong size of binary value";
+	}
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
+	    memcpy(linkPtr->addr, value, (size_t) valueLength);
+	} else {
+	    linkPtr->lastValue.uc = (unsigned char) *value;
+	    LinkedVar(unsigned char) = linkPtr->lastValue.uc;
+	}
+	return NULL;
+    }
+
+    /*
+     * A helper macro. Writing this as a function is messy because of type
+     * variance.
+     */
+
+#define InRange(lowerLimit, value, upperLimit)			\
+    ((value) >= (lowerLimit) && (value) <= (upperLimit))
+
+    /*
+     * If we're working with an array of numbers, extract the Tcl list.
+     */
+
+    if (linkPtr->flags & LINK_ALLOC_LAST) {
+	if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
+		|| objc != linkPtr->numElems) {
+	    return (char *) "wrong dimension";
+	}
+    }
+
     switch (linkPtr->type) {
     case TCL_LINK_INT:
-	if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK
-		&& GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have integer value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		int *varPtr = &linkPtr->lastValue.iPtr[i];
+
+		if (GetInt(objv[i], varPtr)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *) "variable array must have integer values";
+		}
+	    }
+	} else {
+	    int *varPtr = &linkPtr->lastValue.i;
+
+	    if (GetInt(valueObj, varPtr)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have integer value";
+	    }
+	    LinkedVar(int) = *varPtr;
 	}
-	LinkedVar(int) = linkPtr->lastValue.i;
 	break;
 
     case TCL_LINK_WIDE_INT:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK
-		&& GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have integer value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		Tcl_WideInt *varPtr = &linkPtr->lastValue.wPtr[i];
+
+		if (GetWide(objv[i], varPtr)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		    return (char *)
+			    "variable array must have wide integer value";
+		}
+	    }
+	} else {
+	    Tcl_WideInt *varPtr = &linkPtr->lastValue.w;
+
+	    if (GetWide(valueObj, varPtr)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have wide integer value";
+	    }
+	    LinkedVar(Tcl_WideInt) = *varPtr;
 	}
-	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
 	break;
 
     case TCL_LINK_DOUBLE:
-	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
-#ifdef ACCEPT_NAN
-	    Tcl_ObjIntRep *irPtr = TclFetchIntRep(valueObj, &tclDoubleType);
-	    if (irPtr == NULL) {
-#endif
-		if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
-		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-			TCL_GLOBAL_ONLY);
-		    return (char *) "variable must have real value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetDouble(objv[i], &linkPtr->lastValue.dPtr[i])) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		    return (char *) "variable array must have real value";
 		}
-#ifdef ACCEPT_NAN
 	    }
-	    linkPtr->lastValue.d = irPtr->doubleValue;
-#endif
+	} else {
+	    double *varPtr = &linkPtr->lastValue.d;
+
+	    if (GetDouble(valueObj, varPtr)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have real value";
+	    }
+	    LinkedVar(double) = *varPtr;
 	}
-	LinkedVar(double) = linkPtr->lastValue.d;
 	break;
 
     case TCL_LINK_BOOLEAN:
-	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have boolean value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		int *varPtr = &linkPtr->lastValue.iPtr[i];
+
+		if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *) "variable array must have boolean value";
+		}
+	    }
+	} else {
+	    int *varPtr = &linkPtr->lastValue.i;
+
+	    if (Tcl_GetBooleanFromObj(NULL, valueObj, varPtr) != TCL_OK) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have boolean value";
+	    }
+	    LinkedVar(int) = *varPtr;
 	}
-	LinkedVar(int) = linkPtr->lastValue.i;
 	break;
 
     case TCL_LINK_CHAR:
-	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
-		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
-		|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have char value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetInt(objv[i], &valueInt)
+		        || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *) "variable array must have char value";
+		}
+		linkPtr->lastValue.cPtr[i] = (char) valueInt;
+	    }
+	} else {
+	    if (GetInt(valueObj, &valueInt)
+		    || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have char value";
+	    }
+	    LinkedVar(char) = linkPtr->lastValue.c = (char) valueInt;
 	}
-	LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt;
 	break;
 
     case TCL_LINK_UCHAR:
-	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
-		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
-		|| valueInt < 0 || valueInt > UCHAR_MAX) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have unsigned char value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetInt(objv[i], &valueInt)
+		        || !InRange(0, valueInt, UCHAR_MAX)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		    return (char *)
+			    "variable array must have unsigned char value";
+		}
+		linkPtr->lastValue.ucPtr[i] = (unsigned char) valueInt;
+	    }
+	} else {
+	    if (GetInt(valueObj, &valueInt)
+		    || !InRange(0, valueInt, UCHAR_MAX)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have unsigned char value";
+	    }
+	    LinkedVar(unsigned char) = linkPtr->lastValue.uc =
+		    (unsigned char) valueInt;
 	}
-	LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt;
 	break;
 
     case TCL_LINK_SHORT:
-	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
-		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
-		|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have short value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetInt(objv[i], &valueInt)
+			|| !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *) "variable array must have short value";
+		}
+		linkPtr->lastValue.sPtr[i] = (short) valueInt;
+	    }
+	} else {
+	    if (GetInt(valueObj, &valueInt)
+		    || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have short value";
+	    }
+	    LinkedVar(short) = linkPtr->lastValue.s = (short) valueInt;
 	}
-	LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt;
 	break;
 
     case TCL_LINK_USHORT:
-	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
-		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
-		|| valueInt < 0 || valueInt > USHRT_MAX) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have unsigned short value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetInt(objv[i], &valueInt)
+		        || !InRange(0, valueInt, USHRT_MAX)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *)
+			"variable array must have unsigned short value";
+		}
+		linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt;
+	    }
+	} else {
+	    if (GetInt(valueObj, &valueInt)
+		    || !InRange(0, valueInt, USHRT_MAX)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have unsigned short value";
+	    }
+	    LinkedVar(unsigned short) = linkPtr->lastValue.us =
+		    (unsigned short) valueInt;
 	}
-	LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt;
 	break;
 
     case TCL_LINK_UINT:
-	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
-		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
-		|| valueWide < 0 || valueWide > UINT_MAX) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have unsigned int value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetWide(objv[i], &valueWide)
+			|| !InRange(0, valueWide, UINT_MAX)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *)
+			    "variable array must have unsigned int value";
+		}
+		linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide;
+	    }
+	} else {
+	    if (GetWide(valueObj, &valueWide)
+		    || !InRange(0, valueWide, UINT_MAX)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have unsigned int value";
+	    }
+	    LinkedVar(unsigned int) = linkPtr->lastValue.ui =
+		    (unsigned int) valueWide;
 	}
-	LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide;
 	break;
 
 #if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
     case TCL_LINK_LONG:
-	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
-		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
-		|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have long value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetWide(objv[i], &valueWide)
+			|| !InRange(LONG_MIN, valueWide, LONG_MAX)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *) "variable array must have long value";
+		}
+		linkPtr->lastValue.lPtr[i] = (long) valueWide;
+	    }
+	} else {
+	    if (GetWide(valueObj, &valueWide)
+		    || !InRange(LONG_MIN, valueWide, LONG_MAX)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have long value";
+	    }
+	    LinkedVar(long) = linkPtr->lastValue.l = (long) valueWide;
 	}
-	LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide;
 	break;
 
     case TCL_LINK_ULONG:
-	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
-		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
-		|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have unsigned long value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetUWide(objv[i], &valueUWide)
+			|| !InRange(0, valueUWide, ULONG_MAX)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *)
+			    "variable array must have unsigned long value";
+		}
+		linkPtr->lastValue.ulPtr[i] = (unsigned long) valueUWide;
+	    }
+	} else {
+	    if (GetUWide(valueObj, &valueUWide)
+		    || !InRange(0, valueUWide, ULONG_MAX)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have unsigned long value";
+	    }
+	    LinkedVar(unsigned long) = linkPtr->lastValue.ul =
+		    (unsigned long) valueUWide;
 	}
-	LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide;
 	break;
 #endif
 
     case TCL_LINK_WIDE_UINT:
-	/*
-	 * FIXME: represent as a bignum.
-	 */
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
-		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have unsigned wide int value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetUWide(objv[i], &valueUWide)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *)
+			    "variable array must have unsigned wide int value";
+		}
+		linkPtr->lastValue.uwPtr[i] = valueUWide;
+	    }
+	} else {
+	    if (GetUWide(valueObj, &valueUWide)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have unsigned wide int value";
+	    }
+	    LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = valueUWide;
 	}
-	LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
 	break;
 
     case TCL_LINK_FLOAT:
-	if ((Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
-		&& GetInvalidDoubleFromObj(valueObj, &valueDouble) != TCL_OK)
-		|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have float value";
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    for (i=0; i < objc; i++) {
+		if (GetDouble(objv[i], &valueDouble)
+			&& !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
+		        && !IsSpecial(valueDouble)) {
+		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+	            return (char *) "variable array must have float value";
+		}
+		linkPtr->lastValue.fPtr[i] = (float) valueDouble;
+	    }
+	} else {
+	    if (GetDouble(valueObj, &valueDouble)
+		    && !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
+		    && !IsSpecial(valueDouble)) {
+		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
+			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
+		return (char *) "variable must have float value";
+	    }
+	    LinkedVar(float) = linkPtr->lastValue.f = (float) valueDouble;
 	}
-	LinkedVar(float) = linkPtr->lastValue.f = (float)valueDouble;
-	break;
-
-    case TCL_LINK_STRING:
-	value = TclGetString(valueObj);
-	valueLength = valueObj->length + 1;
-	pp = (char **) linkPtr->addr;
-
-	*pp = ckrealloc(*pp, valueLength);
-	memcpy(*pp, value, valueLength);
 	break;
 
     default:
 	return (char *) "internal error: bad linked variable type";
     }
+
+    if (linkPtr->flags & LINK_ALLOC_LAST) {
+	memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
+    }
     return NULL;
 }
 
@@ -582,53 +1251,183 @@ ObjValue(
     Link *linkPtr)		/* Structure describing linked variable. */
 {
     char *p;
-    Tcl_Obj *resultObj;
+    Tcl_Obj *resultObj, **objv;
+    int i;
 
     switch (linkPtr->type) {
     case TCL_LINK_INT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.iPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	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.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.wPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	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.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	linkPtr->lastValue.d = LinkedVar(double);
 	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
     case TCL_LINK_BOOLEAN:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.iPtr[i] != 0);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	linkPtr->lastValue.i = LinkedVar(int);
 	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
     case TCL_LINK_CHAR:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.cPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	linkPtr->lastValue.c = LinkedVar(char);
 	return Tcl_NewIntObj(linkPtr->lastValue.c);
     case TCL_LINK_UCHAR:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.ucPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	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.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.sPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	linkPtr->lastValue.s = LinkedVar(short);
 	return Tcl_NewIntObj(linkPtr->lastValue.s);
     case TCL_LINK_USHORT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.usPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	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.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.uiPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	linkPtr->lastValue.ui = LinkedVar(unsigned int);
 	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
 #if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
     case TCL_LINK_LONG:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.lPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	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.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.ulPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	linkPtr->lastValue.ul = LinkedVar(unsigned long);
 	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
 #endif
     case TCL_LINK_FLOAT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	linkPtr->lastValue.f = LinkedVar(float);
 	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
     case TCL_LINK_WIDE_UINT:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
+	    for (i=0; i < linkPtr->numElems; i++) {
+		objv[i] = Tcl_NewWideIntObj((Tcl_WideInt)
+			linkPtr->lastValue.uwPtr[i]);
+	    }
+	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
+	    ckfree(objv);
+	    return resultObj;
+	}
 	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
-	/*
-	 * FIXME: represent as a bignum.
-	 */
 	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
+
     case TCL_LINK_STRING:
 	p = LinkedVar(char *);
 	if (p == NULL) {
@@ -637,6 +1436,25 @@ ObjValue(
 	}
 	return Tcl_NewStringObj(p, -1);
 
+    case TCL_LINK_CHARS:
+	if (linkPtr->flags & LINK_ALLOC_LAST) {
+	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
+	    linkPtr->lastValue.cPtr[linkPtr->bytes-1] = '\0';
+	    /* take care of proper string end */
+	    return Tcl_NewStringObj(linkPtr->lastValue.cPtr, 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.aryPtr, 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).
@@ -647,107 +1465,34 @@ ObjValue(
 	return resultObj;
     }
 }
-
-static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
-
-static Tcl_ObjType invalidRealType = {
-    "invalidReal",			/* name */
-    NULL,				/* freeIntRepProc */
-    NULL,				/* dupIntRepProc */
-    NULL,				/* updateStringProc */
-    NULL				/* setFromAnyProc */
-};
-
-static int
-SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
-    const char *str;
-    const char *endPtr;
-
-    str = TclGetString(objPtr);
-    if ((objPtr->length == 1) && (str[0] == '.')){
-	objPtr->typePtr = &invalidRealType;
-	objPtr->internalRep.doubleValue = 0.0;
-	return TCL_OK;
-    }
-    if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr,
-	    TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
-	/* If number is followed by [eE][+-]?, then it is an invalid
-	 * double, but it could be the start of a valid double. */
-	if (*endPtr == 'e' || *endPtr == 'E') {
-	    ++endPtr;
-	    if (*endPtr == '+' || *endPtr == '-') ++endPtr;
-	    if (*endPtr == 0) {
-		double doubleValue = 0.0;
-		Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
-		TclFreeIntRep(objPtr);
-		objPtr->typePtr = &invalidRealType;
-		objPtr->internalRep.doubleValue = doubleValue;
-		return TCL_OK;
-	    }
-	}
-    }
-    return TCL_ERROR;
-}
-
-
+
 /*
- * This function checks for integer representations, which are valid
- * when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
- * (upperand lowercase). See bug [39f6304c2e].
+ *----------------------------------------------------------------------
+ *
+ * LinkFree --
+ *
+ *	Free's allocated space of given link and link structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
  */
-int
-GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
-{
-    const char *str = TclGetString(objPtr);
-
-    if ((objPtr->length == 0) ||
-	    ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) {
-	*intPtr = 0;
-	return TCL_OK;
-    } else if ((objPtr->length == 1) && strchr("+-", str[0])) {
-	*intPtr = (str[0] == '+');
-	return TCL_OK;
-    }
-    return TCL_ERROR;
-}
-
-int
-GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr)
-{
-    int intValue;
-
-    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    *widePtr = intValue;
-    return TCL_OK;
-}
 
-/*
- * This function checks for double representations, which are valid
- * when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
- * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
- */
-int
-GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr)
+static void
+LinkFree(
+    Link *linkPtr)		/* Structure describing linked variable. */
 {
-    int intValue;
-
-    if (TclHasIntRep(objPtr, &invalidRealType)) {
-	goto gotdouble;
-    }
-    if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
-	*doublePtr = (double) intValue;
-	return TCL_OK;
+    if (linkPtr->flags & LINK_ALLOC_ADDR) {
+	ckfree(linkPtr->addr);
     }
-    if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
-    gotdouble:
-	*doublePtr = objPtr->internalRep.doubleValue;
-	return TCL_OK;
+    if (linkPtr->flags & LINK_ALLOC_LAST) {
+	ckfree(linkPtr->lastValue.aryPtr);
     }
-    return TCL_ERROR;
+    ckfree((char *) linkPtr);
 }
 
 /*
diff --git a/generic/tclObj.c b/generic/tclObj.c
index f233038..d329aba 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -191,17 +191,6 @@ static Tcl_ThreadDataKey pendingObjDataKey;
 		| ((bignum).alloc << 15) | ((bignum).used));            \
     }
 
-#define UNPACK_BIGNUM(objPtr, bignum) \
-    if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
-	(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
-    } else {                                                            \
-	(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1;          \
-	(bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
-	(bignum).alloc =                                                \
-		(PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7fff; \
-	(bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7fff; \
-    }
-
 /*
  * Prototypes for functions defined later in this file:
  */
@@ -2517,7 +2506,7 @@ Tcl_GetDoubleFromObj(
 	if (objPtr->typePtr == &tclBignumType) {
 	    mp_int big;
 
-	    UNPACK_BIGNUM(objPtr, big);
+	    TclUnpackBignum(objPtr, big);
 	    *dblPtr = TclBignumToDouble(&big);
 	    return TCL_OK;
 	}
@@ -3033,7 +3022,7 @@ Tcl_GetLongFromObj(
 	    unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);
 	    unsigned char *bytes = (unsigned char *) &scratch;
 
-	    UNPACK_BIGNUM(objPtr, big);
+	    TclUnpackBignum(objPtr, big);
 	    if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
 		while (numBytes-- > 0) {
 			value = (value << CHAR_BIT) | *bytes++;
@@ -3273,7 +3262,7 @@ Tcl_GetWideIntFromObj(
 	    Tcl_WideInt scratch;
 	    unsigned char *bytes = (unsigned char *) &scratch;
 
-	    UNPACK_BIGNUM(objPtr, big);
+	    TclUnpackBignum(objPtr, big);
 	    if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
 		while (numBytes-- > 0) {
 		    value = (value << CHAR_BIT) | *bytes++;
@@ -3387,7 +3376,7 @@ FreeBignum(
 {
     mp_int toFree;		/* Bignum to free */
 
-    UNPACK_BIGNUM(objPtr, toFree);
+    TclUnpackBignum(objPtr, toFree);
     mp_clear(&toFree);
     if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
 	ckfree(objPtr->internalRep.twoPtrValue.ptr1);
@@ -3420,7 +3409,7 @@ DupBignum(
     mp_int bignumCopy;
 
     copyPtr->typePtr = &tclBignumType;
-    UNPACK_BIGNUM(srcPtr, bignumVal);
+    TclUnpackBignum(srcPtr, bignumVal);
     if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
 	Tcl_Panic("initialization failure in DupBignum");
     }
@@ -3455,7 +3444,7 @@ UpdateStringOfBignum(
     int size;
     char *stringVal;
 
-    UNPACK_BIGNUM(objPtr, bignumVal);
+    TclUnpackBignum(objPtr, bignumVal);
     if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) {
 	Tcl_Panic("radix size failure in UpdateStringOfBignum");
     }
@@ -3594,10 +3583,10 @@ GetBignumFromObj(
 	    if (copy || Tcl_IsShared(objPtr)) {
 		mp_int temp;
 
-		UNPACK_BIGNUM(objPtr, temp);
+		TclUnpackBignum(objPtr, temp);
 		mp_init_copy(bignumValue, &temp);
 	    } else {
-		UNPACK_BIGNUM(objPtr, *bignumValue);
+		TclUnpackBignum(objPtr, *bignumValue);
 		/* Optimized TclFreeIntRep */
 		objPtr->internalRep.twoPtrValue.ptr1 = NULL;
 		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -3838,7 +3827,7 @@ TclGetNumberFromObj(
 	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
 		    (int) sizeof(mp_int));
 
-	    UNPACK_BIGNUM(objPtr, *bigPtr);
+	    TclUnpackBignum(objPtr, *bigPtr);
 	    *typePtr = TCL_NUMBER_BIG;
 	    *clientDataPtr = bigPtr;
 	    return TCL_OK;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 197ed84..2eb2259 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1628,6 +1628,7 @@ const TclStubs tclStubs = {
     Tcl_IncrRefCount, /* 641 */
     Tcl_DecrRefCount, /* 642 */
     Tcl_IsShared, /* 643 */
+    Tcl_LinkArray, /* 644 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 349d935..f075500 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -308,6 +308,8 @@ static int		TestinterpdeleteCmd(void *dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestlinkCmd(void *dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestlinkarrayCmd(void *dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const *objv);
 static int		TestlocaleCmd(void *dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -665,6 +667,7 @@ Tcltest_Init(
     Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
 	    NULL);
     Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
@@ -3283,6 +3286,123 @@ TestlinkCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * 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, typeIndex, readonly, i, addr, size, length;
+    char *name, *arg;
+
+    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_SetObjResult(interp, Tcl_NewStringObj("wrong size value", -1));
+	    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_SetObjResult(interp, Tcl_NewStringObj(
+			"wrong address value", -1));
+		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
diff --git a/tests/link.test b/tests/link.test
index a12759d..4c4cf99 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -20,6 +20,7 @@ if {"::tcltest" ni [namespace children]} {
 catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testlink [llength [info commands testlink]]
+testConstraint testlinkarray [llength [info commands testlinkarray]]
 
 foreach i {int real bool string} {
     unset -nocomplain $i
@@ -88,7 +89,7 @@ test link-2.5 {writing bad values into variables} -setup {
     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
-} -result {1 {can't set "wide": variable must have integer value} 1}
+} -result {1 {can't set "wide": variable must have wide integer value} 1}
 test link-2.6 {writing C variables from Tcl} -constraints {testlink} -setup {
     testlink delete
 } -body {
@@ -363,7 +364,7 @@ test link-7.7 {access to linked variables via upvar} -setup {
     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
-} -result {1 {can't set "y": variable must have integer value} 778899}
+} -result {1 {can't set "y": variable must have wide integer value} 778899}
 
 test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
     proc x args {
@@ -398,6 +399,477 @@ test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
 	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
     } msg] $msg $int
 } {0 {} 47}
+
+test link-9.1 {linkarray usage messages} -returnCodes error -body {
+    testlinkarray
+} -result {wrong # args: should be "testlinkarray option args"}
+test link-9.2 {linkarray usage messages} -returnCodes error -body {
+    testlinkarray x
+} -result {bad option "x": must be update, remove, or create}
+test link-9.3 {linkarray usage messages} -body {
+    testlinkarray update
+} -result {}
+test link-9.4 {linkarray usage messages} -body {
+    testlinkarray remove
+} -result {}
+test link-9.5 {linkarray usage messages} -returnCodes error -body {
+    testlinkarray create
+} -result {wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?"}
+test link-9.6 {linkarray usage messages} -returnCodes error -body {
+    testlinkarray create xx 1 my
+} -result {bad type "xx": must be char, uchar, short, ushort, int, uint, long, ulong, wide, uwide, float, double, string, char*, or binary}
+test link-9.7 {linkarray usage messages} -returnCodes error -body {
+    testlinkarray create char* 0 my
+} -result {wrong array size given}
+
+test link-10.1 {linkarray char*} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create char* 1 ::my(var)
+    lappend mylist [set ::my(var) ""]
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{} {can't set "::my(var)": wrong size of char* value}}
+test link-10.2 {linkarray char*} -body {
+    testlinkarray create char* 4 ::my(var)
+    set ::my(var) x
+    catch {set ::my(var) xyzz} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": wrong size of char* value}
+test link-10.3 {linkarray char*} -body {
+    testlinkarray create -r char* 4 ::my(var)
+    catch {set ::my(var) x} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-11.1 {linkarray char} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create char 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 1234} msg
+    lappend mylist $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": variable must have char value} 120 {can't set "::my(var)": variable must have char value}}
+test link-11.2 {linkarray char} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create char 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-11.3 {linkarray char} -body {
+    testlinkarray create -r char 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-12.1 {linkarray unsigned char} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create uchar 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 1234} msg
+    lappend mylist $msg
+    catch {set ::my(var) -1} msg
+    lappend mylist $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{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}}
+test link-12.2 {linkarray unsigned char} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create uchar 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-12.3 {linkarray unsigned char} -body {
+    testlinkarray create -r uchar 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-13.1 {linkarray short} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create short 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 123456} msg
+    lappend mylist $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": variable must have short value} 120 {can't set "::my(var)": variable must have short value}}
+test link-13.2 {linkarray short} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create short 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-13.3 {linkarray short} -body {
+    testlinkarray create -r short 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-14.1 {linkarray unsigned short} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create ushort 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 123456} msg
+    lappend mylist $msg
+    catch {set ::my(var) -1} msg
+    lappend mylist $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{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}}
+test link-14.2 {linkarray unsigned short} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create ushort 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-14.3 {linkarray unsigned short} -body {
+    testlinkarray create -r ushort 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-15.1 {linkarray int} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create int 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 1e3} msg
+    lappend mylist $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": variable must have integer value} 120 {can't set "::my(var)": variable must have integer value}}
+test link-15.2 {linkarray int} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create int 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-15.3 {linkarray int} -body {
+    testlinkarray create -r int 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-16.1 {linkarray unsigned int} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create uint 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
+    catch {set ::my(var) -1} msg
+    lappend mylist $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain ::my
+} -result {{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}}
+test link-16.2 {linkarray unsigned int} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create uint 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain ::my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-16.3 {linkarray unsigned int} -body {
+    testlinkarray create -r uint 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-17.1 {linkarray long} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create long 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
+} -match glob -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": variable must have * value} 120 {can't set "::my(var)": variable must have * value}}
+test link-17.2 {linkarray long} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create long 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-17.3 {linkarray long} -body {
+    testlinkarray create -r long 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-18.1 {linkarray unsigned long} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create ulong 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
+} -match glob -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": variable must have unsigned * value} 120 {can't set "::my(var)": variable must have unsigned * value}}
+test link-18.2 {linkarray unsigned long} -body {
+    testlinkarray create ulong 1 ::my(var)
+    set ::my(var) 120
+    catch {set ::my(var) -1} msg
+    return $msg
+} -match glob -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have unsigned * value}
+test link-18.3 {linkarray unsigned long} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create ulong 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-18.4 {linkarray unsigned long} -body {
+    testlinkarray create -r ulong 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-19.1 {linkarray wide} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create wide 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": variable must have wide integer value} 120 {can't set "::my(var)": variable must have wide integer value}}
+test link-19.2 {linkarray wide} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create wide 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-19.3 {linkarray wide} -body {
+    testlinkarray create -r wide 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-20.1 {linkarray unsigned wide} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create uwide 1 ::my(var)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 120]
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
+    lappend mylist [set ::my(var) 0xbabed00dbabed00d]
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{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} 0xbabed00dbabed00d}
+test link-20.2 {linkarray unsigned wide} -body {
+    testlinkarray create uwide 1 ::my(var)
+    set ::my(var) 120
+    catch {set ::my(var) -1} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have unsigned wide int value}
+test link-20.3 {linkarray unsigned wide} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create uwide 4 ::my(var)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
+    set ::my(var) {1 2 3 4}
+    lappend mylist $my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
+test link-20.4 {linkarray unsigned wide} -body {
+    testlinkarray create -r uwide 2 ::my(var)
+    catch {set ::my(var) {1 2}} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-21.1 {linkarray string} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create string 1 ::my(var)
+    lappend mylist [set ::my(var) ""]
+    lappend mylist [set ::my(var) "xyz"]
+    lappend mylist $::my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{} xyz xyz}
+test link-21.2 {linkarray string} -body {
+    testlinkarray create -r string 4 ::my(var)
+    catch {set ::my(var) x} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {can't set "::my(var)": linked variable is read-only}
+
+test link-22.1 {linkarray binary} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create binary 1 ::my(var)
+    set ::my(var) x
+    catch {set ::my(var) xy} msg
+    lappend mylist $msg
+    lappend mylist $::my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong size of binary value} x}
+test link-22.2 {linkarray binary} -setup {
+    set mylist [list]
+} -body {
+    testlinkarray create binary 4 ::my(var)
+    catch {set ::my(var) abc} msg
+    lappend mylist $msg
+    catch {set ::my(var) abcde} msg
+    lappend mylist $msg
+    set ::my(var) abcd
+    lappend mylist $::my(var)
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {{can't set "::my(var)": wrong size of binary value} {can't set "::my(var)": wrong size of binary value} abcd}
+test link-22.3 {linkarray binary} -body {
+    testlinkarray create -r binary 4 ::my(var)
+    catch {set ::my(var) xyzv} msg
+    return $msg
+} -cleanup {
+    testlinkarray remove ::my(var)
+    unset -nocomplain my
+} -result {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}