1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
/* struct::tree - critcl - layer 1 definitions.
* (b) Node operations.
* Tcl_ObjType for nodes, and shimmering to it.
*/
#include <string.h>
#include <tn.h>
/* .................................................. */
static void free_rep (Tcl_Obj* obj);
static void dup_rep (Tcl_Obj* obj, Tcl_Obj* dup);
static void string_rep (Tcl_Obj* obj);
static int from_any (Tcl_Interp* ip, Tcl_Obj* obj);
static
Tcl_ObjType tn_type = {
"tcllib::struct::tree/critcl::node",
free_rep,
dup_rep,
string_rep,
from_any
};
/* .................................................. */
static void
free_rep (Tcl_Obj* obj)
{
/* Nothing to do. The rep is the TN in the T. */
}
static void
dup_rep (Tcl_Obj* obj, Tcl_Obj* dup)
{
TNPtr n = (TNPtr) obj->internalRep.otherValuePtr;
dup->internalRep.otherValuePtr = n;
dup->typePtr = &tn_type;
}
static void
string_rep (Tcl_Obj* obj)
{
Tcl_Obj* temp;
char* str;
TNPtr n = (TNPtr) obj->internalRep.otherValuePtr;
obj->length = n->name->length;
obj->bytes = ckalloc (obj->length + 1);
memcpy (obj->bytes, n->name->bytes, obj->length + 1);
}
static int
from_any (Tcl_Interp* ip, Tcl_Obj* obj)
{
Tcl_Panic ("Cannot create TDN structure via regular shimmering.");
return TCL_ERROR;
}
/* .................................................. */
void
tn_shimmer (Tcl_Obj* o, TNPtr n)
{
/* Release an existing representation */
if (o->typePtr && o->typePtr->freeIntRepProc) {
o->typePtr->freeIntRepProc (o);
}
o->typePtr = &tn_type;
o->internalRep.otherValuePtr = n;
}
/* .................................................. */
TNPtr
tn_get_node (TPtr t, Tcl_Obj* node, Tcl_Interp* interp, Tcl_Obj* tree)
{
TN* n = NULL;
Tcl_HashEntry* he;
/* Check if we have a valid cached int.rep. */
#if 0
/* [x] TODO */
/* Caching of handles implies that the trees have to */
/* keep track of the tcl_obj pointing to them. So that */
/* the int.rep can be invalidated upon tree deletion */
if (node->typePtr == &tn_type) {
n = (TN*) node->internalRep.otherValuePtr;
if (n->tree == t) {
#if 0
fprintf (stderr, "cached: %p (%p - %p)\n", n, t, n->tree);
fflush(stderr);
#endif
return n;
}
}
#endif
/* Incompatible int.rep, or refering to a different
* tree. We go through the hash table.
*/
he = Tcl_FindHashEntry (&t->node, Tcl_GetString (node));
if (he != NULL) {
n = (TN*) Tcl_GetHashValue (he);
/* Shimmer the object, cache the node information.
*/
tn_shimmer (node, n);
return n;
}
/* Node handle not found. Leave an error message,
* if possible.
*/
if (interp != NULL) {
Tcl_Obj* err = Tcl_NewObj ();
/* Keep any prefix ... */
Tcl_AppendObjToObj (err, Tcl_GetObjResult (interp));
Tcl_AppendToObj (err, "node \"", TCL_AUTO_LENGTH); /* OK tcl9 */
Tcl_AppendObjToObj (err, node);
Tcl_AppendToObj (err, "\" does not exist in tree \"", TCL_AUTO_LENGTH); /* OK tcl9 */
Tcl_AppendObjToObj (err, tree);
Tcl_AppendToObj (err, "\"", TCL_AUTO_LENGTH); /* OK tcl9 */
Tcl_SetObjResult (interp, err);
}
return NULL;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
