[175] | 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 | static int
|
---|
| 50 | SetArrayFromAny(interp, objPtr)
|
---|
| 51 | Tcl_Interp *interp;
|
---|
| 52 | Tcl_Obj *objPtr;
|
---|
| 53 | {
|
---|
| 54 | Blt_HashEntry *hPtr;
|
---|
| 55 | Blt_HashTable *tablePtr;
|
---|
| 56 | Tcl_Obj *elemObjPtr;
|
---|
| 57 | Tcl_ObjType *oldTypePtr = objPtr->typePtr;
|
---|
| 58 | char **elemArr;
|
---|
| 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 | /*
|
---|
| 68 | * Get the string representation. Make it up-to-date if necessary.
|
---|
| 69 | */
|
---|
| 70 | string = Tcl_GetString(objPtr);
|
---|
| 71 | if (Tcl_SplitList(interp, string, &nElem, &elemArr) != TCL_OK) {
|
---|
| 72 | return TCL_ERROR;
|
---|
| 73 | }
|
---|
| 74 | tablePtr = Blt_Malloc(sizeof(Blt_HashTable));
|
---|
| 75 | assert(tablePtr);
|
---|
| 76 | Blt_InitHashTable(tablePtr, BLT_STRING_KEYS);
|
---|
| 77 | for (i = 0; i < nElem; i += 2) {
|
---|
| 78 | hPtr = Blt_CreateHashEntry(tablePtr, elemArr[i], &isNew);
|
---|
| 79 | elemObjPtr = Tcl_NewStringObj(elemArr[i + 1], -1);
|
---|
| 80 | Blt_SetHashValue(hPtr, elemObjPtr);
|
---|
| 81 |
|
---|
| 82 | /* Make sure we increment the reference count */
|
---|
| 83 | Tcl_IncrRefCount(elemObjPtr);
|
---|
| 84 | }
|
---|
| 85 |
|
---|
| 86 | if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
|
---|
| 87 | oldTypePtr->freeIntRepProc(objPtr);
|
---|
| 88 | }
|
---|
| 89 | objPtr->internalRep.otherValuePtr = (VOID *)tablePtr;
|
---|
| 90 | objPtr->typePtr = &arrayObjType;
|
---|
| 91 | Blt_Free(elemArr);
|
---|
| 92 |
|
---|
| 93 | return TCL_OK;
|
---|
| 94 | }
|
---|
| 95 |
|
---|
| 96 | static void
|
---|
| 97 | DupArrayInternalRep(srcPtr, destPtr)
|
---|
| 98 | Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
|
---|
| 99 | Tcl_Obj *destPtr; /* Object with internal rep to set. */
|
---|
| 100 | {
|
---|
| 101 | Blt_HashEntry *hPtr;
|
---|
| 102 | Blt_HashSearch cursor;
|
---|
| 103 | Blt_HashTable *srcTablePtr, *destTablePtr;
|
---|
| 104 | Tcl_Obj *valueObjPtr;
|
---|
| 105 | char *key;
|
---|
| 106 | int isNew;
|
---|
| 107 |
|
---|
| 108 | srcTablePtr = (Blt_HashTable *)srcPtr->internalRep.otherValuePtr;
|
---|
| 109 | destTablePtr = Blt_Malloc(sizeof(Blt_HashTable));
|
---|
| 110 | assert(destTablePtr);
|
---|
| 111 | Blt_InitHashTable(destTablePtr, BLT_STRING_KEYS);
|
---|
| 112 | for (hPtr = Blt_FirstHashEntry(srcTablePtr, &cursor); hPtr != NULL;
|
---|
| 113 | hPtr = Blt_NextHashEntry(&cursor)) {
|
---|
| 114 | key = Blt_GetHashKey(srcTablePtr, hPtr);
|
---|
| 115 | Blt_CreateHashEntry(destTablePtr, key, &isNew);
|
---|
| 116 | valueObjPtr = (Tcl_Obj *)Blt_GetHashValue(hPtr);
|
---|
| 117 | Blt_SetHashValue(hPtr, valueObjPtr);
|
---|
| 118 |
|
---|
| 119 | /* Make sure we increment the reference count now that both
|
---|
| 120 | * array objects are using the same elements. */
|
---|
| 121 | Tcl_IncrRefCount(valueObjPtr);
|
---|
| 122 | }
|
---|
| 123 | Tcl_InvalidateStringRep(destPtr);
|
---|
| 124 | destPtr->internalRep.otherValuePtr = (VOID *)destTablePtr;
|
---|
| 125 | destPtr->typePtr = &arrayObjType;
|
---|
| 126 | }
|
---|
| 127 |
|
---|
| 128 | static void
|
---|
| 129 | UpdateStringOfArray(objPtr)
|
---|
| 130 | Tcl_Obj *objPtr; /* Array object whose string rep to update. */
|
---|
| 131 | {
|
---|
| 132 | Tcl_DString dString;
|
---|
| 133 | Blt_HashTable *tablePtr;
|
---|
| 134 | Blt_HashEntry *hPtr;
|
---|
| 135 | Blt_HashSearch cursor;
|
---|
| 136 | Tcl_Obj *elemObjPtr;
|
---|
| 137 |
|
---|
| 138 | tablePtr = (Blt_HashTable *)objPtr->internalRep.otherValuePtr;
|
---|
| 139 | Tcl_DStringInit(&dString);
|
---|
| 140 | for (hPtr = Blt_FirstHashEntry(tablePtr, &cursor); hPtr != NULL;
|
---|
| 141 | hPtr = Blt_NextHashEntry(&cursor)) {
|
---|
| 142 | elemObjPtr = (Tcl_Obj *)Blt_GetHashValue(hPtr);
|
---|
| 143 | Tcl_DStringAppendElement(&dString, Blt_GetHashKey(tablePtr, hPtr));
|
---|
| 144 | Tcl_DStringAppendElement(&dString, Tcl_GetString(elemObjPtr));
|
---|
| 145 | }
|
---|
| 146 | objPtr->bytes = Blt_Strdup(Tcl_DStringValue(&dString));
|
---|
| 147 | objPtr->length = strlen(Tcl_DStringValue(&dString));
|
---|
| 148 | Tcl_DStringFree(&dString);
|
---|
| 149 | }
|
---|
| 150 |
|
---|
| 151 | static void
|
---|
| 152 | FreeArrayInternalRep(objPtr)
|
---|
| 153 | Tcl_Obj *objPtr; /* Array object to release. */
|
---|
| 154 | {
|
---|
| 155 | Blt_HashEntry *hPtr;
|
---|
| 156 | Blt_HashSearch cursor;
|
---|
| 157 | Blt_HashTable *tablePtr;
|
---|
| 158 | Tcl_Obj *elemObjPtr;
|
---|
| 159 |
|
---|
| 160 | Tcl_InvalidateStringRep(objPtr);
|
---|
| 161 | tablePtr = (Blt_HashTable *)objPtr->internalRep.otherValuePtr;
|
---|
| 162 | for (hPtr = Blt_FirstHashEntry(tablePtr, &cursor); hPtr != NULL;
|
---|
| 163 | hPtr = Blt_NextHashEntry(&cursor)) {
|
---|
| 164 | elemObjPtr = (Tcl_Obj *)Blt_GetHashValue(hPtr);
|
---|
| 165 | Tcl_DecrRefCount(elemObjPtr);
|
---|
| 166 | }
|
---|
| 167 | Blt_DeleteHashTable(tablePtr);
|
---|
| 168 | Blt_Free(tablePtr);
|
---|
| 169 | }
|
---|
| 170 |
|
---|
| 171 | int
|
---|
| 172 | Blt_GetArrayFromObj(interp, objPtr, tablePtrPtr)
|
---|
| 173 | Tcl_Interp *interp;
|
---|
| 174 | Tcl_Obj *objPtr;
|
---|
| 175 | Blt_HashTable **tablePtrPtr;
|
---|
| 176 | {
|
---|
| 177 | if (objPtr->typePtr == &arrayObjType) {
|
---|
| 178 | *tablePtrPtr = (Blt_HashTable *)objPtr->internalRep.otherValuePtr;
|
---|
| 179 | return TCL_OK;
|
---|
| 180 | }
|
---|
| 181 | if (SetArrayFromAny(interp, objPtr) == TCL_OK) {
|
---|
| 182 | *tablePtrPtr = (Blt_HashTable *)objPtr->internalRep.otherValuePtr;
|
---|
| 183 | return TCL_OK;
|
---|
| 184 | }
|
---|
| 185 | return TCL_ERROR;
|
---|
| 186 | }
|
---|
| 187 |
|
---|
| 188 | Tcl_Obj *
|
---|
| 189 | Blt_NewArrayObj(objc, objv)
|
---|
| 190 | int objc;
|
---|
| 191 | Tcl_Obj *objv[];
|
---|
| 192 | {
|
---|
| 193 | Blt_HashEntry *hPtr;
|
---|
| 194 | Blt_HashTable *tablePtr;
|
---|
| 195 | Tcl_Obj *arrayObjPtr, *objPtr;
|
---|
| 196 | int isNew;
|
---|
| 197 | register int i;
|
---|
| 198 |
|
---|
| 199 | tablePtr = Blt_Malloc(sizeof(Blt_HashTable));
|
---|
| 200 | assert(tablePtr);
|
---|
| 201 | Blt_InitHashTable(tablePtr, BLT_STRING_KEYS);
|
---|
| 202 |
|
---|
| 203 | for (i = 0; i < objc; i += 2) {
|
---|
| 204 | hPtr = Blt_CreateHashEntry(tablePtr, Tcl_GetString(objv[i]), &isNew);
|
---|
| 205 | if ((i + 1) == objc) {
|
---|
| 206 | objPtr = bltEmptyStringObjPtr;
|
---|
| 207 | } else {
|
---|
| 208 | objPtr = objv[i+1];
|
---|
| 209 | }
|
---|
| 210 | Tcl_IncrRefCount(objPtr);
|
---|
| 211 | if (!isNew) {
|
---|
| 212 | Tcl_Obj *oldObjPtr;
|
---|
| 213 |
|
---|
| 214 | oldObjPtr = Blt_GetHashValue(hPtr);
|
---|
| 215 | Tcl_DecrRefCount(oldObjPtr);
|
---|
| 216 | }
|
---|
| 217 | Blt_SetHashValue(hPtr, objPtr);
|
---|
| 218 | }
|
---|
| 219 | arrayObjPtr = Tcl_NewObj();
|
---|
| 220 | /*
|
---|
| 221 | * Reference counts for entry objects are initialized to 0. They
|
---|
| 222 | * are incremented as they are inserted into the tree via the
|
---|
| 223 | * Blt_TreeSetValue call.
|
---|
| 224 | */
|
---|
| 225 | arrayObjPtr->refCount = 0;
|
---|
| 226 | arrayObjPtr->internalRep.otherValuePtr = (VOID *)tablePtr;
|
---|
| 227 | arrayObjPtr->bytes = NULL;
|
---|
| 228 | arrayObjPtr->length = 0;
|
---|
| 229 | arrayObjPtr->typePtr = &arrayObjType;
|
---|
| 230 | return arrayObjPtr;
|
---|
| 231 | }
|
---|
| 232 |
|
---|
| 233 | int
|
---|
| 234 | Blt_IsArrayObj(objPtr)
|
---|
| 235 | Tcl_Obj *objPtr;
|
---|
| 236 | {
|
---|
| 237 | return (objPtr->typePtr == &arrayObjType);
|
---|
| 238 | }
|
---|
| 239 |
|
---|
| 240 | /*ARGSUSED*/
|
---|
| 241 | void
|
---|
| 242 | Blt_RegisterArrayObj(interp)
|
---|
| 243 | Tcl_Interp *interp; /* Not used. */
|
---|
| 244 | {
|
---|
| 245 | Tcl_RegisterObjType(&arrayObjType);
|
---|
| 246 | }
|
---|
| 247 | #endif /* NO_ARRAY */
|
---|