1 
2 /*
3  * bltArrayObj.c --
4  *
5  * Copyright 2000 Silicon Metrics, Inc.
6  *
7  * Permission to use, copy, modify, and distribute this software and
8  * its documentation for any purpose and without fee is hereby
9  * granted, provided that the above copyright notice appear in all
10  * copies and that both that the copyright notice and warranty
11  * disclaimer appear in supporting documentation, and that the names
12  * of Lucent Technologies or any of their entities not be used in
13  * advertising or publicity pertaining to distribution of the software
14  * without specific, written prior permission.
15  *
16  * Lucent Technologies disclaims all warranties with regard to this
17  * software, including all implied warranties of merchantability and
18  * fitness.  In no event shall Lucent Technologies be liable for any
19  * special, indirect or consequential damages or any damages
20  * whatsoever resulting from loss of use, data or profits, whether in
21  * an action of contract, negligence or other tortuous action, arising
22  * out of or in connection with the use or performance of this
23  * software.
24  *
25  *	The array Tcl object was created by George A. Howlett.
26  */
27 
28 #include "bltInt.h"
29 
30 #ifndef NO_ARRAY
31 #include "bltHash.h"
32 
33 static Tcl_DupInternalRepProc DupArrayInternalRep;
34 static Tcl_FreeInternalRepProc FreeArrayInternalRep;
35 static Tcl_UpdateStringProc UpdateStringOfArray;
36 static Tcl_SetFromAnyProc SetArrayFromAny;
37 
38 static Tcl_ObjType arrayObjType = {
39     "array",
40     FreeArrayInternalRep,	/* Called when an object is freed. */
41     DupArrayInternalRep,	/* Copies an internal representation
42 				 * from one object to another. */
43     UpdateStringOfArray,	/* Creates string representation from
44 				 * an object's internal representation. */
45     SetArrayFromAny,		/* Creates valid internal representation
46 				 * from an object's string representation. */
47 };
48 
49 #if 1
50 static int
SetArrayFromAny(interp,objPtr)51 SetArrayFromAny(interp, objPtr)
52     Tcl_Interp *interp;
53     Tcl_Obj *objPtr;
54 {
55     Blt_HashEntry *hPtr;
56     Blt_HashTable *tablePtr;
57     Tcl_Obj *elemObjPtr, **vobjv;
58     Tcl_ObjType *oldTypePtr;
59     char *string;
60     int isNew;
61     int nElem;
62     register int i;
63 
64     if (objPtr->typePtr == &arrayObjType) {
65 	return TCL_OK;
66     }
67     if (Tcl_ListObjGetElements(interp, objPtr, &nElem, &vobjv) != TCL_OK) {
68         return TCL_ERROR;
69     }
70     if (nElem%2) {
71         if (interp != NULL) {
72             Tcl_AppendResult(interp, "odd length: ", string, 0);
73         }
74         return TCL_ERROR;
75     }
76     tablePtr = Blt_Malloc(sizeof(Blt_HashTable));
77     assert(tablePtr);
78     Blt_InitHashTable(tablePtr, BLT_STRING_KEYS);
79     for (i = 0; i < nElem; i += 2) {
80 	hPtr = Blt_CreateHashEntry(tablePtr, Tcl_GetString(vobjv[i]), &isNew);
81 	elemObjPtr = vobjv[i + 1];
82 	Blt_SetHashValue(hPtr, elemObjPtr);
83 
84 	/* Make sure we increment the reference count */
85 	Tcl_IncrRefCount(elemObjPtr);
86     }
87 
88     oldTypePtr = objPtr->typePtr;
89     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
90         oldTypePtr->freeIntRepProc(objPtr);
91     }
92     objPtr->internalRep.otherValuePtr = (VOID *)tablePtr;
93     objPtr->typePtr = &arrayObjType;
94 
95     return TCL_OK;
96 }
97 #else
98 static int
SetArrayFromAny(interp,objPtr)99 SetArrayFromAny(interp, objPtr)
100     Tcl_Interp *interp;
101     Tcl_Obj *objPtr;
102 {
103     Blt_HashEntry *hPtr;
104     Blt_HashTable *tablePtr;
105     Tcl_Obj *elemObjPtr;
106     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
107     char **elemArr;
108     char *string;
109     int isNew;
110     int nElem;
111     register int i;
112 
113     if (objPtr->typePtr == &arrayObjType) {
114 	return TCL_OK;
115     }
116     /*
117      * Get the string representation. Make it up-to-date if necessary.
118      */
119     string = Tcl_GetString(objPtr);
120     if (Tcl_SplitList(interp, string, &nElem, &elemArr) != TCL_OK) {
121 	return TCL_ERROR;
122     }
123     if (nElem%2) {
124         if (interp != NULL) {
125             Tcl_AppendResult(interp, "odd length: ", string, 0);
126         }
127         Blt_Free(elemArr);
128         return TCL_ERROR;
129     }
130     tablePtr = Blt_Malloc(sizeof(Blt_HashTable));
131     assert(tablePtr);
132     Blt_InitHashTable(tablePtr, BLT_STRING_KEYS);
133     for (i = 0; i < nElem; i += 2) {
134 	hPtr = Blt_CreateHashEntry(tablePtr, elemArr[i], &isNew);
135 	elemObjPtr = Tcl_NewStringObj(elemArr[i + 1], -1);
136 	Blt_SetHashValue(hPtr, elemObjPtr);
137 
138 	/* Make sure we increment the reference count */
139 	Tcl_IncrRefCount(elemObjPtr);
140     }
141 
142     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
143 	oldTypePtr->freeIntRepProc(objPtr);
144     }
145     objPtr->internalRep.otherValuePtr = (VOID *)tablePtr;
146     objPtr->typePtr = &arrayObjType;
147     Blt_Free(elemArr);
148 
149     return TCL_OK;
150 }
151 #endif
152 
153 static void
DupArrayInternalRep(srcPtr,destPtr)154 DupArrayInternalRep(srcPtr, destPtr)
155     Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
156     Tcl_Obj *destPtr;		/* Object with internal rep to set. */
157 {
158     Blt_HashEntry *hPtr, *h2Ptr;
159     Blt_HashSearch cursor;
160     Blt_HashTable *srcTablePtr, *destTablePtr;
161     Tcl_Obj *valueObjPtr;
162     char *key;
163     int isNew;
164 
165     srcTablePtr = (Blt_HashTable *)srcPtr->internalRep.otherValuePtr;
166     destTablePtr = Blt_Malloc(sizeof(Blt_HashTable));
167     assert(destTablePtr);
168     Blt_InitHashTable(destTablePtr, BLT_STRING_KEYS);
169     for (hPtr = Blt_FirstHashEntry(srcTablePtr, &cursor); hPtr != NULL;
170 	 hPtr = Blt_NextHashEntry(&cursor)) {
171 	key = Blt_GetHashKey(srcTablePtr, hPtr);
172 	h2Ptr = Blt_CreateHashEntry(destTablePtr, key, &isNew);
173 	valueObjPtr = (Tcl_Obj *)Blt_GetHashValue(hPtr);
174         assert (valueObjPtr != NULL);
175 	Blt_SetHashValue(h2Ptr, valueObjPtr );
176 
177 	/* Make sure we increment the reference count now that both
178 	 * array objects are using the same elements. */
179 	Tcl_IncrRefCount(valueObjPtr);
180     }
181     Tcl_InvalidateStringRep(destPtr);
182     destPtr->internalRep.otherValuePtr = (VOID *)destTablePtr;
183     destPtr->typePtr = &arrayObjType;
184 }
185 
186 static void
UpdateStringOfArray(objPtr)187 UpdateStringOfArray(objPtr)
188     Tcl_Obj *objPtr;		/* Array object whose string rep to update. */
189 {
190     Tcl_DString dString;
191     Blt_HashTable *tablePtr;
192     Blt_HashEntry *hPtr;
193     Blt_HashSearch cursor;
194     Tcl_Obj *elemObjPtr;
195 
196     tablePtr = (Blt_HashTable *)objPtr->internalRep.otherValuePtr;
197     Tcl_DStringInit(&dString);
198     for (hPtr = Blt_FirstHashEntry(tablePtr, &cursor); hPtr != NULL;
199 	 hPtr = Blt_NextHashEntry(&cursor)) {
200 	elemObjPtr = (Tcl_Obj *)Blt_GetHashValue(hPtr);
201 	Tcl_DStringAppendElement(&dString, Blt_GetHashKey(tablePtr, hPtr));
202 	Tcl_DStringAppendElement(&dString, elemObjPtr == NULL?"":Tcl_GetString(elemObjPtr));
203     }
204     objPtr->bytes = Blt_Strdup(Tcl_DStringValue(&dString));
205     objPtr->length = strlen(Tcl_DStringValue(&dString));
206     Tcl_DStringFree(&dString);
207 }
208 
209 static void
FreeArrayInternalRep(objPtr)210 FreeArrayInternalRep(objPtr)
211     Tcl_Obj *objPtr;		/* Array object to release. */
212 {
213     Blt_HashEntry *hPtr;
214     Blt_HashSearch cursor;
215     Blt_HashTable *tablePtr;
216     Tcl_Obj *elemObjPtr;
217 
218     Tcl_InvalidateStringRep(objPtr);
219     tablePtr = (Blt_HashTable *)objPtr->internalRep.otherValuePtr;
220     for (hPtr = Blt_FirstHashEntry(tablePtr, &cursor); hPtr != NULL;
221 	 hPtr = Blt_NextHashEntry(&cursor)) {
222 	elemObjPtr = (Tcl_Obj *)Blt_GetHashValue(hPtr);
223 	Tcl_DecrRefCount(elemObjPtr);
224     }
225     Blt_DeleteHashTable(tablePtr);
226     Blt_Free(tablePtr);
227 }
228 
229 int
Blt_GetArrayFromObj(interp,objPtr,tablePtrPtr)230 Blt_GetArrayFromObj(interp, objPtr, tablePtrPtr)
231     Tcl_Interp *interp;
232     Tcl_Obj *objPtr;
233     Blt_HashTable **tablePtrPtr;
234 {
235     if (objPtr->typePtr == &arrayObjType) {
236 	*tablePtrPtr = (Blt_HashTable *)objPtr->internalRep.otherValuePtr;
237 	return TCL_OK;
238     }
239     if (SetArrayFromAny(interp, objPtr) == TCL_OK) {
240 	*tablePtrPtr = (Blt_HashTable *)objPtr->internalRep.otherValuePtr;
241 	return TCL_OK;
242     }
243     return TCL_ERROR;
244 }
245 
246 Tcl_Obj *
Blt_NewArrayObj(objc,objv)247 Blt_NewArrayObj(objc, objv)
248     int objc;
249     Tcl_Obj *objv[];
250 {
251     Blt_HashEntry *hPtr;
252     Blt_HashTable *tablePtr;
253     Tcl_Obj *arrayObjPtr, *objPtr;
254     int isNew;
255     register int i;
256 
257     if (objc % 2) {
258         return NULL;
259     }
260     tablePtr = Blt_Malloc(sizeof(Blt_HashTable));
261     assert(tablePtr);
262     Blt_InitHashTable(tablePtr, BLT_STRING_KEYS);
263 
264     for (i = 0; i < objc; i += 2) {
265 	hPtr = Blt_CreateHashEntry(tablePtr, Tcl_GetString(objv[i]), &isNew);
266 	if ((i + 1) == objc) {
267 	    objPtr = Tcl_NewStringObj("",-1);
268 	} else {
269 	    objPtr = objv[i+1];
270 	}
271 	Tcl_IncrRefCount(objPtr);
272 	if (!isNew) {
273 	    Tcl_Obj *oldObjPtr;
274 
275 	    oldObjPtr = Blt_GetHashValue(hPtr);
276 	    Tcl_DecrRefCount(oldObjPtr);
277 	}
278 	Blt_SetHashValue(hPtr, objPtr);
279     }
280     arrayObjPtr = Tcl_NewObj();
281     /*
282      * Reference counts for entry objects are initialized to 0. They
283      * are incremented as they are inserted into the tree via the
284      * Blt_TreeSetValue call.
285      */
286     arrayObjPtr->refCount = 0;
287     arrayObjPtr->internalRep.otherValuePtr = (VOID *)tablePtr;
288     arrayObjPtr->bytes = NULL;
289     arrayObjPtr->length = 0;
290     arrayObjPtr->typePtr = &arrayObjType;
291     return arrayObjPtr;
292 }
293 
294 int
Blt_IsArrayObj(objPtr)295 Blt_IsArrayObj(objPtr)
296     Tcl_Obj *objPtr;
297 {
298     return (objPtr->typePtr == &arrayObjType);
299 }
300 
301 /*ARGSUSED*/
302 void
Blt_RegisterArrayObj(interp)303 Blt_RegisterArrayObj(interp)
304     Tcl_Interp *interp;		/* Not used. */
305 {
306     Tcl_RegisterObjType(&arrayObjType);
307 }
308 #endif /* NO_ARRAY */
309