util/src/TclTk/blt2.5/generic/bltArrayObj.c

   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
  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
  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
 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
 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
 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
 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 *
 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
 295 Blt_IsArrayObj(objPtr)
 296     Tcl_Obj *objPtr;
 297 {
 298     return (objPtr->typePtr == &arrayObjType);
 299 }
 300
 301 /*ARGSUSED*/
 302 void
 303 Blt_RegisterArrayObj(interp)
 304     Tcl_Interp *interp;         /* Not used. */
 305 {
 306     Tcl_RegisterObjType(&arrayObjType);
 307 }
 308 #endif /* NO_ARRAY */