Tcl Source Code

{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
    Tcl_InvalidateStringRep(objPtr);

    if (length < 0) {
	length = 0;
    }
    byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = (ByteArray *) ckrealloc(
		(char *) byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
    Tcl_InvalidateStringRep(objPtr);
    byteArrayPtr->used = length;
    return byteArrayPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *

static void
InvalidateDictChain(
    Tcl_Obj *dictObj)
{
    Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;

    do {
	Tcl_InvalidateStringRep(dictObj);
	dict->epoch++;
	dictObj = dict->chain;
	if (dictObj == NULL) {
	    break;
	}
	dict->chain = NULL;
	dict = dictObj->internalRep.twoPtrValue.ptr1;

	if (result != TCL_OK) {
	    return result;
	}
    }

    if (dictPtr->bytes != NULL) {
	Tcl_InvalidateStringRep(dictPtr);
    }
    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
    Tcl_IncrRefCount(valuePtr);
    if (!isNew) {
	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);

	int result = SetDictFromAny(interp, dictPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    if (dictPtr->bytes != NULL) {
	Tcl_InvalidateStringRep(dictPtr);
    }
    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    if (DeleteChainEntry(dict, keyPtr)) {
	dict->epoch++;
    }
    return TCL_OK;
}

    return Tcl_DbNewDictObj("unknown", 0);
#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    Tcl_InvalidateStringRep(dictPtr);
    dict = (Dict *) ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 0;
    dict->chain = NULL;
    dict->refcount = 1;
    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
    dictPtr->typePtr = &tclDictType;

    int line)
{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    Tcl_InvalidateStringRep(dictPtr);
    dict = (Dict *) ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 0;
    dict->chain = NULL;
    dict->refcount = 1;
    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
    dictPtr->typePtr = &tclDictType;

	    Tcl_IncrRefCount(incrPtr);
	    code = TclIncrObj(interp, valuePtr, incrPtr);
	    Tcl_DecrRefCount(incrPtr);
	}
    }
    if (code == TCL_OK) {
	Tcl_InvalidateStringRep(dictPtr);
	valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
		dictPtr, TCL_LEAVE_ERR_MSG);
	if (valuePtr == NULL) {
	    code = TCL_ERROR;
	} else {
	    Tcl_SetObjResult(interp, valuePtr);
	}

	    }
	}
    }

    if (allocatedValue) {
	Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
    } else if (dictPtr->bytes != NULL) {
	Tcl_InvalidateStringRep(dictPtr);
    }

    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }

		Tcl_IncrRefCount(incrPtr);
		if (Tcl_IsShared(valPtr)) {
		    valPtr = Tcl_DuplicateObj(valPtr);
		    Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valPtr);
		}
		result = TclIncrObj(interp, valPtr, incrPtr);
		if (result == TCL_OK) {
		    Tcl_InvalidateStringRep(dictPtr);
		}
		TclDecrRefCount(incrPtr);
	    }
	    break;
	case INST_DICT_UNSET:
	    cleanup = opnd;
	    result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,

    listRepPtr = NewListIntRep(objc, objv, 1);

    /*
     * Now create the object.
     */

    Tcl_InvalidateStringRep(listPtr);
    ListSetIntRep(listPtr, listRepPtr);
    return listPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------

    listRepPtr = NewListIntRep(objc, objv, 1);

    /*
     * Now create the object.
     */

    Tcl_InvalidateStringRep(listPtr);
    ListSetIntRep(listPtr, listRepPtr);

    return listPtr;
}

