diff options
Diffstat (limited to 'generic/tclLink.c')
| -rw-r--r-- | generic/tclLink.c | 234 |
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); + } } |