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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25