1 /*
2 * = = == === ===== ======== ============= =====================
3 * == pt::rde (critcl) - Data Structures - Tcl_ObjType for interned strings.
4 *
5 */
6
7 #include <ot.h> /* Our public API */
8 #include <util.h> /* Allocation macros */
9 #include <pInt.h> /* API to basic intern(ing) of strings */
10 #include <string.h>
11
12 /*
13 * = = == === ===== ======== ============= =====================
14 */
15
16 static void ot_free_rep (Tcl_Obj* obj);
17 static void ot_dup_rep (Tcl_Obj* obj, Tcl_Obj* dup);
18 static void ot_string_rep (Tcl_Obj* obj);
19 static int ot_from_any (Tcl_Interp* ip, Tcl_Obj* obj);
20
21 static Tcl_ObjType ot_type = {
22 "tcllib/pt::rde/critcl",
23 ot_free_rep,
24 ot_dup_rep,
25 ot_string_rep,
26 ot_from_any
27 };
28
29 static int IsCached (RDE_STATE p, Tcl_Obj* obj, long int* id);
30 static long int Make (RDE_STATE p, Tcl_Obj* obj, const char* str);
31
32
33 /*
34 * = = == === ===== ======== ============= =====================
35 */
36
37 long int
rde_ot_intern0(RDE_STATE p,Tcl_Obj * detail)38 rde_ot_intern0 (RDE_STATE p,
39 Tcl_Obj* detail)
40 {
41 long int id;
42
43 TRACE (("rde_ot_intern0 (%p, %p = '%s')", p, detail, Tcl_GetString(detail)));
44 if (IsCached (p, detail, &id)) {
45 return id;
46 }
47
48 TRACE (("INTERNALIZE"));
49 return Make (p, detail, Tcl_GetString (detail));
50 }
51
52 long int
rde_ot_intern1(RDE_STATE p,const char * operator,Tcl_Obj * detail)53 rde_ot_intern1 (RDE_STATE p,
54 const char* operator,
55 Tcl_Obj* detail)
56 {
57 long int id;
58 Tcl_DString buf;
59
60 TRACE (("rde_ot_intern1 (%p, '%s' %p = '%s')", p, operator, detail, Tcl_GetString(detail)));
61 if (IsCached (p, detail, &id)) {
62 return id;
63 }
64
65 TRACE (("INTERNALIZE"));
66
67 /* Create a list of operator + detail.
68 * Using a DString.
69 */
70
71 Tcl_DStringInit (&buf);
72 Tcl_DStringAppendElement (&buf, operator);
73 Tcl_DStringAppendElement (&buf, Tcl_GetString (detail));
74
75 id = Make (p, detail, Tcl_DStringValue (&buf));
76
77 Tcl_DStringFree (&buf);
78 return id;
79 }
80
81 long int
rde_ot_intern2(RDE_STATE p,const char * operator,Tcl_Obj * detail1,Tcl_Obj * detail2)82 rde_ot_intern2 (RDE_STATE p,
83 const char* operator,
84 Tcl_Obj* detail1,
85 Tcl_Obj* detail2)
86 {
87 long int id;
88 Tcl_DString buf;
89
90 TRACE (("rde_ot_intern2 (%p, '%s' %p = '%s', %p = '%s')", p, operator,
91 detail1, Tcl_GetString(detail1)
92 detail2, Tcl_GetString(detail2)));
93 if (IsCached (p, detail1, &id)) {
94 return id;
95 }
96
97 TRACE (("INTERNALIZE"));
98
99 /* Create a list of operator + detail1 + detail2.
100 * Using a DString.
101 */
102
103 Tcl_DStringInit (&buf);
104 Tcl_DStringAppendElement (&buf, operator);
105 Tcl_DStringAppendElement (&buf, Tcl_GetString (detail1));
106 Tcl_DStringAppendElement (&buf, Tcl_GetString (detail2));
107
108 id = Make (p, detail1, Tcl_DStringValue (&buf));
109
110 Tcl_DStringFree (&buf);
111 return id;
112 }
113
114 /*
115 * = = == === ===== ======== ============= =====================
116 */
117
118 static int
IsCached(RDE_STATE p,Tcl_Obj * obj,long int * id)119 IsCached (RDE_STATE p, Tcl_Obj* obj, long int* id)
120 {
121 /*
122 * Quick exit if we have a cached and valid value.
123 */
124
125 if ((obj->typePtr == &ot_type) &&
126 (obj->internalRep.twoPtrValue.ptr1 == p)) {
127 RDE_STRING* rs = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2;
128 TRACE (("CACHED %p = %d", rs, rs->id));
129 *id = rs->id;
130 return 1;
131 }
132
133 return 0;
134 }
135
136 static long int
Make(RDE_STATE p,Tcl_Obj * obj,const char * str)137 Make (RDE_STATE p, Tcl_Obj* obj, const char* str)
138 {
139 long int id = param_intern (p, str);
140 RDE_STRING* rs = ALLOC (RDE_STRING);
141
142 rs->next = p->sfirst;
143 rs->self = obj;
144 rs->id = id;
145 p->sfirst = rs;
146
147 /* Invalidate previous int.rep before setting our own.
148 * Inlined copy of TclFreeIntRep() macro (tclInt.h)
149 */
150
151 if ((obj)->typePtr &&
152 (obj)->typePtr->freeIntRepProc) {
153 (obj)->typePtr->freeIntRepProc(obj);
154 }
155
156 obj->internalRep.twoPtrValue.ptr1 = p;
157 obj->internalRep.twoPtrValue.ptr2 = rs;
158 obj->typePtr = &ot_type;
159
160 return id;
161 }
162
163 /*
164 * = = == === ===== ======== ============= =====================
165 */
166
167 static void
ot_free_rep(Tcl_Obj * obj)168 ot_free_rep(Tcl_Obj* obj)
169 {
170 RDE_STATE p = (RDE_STATE) obj->internalRep.twoPtrValue.ptr1;
171 RDE_STRING* rs = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2;
172
173 /* Take structure out of the tracking list. */
174 if (p->sfirst == rs) {
175 p->sfirst = rs->next;
176 } else {
177 RDE_STRING* iter = p->sfirst;
178 while (iter->next != rs) {
179 iter = iter->next;
180 }
181 iter->next = rs->next;
182 }
183
184 /* Drop the now un-tracked structure */
185 ckfree ((char*) rs);
186
187 /* Nothing to release in the obj itself, just resetting references. */
188 obj->internalRep.twoPtrValue.ptr1 = NULL;
189 obj->internalRep.twoPtrValue.ptr2 = NULL;
190 }
191
192 static void
ot_dup_rep(Tcl_Obj * obj,Tcl_Obj * dup)193 ot_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup)
194 {
195 RDE_STRING* ors = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2;
196 RDE_STRING* drs;
197 RDE_STATE p = ((RDE_STATE) obj->internalRep.twoPtrValue.ptr1);
198
199 drs = ALLOC (RDE_STRING);
200 drs->next = p->sfirst;
201 drs->self = dup;
202 drs->id = ors->id;
203 p->sfirst = drs;
204
205 dup->internalRep.twoPtrValue.ptr1 = obj->internalRep.twoPtrValue.ptr1;
206 dup->internalRep.twoPtrValue.ptr2 = drs;
207 dup->typePtr = &ot_type;
208 }
209
210 static void
ot_string_rep(Tcl_Obj * obj)211 ot_string_rep(Tcl_Obj* obj)
212 {
213 (void) obj;
214 ASSERT (0, "Attempted reconversion of rde string to string rep");
215 }
216
217 static int
ot_from_any(Tcl_Interp * ip,Tcl_Obj * obj)218 ot_from_any(Tcl_Interp* ip, Tcl_Obj* obj)
219 {
220 (void) ip;
221 (void) obj;
222 ASSERT (0, "Illegal conversion into rde string");
223 return TCL_ERROR;
224 }
225 /*
226 * = = == === ===== ======== ============= =====================
227 */
228
229
230 /*
231 * Local Variables:
232 * mode: c
233 * c-basic-offset: 4
234 * fill-column: 78
235 * End:
236 */
237