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
16static void ot_free_rep   (Tcl_Obj* obj);
17static void ot_dup_rep    (Tcl_Obj* obj, Tcl_Obj* dup);
18static void ot_string_rep (Tcl_Obj* obj);
19static int  ot_from_any   (Tcl_Interp* ip, Tcl_Obj* obj);
20
21static 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/*
30 * = = == === ===== ======== ============= =====================
31 */
32
33int
34rde_ot_intern (Tcl_Obj* obj, RDE_STATE p, char* pfx, char* sfx)
35{
36    int id;
37    RDE_STRING* rs;
38
39    TRACE (("rde_ot_intern (%p, '%s','%s' of %p = '%s')", p, pfx, sfx, obj, Tcl_GetString(obj)));
40
41    /*
42     * Quick exit if we have a cached and valid value.
43     */
44
45    if ((obj->typePtr == &ot_type) &&
46	(obj->internalRep.twoPtrValue.ptr1 == p)) {
47	rs = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2;
48	TRACE (("CACHED %p = %d", rs, rs->id));
49	return rs->id;
50    }
51
52    TRACE (("INTERNALIZE"));
53
54    /*
55     * Drop any previous internal rep.
56     */
57
58    if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) {
59	obj->typePtr->freeIntRepProc(obj);
60    }
61
62    /*
63     * Compute the new int-rep, interning the prefix-modified string.
64     */
65
66    if (!pfx && !sfx) {
67	id = param_intern (p, obj->bytes);
68
69    } else if (pfx && sfx) {
70	int plen  = strlen(pfx);
71	int slen  = strlen(sfx);
72	char* buf = NALLOC (plen + slen + obj->length + 3, char);
73
74	sprintf (buf, "%s %s %s", pfx, obj->bytes, sfx);
75
76	id = param_intern (p, buf);
77	ckfree(buf);
78
79    } else if (pfx) {
80	int plen  = strlen(pfx);
81	char* buf = NALLOC (plen + obj->length + 2, char);
82
83	sprintf (buf, "%s %s", pfx, obj->bytes);
84
85	id = param_intern (p, buf);
86	ckfree(buf);
87
88    } else /* sfx */ {
89	int slen  = strlen(sfx);
90	char* buf = NALLOC (slen + obj->length + 2, char);
91
92	sprintf (buf, "%s %s", obj->bytes, sfx);
93
94	id = param_intern (p, buf);
95	ckfree(buf);
96    }
97
98    rs = ALLOC (RDE_STRING);
99    rs->next = p->sfirst;
100    rs->self = obj;
101    rs->id   = id;
102    p->sfirst = rs;
103
104    obj->internalRep.twoPtrValue.ptr1 = p;
105    obj->internalRep.twoPtrValue.ptr2 = rs;
106    obj->typePtr = &ot_type;
107
108    return id;
109}
110
111/*
112 * = = == === ===== ======== ============= =====================
113 */
114
115static void
116ot_free_rep(Tcl_Obj* obj)
117{
118    RDE_STATE   p  = (RDE_STATE)   obj->internalRep.twoPtrValue.ptr1;
119    RDE_STRING* rs = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2;
120
121    /* Take structure out of the tracking list. */
122    if (p->sfirst == rs) {
123	p->sfirst = rs->next;
124    } else {
125	RDE_STRING* iter = p->sfirst;
126	while (iter->next != rs) {
127	    iter = iter->next;
128	}
129	iter->next = rs->next;
130    }
131
132    /* Nothing to release. */
133    ckfree ((char*) rs);
134    obj->internalRep.twoPtrValue.ptr1 = NULL;
135    obj->internalRep.twoPtrValue.ptr2 = NULL;
136}
137
138static void
139ot_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup)
140{
141    RDE_STRING* ors = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2;
142    RDE_STRING* drs;
143    RDE_STATE   p = ((RDE_STATE) obj->internalRep.twoPtrValue.ptr1);
144
145    drs = ALLOC (RDE_STRING);
146    drs->next = p->sfirst;
147    drs->self = dup;
148    drs->id   = ors->id;
149    p->sfirst = drs;
150
151    dup->internalRep.twoPtrValue.ptr1 = obj->internalRep.twoPtrValue.ptr1;
152    dup->internalRep.twoPtrValue.ptr2 = drs;
153    dup->typePtr = &ot_type;
154}
155
156static void
157ot_string_rep(Tcl_Obj* obj)
158{
159    ASSERT (0, "Attempted reconversion of rde string to string rep");
160}
161
162static int
163ot_from_any(Tcl_Interp* ip, Tcl_Obj* obj)
164{
165    ASSERT (0, "Illegal conversion into rde string");
166    return TCL_ERROR;
167}
168/*
169 * = = == === ===== ======== ============= =====================
170 */
171
172
173/*
174 * Local Variables:
175 * mode: c
176 * c-basic-offset: 4
177 * fill-column: 78
178 * End:
179 */
180