1 /*
2 * tclLink.c --
3 *
4 * This file implements linked variables (a C variable that is
5 * tied to a Tcl variable). The idea of linked variables was
6 * first suggested by Andreas Stolcke and this implementation is
7 * based heavily on a prototype implementation provided by
8 * him.
9 *
10 * Copyright (c) 1993 The Regents of the University of California.
11 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
12 *
13 * See the file "license.terms" for information on usage and redistribution
14 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 *
16 * SCCS: @(#) tclLink.c 1.13 96/08/09 16:23:34
17 */
18
19 #include "tclInt.h"
20
21 /*
22 * For each linked variable there is a data structure of the following
23 * type, which describes the link and is the clientData for the trace
24 * set on the Tcl variable.
25 */
26
27 typedef struct Link {
28 Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
29 char *varName; /* Name of variable (must be global). This
30 * is needed during trace callbacks, since
31 * the actual variable may be aliased at
32 * that time via upvar. */
33 char *addr; /* Location of C variable. */
34 int type; /* Type of link (TCL_LINK_INT, etc.). */
35 union {
36 int i;
37 double d;
38 } lastValue; /* Last known value of C variable; used to
39 * avoid string conversions. */
40 int flags; /* Miscellaneous one-bit values; see below
41 * for definitions. */
42 } Link;
43
44 /*
45 * Definitions for flag bits:
46 * LINK_READ_ONLY - 1 means errors should be generated if Tcl
47 * script attempts to write variable.
48 * LINK_BEING_UPDATED - 1 means that a call to Tcl_UpdateLinkedVar
49 * is in progress for this variable, so
50 * trace callbacks on the variable should
51 * be ignored.
52 */
53
54 #define LINK_READ_ONLY 1
55 #define LINK_BEING_UPDATED 2
56
57 /*
58 * Forward references to procedures defined later in this file:
59 */
60
61 static char * LinkTraceProc _ANSI_ARGS_((ClientData clientData,
62 Tcl_Interp *interp, char *name1, char *name2,
63 int flags));
64 static char * StringValue _ANSI_ARGS_((Link *linkPtr,
65 char *buffer));
66
67 /*
68 *----------------------------------------------------------------------
69 *
70 * Tcl_LinkVar --
71 *
72 * Link a C variable to a Tcl variable so that changes to either
73 * one causes the other to change.
74 *
75 * Results:
76 * The return value is TCL_OK if everything went well or TCL_ERROR
77 * if an error occurred (interp->result is also set after errors).
78 *
79 * Side effects:
80 * The value at *addr is linked to the Tcl variable "varName",
81 * using "type" to convert between string values for Tcl and
82 * binary values for *addr.
83 *
84 *----------------------------------------------------------------------
85 */
86
87 int
Tcl_LinkVar(interp,varName,addr,type)88 Tcl_LinkVar(interp, varName, addr, type)
89 Tcl_Interp *interp; /* Interpreter in which varName exists. */
90 char *varName; /* Name of a global variable in interp. */
91 char *addr; /* Address of a C variable to be linked
92 * to varName. */
93 int type; /* Type of C variable: TCL_LINK_INT, etc.
94 * Also may have TCL_LINK_READ_ONLY
95 * OR'ed in. */
96 {
97 Link *linkPtr;
98 char buffer[TCL_DOUBLE_SPACE];
99 int code;
100
101 linkPtr = (Link *) ckalloc(sizeof(Link));
102 linkPtr->interp = interp;
103 linkPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
104 strcpy(linkPtr->varName, varName);
105 linkPtr->addr = addr;
106 linkPtr->type = type & ~TCL_LINK_READ_ONLY;
107 if (type & TCL_LINK_READ_ONLY) {
108 linkPtr->flags = LINK_READ_ONLY;
109 } else {
110 linkPtr->flags = 0;
111 }
112 if (Tcl_SetVar(interp, varName, StringValue(linkPtr, buffer),
113 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
114 ckfree(linkPtr->varName);
115 ckfree((char *) linkPtr);
116 return TCL_ERROR;
117 }
118 code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
119 |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
120 (ClientData) linkPtr);
121 if (code != TCL_OK) {
122 ckfree(linkPtr->varName);
123 ckfree((char *) linkPtr);
124 }
125 return code;
126 }
127
128 /*
129 *----------------------------------------------------------------------
130 *
131 * Tcl_UnlinkVar --
132 *
133 * Destroy the link between a Tcl variable and a C variable.
134 *
135 * Results:
136 * None.
137 *
138 * Side effects:
139 * If "varName" was previously linked to a C variable, the link
140 * is broken to make the variable independent. If there was no
141 * previous link for "varName" then nothing happens.
142 *
143 *----------------------------------------------------------------------
144 */
145
146 void
Tcl_UnlinkVar(interp,varName)147 Tcl_UnlinkVar(interp, varName)
148 Tcl_Interp *interp; /* Interpreter containing variable to unlink. */
149 char *varName; /* Global variable in interp to unlink. */
150 {
151 Link *linkPtr;
152
153 linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
154 LinkTraceProc, (ClientData) NULL);
155 if (linkPtr == NULL) {
156 return;
157 }
158 Tcl_UntraceVar(interp, varName,
159 TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
160 LinkTraceProc, (ClientData) linkPtr);
161 ckfree(linkPtr->varName);
162 ckfree((char *) linkPtr);
163 }
164
165 /*
166 *----------------------------------------------------------------------
167 *
168 * Tcl_UpdateLinkedVar --
169 *
170 * This procedure is invoked after a linked variable has been
171 * changed by C code. It updates the Tcl variable so that
172 * traces on the variable will trigger.
173 *
174 * Results:
175 * None.
176 *
177 * Side effects:
178 * The Tcl variable "varName" is updated from its C value,
179 * causing traces on the variable to trigger.
180 *
181 *----------------------------------------------------------------------
182 */
183
184 void
Tcl_UpdateLinkedVar(interp,varName)185 Tcl_UpdateLinkedVar(interp, varName)
186 Tcl_Interp *interp; /* Interpreter containing variable. */
187 char *varName; /* Name of global variable that is linked. */
188 {
189 Link *linkPtr;
190 char buffer[TCL_DOUBLE_SPACE];
191 int savedFlag;
192
193 linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
194 LinkTraceProc, (ClientData) NULL);
195 if (linkPtr == NULL) {
196 return;
197 }
198 savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
199 linkPtr->flags |= LINK_BEING_UPDATED;
200 Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
201 TCL_GLOBAL_ONLY);
202 linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
203 }
204
205 /*
206 *----------------------------------------------------------------------
207 *
208 * LinkTraceProc --
209 *
210 * This procedure is invoked when a linked Tcl variable is read,
211 * written, or unset from Tcl. It's responsible for keeping the
212 * C variable in sync with the Tcl variable.
213 *
214 * Results:
215 * If all goes well, NULL is returned; otherwise an error message
216 * is returned.
217 *
218 * Side effects:
219 * The C variable may be updated to make it consistent with the
220 * Tcl variable, or the Tcl variable may be overwritten to reject
221 * a modification.
222 *
223 *----------------------------------------------------------------------
224 */
225
226 static char *
LinkTraceProc(clientData,interp,name1,name2,flags)227 LinkTraceProc(clientData, interp, name1, name2, flags)
228 ClientData clientData; /* Contains information about the link. */
229 Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
230 char *name1; /* First part of variable name. */
231 char *name2; /* Second part of variable name. */
232 int flags; /* Miscellaneous additional information. */
233 {
234 Link *linkPtr = (Link *) clientData;
235 int changed;
236 char buffer[TCL_DOUBLE_SPACE];
237 char *value, **pp;
238 Tcl_DString savedResult;
239
240 /*
241 * If the variable is being unset, then just re-create it (with a
242 * trace) unless the whole interpreter is going away.
243 */
244
245 if (flags & TCL_TRACE_UNSETS) {
246 if (flags & TCL_INTERP_DESTROYED) {
247 ckfree(linkPtr->varName);
248 ckfree((char *) linkPtr);
249 } else if (flags & TCL_TRACE_DESTROYED) {
250 Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
251 TCL_GLOBAL_ONLY);
252 Tcl_TraceVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY
253 |TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
254 LinkTraceProc, (ClientData) linkPtr);
255 }
256 return NULL;
257 }
258
259 /*
260 * If we were invoked because of a call to Tcl_UpdateLinkedVar, then
261 * don't do anything at all. In particular, we don't want to get
262 * upset that the variable is being modified, even if it is
263 * supposed to be read-only.
264 */
265
266 if (linkPtr->flags & LINK_BEING_UPDATED) {
267 return NULL;
268 }
269
270 /*
271 * For read accesses, update the Tcl variable if the C variable
272 * has changed since the last time we updated the Tcl variable.
273 */
274
275 if (flags & TCL_TRACE_READS) {
276 switch (linkPtr->type) {
277 case TCL_LINK_INT:
278 case TCL_LINK_BOOLEAN:
279 changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
280 break;
281 case TCL_LINK_DOUBLE:
282 changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
283 break;
284 case TCL_LINK_STRING:
285 changed = 1;
286 break;
287 default:
288 return "internal error: bad linked variable type";
289 }
290 if (changed) {
291 Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
292 TCL_GLOBAL_ONLY);
293 }
294 return NULL;
295 }
296
297 /*
298 * For writes, first make sure that the variable is writable. Then
299 * convert the Tcl value to C if possible. If the variable isn't
300 * writable or can't be converted, then restore the varaible's old
301 * value and return an error. Another tricky thing: we have to save
302 * and restore the interpreter's result, since the variable access
303 * could occur when the result has been partially set.
304 */
305
306 if (linkPtr->flags & LINK_READ_ONLY) {
307 Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
308 TCL_GLOBAL_ONLY);
309 return "linked variable is read-only";
310 }
311 value = Tcl_GetVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY);
312 if (value == NULL) {
313 /*
314 * This shouldn't ever happen.
315 */
316 return "internal error: linked variable couldn't be read";
317 }
318 Tcl_DStringInit(&savedResult);
319 Tcl_DStringAppend(&savedResult, interp->result, -1);
320 Tcl_ResetResult(interp);
321 switch (linkPtr->type) {
322 case TCL_LINK_INT:
323 if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
324 Tcl_DStringResult(interp, &savedResult);
325 Tcl_SetVar(interp, linkPtr->varName,
326 StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
327 return "variable must have integer value";
328 }
329 *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
330 break;
331 case TCL_LINK_DOUBLE:
332 if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d)
333 != TCL_OK) {
334 Tcl_DStringResult(interp, &savedResult);
335 Tcl_SetVar(interp, linkPtr->varName,
336 StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
337 return "variable must have real value";
338 }
339 *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
340 break;
341 case TCL_LINK_BOOLEAN:
342 if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i)
343 != TCL_OK) {
344 Tcl_DStringResult(interp, &savedResult);
345 Tcl_SetVar(interp, linkPtr->varName,
346 StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
347 return "variable must have boolean value";
348 }
349 *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
350 break;
351 case TCL_LINK_STRING:
352 pp = (char **)(linkPtr->addr);
353 if (*pp != NULL) {
354 ckfree(*pp);
355 }
356 *pp = (char *) ckalloc((unsigned) (strlen(value) + 1));
357 strcpy(*pp, value);
358 break;
359 default:
360 return "internal error: bad linked variable type";
361 }
362 Tcl_DStringResult(interp, &savedResult);
363 return NULL;
364 }
365
366 /*
367 *----------------------------------------------------------------------
368 *
369 * StringValue --
370 *
371 * Converts the value of a C variable to a string for use in a
372 * Tcl variable to which it is linked.
373 *
374 * Results:
375 * The return value is a pointer
376 to a string that represents
377 * the value of the C variable given by linkPtr.
378 *
379 * Side effects:
380 * None.
381 *
382 *----------------------------------------------------------------------
383 */
384
385 static char *
StringValue(linkPtr,buffer)386 StringValue(linkPtr, buffer)
387 Link *linkPtr; /* Structure describing linked variable. */
388 char *buffer; /* Small buffer to use for converting
389 * values. Must have TCL_DOUBLE_SPACE
390 * bytes or more. */
391 {
392 char *p;
393
394 switch (linkPtr->type) {
395 case TCL_LINK_INT:
396 linkPtr->lastValue.i = *(int *)(linkPtr->addr);
397 sprintf(buffer, "%d", linkPtr->lastValue.i);
398 return buffer;
399 case TCL_LINK_DOUBLE:
400 linkPtr->lastValue.d = *(double *)(linkPtr->addr);
401 Tcl_PrintDouble(linkPtr->interp, linkPtr->lastValue.d, buffer);
402 return buffer;
403 case TCL_LINK_BOOLEAN:
404 linkPtr->lastValue.i = *(int *)(linkPtr->addr);
405 if (linkPtr->lastValue.i != 0) {
406 return "1";
407 }
408 return "0";
409 case TCL_LINK_STRING:
410 p = *(char **)(linkPtr->addr);
411 if (p == NULL) {
412 return "NULL";
413 }
414 return p;
415 }
416
417 /*
418 * This code only gets executed if the link type is unknown
419 * (shouldn't ever happen).
420 */
421
422 return "??";
423 }
424