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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 66 - (show annotations) (download)
Sun Oct 30 21:57:38 2016 UTC (7 years, 6 months ago) by dashley
File MIME type: text/plain
File size: 46502 byte(s)
Header and footer cleanup.
1 /* $Header$ */
2 /*
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 /* End of tclstringobj.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25