summaryrefslogtreecommitdiffstats
path: root/generic/tclLink.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclLink.c')
-rw-r--r--generic/tclLink.c234
1 files changed, 124 insertions, 110 deletions
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 3066557..8d7a3fe 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclLink.c,v 1.4 2002/01/25 20:40:55 dgp Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.5 2002/02/15 14:28:49 dkf Exp $
*/
#include "tclInt.h"
@@ -26,7 +26,7 @@
typedef struct Link {
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
- char *varName; /* Name of variable (must be global). This
+ Tcl_Obj *varName; /* Name of variable (must be global). This
* is needed during trace callbacks, since
* the actual variable may be aliased at
* that time via upvar. */
@@ -35,6 +35,7 @@ typedef struct Link {
union {
int i;
double d;
+ Tcl_WideInt w;
} lastValue; /* Last known value of C variable; used to
* avoid string conversions. */
int flags; /* Miscellaneous one-bit values; see below
@@ -61,8 +62,7 @@ typedef struct Link {
static char * LinkTraceProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
-static char * StringValue _ANSI_ARGS_((Link *linkPtr,
- char *buffer));
+static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr));
/*
*----------------------------------------------------------------------
@@ -96,13 +96,12 @@ Tcl_LinkVar(interp, varName, addr, type)
* OR'ed in. */
{
Link *linkPtr;
- char buffer[TCL_DOUBLE_SPACE];
int code;
linkPtr = (Link *) ckalloc(sizeof(Link));
linkPtr->interp = interp;
- linkPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
- strcpy(linkPtr->varName, varName);
+ linkPtr->varName = Tcl_NewStringObj(varName, -1);
+ Tcl_IncrRefCount(linkPtr->varName);
linkPtr->addr = addr;
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
if (type & TCL_LINK_READ_ONLY) {
@@ -110,9 +109,9 @@ Tcl_LinkVar(interp, varName, addr, type)
} else {
linkPtr->flags = 0;
}
- if (Tcl_SetVar(interp, varName, StringValue(linkPtr, buffer),
+ if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- ckfree(linkPtr->varName);
+ Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
return TCL_ERROR;
}
@@ -120,7 +119,7 @@ Tcl_LinkVar(interp, varName, addr, type)
|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
(ClientData) linkPtr);
if (code != TCL_OK) {
- ckfree(linkPtr->varName);
+ Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
}
return code;
@@ -159,7 +158,7 @@ Tcl_UnlinkVar(interp, varName)
Tcl_UntraceVar(interp, varName,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
LinkTraceProc, (ClientData) linkPtr);
- ckfree(linkPtr->varName);
+ Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
}
@@ -188,7 +187,6 @@ Tcl_UpdateLinkedVar(interp, varName)
char *varName; /* Name of global variable that is linked. */
{
Link *linkPtr;
- char buffer[TCL_DOUBLE_SPACE];
int savedFlag;
linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
@@ -198,7 +196,7 @@ Tcl_UpdateLinkedVar(interp, varName)
}
savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
linkPtr->flags |= LINK_BEING_UPDATED;
- Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
}
@@ -233,11 +231,10 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
int flags; /* Miscellaneous additional information. */
{
Link *linkPtr = (Link *) clientData;
- int changed;
- char buffer[TCL_DOUBLE_SPACE];
+ int changed, valueLength;
CONST char *value;
char **pp, *result;
- Tcl_Obj *objPtr;
+ Tcl_Obj *objPtr, *valueObj;
/*
* If the variable is being unset, then just re-create it (with a
@@ -246,14 +243,14 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_UNSETS) {
if (flags & TCL_INTERP_DESTROYED) {
- ckfree(linkPtr->varName);
+ Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
} else if (flags & TCL_TRACE_DESTROYED) {
- Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- Tcl_TraceVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY
- |TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- LinkTraceProc, (ClientData) linkPtr);
+ Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
+ TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
+ |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
}
return NULL;
}
@@ -276,21 +273,24 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_READS) {
switch (linkPtr->type) {
- case TCL_LINK_INT:
- case TCL_LINK_BOOLEAN:
- changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
- break;
- case TCL_LINK_DOUBLE:
- changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
- break;
- case TCL_LINK_STRING:
- changed = 1;
- break;
- default:
- return "internal error: bad linked variable type";
+ case TCL_LINK_INT:
+ case TCL_LINK_BOOLEAN:
+ changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
+ break;
+ case TCL_LINK_DOUBLE:
+ changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
+ break;
+ case TCL_LINK_WIDE_INT:
+ changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
+ break;
+ case TCL_LINK_STRING:
+ changed = 1;
+ break;
+ default:
+ return "internal error: bad linked variable type";
}
if (changed) {
- Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
}
return NULL;
@@ -306,12 +306,12 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*/
if (linkPtr->flags & LINK_READ_ONLY) {
- Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "linked variable is read-only";
}
- value = Tcl_GetVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY);
- if (value == NULL) {
+ valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
+ if (valueObj == NULL) {
/*
* This shouldn't ever happen.
*/
@@ -324,48 +324,67 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
result = NULL;
switch (linkPtr->type) {
- case TCL_LINK_INT:
- if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
- Tcl_SetObjResult(interp, objPtr);
- Tcl_SetVar(interp, linkPtr->varName,
- StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- result = "variable must have integer value";
- goto end;
- }
- *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
- break;
- case TCL_LINK_DOUBLE:
- if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d)
- != TCL_OK) {
- Tcl_SetObjResult(interp, objPtr);
- Tcl_SetVar(interp, linkPtr->varName,
- StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- result = "variable must have real value";
- goto end;
- }
- *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
- break;
- case TCL_LINK_BOOLEAN:
- if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i)
- != TCL_OK) {
- Tcl_SetObjResult(interp, objPtr);
- Tcl_SetVar(interp, linkPtr->varName,
- StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- result = "variable must have boolean value";
- goto end;
- }
- *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
- break;
- case TCL_LINK_STRING:
- pp = (char **)(linkPtr->addr);
- if (*pp != NULL) {
- ckfree(*pp);
- }
- *pp = (char *) ckalloc((unsigned) (strlen(value) + 1));
- strcpy(*pp, value);
- break;
- default:
- result = "internal error: bad linked variable type";
+ case TCL_LINK_INT:
+ if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i)
+ != TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ result = "variable must have integer value";
+ goto end;
+ }
+ *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+ break;
+
+ case TCL_LINK_WIDE_INT:
+ if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w)
+ != TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ result = "variable must have integer value";
+ goto end;
+ }
+ *(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w;
+ break;
+
+ case TCL_LINK_DOUBLE:
+ if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d)
+ != TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ result = "variable must have real value";
+ goto end;
+ }
+ *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
+ break;
+
+ case TCL_LINK_BOOLEAN:
+ if (Tcl_GetBooleanFromObj(interp, valueObj, &linkPtr->lastValue.i)
+ != TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ result = "variable must have boolean value";
+ goto end;
+ }
+ *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+ break;
+
+ case TCL_LINK_STRING:
+ value = Tcl_GetStringFromObj(valueObj, &valueLength);
+ valueLength++;
+ pp = (char **)(linkPtr->addr);
+ if (*pp != NULL) {
+ ckfree(*pp);
+ }
+ *pp = (char *) ckalloc((unsigned) valueLength);
+ memcpy(*pp, value, (unsigned) valueLength);
+ break;
+
+ default:
+ return "internal error: bad linked variable type";
}
end:
Tcl_DecrRefCount(objPtr);
@@ -375,13 +394,13 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
/*
*----------------------------------------------------------------------
*
- * StringValue --
+ * ObjValue --
*
- * Converts the value of a C variable to a string for use in a
+ * Converts the value of a C variable to a Tcl_Obj* for use in a
* Tcl variable to which it is linked.
*
* Results:
- * The return value is a pointer to a string that represents
+ * The return value is a pointer to a Tcl_Obj that represents
* the value of the C variable given by linkPtr.
*
* Side effects:
@@ -390,42 +409,37 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*----------------------------------------------------------------------
*/
-static char *
-StringValue(linkPtr, buffer)
+static Tcl_Obj *
+ObjValue(linkPtr)
Link *linkPtr; /* Structure describing linked variable. */
- char *buffer; /* Small buffer to use for converting
- * values. Must have TCL_DOUBLE_SPACE
- * bytes or more. */
{
char *p;
switch (linkPtr->type) {
- case TCL_LINK_INT:
- linkPtr->lastValue.i = *(int *)(linkPtr->addr);
- TclFormatInt(buffer, linkPtr->lastValue.i);
- return buffer;
- case TCL_LINK_DOUBLE:
- linkPtr->lastValue.d = *(double *)(linkPtr->addr);
- Tcl_PrintDouble((Tcl_Interp *) NULL, linkPtr->lastValue.d, buffer);
- return buffer;
- case TCL_LINK_BOOLEAN:
- linkPtr->lastValue.i = *(int *)(linkPtr->addr);
- if (linkPtr->lastValue.i != 0) {
- return "1";
- }
- return "0";
- case TCL_LINK_STRING:
- p = *(char **)(linkPtr->addr);
- if (p == NULL) {
- return "NULL";
- }
- return p;
- }
+ case TCL_LINK_INT:
+ linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+ return Tcl_NewIntObj(linkPtr->lastValue.i);
+ case TCL_LINK_WIDE_INT:
+ linkPtr->lastValue.w = *(Tcl_WideInt *)(linkPtr->addr);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.w);
+ case TCL_LINK_DOUBLE:
+ linkPtr->lastValue.d = *(double *)(linkPtr->addr);
+ return Tcl_NewDoubleObj(linkPtr->lastValue.d);
+ case TCL_LINK_BOOLEAN:
+ linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+ return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
+ case TCL_LINK_STRING:
+ p = *(char **)(linkPtr->addr);
+ if (p == NULL) {
+ return Tcl_NewStringObj("NULL", 4);
+ }
+ return Tcl_NewStringObj(p, -1);
/*
* This code only gets executed if the link type is unknown
* (shouldn't ever happen).
*/
-
- return "??";
+ default:
+ return Tcl_NewStringObj("??", 2);
+ }
}