/[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 42 - (show annotations) (download)
Fri Oct 14 01:50:00 2016 UTC (7 years, 1 month ago) by dashley
Original Path: projs/trunk/shared_source/tcl_base/tclstringobj.c
File MIME type: text/plain
File size: 46837 byte(s)
Move shared source code to commonize.
1 /* $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