/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstringobj.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstringobj.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 66 - (hide annotations) (download)
Sun Oct 30 21:57:38 2016 UTC (7 years, 3 months ago) by dashley
File MIME type: text/plain
File size: 46502 byte(s)
Header and footer cleanup.
1 dashley 64 /* $Header$ */
2 dashley 25 /*
3     * tclStringObj.c --
4     *
5     * This file contains procedures that implement string operations on Tcl
6     * objects. Some string operations work with UTF strings and others
7     * require Unicode format. Functions that require knowledge of the width
8     * of each character, such as indexing, operate on Unicode data.
9     *
10     * A Unicode string is an internationalized string. Conceptually, a
11     * Unicode string is an array of 16-bit quantities organized as a sequence
12     * of properly formed UTF-8 characters. There is a one-to-one map between
13     * Unicode and UTF characters. Because Unicode characters have a fixed
14     * width, operations such as indexing operate on Unicode data. The String
15     * ojbect is opitmized for the case where each UTF char in a string is
16     * only one byte. In this case, we store the value of numChars, but we
17     * don't store the Unicode data (unless Tcl_GetUnicode is explicitly
18     * called).
19     *
20     * The String object type stores one or both formats. The default
21     * behavior is to store UTF. Once Unicode is calculated by a function, it
22     * is stored in the internal rep for future access (without an additional
23     * O(n) cost).
24     *
25     * To allow many appends to be done to an object without constantly
26     * reallocating the space for the string or Unicode representation, we
27     * allocate double the space for the string or Unicode and use the
28     * internal representation to keep track of how much space is used
29     * vs. allocated.
30     *
31     * Copyright (c) 1995-1997 Sun Microsystems, Inc.
32     * Copyright (c) 1999 by Scriptics Corporation.
33     *
34     * See the file "license.terms" for information on usage and redistribution
35     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
36     *
37     * RCS: @(#) $Id: tclstringobj.c,v 1.1.1.1 2001/06/13 04:46:18 dtashley Exp $ */
38    
39     #include "tclInt.h"
40    
41     /*
42     * Prototypes for procedures defined later in this file:
43     */
44    
45     static void AppendUnicodeToUnicodeRep _ANSI_ARGS_((
46     Tcl_Obj *objPtr, Tcl_UniChar *unicode,
47     int appendNumChars));
48     static void AppendUnicodeToUtfRep _ANSI_ARGS_((
49     Tcl_Obj *objPtr, Tcl_UniChar *unicode,
50     int numChars));
51     static void AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,
52     char *bytes, int numBytes));
53     static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
54     char *bytes, int numBytes));
55    
56     static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
57    
58     static void FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
59     static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
60     Tcl_Obj *copyPtr));
61     static int SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
62     Tcl_Obj *objPtr));
63     static void UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
64    
65     /*
66     * The structure below defines the string Tcl object type by means of
67     * procedures that can be invoked by generic object code.
68     */
69    
70     Tcl_ObjType tclStringType = {
71     "string", /* name */
72     FreeStringInternalRep, /* freeIntRepPro */
73     DupStringInternalRep, /* dupIntRepProc */
74     UpdateStringOfString, /* updateStringProc */
75     SetStringFromAny /* setFromAnyProc */
76     };
77    
78     /*
79     * The following structure is the internal rep for a String object.
80     * It keeps track of how much memory has been used and how much has been
81     * allocated for the Unicode and UTF string to enable growing and
82     * shrinking of the UTF and Unicode reps of the String object with fewer
83     * mallocs. To optimize string length and indexing operations, this
84     * structure also stores the number of characters (same of UTF and Unicode!)
85     * once that value has been computed.
86     */
87    
88     typedef struct String {
89     int numChars; /* The number of chars in the string.
90     * -1 means this value has not been
91     * calculated. >= 0 means that there is a
92     * valid Unicode rep, or that the number
93     * of UTF bytes == the number of chars. */
94     size_t allocated; /* The amount of space actually allocated
95     * for the UTF string (minus 1 byte for
96     * the termination char). */
97     size_t uallocated; /* The amount of space actually allocated
98     * for the Unicode string. 0 means the
99     * Unicode string rep is invalid. */
100     Tcl_UniChar unicode[2]; /* The array of Unicode chars. The actual
101     * size of this field depends on the
102     * 'uallocated' field above. */
103     } String;
104    
105     #define STRING_SIZE(len) \
106     ((unsigned) (sizeof(String) + ((len-1) * sizeof(Tcl_UniChar))))
107     #define GET_STRING(objPtr) \
108     ((String *) (objPtr)->internalRep.otherValuePtr)
109     #define SET_STRING(objPtr, stringPtr) \
110     (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)
111    
112    
113     /*
114     *----------------------------------------------------------------------
115     *
116     * Tcl_NewStringObj --
117     *
118     * This procedure is normally called when not debugging: i.e., when
119     * TCL_MEM_DEBUG is not defined. It creates a new string object and
120     * initializes it from the byte pointer and length arguments.
121     *
122     * When TCL_MEM_DEBUG is defined, this procedure just returns the
123     * result of calling the debugging version Tcl_DbNewStringObj.
124     *
125     * Results:
126     * A newly created string object is returned that has ref count zero.
127     *
128     * Side effects:
129     * The new object's internal string representation will be set to a
130     * copy of the length bytes starting at "bytes". If "length" is
131     * negative, use bytes up to the first NULL byte; i.e., assume "bytes"
132     * points to a C-style NULL-terminated string. The object's type is set
133     * to NULL. An extra NULL is added to the end of the new object's byte
134     * array.
135     *
136     *----------------------------------------------------------------------
137     */
138    
139     #ifdef TCL_MEM_DEBUG
140     #undef Tcl_NewStringObj
141    
142     Tcl_Obj *
143     Tcl_NewStringObj(bytes, length)
144     CONST char *bytes; /* Points to the first of the length bytes
145     * used to initialize the new object. */
146     int length; /* The number of bytes to copy from "bytes"
147     * when initializing the new object. If
148     * negative, use bytes up to the first
149     * NULL byte. */
150     {
151     return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
152     }
153    
154     #else /* if not TCL_MEM_DEBUG */
155    
156     Tcl_Obj *
157     Tcl_NewStringObj(bytes, length)
158     CONST char *bytes; /* Points to the first of the length bytes
159     * used to initialize the new object. */
160     int length; /* The number of bytes to copy from "bytes"
161     * when initializing the new object. If
162     * negative, use bytes up to the first
163     * NULL byte. */
164     {
165     register Tcl_Obj *objPtr;
166    
167     if (length < 0) {
168     length = (bytes? strlen(bytes) : 0);
169     }
170     TclNewObj(objPtr);
171     TclInitStringRep(objPtr, bytes, length);
172     return objPtr;
173     }
174     #endif /* TCL_MEM_DEBUG */
175    
176     /*
177     *----------------------------------------------------------------------
178     *
179     * Tcl_DbNewStringObj --
180     *
181     * This procedure is normally called when debugging: i.e., when
182     * TCL_MEM_DEBUG is defined. It creates new string objects. It is the
183     * same as the Tcl_NewStringObj procedure above except that it calls
184     * Tcl_DbCkalloc directly with the file name and line number from its
185     * caller. This simplifies debugging since then the checkmem command
186     * will report the correct file name and line number when reporting
187     * objects that haven't been freed.
188     *
189     * When TCL_MEM_DEBUG is not defined, this procedure just returns the
190     * result of calling Tcl_NewStringObj.
191     *
192     * Results:
193     * A newly created string object is returned that has ref count zero.
194     *
195     * Side effects:
196     * The new object's internal string representation will be set to a
197     * copy of the length bytes starting at "bytes". If "length" is
198     * negative, use bytes up to the first NULL byte; i.e., assume "bytes"
199     * points to a C-style NULL-terminated string. The object's type is set
200     * to NULL. An extra NULL is added to the end of the new object's byte
201     * array.
202     *
203     *----------------------------------------------------------------------
204     */
205    
206     #ifdef TCL_MEM_DEBUG
207    
208     Tcl_Obj *
209     Tcl_DbNewStringObj(bytes, length, file, line)
210     CONST char *bytes; /* Points to the first of the length bytes
211     * used to initialize the new object. */
212     int length; /* The number of bytes to copy from "bytes"
213     * when initializing the new object. If
214     * negative, use bytes up to the first
215     * NULL byte. */
216     char *file; /* The name of the source file calling this
217     * procedure; used for debugging. */
218     int line; /* Line number in the source file; used
219     * for debugging. */
220     {
221     register Tcl_Obj *objPtr;
222    
223     if (length < 0) {
224     length = (bytes? strlen(bytes) : 0);
225     }
226     TclDbNewObj(objPtr, file, line);
227     TclInitStringRep(objPtr, bytes, length);
228     return objPtr;
229     }
230    
231     #else /* if not TCL_MEM_DEBUG */
232    
233     Tcl_Obj *
234     Tcl_DbNewStringObj(bytes, length, file, line)
235     CONST char *bytes; /* Points to the first of the length bytes
236     * used to initialize the new object. */
237     register int length; /* The number of bytes to copy from "bytes"
238     * when initializing the new object. If
239     * negative, use bytes up to the first
240     * NULL byte. */
241     char *file; /* The name of the source file calling this
242     * procedure; used for debugging. */
243     int line; /* Line number in the source file; used
244     * for debugging. */
245     {
246     return Tcl_NewStringObj(bytes, length);
247     }
248     #endif /* TCL_MEM_DEBUG */
249    
250     /*
251     *---------------------------------------------------------------------------
252     *
253     * TclNewUnicodeObj --
254     *
255     * This procedure is creates a new String object and initializes
256     * it from the given Utf String. If the Utf String is the same size
257     * as the Unicode string, don't duplicate the data.
258     *
259     * Results:
260     * The newly created object is returned. This object will have no
261     * initial string representation. The returned object has a ref count
262     * of 0.
263     *
264     * Side effects:
265     * Memory allocated for new object and copy of Unicode argument.
266     *
267     *---------------------------------------------------------------------------
268     */
269    
270     Tcl_Obj *
271     Tcl_NewUnicodeObj(unicode, numChars)
272     Tcl_UniChar *unicode; /* The unicode string used to initialize
273     * the new object. */
274     int numChars; /* Number of characters in the unicode
275     * string. */
276     {
277     Tcl_Obj *objPtr;
278     String *stringPtr;
279     size_t uallocated;
280    
281     if (numChars < 0) {
282     numChars = 0;
283     if (unicode) {
284     while (unicode[numChars] != 0) { numChars++; }
285     }
286     }
287     uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
288    
289     /*
290     * Create a new obj with an invalid string rep.
291     */
292    
293     TclNewObj(objPtr);
294     Tcl_InvalidateStringRep(objPtr);
295     objPtr->typePtr = &tclStringType;
296    
297     stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
298     stringPtr->numChars = numChars;
299     stringPtr->uallocated = uallocated;
300     stringPtr->allocated = 0;
301     memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
302     stringPtr->unicode[numChars] = 0;
303     SET_STRING(objPtr, stringPtr);
304     return objPtr;
305     }
306    
307     /*
308     *----------------------------------------------------------------------
309     *
310     * Tcl_GetCharLength --
311     *
312     * Get the length of the Unicode string from the Tcl object.
313     *
314     * Results:
315     * Pointer to unicode string representing the unicode object.
316     *
317     * Side effects:
318     * Frees old internal rep. Allocates memory for new "String"
319     * internal rep.
320     *
321     *----------------------------------------------------------------------
322     */
323    
324     int
325     Tcl_GetCharLength(objPtr)
326     Tcl_Obj *objPtr; /* The String object to get the num chars of. */
327     {
328     String *stringPtr;
329    
330     SetStringFromAny(NULL, objPtr);
331     stringPtr = GET_STRING(objPtr);
332    
333     /*
334     * If numChars is unknown, then calculate the number of characaters
335     * while populating the Unicode string.
336     */
337    
338     if (stringPtr->numChars == -1) {
339    
340     stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
341    
342     if (stringPtr->numChars == objPtr->length) {
343    
344     /*
345     * Since we've just calculated the number of chars, and all
346     * UTF chars are 1-byte long, we don't need to store the
347     * unicode string.
348     */
349    
350     stringPtr->uallocated = 0;
351    
352     } else {
353    
354     /*
355     * Since we've just calucalated the number of chars, and not
356     * all UTF chars are 1-byte long, go ahead and populate the
357     * unicode string.
358     */
359    
360     FillUnicodeRep(objPtr);
361    
362     /*
363     * We need to fetch the pointer again because we have just
364     * reallocated the structure to make room for the Unicode data.
365     */
366    
367     stringPtr = GET_STRING(objPtr);
368     }
369     }
370     return stringPtr->numChars;
371     }
372    
373     /*
374     *----------------------------------------------------------------------
375     *
376     * Tcl_GetUniChar --
377     *
378     * Get the index'th Unicode character from the String object. The
379     * index is assumed to be in the appropriate range.
380     *
381     * Results:
382     * Returns the index'th Unicode character in the Object.
383     *
384     * Side effects:
385     * Fills unichar with the index'th Unicode character.
386     *
387     *----------------------------------------------------------------------
388     */
389    
390     Tcl_UniChar
391     Tcl_GetUniChar(objPtr, index)
392     Tcl_Obj *objPtr; /* The object to get the Unicode charater from. */
393     int index; /* Get the index'th Unicode character. */
394     {
395     Tcl_UniChar unichar;
396     String *stringPtr;
397    
398     SetStringFromAny(NULL, objPtr);
399     stringPtr = GET_STRING(objPtr);
400    
401     if (stringPtr->numChars == -1) {
402    
403     /*
404     * We haven't yet calculated the length, so we don't have the
405     * Unicode str. We need to know the number of chars before we
406     * can do indexing.
407     */
408    
409     Tcl_GetCharLength(objPtr);
410    
411     /*
412     * We need to fetch the pointer again because we may have just
413     * reallocated the structure.
414     */
415    
416     stringPtr = GET_STRING(objPtr);
417     }
418     if (stringPtr->uallocated == 0) {
419    
420     /*
421     * All of the characters in the Utf string are 1 byte chars,
422     * so we don't store the unicode char. We get the Utf string
423     * and convert the index'th byte to a Unicode character.
424     */
425    
426     Tcl_UtfToUniChar(&objPtr->bytes[index], &unichar);
427     } else {
428     unichar = stringPtr->unicode[index];
429     }
430     return unichar;
431     }
432    
433     /*
434     *----------------------------------------------------------------------
435     *
436     * Tcl_GetUnicode --
437     *
438     * Get the Unicode form of the String object. If
439     * the object is not already a String object, it will be converted
440     * to one. If the String object does not have a Unicode rep, then
441     * one is create from the UTF string format.
442     *
443     * Results:
444     * Returns a pointer to the object's internal Unicode string.
445     *
446     * Side effects:
447     * Converts the object to have the String internal rep.
448     *
449     *----------------------------------------------------------------------
450     */
451    
452     Tcl_UniChar *
453     Tcl_GetUnicode(objPtr)
454     Tcl_Obj *objPtr; /* The object to find the unicode string for. */
455     {
456     String *stringPtr;
457    
458     SetStringFromAny(NULL, objPtr);
459     stringPtr = GET_STRING(objPtr);
460    
461     if ((stringPtr->numChars == -1) || (stringPtr->uallocated == 0)) {
462    
463     /*
464     * We haven't yet calculated the length, or all of the characters
465     * in the Utf string are 1 byte chars (so we didn't store the
466     * unicode str). Since this function must return a unicode string,
467     * and one has not yet been stored, force the Unicode to be
468     * calculated and stored now.
469     */
470    
471     FillUnicodeRep(objPtr);
472    
473     /*
474     * We need to fetch the pointer again because we have just
475     * reallocated the structure to make room for the Unicode data.
476     */
477    
478     stringPtr = GET_STRING(objPtr);
479     }
480     return stringPtr->unicode;
481     }
482    
483     /*
484     *----------------------------------------------------------------------
485     *
486     * Tcl_GetRange --
487     *
488     * Create a Tcl Object that contains the chars between first and last
489     * of the object indicated by "objPtr". If the object is not already
490     * a String object, convert it to one. The first and last indices
491     * are assumed to be in the appropriate range.
492     *
493     * Results:
494     * Returns a new Tcl Object of the String type.
495     *
496     * Side effects:
497     * Changes the internal rep of "objPtr" to the String type.
498     *
499     *----------------------------------------------------------------------
500     */
501    
502     Tcl_Obj*
503     Tcl_GetRange(objPtr, first, last)
504    
505     Tcl_Obj *objPtr; /* The Tcl object to find the range of. */
506     int first; /* First index of the range. */
507     int last; /* Last index of the range. */
508     {
509     Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
510     String *stringPtr;
511    
512     SetStringFromAny(NULL, objPtr);
513     stringPtr = GET_STRING(objPtr);
514    
515     if (stringPtr->numChars == -1) {
516    
517     /*
518     * We haven't yet calculated the length, so we don't have the
519     * Unicode str. We need to know the number of chars before we
520     * can do indexing.
521     */
522    
523     Tcl_GetCharLength(objPtr);
524    
525     /*
526     * We need to fetch the pointer again because we may have just
527     * reallocated the structure.
528     */
529    
530     stringPtr = GET_STRING(objPtr);
531     }
532    
533     if (stringPtr->numChars == objPtr->length) {
534     char *str = Tcl_GetString(objPtr);
535    
536     /*
537     * All of the characters in the Utf string are 1 byte chars,
538     * so we don't store the unicode char. Create a new string
539     * object containing the specified range of chars.
540     */
541    
542     newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
543    
544     /*
545     * Since we know the new string only has 1-byte chars, we
546     * can set it's numChars field.
547     */
548    
549     SetStringFromAny(NULL, newObjPtr);
550     stringPtr = GET_STRING(newObjPtr);
551     stringPtr->numChars = last-first+1;
552     } else {
553     newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
554     last-first+1);
555     }
556     return newObjPtr;
557     }
558    
559     /*
560     *----------------------------------------------------------------------
561     *
562     * Tcl_SetStringObj --
563     *
564     * Modify an object to hold a string that is a copy of the bytes
565     * indicated by the byte pointer and length arguments.
566     *
567     * Results:
568     * None.
569     *
570     * Side effects:
571     * The object's string representation will be set to a copy of
572     * the "length" bytes starting at "bytes". If "length" is negative, use
573     * bytes up to the first NULL byte; i.e., assume "bytes" points to a
574     * C-style NULL-terminated string. The object's old string and internal
575     * representations are freed and the object's type is set NULL.
576     *
577     *----------------------------------------------------------------------
578     */
579    
580     void
581     Tcl_SetStringObj(objPtr, bytes, length)
582     register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
583     char *bytes; /* Points to the first of the length bytes
584     * used to initialize the object. */
585     register int length; /* The number of bytes to copy from "bytes"
586     * when initializing the object. If
587     * negative, use bytes up to the first
588     * NULL byte.*/
589     {
590     register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
591    
592     /*
593     * Free any old string rep, then set the string rep to a copy of
594     * the length bytes starting at "bytes".
595     */
596    
597     if (Tcl_IsShared(objPtr)) {
598     panic("Tcl_SetStringObj called with shared object");
599     }
600    
601     /*
602     * Set the type to NULL and free any internal rep for the old type.
603     */
604    
605     if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
606     oldTypePtr->freeIntRepProc(objPtr);
607     }
608     objPtr->typePtr = NULL;
609    
610     Tcl_InvalidateStringRep(objPtr);
611     if (length < 0) {
612     length = (bytes? strlen(bytes) : 0);
613     }
614     TclInitStringRep(objPtr, bytes, length);
615     }
616    
617     /*
618     *----------------------------------------------------------------------
619     *
620     * Tcl_SetObjLength --
621     *
622     * This procedure changes the length of the string representation
623     * of an object.
624     *
625     * Results:
626     * None.
627     *
628     * Side effects:
629     * If the size of objPtr's string representation is greater than
630     * length, then it is reduced to length and a new terminating null
631     * byte is stored in the strength. If the length of the string
632     * representation is greater than length, the storage space is
633     * reallocated to the given length; a null byte is stored at the
634     * end, but other bytes past the end of the original string
635     * representation are undefined. The object's internal
636     * representation is changed to "expendable string".
637     *
638     *----------------------------------------------------------------------
639     */
640    
641     void
642     Tcl_SetObjLength(objPtr, length)
643     register Tcl_Obj *objPtr; /* Pointer to object. This object must
644     * not currently be shared. */
645     register int length; /* Number of bytes desired for string
646     * representation of object, not including
647     * terminating null byte. */
648     {
649     char *new;
650     String *stringPtr;
651    
652     if (Tcl_IsShared(objPtr)) {
653     panic("Tcl_SetObjLength called with shared object");
654     }
655     SetStringFromAny(NULL, objPtr);
656    
657     /*
658     * Invalidate the unicode data.
659     */
660    
661     stringPtr = GET_STRING(objPtr);
662     stringPtr->numChars = -1;
663     stringPtr->uallocated = 0;
664    
665     if (length > (int) stringPtr->allocated) {
666    
667     /*
668     * Not enough space in current string. Reallocate the string
669     * space and free the old string.
670     */
671    
672     new = (char *) ckalloc((unsigned) (length+1));
673     if (objPtr->bytes != NULL) {
674     memcpy((VOID *) new, (VOID *) objPtr->bytes,
675     (size_t) objPtr->length);
676     Tcl_InvalidateStringRep(objPtr);
677     }
678     objPtr->bytes = new;
679     stringPtr->allocated = length;
680     }
681    
682     objPtr->length = length;
683     if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
684     objPtr->bytes[length] = 0;
685     }
686     }
687    
688     /*
689     *---------------------------------------------------------------------------
690     *
691     * TclSetUnicodeObj --
692     *
693     * Modify an object to hold the Unicode string indicated by "unicode".
694     *
695     * Results:
696     * None.
697     *
698     * Side effects:
699     * Memory allocated for new "String" internal rep.
700     *
701     *---------------------------------------------------------------------------
702     */
703    
704     void
705     Tcl_SetUnicodeObj(objPtr, unicode, numChars)
706     Tcl_Obj *objPtr; /* The object to set the string of. */
707     Tcl_UniChar *unicode; /* The unicode string used to initialize
708     * the object. */
709     int numChars; /* Number of characters in the unicode
710     * string. */
711     {
712     Tcl_ObjType *typePtr;
713     String *stringPtr;
714     size_t uallocated;
715    
716     if (numChars < 0) {
717     numChars = 0;
718     if (unicode) {
719     while (unicode[numChars] != 0) { numChars++; }
720     }
721     }
722     uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
723    
724     /*
725     * Free the internal rep if one exists, and invalidate the string rep.
726     */
727    
728     typePtr = objPtr->typePtr;
729     if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
730     (*typePtr->freeIntRepProc)(objPtr);
731     }
732     objPtr->typePtr = &tclStringType;
733    
734     /*
735     * Allocate enough space for the String structure + Unicode string.
736     */
737    
738     stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
739     stringPtr->numChars = numChars;
740     stringPtr->uallocated = uallocated;
741     stringPtr->allocated = 0;
742     memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
743     stringPtr->unicode[numChars] = 0;
744     SET_STRING(objPtr, stringPtr);
745     Tcl_InvalidateStringRep(objPtr);
746     return;
747     }
748    
749     /*
750     *----------------------------------------------------------------------
751     *
752     * Tcl_AppendToObj --
753     *
754     * This procedure appends a sequence of bytes to an object.
755     *
756     * Results:
757     * None.
758     *
759     * Side effects:
760     * The bytes at *bytes are appended to the string representation
761     * of objPtr.
762     *
763     *----------------------------------------------------------------------
764     */
765    
766     void
767     Tcl_AppendToObj(objPtr, bytes, length)
768     register Tcl_Obj *objPtr; /* Points to the object to append to. */
769     char *bytes; /* Points to the bytes to append to the
770     * object. */
771     register int length; /* The number of bytes to append from
772     * "bytes". If < 0, then append all bytes
773     * up to NULL byte. */
774     {
775     String *stringPtr;
776    
777     if (Tcl_IsShared(objPtr)) {
778     panic("Tcl_AppendToObj called with shared object");
779     }
780    
781     SetStringFromAny(NULL, objPtr);
782    
783     if (length < 0) {
784     length = (bytes ? strlen(bytes) : 0);
785     }
786     if (length == 0) {
787     return;
788     }
789    
790     /*
791     * If objPtr has a valid Unicode rep, then append the Unicode
792     * conversion of "bytes" to the objPtr's Unicode rep, otherwise
793     * append "bytes" to objPtr's string rep.
794     */
795    
796     stringPtr = GET_STRING(objPtr);
797     if (stringPtr->uallocated > 0) {
798     AppendUtfToUnicodeRep(objPtr, bytes, length);
799    
800     stringPtr = GET_STRING(objPtr);
801     } else {
802     AppendUtfToUtfRep(objPtr, bytes, length);
803     }
804     }
805    
806     /*
807     *----------------------------------------------------------------------
808     *
809     * Tcl_AppendUnicodeToObj --
810     *
811     * This procedure appends a Unicode string to an object in the
812     * most efficient manner possible. Length must be >= 0.
813     *
814     * Results:
815     * None.
816     *
817     * Side effects:
818     * Invalidates the string rep and creates a new Unicode string.
819     *
820     *----------------------------------------------------------------------
821     */
822    
823     void
824     Tcl_AppendUnicodeToObj(objPtr, unicode, length)
825     register Tcl_Obj *objPtr; /* Points to the object to append to. */
826     Tcl_UniChar *unicode; /* The unicode string to append to the
827     * object. */
828     int length; /* Number of chars in "unicode". */
829     {
830     String *stringPtr;
831    
832     if (Tcl_IsShared(objPtr)) {
833     panic("Tcl_AppendUnicodeToObj called with shared object");
834     }
835    
836     if (length == 0) {
837     return;
838     }
839    
840     SetStringFromAny(NULL, objPtr);
841    
842     /*
843     * TEMPORARY!!! This is terribly inefficient, but it works, and Don
844     * needs for me to check this stuff in ASAP. -Melissa
845     */
846    
847     /* UpdateStringOfString(objPtr); */
848     /* AppendUnicodeToUtfRep(objPtr, unicode, length); */
849     /* return; */
850    
851     /*
852     * If objPtr has a valid Unicode rep, then append the "unicode"
853     * to the objPtr's Unicode rep, otherwise the UTF conversion of
854     * "unicode" to objPtr's string rep.
855     */
856    
857     stringPtr = GET_STRING(objPtr);
858     if (stringPtr->uallocated > 0) {
859     AppendUnicodeToUnicodeRep(objPtr, unicode, length);
860     } else {
861     AppendUnicodeToUtfRep(objPtr, unicode, length);
862     }
863     }
864    
865     /*
866     *----------------------------------------------------------------------
867     *
868     * Tcl_AppendObjToObj --
869     *
870     * This procedure appends the string rep of one object to another.
871     * "objPtr" cannot be a shared object.
872     *
873     * Results:
874     * None.
875     *
876     * Side effects:
877     * The string rep of appendObjPtr is appended to the string
878     * representation of objPtr.
879     *
880     *----------------------------------------------------------------------
881     */
882    
883     void
884     Tcl_AppendObjToObj(objPtr, appendObjPtr)
885     Tcl_Obj *objPtr; /* Points to the object to append to. */
886     Tcl_Obj *appendObjPtr; /* Object to append. */
887     {
888     String *stringPtr;
889     int length, numChars, allOneByteChars;
890     char *bytes;
891    
892     SetStringFromAny(NULL, objPtr);
893    
894     /*
895     * If objPtr has a valid Unicode rep, then get a Unicode string
896     * from appendObjPtr and append it.
897     */
898    
899     stringPtr = GET_STRING(objPtr);
900     if (stringPtr->uallocated > 0) {
901    
902     /*
903     * If appendObjPtr is not of the "String" type, don't convert it.
904     */
905    
906     if (appendObjPtr->typePtr == &tclStringType) {
907     stringPtr = GET_STRING(appendObjPtr);
908     if ((stringPtr->numChars == -1)
909     || (stringPtr->uallocated == 0)) {
910    
911     /*
912     * If appendObjPtr is a string obj with no valide Unicode
913     * rep, then fill its unicode rep.
914     */
915    
916     FillUnicodeRep(appendObjPtr);
917     stringPtr = GET_STRING(appendObjPtr);
918     }
919     AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
920     stringPtr->numChars);
921     } else {
922     bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
923     AppendUtfToUnicodeRep(objPtr, bytes, length);
924     }
925     return;
926     }
927    
928     /*
929     * Append to objPtr's UTF string rep. If we know the number of
930     * characters in both objects before appending, then set the combined
931     * number of characters in the final (appended-to) object.
932     */
933    
934     bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
935    
936     allOneByteChars = 0;
937     numChars = stringPtr->numChars;
938     if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
939     stringPtr = GET_STRING(appendObjPtr);
940     if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
941     numChars += stringPtr->numChars;
942     allOneByteChars = 1;
943     }
944     }
945    
946     AppendUtfToUtfRep(objPtr, bytes, length);
947    
948     if (allOneByteChars) {
949     stringPtr = GET_STRING(objPtr);
950     stringPtr->numChars = numChars;
951     }
952     }
953    
954     /*
955     *----------------------------------------------------------------------
956     *
957     * AppendUnicodeToUnicodeRep --
958     *
959     * This procedure appends the contents of "unicode" to the Unicode
960     * rep of "objPtr". objPtr must already have a valid Unicode rep.
961     *
962     * Results:
963     * None.
964     *
965     * Side effects:
966     * objPtr's internal rep is reallocated.
967     *
968     *----------------------------------------------------------------------
969     */
970    
971     static void
972     AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
973     Tcl_Obj *objPtr; /* Points to the object to append to. */
974     Tcl_UniChar *unicode; /* String to append. */
975     int appendNumChars; /* Number of chars of "unicode" to append. */
976     {
977     String *stringPtr;
978     int numChars;
979     size_t newSize;
980    
981     if (appendNumChars < 0) {
982     appendNumChars = 0;
983     if (unicode) {
984     while (unicode[appendNumChars] != 0) { appendNumChars++; }
985     }
986     }
987     if (appendNumChars == 0) {
988     return;
989     }
990    
991     SetStringFromAny(NULL, objPtr);
992     stringPtr = GET_STRING(objPtr);
993    
994     /*
995     * If not enough space has been allocated for the unicode rep,
996     * reallocate the internal rep object with double the amount of
997     * space needed, so the unicode string can grow without being
998     * reallocated.
999     */
1000    
1001     numChars = stringPtr->numChars + appendNumChars;
1002     newSize = (numChars + 1) * sizeof(Tcl_UniChar);
1003    
1004     if (newSize > stringPtr->uallocated) {
1005     stringPtr->uallocated = newSize * 2;
1006     stringPtr = (String *) ckrealloc((char*)stringPtr,
1007     STRING_SIZE(stringPtr->uallocated));
1008     SET_STRING(objPtr, stringPtr);
1009     }
1010    
1011     /*
1012     * Copy the new string onto the end of the old string, then add the
1013     * trailing null.
1014     */
1015    
1016     memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode,
1017     appendNumChars * sizeof(Tcl_UniChar));
1018     stringPtr->unicode[numChars] = 0;
1019     stringPtr->numChars = numChars;
1020    
1021     SET_STRING(objPtr, stringPtr);
1022     Tcl_InvalidateStringRep(objPtr);
1023     }
1024    
1025     /*
1026     *----------------------------------------------------------------------
1027     *
1028     * AppendUnicodeToUtfRep --
1029     *
1030     * This procedure converts the contents of "unicode" to UTF and
1031     * appends the UTF to the string rep of "objPtr".
1032     *
1033     * Results:
1034     * None.
1035     *
1036     * Side effects:
1037     * objPtr's internal rep is reallocated.
1038     *
1039     *----------------------------------------------------------------------
1040     */
1041    
1042     static void
1043     AppendUnicodeToUtfRep(objPtr, unicode, numChars)
1044     Tcl_Obj *objPtr; /* Points to the object to append to. */
1045     Tcl_UniChar *unicode; /* String to convert to UTF. */
1046     int numChars; /* Number of chars of "unicode" to convert. */
1047     {
1048     Tcl_DString dsPtr;
1049     char *bytes;
1050    
1051     if (numChars < 0) {
1052     numChars = 0;
1053     if (unicode) {
1054     while (unicode[numChars] != 0) { numChars++; }
1055     }
1056     }
1057     if (numChars == 0) {
1058     return;
1059     }
1060    
1061     Tcl_DStringInit(&dsPtr);
1062     bytes = (char *)Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
1063     AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
1064     Tcl_DStringFree(&dsPtr);
1065     }
1066    
1067     /*
1068     *----------------------------------------------------------------------
1069     *
1070     * AppendUtfToUnicodeRep --
1071     *
1072     * This procedure converts the contents of "bytes" to Unicode and
1073     * appends the Unicode to the Unicode rep of "objPtr". objPtr must
1074     * already have a valid Unicode rep.
1075     *
1076     * Results:
1077     * None.
1078     *
1079     * Side effects:
1080     * objPtr's internal rep is reallocated.
1081     *
1082     *----------------------------------------------------------------------
1083     */
1084    
1085     static void
1086     AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
1087     Tcl_Obj *objPtr; /* Points to the object to append to. */
1088     char *bytes; /* String to convert to Unicode. */
1089     int numBytes; /* Number of bytes of "bytes" to convert. */
1090     {
1091     Tcl_DString dsPtr;
1092     int numChars;
1093     Tcl_UniChar *unicode;
1094    
1095     if (numBytes < 0) {
1096     numBytes = (bytes ? strlen(bytes) : 0);
1097     }
1098     if (numBytes == 0) {
1099     return;
1100     }
1101    
1102     Tcl_DStringInit(&dsPtr);
1103     numChars = Tcl_NumUtfChars(bytes, numBytes);
1104     unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
1105     AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
1106     Tcl_DStringFree(&dsPtr);
1107     }
1108    
1109     /*
1110     *----------------------------------------------------------------------
1111     *
1112     * AppendUtfToUtfRep --
1113     *
1114     * This procedure appends "numBytes" bytes of "bytes" to the UTF string
1115     * rep of "objPtr". objPtr must already have a valid String rep.
1116     *
1117     * Results:
1118     * None.
1119     *
1120     * Side effects:
1121     * objPtr's internal rep is reallocated.
1122     *
1123     *----------------------------------------------------------------------
1124     */
1125    
1126     static void
1127     AppendUtfToUtfRep(objPtr, bytes, numBytes)
1128     Tcl_Obj *objPtr; /* Points to the object to append to. */
1129     char *bytes; /* String to append. */
1130     int numBytes; /* Number of bytes of "bytes" to append. */
1131     {
1132     String *stringPtr;
1133     int newLength, oldLength;
1134    
1135     if (numBytes < 0) {
1136     numBytes = (bytes ? strlen(bytes) : 0);
1137     }
1138     if (numBytes == 0) {
1139     return;
1140     }
1141    
1142     /*
1143     * Copy the new string onto the end of the old string, then add the
1144     * trailing null.
1145     */
1146    
1147     oldLength = objPtr->length;
1148     newLength = numBytes + oldLength;
1149    
1150     stringPtr = GET_STRING(objPtr);
1151     if (newLength > (int) stringPtr->allocated) {
1152    
1153     /*
1154     * There isn't currently enough space in the string
1155     * representation so allocate additional space. Overallocate the
1156     * space by doubling it so that we won't have to do as much
1157     * reallocation in the future.
1158     */
1159    
1160     Tcl_SetObjLength(objPtr, 2*newLength);
1161     } else {
1162    
1163     /*
1164     * Invalidate the unicode data.
1165     */
1166    
1167     stringPtr->numChars = -1;
1168     stringPtr->uallocated = 0;
1169     }
1170    
1171     memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
1172     (size_t) numBytes);
1173     objPtr->bytes[newLength] = 0;
1174     objPtr->length = newLength;
1175     }
1176    
1177     /*
1178     *----------------------------------------------------------------------
1179     *
1180     * Tcl_AppendStringsToObjVA --
1181     *
1182     * This procedure appends one or more null-terminated strings
1183     * to an object.
1184     *
1185     * Results:
1186     * None.
1187     *
1188     * Side effects:
1189     * The contents of all the string arguments are appended to the
1190     * string representation of objPtr.
1191     *
1192     *----------------------------------------------------------------------
1193     */
1194    
1195     void
1196     Tcl_AppendStringsToObjVA (objPtr, argList)
1197     Tcl_Obj *objPtr; /* Points to the object to append to. */
1198     va_list argList; /* Variable argument list. */
1199     {
1200     #define STATIC_LIST_SIZE 16
1201     String *stringPtr;
1202     int newLength, oldLength;
1203     register char *string, *dst;
1204     char *static_list[STATIC_LIST_SIZE];
1205     char **args = static_list;
1206     int nargs_space = STATIC_LIST_SIZE;
1207     int nargs, i;
1208    
1209     if (Tcl_IsShared(objPtr)) {
1210     panic("Tcl_AppendStringsToObj called with shared object");
1211     }
1212    
1213     SetStringFromAny(NULL, objPtr);
1214    
1215     /*
1216     * Figure out how much space is needed for all the strings, and
1217     * expand the string representation if it isn't big enough. If no
1218     * bytes would be appended, just return. Note that on some platforms
1219     * (notably OS/390) the argList is an array so we need to use memcpy.
1220     */
1221    
1222     nargs = 0;
1223     newLength = oldLength = objPtr->length;
1224     while (1) {
1225     string = va_arg(argList, char *);
1226     if (string == NULL) {
1227     break;
1228     }
1229     if (nargs >= nargs_space) {
1230     /*
1231     * Expand the args buffer
1232     */
1233     nargs_space += STATIC_LIST_SIZE;
1234     if (args == static_list) {
1235     args = (void *)ckalloc(nargs_space * sizeof(char *));
1236     for (i = 0; i < nargs; ++i) {
1237     args[i] = static_list[i];
1238     }
1239     } else {
1240     args = (void *)ckrealloc((void *)args,
1241     nargs_space * sizeof(char *));
1242     }
1243     }
1244     newLength += strlen(string);
1245     args[nargs++] = string;
1246     }
1247     if (newLength == oldLength) {
1248     goto done;
1249     }
1250    
1251     stringPtr = GET_STRING(objPtr);
1252     if (newLength > (int) stringPtr->allocated) {
1253    
1254     /*
1255     * There isn't currently enough space in the string
1256     * representation so allocate additional space. If the current
1257     * string representation isn't empty (i.e. it looks like we're
1258     * doing a series of appends) then overallocate the space so
1259     * that we won't have to do as much reallocation in the future.
1260     */
1261    
1262     Tcl_SetObjLength(objPtr,
1263     (objPtr->length == 0) ? newLength : 2*newLength);
1264     }
1265    
1266     /*
1267     * Make a second pass through the arguments, appending all the
1268     * strings to the object.
1269     */
1270    
1271     dst = objPtr->bytes + oldLength;
1272     for (i = 0; i < nargs; ++i) {
1273     string = args[i];
1274     if (string == NULL) {
1275     break;
1276     }
1277     while (*string != 0) {
1278     *dst = *string;
1279     dst++;
1280     string++;
1281     }
1282     }
1283    
1284     /*
1285     * Add a null byte to terminate the string. However, be careful:
1286     * it's possible that the object is totally empty (if it was empty
1287     * originally and there was nothing to append). In this case dst is
1288     * NULL; just leave everything alone.
1289     */
1290    
1291     if (dst != NULL) {
1292     *dst = 0;
1293     }
1294     objPtr->length = newLength;
1295    
1296     done:
1297     /*
1298     * If we had to allocate a buffer from the heap,
1299     * free it now.
1300     */
1301    
1302     if (args != static_list) {
1303     ckfree((void *)args);
1304     }
1305     #undef STATIC_LIST_SIZE
1306     }
1307    
1308     /*
1309     *----------------------------------------------------------------------
1310     *
1311     * Tcl_AppendStringsToObj --
1312     *
1313     * This procedure appends one or more null-terminated strings
1314     * to an object.
1315     *
1316     * Results:
1317     * None.
1318     *
1319     * Side effects:
1320     * The contents of all the string arguments are appended to the
1321     * string representation of objPtr.
1322     *
1323     *----------------------------------------------------------------------
1324     */
1325    
1326     void
1327     Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
1328     {
1329     register Tcl_Obj *objPtr;
1330     va_list argList;
1331    
1332     objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
1333     Tcl_AppendStringsToObjVA(objPtr, argList);
1334     va_end(argList);
1335     }
1336    
1337     /*
1338     *---------------------------------------------------------------------------
1339     *
1340     * FillUnicodeRep --
1341     *
1342     * Populate the Unicode internal rep with the Unicode form of its string
1343     * rep. The object must alread have a "String" internal rep.
1344     *
1345     * Results:
1346     * None.
1347     *
1348     * Side effects:
1349     * Reallocates the String internal rep.
1350     *
1351     *---------------------------------------------------------------------------
1352     */
1353    
1354     static void
1355     FillUnicodeRep(objPtr)
1356     Tcl_Obj *objPtr; /* The object in which to fill the unicode rep. */
1357     {
1358     String *stringPtr;
1359     size_t uallocated;
1360     char *src, *srcEnd;
1361     Tcl_UniChar *dst;
1362     src = objPtr->bytes;
1363    
1364     stringPtr = GET_STRING(objPtr);
1365     if (stringPtr->numChars == -1) {
1366     stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
1367     }
1368    
1369     uallocated = stringPtr->numChars * sizeof(Tcl_UniChar);
1370     if (uallocated > stringPtr->uallocated) {
1371    
1372     /*
1373     * If not enough space has been allocated for the unicode rep,
1374     * reallocate the internal rep object.
1375     */
1376    
1377     /*
1378     * There isn't currently enough space in the Unicode
1379     * representation so allocate additional space. If the current
1380     * Unicode representation isn't empty (i.e. it looks like we've
1381     * done some appends) then overallocate the space so
1382     * that we won't have to do as much reallocation in the future.
1383     */
1384    
1385     if (stringPtr->uallocated > 0) {
1386     uallocated *= 2;
1387     }
1388     stringPtr = (String *) ckrealloc((char*) stringPtr,
1389     STRING_SIZE(uallocated));
1390     stringPtr->uallocated = uallocated;
1391     }
1392    
1393     /*
1394     * Convert src to Unicode and store the coverted data in "unicode".
1395     */
1396    
1397     srcEnd = src + objPtr->length;
1398     for (dst = stringPtr->unicode; src < srcEnd; dst++) {
1399     src += Tcl_UtfToUniChar(src, dst);
1400     }
1401     *dst = 0;
1402    
1403     SET_STRING(objPtr, stringPtr);
1404     }
1405    
1406     /*
1407     *----------------------------------------------------------------------
1408     *
1409     * DupStringInternalRep --
1410     *
1411     * Initialize the internal representation of a new Tcl_Obj to a
1412     * copy of the internal representation of an existing string object.
1413     *
1414     * Results:
1415     * None.
1416     *
1417     * Side effects:
1418     * copyPtr's internal rep is set to a copy of srcPtr's internal
1419     * representation.
1420     *
1421     *----------------------------------------------------------------------
1422     */
1423    
1424     static void
1425     DupStringInternalRep(srcPtr, copyPtr)
1426     register Tcl_Obj *srcPtr; /* Object with internal rep to copy. Must
1427     * have an internal rep of type "String". */
1428     register Tcl_Obj *copyPtr; /* Object with internal rep to set. Must
1429     * not currently have an internal rep.*/
1430     {
1431     String *srcStringPtr = GET_STRING(srcPtr);
1432     String *copyStringPtr = NULL;
1433    
1434     /*
1435     * If the src obj is a string of 1-byte Utf chars, then copy the
1436     * string rep of the source object and create an "empty" Unicode
1437     * internal rep for the new object. Otherwise, copy Unicode
1438     * internal rep, and invalidate the string rep of the new object.
1439     */
1440    
1441     if (srcStringPtr->uallocated == 0) {
1442     copyStringPtr = (String *) ckalloc(sizeof(String));
1443     copyStringPtr->uallocated = 0;
1444     } else {
1445     copyStringPtr = (String *) ckalloc(
1446     STRING_SIZE(srcStringPtr->uallocated));
1447     copyStringPtr->uallocated = srcStringPtr->uallocated;
1448    
1449     memcpy((VOID *) copyStringPtr->unicode,
1450     (VOID *) srcStringPtr->unicode,
1451     (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
1452     copyStringPtr->unicode[srcStringPtr->numChars] = 0;
1453     }
1454     copyStringPtr->numChars = srcStringPtr->numChars;
1455     copyStringPtr->allocated = srcStringPtr->allocated;
1456    
1457     /*
1458     * Tricky point: the string value was copied by generic object
1459     * management code, so it doesn't contain any extra bytes that
1460     * might exist in the source object.
1461     */
1462    
1463     copyStringPtr->allocated = copyPtr->length;
1464    
1465     SET_STRING(copyPtr, copyStringPtr);
1466     copyPtr->typePtr = &tclStringType;
1467     }
1468    
1469     /*
1470     *----------------------------------------------------------------------
1471     *
1472     * SetStringFromAny --
1473     *
1474     * Create an internal representation of type "String" for an object.
1475     *
1476     * Results:
1477     * This operation always succeeds and returns TCL_OK.
1478     *
1479     * Side effects:
1480     * Any old internal reputation for objPtr is freed and the
1481     * internal representation is set to "String".
1482     *
1483     *----------------------------------------------------------------------
1484     */
1485    
1486     static int
1487     SetStringFromAny(interp, objPtr)
1488     Tcl_Interp *interp; /* Used for error reporting if not NULL. */
1489     Tcl_Obj *objPtr; /* The object to convert. */
1490     {
1491     String *stringPtr;
1492    
1493     /*
1494     * The Unicode object is opitmized for the case where each UTF char
1495     * in a string is only one byte. In this case, we store the value of
1496     * numChars, but we don't copy the bytes to the unicodeObj->unicode.
1497     */
1498    
1499     if (objPtr->typePtr != &tclStringType) {
1500    
1501     if (objPtr->typePtr != NULL) {
1502     if (objPtr->bytes == NULL) {
1503     objPtr->typePtr->updateStringProc(objPtr);
1504     }
1505     if ((objPtr->typePtr->freeIntRepProc) != NULL) {
1506     (*objPtr->typePtr->freeIntRepProc)(objPtr);
1507     }
1508     }
1509     objPtr->typePtr = &tclStringType;
1510    
1511     /*
1512     * Allocate enough space for the basic String structure.
1513     */
1514    
1515     stringPtr = (String *) ckalloc(sizeof(String));
1516     stringPtr->numChars = -1;
1517     stringPtr->uallocated = 0;
1518    
1519     if (objPtr->bytes != NULL) {
1520     stringPtr->allocated = objPtr->length;
1521     objPtr->bytes[objPtr->length] = 0;
1522     } else {
1523     objPtr->length = 0;
1524     }
1525     SET_STRING(objPtr, stringPtr);
1526     }
1527     return TCL_OK;
1528     }
1529    
1530     /*
1531     *----------------------------------------------------------------------
1532     *
1533     * UpdateStringOfString --
1534     *
1535     * Update the string representation for an object whose internal
1536     * representation is "String".
1537     *
1538     * Results:
1539     * None.
1540     *
1541     * Side effects:
1542     * The object's string may be set by converting its Unicode
1543     * represention to UTF format.
1544     *
1545     *----------------------------------------------------------------------
1546     */
1547    
1548     static void
1549     UpdateStringOfString(objPtr)
1550     Tcl_Obj *objPtr; /* Object with string rep to update. */
1551     {
1552     int i, length, size;
1553     Tcl_UniChar *unicode;
1554     char dummy[TCL_UTF_MAX];
1555     char *dst;
1556     String *stringPtr;
1557    
1558     stringPtr = GET_STRING(objPtr);
1559     if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
1560    
1561     if (stringPtr->numChars <= 0) {
1562    
1563     /*
1564     * If there is no Unicode rep, or the string has 0 chars,
1565     * then set the string rep to an empty string.
1566     */
1567    
1568     objPtr->bytes = tclEmptyStringRep;
1569     objPtr->length = 0;
1570     return;
1571     }
1572    
1573     unicode = stringPtr->unicode;
1574     length = stringPtr->numChars * sizeof(Tcl_UniChar);
1575    
1576     /*
1577     * Translate the Unicode string to UTF. "size" will hold the
1578     * amount of space the UTF string needs.
1579     */
1580    
1581     size = 0;
1582     for (i = 0; i < stringPtr->numChars; i++) {
1583     size += Tcl_UniCharToUtf((int) unicode[i], dummy);
1584     }
1585    
1586     dst = (char *) ckalloc((unsigned) (size + 1));
1587     objPtr->bytes = dst;
1588     objPtr->length = size;
1589     stringPtr->allocated = size;
1590    
1591     for (i = 0; i < stringPtr->numChars; i++) {
1592     dst += Tcl_UniCharToUtf(unicode[i], dst);
1593     }
1594     *dst = '\0';
1595     }
1596     return;
1597     }
1598    
1599     /*
1600     *----------------------------------------------------------------------
1601     *
1602     * FreeStringInternalRep --
1603     *
1604     * Deallocate the storage associated with a String data object's
1605     * internal representation.
1606     *
1607     * Results:
1608     * None.
1609     *
1610     * Side effects:
1611     * Frees memory.
1612     *
1613     *----------------------------------------------------------------------
1614     */
1615    
1616     static void
1617     FreeStringInternalRep(objPtr)
1618     Tcl_Obj *objPtr; /* Object with internal rep to free. */
1619     {
1620     ckfree((char *) GET_STRING(objPtr));
1621     }
1622    
1623 dashley 66 /* End of tclstringobj.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25