#else /* if not TCL_MEM_DEBUG */

    /*
     * Free any old string rep and any internal rep for the old type.
     */

    TclFreeIntRep(objPtr);
    objPtr->typePtr = NULL;
    Tcl_InvalidateStringRep(objPtr);

    /*
     * Set the object's type to "list" and initialize the internal rep.
     * However, if there are no elements to put in the list, just give the
     * object an empty string rep and a NULL type.
     */

    listRepPtr->elemCount++;

    /*
     * Invalidate any old string representation since the list's internal
     * representation has changed.
     */

    Tcl_InvalidateStringRep(listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --

    listRepPtr->elemCount = numRequired;

    /*
     * Invalidate and free any old string representation since it no longer
     * reflects the list's internal representation.
     */

    Tcl_InvalidateStringRep(listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexList --

	if (result == TCL_OK) {

	    /*
	     * We're going to store valuePtr, so spoil string reps
	     * of all containing lists.
	     */

	    Tcl_InvalidateStringRep(objPtr);
	}

	/* Clear away our intrep surgery mess */
	chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    }

    if (result != TCL_OK) {
	/* 
	 * Error return; message is already in interp. Clean up
	 * any excess memory. 
	 */
	if (retValuePtr != listPtr) {
	    Tcl_DecrRefCount(retValuePtr);
	}
	return NULL;
    }

    /* Store valuePtr in proper sublist and return */
    TclListObjSetElement(NULL, subListPtr, index, valuePtr);
    Tcl_InvalidateStringRep(subListPtr);
    Tcl_IncrRefCount(retValuePtr);
    return retValuePtr;
}

/*
 *----------------------------------------------------------------------
 *

    objPtr->typePtr = NULL;

    /*
     * Free any old string rep, then set the string rep to a copy of the
     * length bytes starting at "bytes".
     */

    Tcl_InvalidateStringRep(objPtr);
    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclInitStringRep(objPtr, bytes, length);
}

/*

	    objPtr->bytes = ckrealloc((char *) objPtr->bytes,
		    (unsigned) (length + 1));
	} else {
	    char *newBytes = ckalloc((unsigned) (length+1));

	    if (objPtr->bytes != NULL && objPtr->length != 0) {
		memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
		Tcl_InvalidateStringRep(objPtr);
	    }
	    objPtr->bytes = newBytes;
	}
	stringPtr->allocated = length;

	/*
	 * Invalidate the unicode data.

	} else {
	    newBytes = attemptckalloc((unsigned) (length + 1));
	    if (newBytes == NULL) {
		return 0;
	    }
	    if (objPtr->bytes != NULL && objPtr->length != 0) {
		memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
		Tcl_InvalidateStringRep(objPtr);
	    }
	}
	objPtr->bytes = newBytes;
	stringPtr->allocated = length;

	/*
	 * Invalidate the unicode data.

    stringPtr->numChars = numChars;
    stringPtr->uallocated = uallocated;
    stringPtr->hasUnicode = (numChars > 0);
    stringPtr->allocated = 0;
    memcpy(stringPtr->unicode, unicode, uallocated);
    stringPtr->unicode[numChars] = 0;

    Tcl_InvalidateStringRep(objPtr);
    objPtr->typePtr = &tclStringType;
    SET_STRING(objPtr, stringPtr);
}

/*
 *----------------------------------------------------------------------
 *

    memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
	    appendNumChars * sizeof(Tcl_UniChar));
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->allocated = 0;

    Tcl_InvalidateStringRep(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUnicodeToUtfRep --
 *

	}

	while (i < lastCharIdx) {
	    Tcl_UniChar tmp = source[lastCharIdx];
	    source[lastCharIdx--] = source[i];
	    source[i++] = tmp;
	}
	Tcl_InvalidateStringRep(objPtr);
	stringPtr->allocated = 0;
	return objPtr;
    }

    bytes = TclGetString(objPtr);
    if (Tcl_IsShared(objPtr)) {
	char *dest;

static Tcl_Obj *
NewOSTypeObj(
    const OSType osType)    /* OSType used to initialize the new object. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    Tcl_InvalidateStringRep(objPtr);
    objPtr->internalRep.longValue = (long) osType;
    objPtr->typePtr = &tclOSTypeType;
    return objPtr;
}

/*
 *----------------------------------------------------------------------