1/* 2 * tclStringObj.c -- 3 * 4 * This file contains functions that implement string operations on Tcl 5 * objects. Some string operations work with UTF strings and others 6 * require Unicode format. Functions that require knowledge of the width 7 * of each character, such as indexing, operate on Unicode data. 8 * 9 * A Unicode string is an internationalized string. Conceptually, a 10 * Unicode string is an array of 16-bit quantities organized as a 11 * sequence of properly formed UTF-8 characters. There is a one-to-one 12 * map between Unicode and UTF characters. Because Unicode characters 13 * have a fixed width, operations such as indexing operate on Unicode 14 * data. The String object is optimized for the case where each UTF char 15 * in a string is only one byte. In this case, we store the value of 16 * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode 17 * is explicitly called). 18 * 19 * The String object type stores one or both formats. The default 20 * behavior is to store UTF. Once Unicode is calculated by a function, it 21 * is stored in the internal rep for future access (without an additional 22 * O(n) cost). 23 * 24 * To allow many appends to be done to an object without constantly 25 * reallocating the space for the string or Unicode representation, we 26 * allocate double the space for the string or Unicode and use the 27 * internal representation to keep track of how much space is used vs. 28 * allocated. 29 * 30 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 31 * Copyright (c) 1999 by Scriptics Corporation. 32 * 33 * See the file "license.terms" for information on usage and redistribution of 34 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 35 * 36 * RCS: @(#) $Id: tclStringObj.c,v 1.70.2.21 2010/04/02 14:30:41 vasiljevic Exp $ */ 37 38#include "tclInt.h" 39#include "tommath.h" 40 41/* 42 * Prototypes for functions defined later in this file: 43 */ 44 45static void AppendPrintfToObjVA(Tcl_Obj *objPtr, 46 const char *format, va_list argList); 47static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, 48 const Tcl_UniChar *unicode, int appendNumChars); 49static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, 50 const Tcl_UniChar *unicode, int numChars); 51static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, 52 const char *bytes, int numBytes); 53static void AppendUtfToUtfRep(Tcl_Obj *objPtr, 54 const char *bytes, int numBytes); 55static void DupStringInternalRep(Tcl_Obj *objPtr, 56 Tcl_Obj *copyPtr); 57static void FillUnicodeRep(Tcl_Obj *objPtr); 58static void FreeStringInternalRep(Tcl_Obj *objPtr); 59static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); 60static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); 61static void SetUnicodeObj(Tcl_Obj *objPtr, 62 const Tcl_UniChar *unicode, int numChars); 63static int UnicodeLength(const Tcl_UniChar *unicode); 64static void UpdateStringOfString(Tcl_Obj *objPtr); 65 66/* 67 * The structure below defines the string Tcl object type by means of 68 * functions that can be invoked by generic object code. 69 */ 70 71Tcl_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. It keeps 81 * track of how much memory has been used and how much has been allocated for 82 * the Unicode and UTF string to enable growing and shrinking of the UTF and 83 * Unicode reps of the String object with fewer mallocs. To optimize string 84 * length and indexing operations, this structure also stores the number of 85 * characters (same of UTF and Unicode!) once that value has been computed. 86 * 87 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16 88 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This 89 * can be officially modified by altering the definition of Tcl_UniChar in 90 * tcl.h, but do not do that unless you are sure what you're doing! 91 */ 92 93typedef struct String { 94 int numChars; /* The number of chars in the string. -1 means 95 * this value has not been calculated. >= 0 96 * means that there is a valid Unicode rep, or 97 * that the number of UTF bytes == the number 98 * of chars. */ 99 size_t allocated; /* The amount of space actually allocated for 100 * the UTF string (minus 1 byte for the 101 * termination char). */ 102 size_t uallocated; /* The amount of space actually allocated for 103 * the Unicode string (minus 2 bytes for the 104 * termination char). */ 105 int hasUnicode; /* Boolean determining whether the string has 106 * a Unicode representation. */ 107 Tcl_UniChar unicode[2]; /* The array of Unicode chars. The actual size 108 * of this field depends on the 'uallocated' 109 * field above. */ 110} String; 111 112#define STRING_MAXCHARS \ 113 (1 + (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))) 114#define STRING_UALLOC(numChars) \ 115 ((numChars) * sizeof(Tcl_UniChar)) 116#define STRING_SIZE(ualloc) \ 117 ((unsigned) ((ualloc) \ 118 ? (sizeof(String) - sizeof(Tcl_UniChar) + (ualloc)) \ 119 : sizeof(String))) 120#define stringCheckLimits(numChars) \ 121 if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ 122 Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ 123 STRING_MAXCHARS); \ 124 } 125#define stringRealloc(ptr, numChars) \ 126 (String *) ckrealloc((char *) ptr, \ 127 (unsigned) STRING_SIZE(STRING_UALLOC(numChars)) ) 128#define stringAttemptRealloc(ptr, numChars) \ 129 (String *) attemptckrealloc((char *) ptr, \ 130 (unsigned) STRING_SIZE(STRING_UALLOC(numChars)) ) 131#define GET_STRING(objPtr) \ 132 ((String *) (objPtr)->internalRep.otherValuePtr) 133#define SET_STRING(objPtr, stringPtr) \ 134 ((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr)) 135 136/* 137 * TCL STRING GROWTH ALGORITHM 138 * 139 * When growing strings (during an append, for example), the following growth 140 * algorithm is used: 141 * 142 * Attempt to allocate 2 * (originalLength + appendLength) 143 * On failure: 144 * attempt to allocate originalLength + 2*appendLength + 145 * TCL_GROWTH_MIN_ALLOC 146 * 147 * This algorithm allows very good performance, as it rapidly increases the 148 * memory allocated for a given string, which minimizes the number of 149 * reallocations that must be performed. However, using only the doubling 150 * algorithm can lead to a significant waste of memory. In particular, it may 151 * fail even when there is sufficient memory available to complete the append 152 * request (but there is not 2*totalLength memory available). So when the 153 * doubling fails (because there is not enough memory available), the 154 * algorithm requests a smaller amount of memory, which is still enough to 155 * cover the request, but which hopefully will be less than the total 156 * available memory. 157 * 158 * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling of very 159 * small appends. Without this extra slush factor, a sequence of several small 160 * appends would cause several memory allocations. As long as 161 * TCL_GROWTH_MIN_ALLOC is a reasonable size, we can avoid that behavior. 162 * 163 * The growth algorithm can be tuned by adjusting the following parameters: 164 * 165 * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when 166 * the double allocation has failed. Default is 167 * 1024 (1 kilobyte). 168 */ 169 170#ifndef TCL_GROWTH_MIN_ALLOC 171#define TCL_GROWTH_MIN_ALLOC 1024 172#endif 173 174static void 175GrowUnicodeBuffer( 176 Tcl_Obj *objPtr, 177 int needed) 178{ 179 /* Pre-conditions: 180 * objPtr->typePtr == &tclStringType 181 * STRING_UALLOC(needed) > stringPtr->uallocated 182 * needed < STRING_MAXCHARS 183 */ 184 String *ptr = NULL, *stringPtr = GET_STRING(objPtr); 185 int attempt; 186 187 if (stringPtr->uallocated > 0) { 188 /* Subsequent appends - apply the growth algorithm. */ 189 attempt = 2 * needed; 190 if (attempt >= 0 && attempt <= STRING_MAXCHARS) { 191 ptr = stringAttemptRealloc(stringPtr, attempt); 192 } 193 if (ptr == NULL) { 194 /* 195 * Take care computing the amount of modest growth to avoid 196 * overflow into invalid argument values for attempt. 197 */ 198 unsigned int limit = STRING_MAXCHARS - needed; 199 unsigned int extra = needed - stringPtr->numChars 200 + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar); 201 int growth = (int) ((extra > limit) ? limit : extra); 202 attempt = needed + growth; 203 ptr = stringAttemptRealloc(stringPtr, attempt); 204 } 205 } 206 if (ptr == NULL) { 207 /* First allocation - just big enough; or last chance fallback. */ 208 attempt = needed; 209 ptr = stringRealloc(stringPtr, attempt); 210 } 211 stringPtr = ptr; 212 stringPtr->uallocated = STRING_UALLOC(attempt); 213 SET_STRING(objPtr, stringPtr); 214} 215 216 217/* 218 *---------------------------------------------------------------------- 219 * 220 * Tcl_NewStringObj -- 221 * 222 * This function is normally called when not debugging: i.e., when 223 * TCL_MEM_DEBUG is not defined. It creates a new string object and 224 * initializes it from the byte pointer and length arguments. 225 * 226 * When TCL_MEM_DEBUG is defined, this function just returns the result 227 * of calling the debugging version Tcl_DbNewStringObj. 228 * 229 * Results: 230 * A newly created string object is returned that has ref count zero. 231 * 232 * Side effects: 233 * The new object's internal string representation will be set to a copy 234 * of the length bytes starting at "bytes". If "length" is negative, use 235 * bytes up to the first NUL byte; i.e., assume "bytes" points to a 236 * C-style NUL-terminated string. The object's type is set to NULL. An 237 * extra NUL is added to the end of the new object's byte array. 238 * 239 *---------------------------------------------------------------------- 240 */ 241 242#ifdef TCL_MEM_DEBUG 243#undef Tcl_NewStringObj 244Tcl_Obj * 245Tcl_NewStringObj( 246 const char *bytes, /* Points to the first of the length bytes 247 * used to initialize the new object. */ 248 int length) /* The number of bytes to copy from "bytes" 249 * when initializing the new object. If 250 * negative, use bytes up to the first NUL 251 * byte. */ 252{ 253 return Tcl_DbNewStringObj(bytes, length, "unknown", 0); 254} 255#else /* if not TCL_MEM_DEBUG */ 256Tcl_Obj * 257Tcl_NewStringObj( 258 const char *bytes, /* Points to the first of the length bytes 259 * used to initialize the new object. */ 260 int length) /* The number of bytes to copy from "bytes" 261 * when initializing the new object. If 262 * negative, use bytes up to the first NUL 263 * byte. */ 264{ 265 register Tcl_Obj *objPtr; 266 267 if (length < 0) { 268 length = (bytes? strlen(bytes) : 0); 269 } 270 TclNewStringObj(objPtr, bytes, length); 271 return objPtr; 272} 273#endif /* TCL_MEM_DEBUG */ 274 275/* 276 *---------------------------------------------------------------------- 277 * 278 * Tcl_DbNewStringObj -- 279 * 280 * This function is normally called when debugging: i.e., when 281 * TCL_MEM_DEBUG is defined. It creates new string objects. It is the 282 * same as the Tcl_NewStringObj function above except that it calls 283 * Tcl_DbCkalloc directly with the file name and line number from its 284 * caller. This simplifies debugging since then the [memory active] 285 * command will report the correct file name and line number when 286 * reporting objects that haven't been freed. 287 * 288 * When TCL_MEM_DEBUG is not defined, this function just returns the 289 * result of calling Tcl_NewStringObj. 290 * 291 * Results: 292 * A newly created string object is returned that has ref count zero. 293 * 294 * Side effects: 295 * The new object's internal string representation will be set to a copy 296 * of the length bytes starting at "bytes". If "length" is negative, use 297 * bytes up to the first NUL byte; i.e., assume "bytes" points to a 298 * C-style NUL-terminated string. The object's type is set to NULL. An 299 * extra NUL is added to the end of the new object's byte array. 300 * 301 *---------------------------------------------------------------------- 302 */ 303 304#ifdef TCL_MEM_DEBUG 305Tcl_Obj * 306Tcl_DbNewStringObj( 307 const char *bytes, /* Points to the first of the length bytes 308 * used to initialize the new object. */ 309 int length, /* The number of bytes to copy from "bytes" 310 * when initializing the new object. If 311 * negative, use bytes up to the first NUL 312 * byte. */ 313 const char *file, /* The name of the source file calling this 314 * function; used for debugging. */ 315 int line) /* Line number in the source file; used for 316 * debugging. */ 317{ 318 register Tcl_Obj *objPtr; 319 320 if (length < 0) { 321 length = (bytes? strlen(bytes) : 0); 322 } 323 TclDbNewObj(objPtr, file, line); 324 TclInitStringRep(objPtr, bytes, length); 325 return objPtr; 326} 327#else /* if not TCL_MEM_DEBUG */ 328Tcl_Obj * 329Tcl_DbNewStringObj( 330 const char *bytes, /* Points to the first of the length bytes 331 * used to initialize the new object. */ 332 register int length, /* The number of bytes to copy from "bytes" 333 * when initializing the new object. If 334 * negative, use bytes up to the first NUL 335 * byte. */ 336 const char *file, /* The name of the source file calling this 337 * function; used for debugging. */ 338 int line) /* Line number in the source file; used for 339 * debugging. */ 340{ 341 return Tcl_NewStringObj(bytes, length); 342} 343#endif /* TCL_MEM_DEBUG */ 344 345/* 346 *--------------------------------------------------------------------------- 347 * 348 * Tcl_NewUnicodeObj -- 349 * 350 * This function is creates a new String object and initializes it from 351 * the given Unicode String. If the Utf String is the same size as the 352 * Unicode string, don't duplicate the data. 353 * 354 * Results: 355 * The newly created object is returned. This object will have no initial 356 * string representation. The returned object has a ref count of 0. 357 * 358 * Side effects: 359 * Memory allocated for new object and copy of Unicode argument. 360 * 361 *--------------------------------------------------------------------------- 362 */ 363 364Tcl_Obj * 365Tcl_NewUnicodeObj( 366 const Tcl_UniChar *unicode, /* The unicode string used to initialize the 367 * new object. */ 368 int numChars) /* Number of characters in the unicode 369 * string. */ 370{ 371 Tcl_Obj *objPtr; 372 373 TclNewObj(objPtr); 374 SetUnicodeObj(objPtr, unicode, numChars); 375 return objPtr; 376} 377 378/* 379 *---------------------------------------------------------------------- 380 * 381 * Tcl_GetCharLength -- 382 * 383 * Get the length of the Unicode string from the Tcl object. 384 * 385 * Results: 386 * Pointer to unicode string representing the unicode object. 387 * 388 * Side effects: 389 * Frees old internal rep. Allocates memory for new "String" internal 390 * rep. 391 * 392 *---------------------------------------------------------------------- 393 */ 394 395int 396Tcl_GetCharLength( 397 Tcl_Obj *objPtr) /* The String object to get the num chars 398 * of. */ 399{ 400 String *stringPtr; 401 402 SetStringFromAny(NULL, objPtr); 403 stringPtr = GET_STRING(objPtr); 404 405 /* 406 * If numChars is unknown, then calculate the number of characaters while 407 * populating the Unicode string. 408 */ 409 410 if (stringPtr->numChars == -1) { 411 register int i = objPtr->length; 412 register unsigned char *str = (unsigned char *) objPtr->bytes; 413 414 /* 415 * This is a speed sensitive function, so run specially over the 416 * string to count continuous ascii characters before resorting to the 417 * Tcl_NumUtfChars call. This is a long form of: 418 stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes,objPtr->length); 419 * 420 * TODO: Consider macro-izing this. 421 */ 422 423 while (i && (*str < 0xC0)) { 424 i--; 425 str++; 426 } 427 stringPtr->numChars = objPtr->length - i; 428 if (i) { 429 stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes 430 + (objPtr->length - i), i); 431 } 432 433 if (stringPtr->numChars == objPtr->length) { 434 /* 435 * Since we've just calculated the number of chars, and all UTF 436 * chars are 1-byte long, we don't need to store the unicode 437 * string. 438 */ 439 440 stringPtr->hasUnicode = 0; 441 } else { 442 /* 443 * Since we've just calucalated the number of chars, and not all 444 * UTF chars are 1-byte long, go ahead and populate the unicode 445 * string. 446 */ 447 448 FillUnicodeRep(objPtr); 449 450 /* 451 * We need to fetch the pointer again because we have just 452 * reallocated the structure to make room for the Unicode data. 453 */ 454 455 stringPtr = GET_STRING(objPtr); 456 } 457 } 458 return stringPtr->numChars; 459} 460 461/* 462 *---------------------------------------------------------------------- 463 * 464 * Tcl_GetUniChar -- 465 * 466 * Get the index'th Unicode character from the String object. The index 467 * is assumed to be in the appropriate range. 468 * 469 * Results: 470 * Returns the index'th Unicode character in the Object. 471 * 472 * Side effects: 473 * Fills unichar with the index'th Unicode character. 474 * 475 *---------------------------------------------------------------------- 476 */ 477 478Tcl_UniChar 479Tcl_GetUniChar( 480 Tcl_Obj *objPtr, /* The object to get the Unicode charater 481 * from. */ 482 int index) /* Get the index'th Unicode character. */ 483{ 484 Tcl_UniChar unichar; 485 String *stringPtr; 486 487 SetStringFromAny(NULL, objPtr); 488 stringPtr = GET_STRING(objPtr); 489 490 if (stringPtr->numChars == -1) { 491 /* 492 * We haven't yet calculated the length, so we don't have the Unicode 493 * str. We need to know the number of chars before we can do indexing. 494 */ 495 496 Tcl_GetCharLength(objPtr); 497 498 /* 499 * We need to fetch the pointer again because we may have just 500 * reallocated the structure. 501 */ 502 503 stringPtr = GET_STRING(objPtr); 504 } 505 if (stringPtr->hasUnicode == 0) { 506 /* 507 * All of the characters in the Utf string are 1 byte chars, so we 508 * don't store the unicode char. We get the Utf string and convert the 509 * index'th byte to a Unicode character. 510 */ 511 512 unichar = (Tcl_UniChar) objPtr->bytes[index]; 513 } else { 514 unichar = stringPtr->unicode[index]; 515 } 516 return unichar; 517} 518 519/* 520 *---------------------------------------------------------------------- 521 * 522 * Tcl_GetUnicode -- 523 * 524 * Get the Unicode form of the String object. If the object is not 525 * already a String object, it will be converted to one. If the String 526 * object does not have a Unicode rep, then one is create from the UTF 527 * string format. 528 * 529 * Results: 530 * Returns a pointer to the object's internal Unicode string. 531 * 532 * Side effects: 533 * Converts the object to have the String internal rep. 534 * 535 *---------------------------------------------------------------------- 536 */ 537 538Tcl_UniChar * 539Tcl_GetUnicode( 540 Tcl_Obj *objPtr) /* The object to find the unicode string 541 * for. */ 542{ 543 String *stringPtr; 544 545 SetStringFromAny(NULL, objPtr); 546 stringPtr = GET_STRING(objPtr); 547 548 if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) { 549 /* 550 * We haven't yet calculated the length, or all of the characters in 551 * the Utf string are 1 byte chars (so we didn't store the unicode 552 * str). Since this function must return a unicode string, and one has 553 * not yet been stored, force the Unicode to be calculated and stored 554 * now. 555 */ 556 557 FillUnicodeRep(objPtr); 558 559 /* 560 * We need to fetch the pointer again because we have just reallocated 561 * the structure to make room for the Unicode data. 562 */ 563 564 stringPtr = GET_STRING(objPtr); 565 } 566 return stringPtr->unicode; 567} 568 569/* 570 *---------------------------------------------------------------------- 571 * 572 * Tcl_GetUnicodeFromObj -- 573 * 574 * Get the Unicode form of the String object with length. If the object 575 * is not already a String object, it will be converted to one. If the 576 * String object does not have a Unicode rep, then one is create from the 577 * UTF string format. 578 * 579 * Results: 580 * Returns a pointer to the object's internal Unicode string. 581 * 582 * Side effects: 583 * Converts the object to have the String internal rep. 584 * 585 *---------------------------------------------------------------------- 586 */ 587 588Tcl_UniChar * 589Tcl_GetUnicodeFromObj( 590 Tcl_Obj *objPtr, /* The object to find the unicode string 591 * for. */ 592 int *lengthPtr) /* If non-NULL, the location where the string 593 * rep's unichar length should be stored. If 594 * NULL, no length is stored. */ 595{ 596 String *stringPtr; 597 598 SetStringFromAny(NULL, objPtr); 599 stringPtr = GET_STRING(objPtr); 600 601 if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) { 602 /* 603 * We haven't yet calculated the length, or all of the characters in 604 * the Utf string are 1 byte chars (so we didn't store the unicode 605 * str). Since this function must return a unicode string, and one has 606 * not yet been stored, force the Unicode to be calculated and stored 607 * now. 608 */ 609 610 FillUnicodeRep(objPtr); 611 612 /* 613 * We need to fetch the pointer again because we have just reallocated 614 * the structure to make room for the Unicode data. 615 */ 616 617 stringPtr = GET_STRING(objPtr); 618 } 619 620 if (lengthPtr != NULL) { 621 *lengthPtr = stringPtr->numChars; 622 } 623 return stringPtr->unicode; 624} 625 626/* 627 *---------------------------------------------------------------------- 628 * 629 * Tcl_GetRange -- 630 * 631 * Create a Tcl Object that contains the chars between first and last of 632 * the object indicated by "objPtr". If the object is not already a 633 * String object, convert it to one. The first and last indices are 634 * assumed to be in the appropriate range. 635 * 636 * Results: 637 * Returns a new Tcl Object of the String type. 638 * 639 * Side effects: 640 * Changes the internal rep of "objPtr" to the String type. 641 * 642 *---------------------------------------------------------------------- 643 */ 644 645Tcl_Obj * 646Tcl_GetRange( 647 Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ 648 int first, /* First index of the range. */ 649 int last) /* Last index of the range. */ 650{ 651 Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ 652 String *stringPtr; 653 654 SetStringFromAny(NULL, objPtr); 655 stringPtr = GET_STRING(objPtr); 656 657 if (stringPtr->numChars == -1) { 658 /* 659 * We haven't yet calculated the length, so we don't have the Unicode 660 * str. We need to know the number of chars before we can do indexing. 661 */ 662 663 Tcl_GetCharLength(objPtr); 664 665 /* 666 * We need to fetch the pointer again because we may have just 667 * reallocated the structure. 668 */ 669 670 stringPtr = GET_STRING(objPtr); 671 } 672 673 if (objPtr->bytes && (stringPtr->numChars == objPtr->length)) { 674 char *str = TclGetString(objPtr); 675 676 /* 677 * All of the characters in the Utf string are 1 byte chars, so we 678 * don't store the unicode char. Create a new string object containing 679 * the specified range of chars. 680 */ 681 682 newObjPtr = Tcl_NewStringObj(&str[first], last-first+1); 683 684 /* 685 * Since we know the new string only has 1-byte chars, we can set it's 686 * numChars field. 687 */ 688 689 SetStringFromAny(NULL, newObjPtr); 690 stringPtr = GET_STRING(newObjPtr); 691 stringPtr->numChars = last-first+1; 692 } else { 693 newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first, 694 last-first+1); 695 } 696 return newObjPtr; 697} 698 699/* 700 *---------------------------------------------------------------------- 701 * 702 * Tcl_SetStringObj -- 703 * 704 * Modify an object to hold a string that is a copy of the bytes 705 * indicated by the byte pointer and length arguments. 706 * 707 * Results: 708 * None. 709 * 710 * Side effects: 711 * The object's string representation will be set to a copy of the 712 * "length" bytes starting at "bytes". If "length" is negative, use bytes 713 * up to the first NUL byte; i.e., assume "bytes" points to a C-style 714 * NUL-terminated string. The object's old string and internal 715 * representations are freed and the object's type is set NULL. 716 * 717 *---------------------------------------------------------------------- 718 */ 719 720void 721Tcl_SetStringObj( 722 register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ 723 const char *bytes, /* Points to the first of the length bytes 724 * used to initialize the object. */ 725 register int length) /* The number of bytes to copy from "bytes" 726 * when initializing the object. If negative, 727 * use bytes up to the first NUL byte.*/ 728{ 729 if (Tcl_IsShared(objPtr)) { 730 Tcl_Panic("%s called with shared object", "Tcl_SetStringObj"); 731 } 732 733 /* 734 * Set the type to NULL and free any internal rep for the old type. 735 */ 736 737 TclFreeIntRep(objPtr); 738 objPtr->typePtr = NULL; 739 740 /* 741 * Free any old string rep, then set the string rep to a copy of the 742 * length bytes starting at "bytes". 743 */ 744 745 Tcl_InvalidateStringRep(objPtr); 746 if (length < 0) { 747 length = (bytes? strlen(bytes) : 0); 748 } 749 TclInitStringRep(objPtr, bytes, length); 750} 751 752/* 753 *---------------------------------------------------------------------- 754 * 755 * Tcl_SetObjLength -- 756 * 757 * This function changes the length of the string representation of an 758 * object. 759 * 760 * Results: 761 * None. 762 * 763 * Side effects: 764 * If the size of objPtr's string representation is greater than length, 765 * then it is reduced to length and a new terminating null byte is stored 766 * in the strength. If the length of the string representation is greater 767 * than length, the storage space is reallocated to the given length; a 768 * null byte is stored at the end, but other bytes past the end of the 769 * original string representation are undefined. The object's internal 770 * representation is changed to "expendable string". 771 * 772 *---------------------------------------------------------------------- 773 */ 774 775void 776Tcl_SetObjLength( 777 register Tcl_Obj *objPtr, /* Pointer to object. This object must not 778 * currently be shared. */ 779 register int length) /* Number of bytes desired for string 780 * representation of object, not including 781 * terminating null byte. */ 782{ 783 String *stringPtr; 784 785 if (length < 0) { 786 /* 787 * Setting to a negative length is nonsense. This is probably the 788 * result of overflowing the signed integer range. 789 */ 790 Tcl_Panic("Tcl_SetObjLength: negative length requested: " 791 "%d (integer overflow?)", length); 792 } 793 if (Tcl_IsShared(objPtr)) { 794 Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); 795 } 796 SetStringFromAny(NULL, objPtr); 797 798 stringPtr = GET_STRING(objPtr); 799 800 /* 801 * Check that we're not extending a pure unicode string. 802 */ 803 804 if ((size_t)length > stringPtr->allocated && 805 (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) { 806 /* 807 * Not enough space in current string. Reallocate the string space and 808 * free the old string. 809 */ 810 811 if (objPtr->bytes != tclEmptyStringRep) { 812 objPtr->bytes = ckrealloc((char *) objPtr->bytes, 813 (unsigned) (length + 1)); 814 } else { 815 char *newBytes = ckalloc((unsigned) (length+1)); 816 817 if (objPtr->bytes != NULL && objPtr->length != 0) { 818 memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length); 819 Tcl_InvalidateStringRep(objPtr); 820 } 821 objPtr->bytes = newBytes; 822 } 823 stringPtr->allocated = length; 824 825 /* 826 * Invalidate the unicode data. 827 */ 828 829 stringPtr->hasUnicode = 0; 830 } 831 832 if (objPtr->bytes != NULL) { 833 objPtr->length = length; 834 if (objPtr->bytes != tclEmptyStringRep) { 835 /* 836 * Ensure the string is NUL-terminated. 837 */ 838 839 objPtr->bytes[length] = 0; 840 } 841 842 /* 843 * Invalidate the unicode data. 844 */ 845 846 stringPtr->numChars = -1; 847 stringPtr->hasUnicode = 0; 848 } else { 849 /* 850 * Changing length of pure unicode string. 851 */ 852 853 size_t uallocated = STRING_UALLOC(length); 854 855 stringCheckLimits(length); 856 if (uallocated > stringPtr->uallocated) { 857 stringPtr = stringRealloc(stringPtr, length); 858 SET_STRING(objPtr, stringPtr); 859 stringPtr->uallocated = uallocated; 860 } 861 stringPtr->numChars = length; 862 stringPtr->hasUnicode = (length > 0); 863 864 /* 865 * Ensure the string is NUL-terminated. 866 */ 867 868 stringPtr->unicode[length] = 0; 869 stringPtr->allocated = 0; 870 objPtr->length = 0; 871 } 872} 873 874/* 875 *---------------------------------------------------------------------- 876 * 877 * Tcl_AttemptSetObjLength -- 878 * 879 * This function changes the length of the string representation of an 880 * object. It uses the attempt* (non-panic'ing) memory allocators. 881 * 882 * Results: 883 * 1 if the requested memory was allocated, 0 otherwise. 884 * 885 * Side effects: 886 * If the size of objPtr's string representation is greater than length, 887 * then it is reduced to length and a new terminating null byte is stored 888 * in the strength. If the length of the string representation is greater 889 * than length, the storage space is reallocated to the given length; a 890 * null byte is stored at the end, but other bytes past the end of the 891 * original string representation are undefined. The object's internal 892 * representation is changed to "expendable string". 893 * 894 *---------------------------------------------------------------------- 895 */ 896 897int 898Tcl_AttemptSetObjLength( 899 register Tcl_Obj *objPtr, /* Pointer to object. This object must not 900 * currently be shared. */ 901 register int length) /* Number of bytes desired for string 902 * representation of object, not including 903 * terminating null byte. */ 904{ 905 String *stringPtr; 906 907 if (length < 0) { 908 /* 909 * Setting to a negative length is nonsense. This is probably the 910 * result of overflowing the signed integer range. 911 */ 912 return 0; 913 } 914 if (Tcl_IsShared(objPtr)) { 915 Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); 916 } 917 SetStringFromAny(NULL, objPtr); 918 919 stringPtr = GET_STRING(objPtr); 920 921 /* 922 * Check that we're not extending a pure unicode string. 923 */ 924 925 if (length > (int) stringPtr->allocated && 926 (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) { 927 char *newBytes; 928 929 /* 930 * Not enough space in current string. Reallocate the string space and 931 * free the old string. 932 */ 933 934 if (objPtr->bytes != tclEmptyStringRep) { 935 newBytes = attemptckrealloc(objPtr->bytes, 936 (unsigned)(length + 1)); 937 if (newBytes == NULL) { 938 return 0; 939 } 940 } else { 941 newBytes = attemptckalloc((unsigned) (length + 1)); 942 if (newBytes == NULL) { 943 return 0; 944 } 945 if (objPtr->bytes != NULL && objPtr->length != 0) { 946 memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length); 947 Tcl_InvalidateStringRep(objPtr); 948 } 949 } 950 objPtr->bytes = newBytes; 951 stringPtr->allocated = length; 952 953 /* 954 * Invalidate the unicode data. 955 */ 956 957 stringPtr->hasUnicode = 0; 958 } 959 960 if (objPtr->bytes != NULL) { 961 objPtr->length = length; 962 if (objPtr->bytes != tclEmptyStringRep) { 963 /* 964 * Ensure the string is NULL-terminated. 965 */ 966 967 objPtr->bytes[length] = 0; 968 } 969 970 /* 971 * Invalidate the unicode data. 972 */ 973 974 stringPtr->numChars = -1; 975 stringPtr->hasUnicode = 0; 976 } else { 977 /* 978 * Changing length of pure unicode string. 979 */ 980 981 size_t uallocated = STRING_UALLOC(length); 982 if (length > STRING_MAXCHARS) { 983 return 0; 984 } 985 986 if (uallocated > stringPtr->uallocated) { 987 stringPtr = stringAttemptRealloc(stringPtr, length); 988 if (stringPtr == NULL) { 989 return 0; 990 } 991 SET_STRING(objPtr, stringPtr); 992 stringPtr->uallocated = uallocated; 993 } 994 stringPtr->numChars = length; 995 stringPtr->hasUnicode = (length > 0); 996 997 /* 998 * Ensure the string is NUL-terminated. 999 */ 1000 1001 stringPtr->unicode[length] = 0; 1002 stringPtr->allocated = 0; 1003 objPtr->length = 0; 1004 } 1005 return 1; 1006} 1007 1008/* 1009 *--------------------------------------------------------------------------- 1010 * 1011 * Tcl_SetUnicodeObj -- 1012 * 1013 * Modify an object to hold the Unicode string indicated by "unicode". 1014 * 1015 * Results: 1016 * None. 1017 * 1018 * Side effects: 1019 * Memory allocated for new "String" internal rep. 1020 * 1021 *--------------------------------------------------------------------------- 1022 */ 1023 1024void 1025Tcl_SetUnicodeObj( 1026 Tcl_Obj *objPtr, /* The object to set the string of. */ 1027 const Tcl_UniChar *unicode, /* The unicode string used to initialize the 1028 * object. */ 1029 int numChars) /* Number of characters in the unicode 1030 * string. */ 1031{ 1032 if (Tcl_IsShared(objPtr)) { 1033 Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj"); 1034 } 1035 TclFreeIntRep(objPtr); 1036 SetUnicodeObj(objPtr, unicode, numChars); 1037} 1038 1039static int 1040UnicodeLength( 1041 const Tcl_UniChar *unicode) 1042{ 1043 int numChars = 0; 1044 1045 if (unicode) { 1046 while (numChars >= 0 && unicode[numChars] != 0) { 1047 numChars++; 1048 } 1049 } 1050 stringCheckLimits(numChars); 1051 return numChars; 1052} 1053 1054static void 1055SetUnicodeObj( 1056 Tcl_Obj *objPtr, /* The object to set the string of. */ 1057 const Tcl_UniChar *unicode, /* The unicode string used to initialize the 1058 * object. */ 1059 int numChars) /* Number of characters in the unicode 1060 * string. */ 1061{ 1062 String *stringPtr; 1063 size_t uallocated; 1064 1065 if (numChars < 0) { 1066 numChars = UnicodeLength(unicode); 1067 } 1068 1069 /* 1070 * Allocate enough space for the String structure + Unicode string. 1071 */ 1072 1073 stringCheckLimits(numChars); 1074 uallocated = STRING_UALLOC(numChars); 1075 stringPtr = (String *) ckalloc(STRING_SIZE(uallocated)); 1076 1077 stringPtr->numChars = numChars; 1078 stringPtr->uallocated = uallocated; 1079 stringPtr->hasUnicode = (numChars > 0); 1080 stringPtr->allocated = 0; 1081 memcpy(stringPtr->unicode, unicode, uallocated); 1082 stringPtr->unicode[numChars] = 0; 1083 1084 Tcl_InvalidateStringRep(objPtr); 1085 objPtr->typePtr = &tclStringType; 1086 SET_STRING(objPtr, stringPtr); 1087} 1088 1089/* 1090 *---------------------------------------------------------------------- 1091 * 1092 * Tcl_AppendLimitedToObj -- 1093 * 1094 * This function appends a limited number of bytes from a sequence of 1095 * bytes to an object, marking any limitation with an ellipsis. 1096 * 1097 * Results: 1098 * None. 1099 * 1100 * Side effects: 1101 * The bytes at *bytes are appended to the string representation of 1102 * objPtr. 1103 * 1104 *---------------------------------------------------------------------- 1105 */ 1106 1107void 1108Tcl_AppendLimitedToObj( 1109 register Tcl_Obj *objPtr, /* Points to the object to append to. */ 1110 const char *bytes, /* Points to the bytes to append to the 1111 * object. */ 1112 register int length, /* The number of bytes available to be 1113 * appended from "bytes". If < 0, then all 1114 * bytes up to a NUL byte are available. */ 1115 register int limit, /* The maximum number of bytes to append to 1116 * the object. */ 1117 const char *ellipsis) /* Ellipsis marker string, appended to the 1118 * object to indicate not all available bytes 1119 * at "bytes" were appended. */ 1120{ 1121 String *stringPtr; 1122 int toCopy = 0; 1123 1124 if (Tcl_IsShared(objPtr)) { 1125 Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj"); 1126 } 1127 1128 SetStringFromAny(NULL, objPtr); 1129 1130 if (length < 0) { 1131 length = (bytes ? strlen(bytes) : 0); 1132 } 1133 if (length == 0) { 1134 return; 1135 } 1136 1137 if (length <= limit) { 1138 toCopy = length; 1139 } else { 1140 if (ellipsis == NULL) { 1141 ellipsis = "..."; 1142 } 1143 toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes; 1144 } 1145 1146 /* 1147 * If objPtr has a valid Unicode rep, then append the Unicode conversion 1148 * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to 1149 * objPtr's string rep. 1150 */ 1151 1152 stringPtr = GET_STRING(objPtr); 1153 if (stringPtr->hasUnicode != 0) { 1154 AppendUtfToUnicodeRep(objPtr, bytes, toCopy); 1155 } else { 1156 AppendUtfToUtfRep(objPtr, bytes, toCopy); 1157 } 1158 1159 if (length <= limit) { 1160 return; 1161 } 1162 1163 stringPtr = GET_STRING(objPtr); 1164 if (stringPtr->hasUnicode != 0) { 1165 AppendUtfToUnicodeRep(objPtr, ellipsis, -1); 1166 } else { 1167 AppendUtfToUtfRep(objPtr, ellipsis, -1); 1168 } 1169} 1170 1171/* 1172 *---------------------------------------------------------------------- 1173 * 1174 * Tcl_AppendToObj -- 1175 * 1176 * This function appends a sequence of bytes to an object. 1177 * 1178 * Results: 1179 * None. 1180 * 1181 * Side effects: 1182 * The bytes at *bytes are appended to the string representation of 1183 * objPtr. 1184 * 1185 *---------------------------------------------------------------------- 1186 */ 1187 1188void 1189Tcl_AppendToObj( 1190 register Tcl_Obj *objPtr, /* Points to the object to append to. */ 1191 const char *bytes, /* Points to the bytes to append to the 1192 * object. */ 1193 register int length) /* The number of bytes to append from "bytes". 1194 * If < 0, then append all bytes up to NUL 1195 * byte. */ 1196{ 1197 Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); 1198} 1199 1200/* 1201 *---------------------------------------------------------------------- 1202 * 1203 * Tcl_AppendUnicodeToObj -- 1204 * 1205 * This function appends a Unicode string to an object in the most 1206 * efficient manner possible. Length must be >= 0. 1207 * 1208 * Results: 1209 * None. 1210 * 1211 * Side effects: 1212 * Invalidates the string rep and creates a new Unicode string. 1213 * 1214 *---------------------------------------------------------------------- 1215 */ 1216 1217void 1218Tcl_AppendUnicodeToObj( 1219 register Tcl_Obj *objPtr, /* Points to the object to append to. */ 1220 const Tcl_UniChar *unicode, /* The unicode string to append to the 1221 * object. */ 1222 int length) /* Number of chars in "unicode". */ 1223{ 1224 String *stringPtr; 1225 1226 if (Tcl_IsShared(objPtr)) { 1227 Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); 1228 } 1229 1230 if (length == 0) { 1231 return; 1232 } 1233 1234 SetStringFromAny(NULL, objPtr); 1235 stringPtr = GET_STRING(objPtr); 1236 1237 /* 1238 * If objPtr has a valid Unicode rep, then append the "unicode" to the 1239 * objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to 1240 * objPtr's string rep. 1241 */ 1242 1243 if (stringPtr->hasUnicode != 0) { 1244 AppendUnicodeToUnicodeRep(objPtr, unicode, length); 1245 } else { 1246 AppendUnicodeToUtfRep(objPtr, unicode, length); 1247 } 1248} 1249 1250/* 1251 *---------------------------------------------------------------------- 1252 * 1253 * Tcl_AppendObjToObj -- 1254 * 1255 * This function appends the string rep of one object to another. 1256 * "objPtr" cannot be a shared object. 1257 * 1258 * Results: 1259 * None. 1260 * 1261 * Side effects: 1262 * The string rep of appendObjPtr is appended to the string 1263 * representation of objPtr. 1264 * 1265 *---------------------------------------------------------------------- 1266 */ 1267 1268void 1269Tcl_AppendObjToObj( 1270 Tcl_Obj *objPtr, /* Points to the object to append to. */ 1271 Tcl_Obj *appendObjPtr) /* Object to append. */ 1272{ 1273 String *stringPtr; 1274 int length, numChars, allOneByteChars; 1275 char *bytes; 1276 1277 SetStringFromAny(NULL, objPtr); 1278 1279 /* 1280 * If objPtr has a valid Unicode rep, then get a Unicode string from 1281 * appendObjPtr and append it. 1282 */ 1283 1284 stringPtr = GET_STRING(objPtr); 1285 if (stringPtr->hasUnicode != 0) { 1286 /* 1287 * If appendObjPtr is not of the "String" type, don't convert it. 1288 */ 1289 1290 if (appendObjPtr->typePtr == &tclStringType) { 1291 stringPtr = GET_STRING(appendObjPtr); 1292 if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) { 1293 /* 1294 * If appendObjPtr is a string obj with no valid Unicode rep, 1295 * then fill its unicode rep. 1296 */ 1297 1298 FillUnicodeRep(appendObjPtr); 1299 stringPtr = GET_STRING(appendObjPtr); 1300 } 1301 AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode, 1302 stringPtr->numChars); 1303 } else { 1304 bytes = TclGetStringFromObj(appendObjPtr, &length); 1305 AppendUtfToUnicodeRep(objPtr, bytes, length); 1306 } 1307 return; 1308 } 1309 1310 /* 1311 * Append to objPtr's UTF string rep. If we know the number of characters 1312 * in both objects before appending, then set the combined number of 1313 * characters in the final (appended-to) object. 1314 */ 1315 1316 bytes = TclGetStringFromObj(appendObjPtr, &length); 1317 1318 allOneByteChars = 0; 1319 numChars = stringPtr->numChars; 1320 if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) { 1321 stringPtr = GET_STRING(appendObjPtr); 1322 if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) { 1323 numChars += stringPtr->numChars; 1324 allOneByteChars = 1; 1325 } 1326 } 1327 1328 AppendUtfToUtfRep(objPtr, bytes, length); 1329 1330 if (allOneByteChars) { 1331 stringPtr = GET_STRING(objPtr); 1332 stringPtr->numChars = numChars; 1333 } 1334} 1335 1336/* 1337 *---------------------------------------------------------------------- 1338 * 1339 * AppendUnicodeToUnicodeRep -- 1340 * 1341 * This function appends the contents of "unicode" to the Unicode rep of 1342 * "objPtr". objPtr must already have a valid Unicode rep. 1343 * 1344 * Results: 1345 * None. 1346 * 1347 * Side effects: 1348 * objPtr's internal rep is reallocated. 1349 * 1350 *---------------------------------------------------------------------- 1351 */ 1352 1353static void 1354AppendUnicodeToUnicodeRep( 1355 Tcl_Obj *objPtr, /* Points to the object to append to. */ 1356 const Tcl_UniChar *unicode, /* String to append. */ 1357 int appendNumChars) /* Number of chars of "unicode" to append. */ 1358{ 1359 String *stringPtr; 1360 int numChars; 1361 1362 if (appendNumChars < 0) { 1363 appendNumChars = UnicodeLength(unicode); 1364 } 1365 if (appendNumChars == 0) { 1366 return; 1367 } 1368 1369 SetStringFromAny(NULL, objPtr); 1370 stringPtr = GET_STRING(objPtr); 1371 1372 /* 1373 * If not enough space has been allocated for the unicode rep, reallocate 1374 * the internal rep object with additional space. First try to double the 1375 * required allocation; if that fails, try a more modest increase. See the 1376 * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an 1377 * explanation of this growth algorithm. 1378 */ 1379 1380 numChars = stringPtr->numChars + appendNumChars; 1381 stringCheckLimits(numChars); 1382 1383 if (STRING_UALLOC(numChars) >= stringPtr->uallocated) { 1384 /* 1385 * Protect against case where unicode points into the existing 1386 * stringPtr->unicode array. Force it to follow any relocations 1387 * due to the reallocs below. 1388 */ 1389 int offset = -1; 1390 if (unicode >= stringPtr->unicode && unicode <= stringPtr->unicode 1391 + 1 + stringPtr->uallocated / sizeof(Tcl_UniChar)) { 1392 offset = unicode - stringPtr->unicode; 1393 } 1394 1395 GrowUnicodeBuffer(objPtr, numChars); 1396 stringPtr = GET_STRING(objPtr); 1397 1398 /* Relocate unicode if needed; see above. */ 1399 if (offset >= 0) { 1400 unicode = stringPtr->unicode + offset; 1401 } 1402 } 1403 1404 /* 1405 * Copy the new string onto the end of the old string, then add the 1406 * trailing null. 1407 */ 1408 1409 memcpy(stringPtr->unicode + stringPtr->numChars, unicode, 1410 appendNumChars * sizeof(Tcl_UniChar)); 1411 stringPtr->unicode[numChars] = 0; 1412 stringPtr->numChars = numChars; 1413 stringPtr->allocated = 0; 1414 1415 Tcl_InvalidateStringRep(objPtr); 1416} 1417 1418/* 1419 *---------------------------------------------------------------------- 1420 * 1421 * AppendUnicodeToUtfRep -- 1422 * 1423 * This function converts the contents of "unicode" to UTF and appends 1424 * the UTF to the string rep of "objPtr". 1425 * 1426 * Results: 1427 * None. 1428 * 1429 * Side effects: 1430 * objPtr's internal rep is reallocated. 1431 * 1432 *---------------------------------------------------------------------- 1433 */ 1434 1435static void 1436AppendUnicodeToUtfRep( 1437 Tcl_Obj *objPtr, /* Points to the object to append to. */ 1438 const Tcl_UniChar *unicode, /* String to convert to UTF. */ 1439 int numChars) /* Number of chars of "unicode" to convert. */ 1440{ 1441 Tcl_DString dsPtr; 1442 const char *bytes; 1443 1444 if (numChars < 0) { 1445 numChars = UnicodeLength(unicode); 1446 } 1447 if (numChars == 0) { 1448 return; 1449 } 1450 1451 Tcl_DStringInit(&dsPtr); 1452 bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr); 1453 AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr)); 1454 Tcl_DStringFree(&dsPtr); 1455} 1456 1457/* 1458 *---------------------------------------------------------------------- 1459 * 1460 * AppendUtfToUnicodeRep -- 1461 * 1462 * This function converts the contents of "bytes" to Unicode and appends 1463 * the Unicode to the Unicode rep of "objPtr". objPtr must already have a 1464 * valid Unicode rep. 1465 * 1466 * Results: 1467 * None. 1468 * 1469 * Side effects: 1470 * objPtr's internal rep is reallocated. 1471 * 1472 *---------------------------------------------------------------------- 1473 */ 1474 1475static void 1476AppendUtfToUnicodeRep( 1477 Tcl_Obj *objPtr, /* Points to the object to append to. */ 1478 const char *bytes, /* String to convert to Unicode. */ 1479 int numBytes) /* Number of bytes of "bytes" to convert. */ 1480{ 1481 Tcl_DString dsPtr; 1482 int numChars; 1483 Tcl_UniChar *unicode; 1484 1485 if (numBytes < 0) { 1486 numBytes = (bytes ? strlen(bytes) : 0); 1487 } 1488 if (numBytes == 0) { 1489 return; 1490 } 1491 1492 Tcl_DStringInit(&dsPtr); 1493 numChars = Tcl_NumUtfChars(bytes, numBytes); 1494 unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr); 1495 AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); 1496 Tcl_DStringFree(&dsPtr); 1497} 1498 1499/* 1500 *---------------------------------------------------------------------- 1501 * 1502 * AppendUtfToUtfRep -- 1503 * 1504 * This function appends "numBytes" bytes of "bytes" to the UTF string 1505 * rep of "objPtr". objPtr must already have a valid String rep. 1506 * 1507 * Results: 1508 * None. 1509 * 1510 * Side effects: 1511 * objPtr's internal rep is reallocated. 1512 * 1513 *---------------------------------------------------------------------- 1514 */ 1515 1516static void 1517AppendUtfToUtfRep( 1518 Tcl_Obj *objPtr, /* Points to the object to append to. */ 1519 const char *bytes, /* String to append. */ 1520 int numBytes) /* Number of bytes of "bytes" to append. */ 1521{ 1522 String *stringPtr; 1523 int newLength, oldLength; 1524 1525 if (numBytes < 0) { 1526 numBytes = (bytes ? strlen(bytes) : 0); 1527 } 1528 if (numBytes == 0) { 1529 return; 1530 } 1531 1532 /* 1533 * Copy the new string onto the end of the old string, then add the 1534 * trailing null. 1535 */ 1536 1537 oldLength = objPtr->length; 1538 newLength = numBytes + oldLength; 1539 if (newLength < 0) { 1540 Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); 1541 } 1542 1543 stringPtr = GET_STRING(objPtr); 1544 if (newLength > (int) stringPtr->allocated) { 1545 /* 1546 * Protect against case where unicode points into the existing 1547 * stringPtr->unicode array. Force it to follow any relocations 1548 * due to the reallocs below. 1549 */ 1550 int offset = -1; 1551 if (bytes >= objPtr->bytes 1552 && bytes <= objPtr->bytes + objPtr->length) { 1553 offset = bytes - objPtr->bytes; 1554 } 1555 1556 /* 1557 * There isn't currently enough space in the string representation so 1558 * allocate additional space. First, try to double the length 1559 * required. If that fails, try a more modest allocation. See the "TCL 1560 * STRING GROWTH ALGORITHM" comment at the top of this file for an 1561 * explanation of this growth algorithm. 1562 */ 1563 1564 if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) { 1565 /* 1566 * Take care computing the amount of modest growth to avoid 1567 * overflow into invalid argument values for Tcl_SetObjLength. 1568 */ 1569 unsigned int limit = INT_MAX - newLength; 1570 unsigned int extra = numBytes + TCL_GROWTH_MIN_ALLOC; 1571 int growth = (int) ((extra > limit) ? limit : extra); 1572 1573 Tcl_SetObjLength(objPtr, newLength + growth); 1574 } 1575 1576 /* Relocate bytes if needed; see above. */ 1577 if (offset >=0) { 1578 bytes = objPtr->bytes + offset; 1579 } 1580 } 1581 1582 /* 1583 * Invalidate the unicode data. 1584 */ 1585 1586 stringPtr->numChars = -1; 1587 stringPtr->hasUnicode = 0; 1588 1589 memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes); 1590 objPtr->bytes[newLength] = 0; 1591 objPtr->length = newLength; 1592} 1593 1594/* 1595 *---------------------------------------------------------------------- 1596 * 1597 * Tcl_AppendStringsToObjVA -- 1598 * 1599 * This function appends one or more null-terminated strings to an 1600 * object. 1601 * 1602 * Results: 1603 * None. 1604 * 1605 * Side effects: 1606 * The contents of all the string arguments are appended to the string 1607 * representation of objPtr. 1608 * 1609 *---------------------------------------------------------------------- 1610 */ 1611 1612void 1613Tcl_AppendStringsToObjVA( 1614 Tcl_Obj *objPtr, /* Points to the object to append to. */ 1615 va_list argList) /* Variable argument list. */ 1616{ 1617#define STATIC_LIST_SIZE 16 1618 String *stringPtr; 1619 int newLength, oldLength, attemptLength; 1620 register char *string, *dst; 1621 char *static_list[STATIC_LIST_SIZE]; 1622 char **args = static_list; 1623 int nargs_space = STATIC_LIST_SIZE; 1624 int nargs, i; 1625 1626 if (Tcl_IsShared(objPtr)) { 1627 Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); 1628 } 1629 1630 SetStringFromAny(NULL, objPtr); 1631 1632 /* 1633 * Force the existence of a string rep. so we avoid crashes operating 1634 * on a pure unicode value. [Bug 2597185] 1635 */ 1636 1637 (void) Tcl_GetStringFromObj(objPtr, &oldLength); 1638 1639 /* 1640 * Figure out how much space is needed for all the strings, and expand the 1641 * string representation if it isn't big enough. If no bytes would be 1642 * appended, just return. Note that on some platforms (notably OS/390) the 1643 * argList is an array so we need to use memcpy. 1644 */ 1645 1646 nargs = 0; 1647 newLength = 0; 1648 while (1) { 1649 string = va_arg(argList, char *); 1650 if (string == NULL) { 1651 break; 1652 } 1653 if (nargs >= nargs_space) { 1654 /* 1655 * Expand the args buffer. 1656 */ 1657 1658 nargs_space += STATIC_LIST_SIZE; 1659 if (args == static_list) { 1660 args = (void *) ckalloc(nargs_space * sizeof(char *)); 1661 for (i = 0; i < nargs; ++i) { 1662 args[i] = static_list[i]; 1663 } 1664 } else { 1665 args = (void *) ckrealloc((void *) args, 1666 nargs_space * sizeof(char *)); 1667 } 1668 } 1669 newLength += strlen(string); 1670 args[nargs++] = string; 1671 } 1672 if (newLength == 0) { 1673 goto done; 1674 } 1675 1676 stringPtr = GET_STRING(objPtr); 1677 if (oldLength + newLength > (int) stringPtr->allocated) { 1678 /* 1679 * There isn't currently enough space in the string representation, so 1680 * allocate additional space. If the current string representation 1681 * isn't empty (i.e. it looks like we're doing a series of appends) 1682 * then try to allocate extra space to accomodate future growth: first 1683 * try to double the required memory; if that fails, try a more modest 1684 * allocation. See the "TCL STRING GROWTH ALGORITHM" comment at the 1685 * top of this file for an explanation of this growth algorithm. 1686 * Otherwise, if the current string representation is empty, exactly 1687 * enough memory is allocated. 1688 */ 1689 1690 if (oldLength == 0) { 1691 Tcl_SetObjLength(objPtr, newLength); 1692 } else { 1693 attemptLength = 2 * (oldLength + newLength); 1694 if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) { 1695 attemptLength = oldLength + (2 * newLength) + 1696 TCL_GROWTH_MIN_ALLOC; 1697 Tcl_SetObjLength(objPtr, attemptLength); 1698 } 1699 } 1700 } 1701 1702 /* 1703 * Make a second pass through the arguments, appending all the strings to 1704 * the object. 1705 */ 1706 1707 dst = objPtr->bytes + oldLength; 1708 for (i = 0; i < nargs; ++i) { 1709 string = args[i]; 1710 if (string == NULL) { 1711 break; 1712 } 1713 while (*string != 0) { 1714 *dst = *string; 1715 dst++; 1716 string++; 1717 } 1718 } 1719 1720 /* 1721 * Add a null byte to terminate the string. However, be careful: it's 1722 * possible that the object is totally empty (if it was empty originally 1723 * and there was nothing to append). In this case dst is NULL; just leave 1724 * everything alone. 1725 */ 1726 1727 if (dst != NULL) { 1728 *dst = 0; 1729 } 1730 objPtr->length = oldLength + newLength; 1731 1732 done: 1733 /* 1734 * If we had to allocate a buffer from the heap, free it now. 1735 */ 1736 1737 if (args != static_list) { 1738 ckfree((void *) args); 1739 } 1740#undef STATIC_LIST_SIZE 1741} 1742 1743/* 1744 *---------------------------------------------------------------------- 1745 * 1746 * Tcl_AppendStringsToObj -- 1747 * 1748 * This function appends one or more null-terminated strings to an 1749 * object. 1750 * 1751 * Results: 1752 * None. 1753 * 1754 * Side effects: 1755 * The contents of all the string arguments are appended to the string 1756 * representation of objPtr. 1757 * 1758 *---------------------------------------------------------------------- 1759 */ 1760 1761void 1762Tcl_AppendStringsToObj( 1763 Tcl_Obj *objPtr, 1764 ...) 1765{ 1766 va_list argList; 1767 1768 va_start(argList, objPtr); 1769 Tcl_AppendStringsToObjVA(objPtr, argList); 1770 va_end(argList); 1771} 1772 1773/* 1774 *---------------------------------------------------------------------- 1775 * 1776 * Tcl_AppendFormatToObj -- 1777 * 1778 * This function appends a list of Tcl_Obj's to a Tcl_Obj according to 1779 * the formatting instructions embedded in the format string. The 1780 * formatting instructions are inspired by sprintf(). Returns TCL_OK when 1781 * successful. If there's an error in the arguments, TCL_ERROR is 1782 * returned, and an error message is written to the interp, if non-NULL. 1783 * 1784 * Results: 1785 * A standard Tcl result. 1786 * 1787 * Side effects: 1788 * None. 1789 * 1790 *---------------------------------------------------------------------- 1791 */ 1792 1793int 1794Tcl_AppendFormatToObj( 1795 Tcl_Interp *interp, 1796 Tcl_Obj *appendObj, 1797 const char *format, 1798 int objc, 1799 Tcl_Obj *const objv[]) 1800{ 1801 const char *span = format, *msg; 1802 int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; 1803 int originalLength, limit; 1804 static const char *mixedXPG = 1805 "cannot mix \"%\" and \"%n$\" conversion specifiers"; 1806 static const char *badIndex[2] = { 1807 "not enough arguments for all format specifiers", 1808 "\"%n$\" argument index out of range" 1809 }; 1810 static const char *overflow = "max size for a Tcl value exceeded"; 1811 1812 if (Tcl_IsShared(appendObj)) { 1813 Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); 1814 } 1815 TclGetStringFromObj(appendObj, &originalLength); 1816 limit = INT_MAX - originalLength; 1817 1818 /* 1819 * Format string is NUL-terminated. 1820 */ 1821 1822 while (*format != '\0') { 1823 char *end; 1824 int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag; 1825 int width, gotPrecision, precision, useShort, useWide, useBig; 1826 int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; 1827 Tcl_Obj *segment; 1828 Tcl_UniChar ch; 1829 int step = Tcl_UtfToUniChar(format, &ch); 1830 1831 format += step; 1832 if (ch != '%') { 1833 numBytes += step; 1834 continue; 1835 } 1836 if (numBytes) { 1837 if (numBytes > limit) { 1838 msg = overflow; 1839 goto errorMsg; 1840 } 1841 Tcl_AppendToObj(appendObj, span, numBytes); 1842 limit -= numBytes; 1843 numBytes = 0; 1844 } 1845 1846 /* 1847 * Saw a % : process the format specifier. 1848 * 1849 * Step 0. Handle special case of escaped format marker (i.e., %%). 1850 */ 1851 1852 step = Tcl_UtfToUniChar(format, &ch); 1853 if (ch == '%') { 1854 span = format; 1855 numBytes = step; 1856 format += step; 1857 continue; 1858 } 1859 1860 /* 1861 * Step 1. XPG3 position specifier 1862 */ 1863 1864 newXpg = 0; 1865 if (isdigit(UCHAR(ch))) { 1866 int position = strtoul(format, &end, 10); 1867 if (*end == '$') { 1868 newXpg = 1; 1869 objIndex = position - 1; 1870 format = end + 1; 1871 step = Tcl_UtfToUniChar(format, &ch); 1872 } 1873 } 1874 if (newXpg) { 1875 if (gotSequential) { 1876 msg = mixedXPG; 1877 goto errorMsg; 1878 } 1879 gotXpg = 1; 1880 } else { 1881 if (gotXpg) { 1882 msg = mixedXPG; 1883 goto errorMsg; 1884 } 1885 gotSequential = 1; 1886 } 1887 if ((objIndex < 0) || (objIndex >= objc)) { 1888 msg = badIndex[gotXpg]; 1889 goto errorMsg; 1890 } 1891 1892 /* 1893 * Step 2. Set of flags. 1894 */ 1895 1896 gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0; 1897 sawFlag = 1; 1898 do { 1899 switch (ch) { 1900 case '-': 1901 gotMinus = 1; 1902 break; 1903 case '#': 1904 gotHash = 1; 1905 break; 1906 case '0': 1907 gotZero = 1; 1908 break; 1909 case ' ': 1910 gotSpace = 1; 1911 break; 1912 case '+': 1913 gotPlus = 1; 1914 break; 1915 default: 1916 sawFlag = 0; 1917 } 1918 if (sawFlag) { 1919 format += step; 1920 step = Tcl_UtfToUniChar(format, &ch); 1921 } 1922 } while (sawFlag); 1923 1924 /* 1925 * Step 3. Minimum field width. 1926 */ 1927 1928 width = 0; 1929 if (isdigit(UCHAR(ch))) { 1930 width = strtoul(format, &end, 10); 1931 format = end; 1932 step = Tcl_UtfToUniChar(format, &ch); 1933 } else if (ch == '*') { 1934 if (objIndex >= objc - 1) { 1935 msg = badIndex[gotXpg]; 1936 goto errorMsg; 1937 } 1938 if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { 1939 goto error; 1940 } 1941 if (width < 0) { 1942 width = -width; 1943 gotMinus = 1; 1944 } 1945 objIndex++; 1946 format += step; 1947 step = Tcl_UtfToUniChar(format, &ch); 1948 } 1949 if (width > limit) { 1950 msg = overflow; 1951 goto errorMsg; 1952 } 1953 1954 /* 1955 * Step 4. Precision. 1956 */ 1957 1958 gotPrecision = precision = 0; 1959 if (ch == '.') { 1960 gotPrecision = 1; 1961 format += step; 1962 step = Tcl_UtfToUniChar(format, &ch); 1963 } 1964 if (isdigit(UCHAR(ch))) { 1965 precision = strtoul(format, &end, 10); 1966 format = end; 1967 step = Tcl_UtfToUniChar(format, &ch); 1968 } else if (ch == '*') { 1969 if (objIndex >= objc - 1) { 1970 msg = badIndex[gotXpg]; 1971 goto errorMsg; 1972 } 1973 if (TclGetIntFromObj(interp, objv[objIndex], &precision) 1974 != TCL_OK) { 1975 goto error; 1976 } 1977 1978 /* 1979 * TODO: Check this truncation logic. 1980 */ 1981 1982 if (precision < 0) { 1983 precision = 0; 1984 } 1985 objIndex++; 1986 format += step; 1987 step = Tcl_UtfToUniChar(format, &ch); 1988 } 1989 1990 /* 1991 * Step 5. Length modifier. 1992 */ 1993 1994 useShort = useWide = useBig = 0; 1995 if (ch == 'h') { 1996 useShort = 1; 1997 format += step; 1998 step = Tcl_UtfToUniChar(format, &ch); 1999 } else if (ch == 'l') { 2000 format += step; 2001 step = Tcl_UtfToUniChar(format, &ch); 2002 if (ch == 'l') { 2003 useBig = 1; 2004 format += step; 2005 step = Tcl_UtfToUniChar(format, &ch); 2006 } else { 2007#ifndef TCL_WIDE_INT_IS_LONG 2008 useWide = 1; 2009#endif 2010 } 2011 } 2012 2013 format += step; 2014 span = format; 2015 2016 /* 2017 * Step 6. The actual conversion character. 2018 */ 2019 2020 segment = objv[objIndex]; 2021 numChars = -1; 2022 if (ch == 'i') { 2023 ch = 'd'; 2024 } 2025 switch (ch) { 2026 case '\0': 2027 msg = "format string ended in middle of field specifier"; 2028 goto errorMsg; 2029 case 's': 2030 if (gotPrecision) { 2031 numChars = Tcl_GetCharLength(segment); 2032 if (precision < numChars) { 2033 segment = Tcl_GetRange(segment, 0, precision - 1); 2034 numChars = precision; 2035 Tcl_IncrRefCount(segment); 2036 allocSegment = 1; 2037 } 2038 } 2039 break; 2040 case 'c': { 2041 char buf[TCL_UTF_MAX]; 2042 int code, length; 2043 2044 if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) { 2045 goto error; 2046 } 2047 length = Tcl_UniCharToUtf(code, buf); 2048 segment = Tcl_NewStringObj(buf, length); 2049 Tcl_IncrRefCount(segment); 2050 allocSegment = 1; 2051 break; 2052 } 2053 2054 case 'u': 2055 if (useBig) { 2056 msg = "unsigned bignum format is invalid"; 2057 goto errorMsg; 2058 } 2059 case 'd': 2060 case 'o': 2061 case 'x': 2062 case 'X': { 2063 short int s = 0; /* Silence compiler warning; only defined and 2064 * used when useShort is true. */ 2065 long l; 2066 Tcl_WideInt w; 2067 mp_int big; 2068 int toAppend, isNegative = 0; 2069 2070 if (useBig) { 2071 if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { 2072 goto error; 2073 } 2074 isNegative = (mp_cmp_d(&big, 0) == MP_LT); 2075 } else if (useWide) { 2076 if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { 2077 Tcl_Obj *objPtr; 2078 2079 if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { 2080 goto error; 2081 } 2082 mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big); 2083 objPtr = Tcl_NewBignumObj(&big); 2084 Tcl_IncrRefCount(objPtr); 2085 Tcl_GetWideIntFromObj(NULL, objPtr, &w); 2086 Tcl_DecrRefCount(objPtr); 2087 } 2088 isNegative = (w < (Tcl_WideInt)0); 2089 } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { 2090 if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { 2091 Tcl_Obj *objPtr; 2092 2093 if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { 2094 goto error; 2095 } 2096 mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); 2097 objPtr = Tcl_NewBignumObj(&big); 2098 Tcl_IncrRefCount(objPtr); 2099 TclGetLongFromObj(NULL, objPtr, &l); 2100 Tcl_DecrRefCount(objPtr); 2101 } else { 2102 l = Tcl_WideAsLong(w); 2103 } 2104 if (useShort) { 2105 s = (short int) l; 2106 isNegative = (s < (short int)0); 2107 } else { 2108 isNegative = (l < (long)0); 2109 } 2110 } else if (useShort) { 2111 s = (short int) l; 2112 isNegative = (s < (short int)0); 2113 } else { 2114 isNegative = (l < (long)0); 2115 } 2116 2117 segment = Tcl_NewObj(); 2118 allocSegment = 1; 2119 segmentLimit = INT_MAX; 2120 Tcl_IncrRefCount(segment); 2121 2122 if ((isNegative || gotPlus || gotSpace) && (useBig || (ch == 'd'))) { 2123 Tcl_AppendToObj(segment, (isNegative ? "-" : gotPlus ? "+" : " "), 1); 2124 segmentLimit -= 1; 2125 } 2126 2127 if (gotHash) { 2128 switch (ch) { 2129 case 'o': 2130 Tcl_AppendToObj(segment, "0", 1); 2131 segmentLimit -= 1; 2132 precision--; 2133 break; 2134 case 'x': 2135 case 'X': 2136 Tcl_AppendToObj(segment, "0x", 2); 2137 segmentLimit -= 2; 2138 break; 2139 } 2140 } 2141 2142 switch (ch) { 2143 case 'd': { 2144 int length; 2145 Tcl_Obj *pure; 2146 const char *bytes; 2147 2148 if (useShort) { 2149 pure = Tcl_NewIntObj((int)(s)); 2150 } else if (useWide) { 2151 pure = Tcl_NewWideIntObj(w); 2152 } else if (useBig) { 2153 pure = Tcl_NewBignumObj(&big); 2154 } else { 2155 pure = Tcl_NewLongObj(l); 2156 } 2157 Tcl_IncrRefCount(pure); 2158 bytes = TclGetStringFromObj(pure, &length); 2159 2160 /* 2161 * Already did the sign above. 2162 */ 2163 2164 if (*bytes == '-') { 2165 length--; 2166 bytes++; 2167 } 2168 toAppend = length; 2169 2170 /* 2171 * Canonical decimal string reps for integers are composed 2172 * entirely of one-byte encoded characters, so "length" is the 2173 * number of chars. 2174 */ 2175 2176 if (gotPrecision) { 2177 if (length < precision) { 2178 segmentLimit -= (precision - length); 2179 } 2180 while (length < precision) { 2181 Tcl_AppendToObj(segment, "0", 1); 2182 length++; 2183 } 2184 gotZero = 0; 2185 } 2186 if (gotZero) { 2187 length += Tcl_GetCharLength(segment); 2188 if (length < width) { 2189 segmentLimit -= (width - length); 2190 } 2191 while (length < width) { 2192 Tcl_AppendToObj(segment, "0", 1); 2193 length++; 2194 } 2195 } 2196 if (toAppend > segmentLimit) { 2197 msg = overflow; 2198 goto errorMsg; 2199 } 2200 Tcl_AppendToObj(segment, bytes, toAppend); 2201 Tcl_DecrRefCount(pure); 2202 break; 2203 } 2204 2205 case 'u': 2206 case 'o': 2207 case 'x': 2208 case 'X': { 2209 Tcl_WideUInt bits = (Tcl_WideUInt)0; 2210 Tcl_WideInt numDigits = (Tcl_WideInt)0; 2211 int length, numBits = 4, base = 16; 2212 int index = 0, shift = 0; 2213 Tcl_Obj *pure; 2214 char *bytes; 2215 2216 if (ch == 'u') { 2217 base = 10; 2218 } 2219 if (ch == 'o') { 2220 base = 8; 2221 numBits = 3; 2222 } 2223 if (useShort) { 2224 unsigned short int us = (unsigned short int) s; 2225 2226 bits = (Tcl_WideUInt) us; 2227 while (us) { 2228 numDigits++; 2229 us /= base; 2230 } 2231 } else if (useWide) { 2232 Tcl_WideUInt uw = (Tcl_WideUInt) w; 2233 2234 bits = uw; 2235 while (uw) { 2236 numDigits++; 2237 uw /= base; 2238 } 2239 } else if (useBig && big.used) { 2240 int leftover = (big.used * DIGIT_BIT) % numBits; 2241 mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover); 2242 2243 numDigits = 1 + 2244 (((Tcl_WideInt)big.used * DIGIT_BIT) / numBits); 2245 while ((mask & big.dp[big.used-1]) == 0) { 2246 numDigits--; 2247 mask >>= numBits; 2248 } 2249 if (numDigits > INT_MAX) { 2250 msg = overflow; 2251 goto errorMsg; 2252 } 2253 } else if (!useBig) { 2254 unsigned long int ul = (unsigned long int) l; 2255 2256 bits = (Tcl_WideUInt) ul; 2257 while (ul) { 2258 numDigits++; 2259 ul /= base; 2260 } 2261 } 2262 2263 /* 2264 * Need to be sure zero becomes "0", not "". 2265 */ 2266 2267 if ((numDigits == 0) && !((ch == 'o') && gotHash)) { 2268 numDigits = 1; 2269 } 2270 pure = Tcl_NewObj(); 2271 Tcl_SetObjLength(pure, (int)numDigits); 2272 bytes = TclGetString(pure); 2273 toAppend = length = (int)numDigits; 2274 while (numDigits--) { 2275 int digitOffset; 2276 2277 if (useBig && big.used) { 2278 if (index < big.used && (size_t) shift < 2279 CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) { 2280 bits |= (((Tcl_WideUInt)big.dp[index++]) <<shift); 2281 shift += DIGIT_BIT; 2282 } 2283 shift -= numBits; 2284 } 2285 digitOffset = (int) (bits % base); 2286 if (digitOffset > 9) { 2287 bytes[numDigits] = 'a' + digitOffset - 10; 2288 } else { 2289 bytes[numDigits] = '0' + digitOffset; 2290 } 2291 bits /= base; 2292 } 2293 if (useBig) { 2294 mp_clear(&big); 2295 } 2296 if (gotPrecision) { 2297 if (length < precision) { 2298 segmentLimit -= (precision - length); 2299 } 2300 while (length < precision) { 2301 Tcl_AppendToObj(segment, "0", 1); 2302 length++; 2303 } 2304 gotZero = 0; 2305 } 2306 if (gotZero) { 2307 length += Tcl_GetCharLength(segment); 2308 if (length < width) { 2309 segmentLimit -= (width - length); 2310 } 2311 while (length < width) { 2312 Tcl_AppendToObj(segment, "0", 1); 2313 length++; 2314 } 2315 } 2316 if (toAppend > segmentLimit) { 2317 msg = overflow; 2318 goto errorMsg; 2319 } 2320 Tcl_AppendObjToObj(segment, pure); 2321 Tcl_DecrRefCount(pure); 2322 break; 2323 } 2324 2325 } 2326 break; 2327 } 2328 2329 case 'e': 2330 case 'E': 2331 case 'f': 2332 case 'g': 2333 case 'G': { 2334#define MAX_FLOAT_SIZE 320 2335 char spec[2*TCL_INTEGER_SPACE + 9], *p = spec; 2336 double d; 2337 int length = MAX_FLOAT_SIZE; 2338 char *bytes; 2339 2340 if (Tcl_GetDoubleFromObj(interp, segment, &d) != TCL_OK) { 2341 /* TODO: Figure out ACCEPT_NAN here */ 2342 goto error; 2343 } 2344 *p++ = '%'; 2345 if (gotMinus) { 2346 *p++ = '-'; 2347 } 2348 if (gotHash) { 2349 *p++ = '#'; 2350 } 2351 if (gotZero) { 2352 *p++ = '0'; 2353 } 2354 if (gotSpace) { 2355 *p++ = ' '; 2356 } 2357 if (gotPlus) { 2358 *p++ = '+'; 2359 } 2360 if (width) { 2361 p += sprintf(p, "%d", width); 2362 if (width > length) { 2363 length = width; 2364 } 2365 } 2366 if (gotPrecision) { 2367 *p++ = '.'; 2368 p += sprintf(p, "%d", precision); 2369 if (precision > INT_MAX - length) { 2370 msg=overflow; 2371 goto errorMsg; 2372 } 2373 length += precision; 2374 } 2375 2376 /* 2377 * Don't pass length modifiers! 2378 */ 2379 2380 *p++ = (char) ch; 2381 *p = '\0'; 2382 2383 segment = Tcl_NewObj(); 2384 allocSegment = 1; 2385 if (!Tcl_AttemptSetObjLength(segment, length)) { 2386 msg = overflow; 2387 goto errorMsg; 2388 } 2389 bytes = TclGetString(segment); 2390 if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) { 2391 msg = overflow; 2392 goto errorMsg; 2393 } 2394 break; 2395 } 2396 default: 2397 if (interp != NULL) { 2398 Tcl_SetObjResult(interp, 2399 Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); 2400 } 2401 goto error; 2402 } 2403 2404 switch (ch) { 2405 case 'E': 2406 case 'G': 2407 case 'X': { 2408 Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment))); 2409 } 2410 } 2411 2412 if (width > 0) { 2413 if (numChars < 0) { 2414 numChars = Tcl_GetCharLength(segment); 2415 } 2416 if (!gotMinus) { 2417 if (numChars < width) { 2418 limit -= (width - numChars); 2419 } 2420 while (numChars < width) { 2421 Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); 2422 numChars++; 2423 } 2424 } 2425 } 2426 2427 Tcl_GetStringFromObj(segment, &segmentNumBytes); 2428 if (segmentNumBytes > limit) { 2429 if (allocSegment) { 2430 Tcl_DecrRefCount(segment); 2431 } 2432 msg = overflow; 2433 goto errorMsg; 2434 } 2435 Tcl_AppendObjToObj(appendObj, segment); 2436 limit -= segmentNumBytes; 2437 if (allocSegment) { 2438 Tcl_DecrRefCount(segment); 2439 } 2440 if (width > 0) { 2441 if (numChars < width) { 2442 limit -= (width - numChars); 2443 } 2444 while (numChars < width) { 2445 Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); 2446 numChars++; 2447 } 2448 } 2449 2450 objIndex += gotSequential; 2451 } 2452 if (numBytes) { 2453 if (numBytes > limit) { 2454 msg = overflow; 2455 goto errorMsg; 2456 } 2457 Tcl_AppendToObj(appendObj, span, numBytes); 2458 limit -= numBytes; 2459 numBytes = 0; 2460 } 2461 2462 return TCL_OK; 2463 2464 errorMsg: 2465 if (interp != NULL) { 2466 Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); 2467 } 2468 error: 2469 Tcl_SetObjLength(appendObj, originalLength); 2470 return TCL_ERROR; 2471} 2472 2473/* 2474 *--------------------------------------------------------------------------- 2475 * 2476 * Tcl_Format-- 2477 * 2478 * Results: 2479 * A refcount zero Tcl_Obj. 2480 * 2481 * Side effects: 2482 * None. 2483 * 2484 *--------------------------------------------------------------------------- 2485 */ 2486 2487Tcl_Obj * 2488Tcl_Format( 2489 Tcl_Interp *interp, 2490 const char *format, 2491 int objc, 2492 Tcl_Obj *const objv[]) 2493{ 2494 int result; 2495 Tcl_Obj *objPtr = Tcl_NewObj(); 2496 result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv); 2497 if (result != TCL_OK) { 2498 Tcl_DecrRefCount(objPtr); 2499 return NULL; 2500 } 2501 return objPtr; 2502} 2503 2504/* 2505 *--------------------------------------------------------------------------- 2506 * 2507 * AppendPrintfToObjVA -- 2508 * 2509 * Results: 2510 * 2511 * Side effects: 2512 * 2513 *--------------------------------------------------------------------------- 2514 */ 2515 2516static void 2517AppendPrintfToObjVA( 2518 Tcl_Obj *objPtr, 2519 const char *format, 2520 va_list argList) 2521{ 2522 int code, objc; 2523 Tcl_Obj **objv, *list = Tcl_NewObj(); 2524 const char *p; 2525 char *end; 2526 2527 p = format; 2528 Tcl_IncrRefCount(list); 2529 while (*p != '\0') { 2530 int size = 0, seekingConversion = 1, gotPrecision = 0; 2531 int lastNum = -1; 2532 2533 if (*p++ != '%') { 2534 continue; 2535 } 2536 if (*p == '%') { 2537 p++; 2538 continue; 2539 } 2540 do { 2541 switch (*p) { 2542 2543 case '\0': 2544 seekingConversion = 0; 2545 break; 2546 case 's': { 2547 const char *q, *end, *bytes = va_arg(argList, char *); 2548 seekingConversion = 0; 2549 2550 /* 2551 * The buffer to copy characters from starts at bytes and ends 2552 * at either the first NUL byte, or after lastNum bytes, when 2553 * caller has indicated a limit. 2554 */ 2555 2556 end = bytes; 2557 while ((!gotPrecision || lastNum--) && (*end != '\0')) { 2558 end++; 2559 } 2560 2561 /* 2562 * Within that buffer, we trim both ends if needed so that we 2563 * copy only whole characters, and avoid copying any partial 2564 * multi-byte characters. 2565 */ 2566 2567 q = Tcl_UtfPrev(end, bytes); 2568 if (!Tcl_UtfCharComplete(q, (int)(end - q))) { 2569 end = q; 2570 } 2571 2572 q = bytes + TCL_UTF_MAX; 2573 while ((bytes < end) && (bytes < q) 2574 && ((*bytes & 0xC0) == 0x80)) { 2575 bytes++; 2576 } 2577 2578 Tcl_ListObjAppendElement(NULL, list, 2579 Tcl_NewStringObj(bytes , (int)(end - bytes))); 2580 2581 break; 2582 } 2583 case 'c': 2584 case 'i': 2585 case 'u': 2586 case 'd': 2587 case 'o': 2588 case 'x': 2589 case 'X': 2590 seekingConversion = 0; 2591 switch (size) { 2592 case -1: 2593 case 0: 2594 Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( 2595 (long int)va_arg(argList, int))); 2596 break; 2597 case 1: 2598 Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( 2599 va_arg(argList, long int))); 2600 break; 2601 } 2602 break; 2603 case 'e': 2604 case 'E': 2605 case 'f': 2606 case 'g': 2607 case 'G': 2608 Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( 2609 va_arg(argList, double))); 2610 seekingConversion = 0; 2611 break; 2612 case '*': 2613 lastNum = (int)va_arg(argList, int); 2614 Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum)); 2615 p++; 2616 break; 2617 case '0': case '1': case '2': case '3': case '4': 2618 case '5': case '6': case '7': case '8': case '9': 2619 lastNum = (int) strtoul(p, &end, 10); 2620 p = end; 2621 break; 2622 case '.': 2623 gotPrecision = 1; 2624 p++; 2625 break; 2626 /* TODO: support for wide (and bignum?) arguments */ 2627 case 'l': 2628 size = 1; 2629 p++; 2630 break; 2631 case 'h': 2632 size = -1; 2633 default: 2634 p++; 2635 } 2636 } while (seekingConversion); 2637 } 2638 TclListObjGetElements(NULL, list, &objc, &objv); 2639 code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); 2640 if (code != TCL_OK) { 2641 Tcl_AppendPrintfToObj(objPtr, 2642 "Unable to format \"%s\" with supplied arguments: %s", 2643 format, Tcl_GetString(list)); 2644 } 2645 Tcl_DecrRefCount(list); 2646} 2647 2648/* 2649 *--------------------------------------------------------------------------- 2650 * 2651 * Tcl_AppendPrintfToObj -- 2652 * 2653 * Results: 2654 * A standard Tcl result. 2655 * 2656 * Side effects: 2657 * None. 2658 * 2659 *--------------------------------------------------------------------------- 2660 */ 2661 2662void 2663Tcl_AppendPrintfToObj( 2664 Tcl_Obj *objPtr, 2665 const char *format, 2666 ...) 2667{ 2668 va_list argList; 2669 2670 va_start(argList, format); 2671 AppendPrintfToObjVA(objPtr, format, argList); 2672 va_end(argList); 2673} 2674 2675/* 2676 *--------------------------------------------------------------------------- 2677 * 2678 * Tcl_ObjPrintf -- 2679 * 2680 * Results: 2681 * A refcount zero Tcl_Obj. 2682 * 2683 * Side effects: 2684 * None. 2685 * 2686 *--------------------------------------------------------------------------- 2687 */ 2688 2689Tcl_Obj * 2690Tcl_ObjPrintf( 2691 const char *format, 2692 ...) 2693{ 2694 va_list argList; 2695 Tcl_Obj *objPtr = Tcl_NewObj(); 2696 2697 va_start(argList, format); 2698 AppendPrintfToObjVA(objPtr, format, argList); 2699 va_end(argList); 2700 return objPtr; 2701} 2702 2703/* 2704 *--------------------------------------------------------------------------- 2705 * 2706 * TclStringObjReverse -- 2707 * 2708 * Implements the [string reverse] operation. 2709 * 2710 * Results: 2711 * An unshared Tcl value which is the [string reverse] of the argument 2712 * supplied. When sharing rules permit, the returned value might be 2713 * the argument with modifications done in place. 2714 * 2715 * Side effects: 2716 * May allocate a new Tcl_Obj. 2717 * 2718 *--------------------------------------------------------------------------- 2719 */ 2720 2721Tcl_Obj * 2722TclStringObjReverse( 2723 Tcl_Obj *objPtr) 2724{ 2725 String *stringPtr; 2726 int numChars = Tcl_GetCharLength(objPtr); 2727 int i = 0, lastCharIdx = numChars - 1; 2728 char *bytes; 2729 2730 if (numChars <= 1) { 2731 return objPtr; 2732 } 2733 2734 stringPtr = GET_STRING(objPtr); 2735 if (stringPtr->hasUnicode) { 2736 Tcl_UniChar *source = stringPtr->unicode; 2737 2738 if (Tcl_IsShared(objPtr)) { 2739 Tcl_UniChar *dest, ch = 0; 2740 2741 /* 2742 * Create a non-empty, pure unicode value, so we can coax 2743 * Tcl_SetObjLength into growing the unicode rep buffer. 2744 */ 2745 2746 Tcl_Obj *resultPtr = Tcl_NewUnicodeObj(&ch, 1); 2747 Tcl_SetObjLength(resultPtr, numChars); 2748 dest = Tcl_GetUnicode(resultPtr); 2749 2750 while (i < numChars) { 2751 dest[i++] = source[lastCharIdx--]; 2752 } 2753 return resultPtr; 2754 } 2755 2756 while (i < lastCharIdx) { 2757 Tcl_UniChar tmp = source[lastCharIdx]; 2758 source[lastCharIdx--] = source[i]; 2759 source[i++] = tmp; 2760 } 2761 Tcl_InvalidateStringRep(objPtr); 2762 return objPtr; 2763 } 2764 2765 bytes = TclGetString(objPtr); 2766 if (Tcl_IsShared(objPtr)) { 2767 char *dest; 2768 Tcl_Obj *resultPtr = Tcl_NewObj(); 2769 Tcl_SetObjLength(resultPtr, numChars); 2770 dest = TclGetString(resultPtr); 2771 while (i < numChars) { 2772 dest[i++] = bytes[lastCharIdx--]; 2773 } 2774 return resultPtr; 2775 } 2776 2777 while (i < lastCharIdx) { 2778 char tmp = bytes[lastCharIdx]; 2779 bytes[lastCharIdx--] = bytes[i]; 2780 bytes[i++] = tmp; 2781 } 2782 return objPtr; 2783} 2784 2785/* 2786 *--------------------------------------------------------------------------- 2787 * 2788 * FillUnicodeRep -- 2789 * 2790 * Populate the Unicode internal rep with the Unicode form of its string 2791 * rep. The object must alread have a "String" internal rep. 2792 * 2793 * Results: 2794 * None. 2795 * 2796 * Side effects: 2797 * Reallocates the String internal rep. 2798 * 2799 *--------------------------------------------------------------------------- 2800 */ 2801 2802static void 2803FillUnicodeRep( 2804 Tcl_Obj *objPtr) /* The object in which to fill the unicode 2805 * rep. */ 2806{ 2807 String *stringPtr; 2808 size_t uallocated; 2809 char *srcEnd, *src = objPtr->bytes; 2810 Tcl_UniChar *dst; 2811 2812 stringPtr = GET_STRING(objPtr); 2813 if (stringPtr->numChars == -1) { 2814 stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length); 2815 } 2816 stringPtr->hasUnicode = (stringPtr->numChars > 0); 2817 2818 stringCheckLimits(stringPtr->numChars); 2819 uallocated = STRING_UALLOC(stringPtr->numChars); 2820 if (uallocated > stringPtr->uallocated) { 2821 GrowUnicodeBuffer(objPtr, stringPtr->numChars); 2822 stringPtr = GET_STRING(objPtr); 2823 } 2824 2825 /* 2826 * Convert src to Unicode and store the coverted data in "unicode". 2827 */ 2828 2829 srcEnd = src + objPtr->length; 2830 for (dst = stringPtr->unicode; src < srcEnd; dst++) { 2831 src += TclUtfToUniChar(src, dst); 2832 } 2833 *dst = 0; 2834 2835 SET_STRING(objPtr, stringPtr); 2836} 2837 2838/* 2839 *---------------------------------------------------------------------- 2840 * 2841 * DupStringInternalRep -- 2842 * 2843 * Initialize the internal representation of a new Tcl_Obj to a copy of 2844 * the internal representation of an existing string object. 2845 * 2846 * Results: 2847 * None. 2848 * 2849 * Side effects: 2850 * copyPtr's internal rep is set to a copy of srcPtr's internal 2851 * representation. 2852 * 2853 *---------------------------------------------------------------------- 2854 */ 2855 2856static void 2857DupStringInternalRep( 2858 register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have 2859 * an internal rep of type "String". */ 2860 register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not 2861 * currently have an internal rep.*/ 2862{ 2863 String *srcStringPtr = GET_STRING(srcPtr); 2864 String *copyStringPtr = NULL; 2865 2866 /* 2867 * If the src obj is a string of 1-byte Utf chars, then copy the string 2868 * rep of the source object and create an "empty" Unicode internal rep for 2869 * the new object. Otherwise, copy Unicode internal rep, and invalidate 2870 * the string rep of the new object. 2871 */ 2872 2873 if (srcStringPtr->hasUnicode == 0) { 2874 copyStringPtr = (String *) ckalloc(sizeof(String)); 2875 copyStringPtr->uallocated = 0; 2876 } else { 2877 copyStringPtr = (String *) ckalloc( 2878 STRING_SIZE(srcStringPtr->uallocated)); 2879 copyStringPtr->uallocated = srcStringPtr->uallocated; 2880 2881 memcpy(copyStringPtr->unicode, srcStringPtr->unicode, 2882 (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar)); 2883 copyStringPtr->unicode[srcStringPtr->numChars] = 0; 2884 } 2885 copyStringPtr->numChars = srcStringPtr->numChars; 2886 copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; 2887 copyStringPtr->allocated = srcStringPtr->allocated; 2888 2889 /* 2890 * Tricky point: the string value was copied by generic object management 2891 * code, so it doesn't contain any extra bytes that might exist in the 2892 * source object. 2893 */ 2894 2895 copyStringPtr->allocated = copyPtr->length; 2896 2897 SET_STRING(copyPtr, copyStringPtr); 2898 copyPtr->typePtr = &tclStringType; 2899} 2900 2901/* 2902 *---------------------------------------------------------------------- 2903 * 2904 * SetStringFromAny -- 2905 * 2906 * Create an internal representation of type "String" for an object. 2907 * 2908 * Results: 2909 * This operation always succeeds and returns TCL_OK. 2910 * 2911 * Side effects: 2912 * Any old internal reputation for objPtr is freed and the internal 2913 * representation is set to "String". 2914 * 2915 *---------------------------------------------------------------------- 2916 */ 2917 2918static int 2919SetStringFromAny( 2920 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 2921 register Tcl_Obj *objPtr) /* The object to convert. */ 2922{ 2923 /* 2924 * The Unicode object is optimized for the case where each UTF char in a 2925 * string is only one byte. In this case, we store the value of numChars, 2926 * but we don't copy the bytes to the unicodeObj->unicode. 2927 */ 2928 2929 if (objPtr->typePtr != &tclStringType) { 2930 String *stringPtr; 2931 2932 if (objPtr->typePtr != NULL) { 2933 if (objPtr->bytes == NULL) { 2934 objPtr->typePtr->updateStringProc(objPtr); 2935 } 2936 TclFreeIntRep(objPtr); 2937 } 2938 objPtr->typePtr = &tclStringType; 2939 2940 /* 2941 * Allocate enough space for the basic String structure. 2942 */ 2943 2944 stringPtr = (String *) ckalloc(sizeof(String)); 2945 stringPtr->numChars = -1; 2946 stringPtr->uallocated = 0; 2947 stringPtr->hasUnicode = 0; 2948 2949 if (objPtr->bytes != NULL) { 2950 stringPtr->allocated = objPtr->length; 2951 if (objPtr->bytes != tclEmptyStringRep) { 2952 objPtr->bytes[objPtr->length] = 0; 2953 } 2954 } else { 2955 objPtr->length = 0; 2956 } 2957 SET_STRING(objPtr, stringPtr); 2958 } 2959 return TCL_OK; 2960} 2961 2962/* 2963 *---------------------------------------------------------------------- 2964 * 2965 * UpdateStringOfString -- 2966 * 2967 * Update the string representation for an object whose internal 2968 * representation is "String". 2969 * 2970 * Results: 2971 * None. 2972 * 2973 * Side effects: 2974 * The object's string may be set by converting its Unicode represention 2975 * to UTF format. 2976 * 2977 *---------------------------------------------------------------------- 2978 */ 2979 2980static void 2981UpdateStringOfString( 2982 Tcl_Obj *objPtr) /* Object with string rep to update. */ 2983{ 2984 int i, size; 2985 Tcl_UniChar *unicode; 2986 char dummy[TCL_UTF_MAX]; 2987 char *dst; 2988 String *stringPtr; 2989 2990 stringPtr = GET_STRING(objPtr); 2991 if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) { 2992 if (stringPtr->numChars <= 0) { 2993 /* 2994 * If there is no Unicode rep, or the string has 0 chars, then set 2995 * the string rep to an empty string. 2996 */ 2997 2998 objPtr->bytes = tclEmptyStringRep; 2999 objPtr->length = 0; 3000 return; 3001 } 3002 3003 unicode = stringPtr->unicode; 3004 3005 /* 3006 * Translate the Unicode string to UTF. "size" will hold the amount of 3007 * space the UTF string needs. 3008 */ 3009 3010 if (stringPtr->numChars <= INT_MAX/TCL_UTF_MAX 3011 && stringPtr->allocated >= stringPtr->numChars * (size_t)TCL_UTF_MAX) { 3012 goto copyBytes; 3013 } 3014 3015 size = 0; 3016 for (i = 0; i < stringPtr->numChars && size >= 0; i++) { 3017 size += Tcl_UniCharToUtf((int) unicode[i], dummy); 3018 } 3019 if (size < 0) { 3020 Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); 3021 } 3022 3023 objPtr->bytes = (char *) ckalloc((unsigned) (size + 1)); 3024 objPtr->length = size; 3025 stringPtr->allocated = size; 3026 3027 copyBytes: 3028 dst = objPtr->bytes; 3029 for (i = 0; i < stringPtr->numChars; i++) { 3030 dst += Tcl_UniCharToUtf(unicode[i], dst); 3031 } 3032 *dst = '\0'; 3033 } 3034 return; 3035} 3036 3037/* 3038 *---------------------------------------------------------------------- 3039 * 3040 * FreeStringInternalRep -- 3041 * 3042 * Deallocate the storage associated with a String data object's internal 3043 * representation. 3044 * 3045 * Results: 3046 * None. 3047 * 3048 * Side effects: 3049 * Frees memory. 3050 * 3051 *---------------------------------------------------------------------- 3052 */ 3053 3054static void 3055FreeStringInternalRep( 3056 Tcl_Obj *objPtr) /* Object with internal rep to free. */ 3057{ 3058 ckfree((char *) GET_STRING(objPtr)); 3059} 3060 3061/* 3062 * Local Variables: 3063 * mode: c 3064 * c-basic-offset: 4 3065 * fill-column: 78 3066 * End: 3067 */ 3068