Fork me on GitHub

source: git/external/tcl/tclStringObj.c@ 6ec8d18

ImprovedOutputFile Timing dual_readout llp
Last change on this file since 6ec8d18 was d7d2da3, checked in by pavel <pavel@…>, 12 years ago

move branches/ModularDelphes to trunk

  • Property mode set to 100644
File size: 17.1 KB
RevLine 
[d7d2da3]1/*
2 * tclStringObj.c --
3 *
4 * This file contains procedures that implement string operations
5 * on Tcl objects. To do this efficiently (i.e. to allow many
6 * appends to be done to an object without constantly reallocating
7 * the space for the string representation) we overallocate the
8 * space for the string and use the internal representation to keep
9 * track of the extra space. Objects with this internal
10 * representation are called "expandable string objects".
11 *
12 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
13 *
14 * See the file "license.terms" for information on usage and redistribution
15 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16 *
17 * RCS: @(#) $Id: tclStringObj.c,v 1.1 2008-06-04 13:58:10 demin Exp $
18 */
19
20#include "tclInt.h"
21
22/*
23 * Prototypes for procedures defined later in this file:
24 */
25
26static void ConvertToStringType _ANSI_ARGS_((Tcl_Obj *objPtr));
27static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
28 Tcl_Obj *copyPtr));
29static int SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
30 Tcl_Obj *objPtr));
31static void UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
32
33/*
34 * The structure below defines the string Tcl object type by means of
35 * procedures that can be invoked by generic object code.
36 */
37
38Tcl_ObjType tclStringType = {
39 "string", /* name */
40 (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
41 DupStringInternalRep, /* dupIntRepProc */
42 UpdateStringOfString, /* updateStringProc */
43 SetStringFromAny /* setFromAnyProc */
44};
45
46
47/*
48 *----------------------------------------------------------------------
49 *
50 * Tcl_NewStringObj --
51 *
52 * This procedure is normally called when not debugging: i.e., when
53 * TCL_MEM_DEBUG is not defined. It creates a new string object and
54 * initializes it from the byte pointer and length arguments.
55 *
56 * When TCL_MEM_DEBUG is defined, this procedure just returns the
57 * result of calling the debugging version Tcl_DbNewStringObj.
58 *
59 * Results:
60 * A newly created string object is returned that has ref count zero.
61 *
62 * Side effects:
63 * The new object's internal string representation will be set to a
64 * copy of the length bytes starting at "bytes". If "length" is
65 * negative, use bytes up to the first NULL byte; i.e., assume "bytes"
66 * points to a C-style NULL-terminated string. The object's type is set
67 * to NULL. An extra NULL is added to the end of the new object's byte
68 * array.
69 *
70 *----------------------------------------------------------------------
71 */
72
73#ifdef TCL_MEM_DEBUG
74#undef Tcl_NewStringObj
75
76Tcl_Obj *
77Tcl_NewStringObj(bytes, length)
78 register char *bytes; /* Points to the first of the length bytes
79 * used to initialize the new object. */
80 register int length; /* The number of bytes to copy from "bytes"
81 * when initializing the new object. If
82 * negative, use bytes up to the first
83 * NULL byte. */
84{
85 return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
86}
87
88#else /* if not TCL_MEM_DEBUG */
89
90Tcl_Obj *
91Tcl_NewStringObj(bytes, length)
92 register char *bytes; /* Points to the first of the length bytes
93 * used to initialize the new object. */
94 register int length; /* The number of bytes to copy from "bytes"
95 * when initializing the new object. If
96 * negative, use bytes up to the first
97 * NULL byte. */
98{
99 register Tcl_Obj *objPtr;
100
101 if (length < 0) {
102 length = (bytes? strlen(bytes) : 0);
103 }
104 TclNewObj(objPtr);
105 TclInitStringRep(objPtr, bytes, length);
106 return objPtr;
107}
108#endif /* TCL_MEM_DEBUG */
109
110
111/*
112 *----------------------------------------------------------------------
113 *
114 * Tcl_DbNewStringObj --
115 *
116 * This procedure is normally called when debugging: i.e., when
117 * TCL_MEM_DEBUG is defined. It creates new string objects. It is the
118 * same as the Tcl_NewStringObj procedure above except that it calls
119 * Tcl_DbCkalloc directly with the file name and line number from its
120 * caller. This simplifies debugging since then the checkmem command
121 * will report the correct file name and line number when reporting
122 * objects that haven't been freed.
123 *
124 * When TCL_MEM_DEBUG is not defined, this procedure just returns the
125 * result of calling Tcl_NewStringObj.
126 *
127 * Results:
128 * A newly created string object is returned that has ref count zero.
129 *
130 * Side effects:
131 * The new object's internal string representation will be set to a
132 * copy of the length bytes starting at "bytes". If "length" is
133 * negative, use bytes up to the first NULL byte; i.e., assume "bytes"
134 * points to a C-style NULL-terminated string. The object's type is set
135 * to NULL. An extra NULL is added to the end of the new object's byte
136 * array.
137 *
138 *----------------------------------------------------------------------
139 */
140
141#ifdef TCL_MEM_DEBUG
142
143Tcl_Obj *
144Tcl_DbNewStringObj(bytes, length, file, line)
145 register char *bytes; /* Points to the first of the length bytes
146 * used to initialize the new object. */
147 register 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 char *file; /* The name of the source file calling this
152 * procedure; used for debugging. */
153 int line; /* Line number in the source file; used
154 * for debugging. */
155{
156 register Tcl_Obj *objPtr;
157
158 if (length < 0) {
159 length = (bytes? strlen(bytes) : 0);
160 }
161 TclDbNewObj(objPtr, file, line);
162 TclInitStringRep(objPtr, bytes, length);
163 return objPtr;
164}
165
166#else /* if not TCL_MEM_DEBUG */
167
168Tcl_Obj *
169Tcl_DbNewStringObj(bytes, length, file, line)
170 register char *bytes; /* Points to the first of the length bytes
171 * used to initialize the new object. */
172 register int length; /* The number of bytes to copy from "bytes"
173 * when initializing the new object. If
174 * negative, use bytes up to the first
175 * NULL byte. */
176 char *file; /* The name of the source file calling this
177 * procedure; used for debugging. */
178 int line; /* Line number in the source file; used
179 * for debugging. */
180{
181 return Tcl_NewStringObj(bytes, length);
182}
183#endif /* TCL_MEM_DEBUG */
184
185
186/*
187 *----------------------------------------------------------------------
188 *
189 * Tcl_SetStringObj --
190 *
191 * Modify an object to hold a string that is a copy of the bytes
192 * indicated by the byte pointer and length arguments.
193 *
194 * Results:
195 * None.
196 *
197 * Side effects:
198 * The object's string representation will be set to a copy of
199 * the "length" bytes starting at "bytes". If "length" is negative, use
200 * bytes up to the first NULL byte; i.e., assume "bytes" points to a
201 * C-style NULL-terminated string. The object's old string and internal
202 * representations are freed and the object's type is set NULL.
203 *
204 *----------------------------------------------------------------------
205 */
206
207void
208Tcl_SetStringObj(objPtr, bytes, length)
209 register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
210 char *bytes; /* Points to the first of the length bytes
211 * used to initialize the object. */
212 register int length; /* The number of bytes to copy from "bytes"
213 * when initializing the object. If
214 * negative, use bytes up to the first
215 * NULL byte.*/
216{
217 register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
218
219 /*
220 * Free any old string rep, then set the string rep to a copy of
221 * the length bytes starting at "bytes".
222 */
223
224 if (Tcl_IsShared(objPtr)) {
225 panic("Tcl_SetStringObj called with shared object");
226 }
227
228 Tcl_InvalidateStringRep(objPtr);
229 if (length < 0) {
230 length = strlen(bytes);
231 }
232 TclInitStringRep(objPtr, bytes, length);
233
234 /*
235 * Set the type to NULL and free any internal rep for the old type.
236 */
237
238 if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
239 oldTypePtr->freeIntRepProc(objPtr);
240 }
241 objPtr->typePtr = NULL;
242}
243
244
245/*
246 *----------------------------------------------------------------------
247 *
248 * Tcl_SetObjLength --
249 *
250 * This procedure changes the length of the string representation
251 * of an object.
252 *
253 * Results:
254 * None.
255 *
256 * Side effects:
257 * If the size of objPtr's string representation is greater than
258 * length, then it is reduced to length and a new terminating null
259 * byte is stored in the strength. If the length of the string
260 * representation is greater than length, the storage space is
261 * reallocated to the given length; a null byte is stored at the
262 * end, but other bytes past the end of the original string
263 * representation are undefined. The object's internal
264 * representation is changed to "expendable string".
265 *
266 *----------------------------------------------------------------------
267 */
268
269void
270Tcl_SetObjLength(objPtr, length)
271 register Tcl_Obj *objPtr; /* Pointer to object. This object must
272 * not currently be shared. */
273 register int length; /* Number of bytes desired for string
274 * representation of object, not including
275 * terminating null byte. */
276{
277 char *new;
278
279 if (Tcl_IsShared(objPtr)) {
280 panic("Tcl_SetObjLength called with shared object");
281 }
282 if (objPtr->typePtr != &tclStringType) {
283 ConvertToStringType(objPtr);
284 }
285
286 if ((long)length > objPtr->internalRep.longValue) {
287 /*
288 * Not enough space in current string. Reallocate the string
289 * space and free the old string.
290 */
291
292 new = (char *) ckalloc((unsigned) (length+1));
293 if (objPtr->bytes != NULL) {
294 memcpy((VOID *) new, (VOID *) objPtr->bytes,
295 (size_t) objPtr->length);
296 Tcl_InvalidateStringRep(objPtr);
297 }
298 objPtr->bytes = new;
299 objPtr->internalRep.longValue = (long) length;
300 }
301 objPtr->length = length;
302 if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
303 objPtr->bytes[length] = 0;
304 }
305}
306
307
308/*
309 *----------------------------------------------------------------------
310 *
311 * Tcl_AppendToObj --
312 *
313 * This procedure appends a sequence of bytes to an object.
314 *
315 * Results:
316 * None.
317 *
318 * Side effects:
319 * The bytes at *bytes are appended to the string representation
320 * of objPtr.
321 *
322 *----------------------------------------------------------------------
323 */
324
325void
326Tcl_AppendToObj(objPtr, bytes, length)
327 register Tcl_Obj *objPtr; /* Points to the object to append to. */
328 char *bytes; /* Points to the bytes to append to the
329 * object. */
330 register int length; /* The number of bytes to append from
331 * "bytes". If < 0, then append all bytes
332 * up to NULL byte. */
333{
334 int newLength, oldLength;
335
336 if (Tcl_IsShared(objPtr)) {
337 panic("Tcl_AppendToObj called with shared object");
338 }
339 if (objPtr->typePtr != &tclStringType) {
340 ConvertToStringType(objPtr);
341 }
342 if (length < 0) {
343 length = strlen(bytes);
344 }
345 if (length == 0) {
346 return;
347 }
348 oldLength = objPtr->length;
349 newLength = length + oldLength;
350 if ((long)newLength > objPtr->internalRep.longValue) {
351 /*
352 * There isn't currently enough space in the string
353 * representation so allocate additional space. In fact,
354 * overallocate so that there is room for future growth without
355 * having to reallocate again.
356 */
357
358 Tcl_SetObjLength(objPtr, 2*newLength);
359 }
360 if (length > 0) {
361 memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
362 (size_t) length);
363 objPtr->length = newLength;
364 objPtr->bytes[objPtr->length] = 0;
365 }
366}
367
368
369/*
370 *----------------------------------------------------------------------
371 *
372 * Tcl_AppendStringsToObj --
373 *
374 * This procedure appends one or more null-terminated strings
375 * to an object.
376 *
377 * Results:
378 * None.
379 *
380 * Side effects:
381 * The contents of all the string arguments are appended to the
382 * string representation of objPtr.
383 *
384 *----------------------------------------------------------------------
385 */
386
387void
388Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
389{
390 va_list argList;
391 register Tcl_Obj *objPtr;
392 int newLength, oldLength;
393 register char *string, *dst;
394
395 objPtr = (Tcl_Obj *) TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
396 if (Tcl_IsShared(objPtr)) {
397 panic("Tcl_AppendStringsToObj called with shared object");
398 }
399 if (objPtr->typePtr != &tclStringType) {
400 ConvertToStringType(objPtr);
401 }
402
403 /*
404 * Figure out how much space is needed for all the strings, and
405 * expand the string representation if it isn't big enough. If no
406 * bytes would be appended, just return.
407 */
408
409 newLength = oldLength = objPtr->length;
410 while (1) {
411 string = va_arg(argList, char *);
412 if (string == NULL) {
413 break;
414 }
415 newLength += strlen(string);
416 }
417 if (newLength == oldLength) {
418 return;
419 }
420
421 if ((long)newLength > objPtr->internalRep.longValue) {
422 /*
423 * There isn't currently enough space in the string
424 * representation so allocate additional space. If the current
425 * string representation isn't empty (i.e. it looks like we're
426 * doing a series of appends) then overallocate the space so
427 * that we won't have to do as much reallocation in the future.
428 */
429
430 Tcl_SetObjLength(objPtr,
431 (objPtr->length == 0) ? newLength : 2*newLength);
432 }
433
434 /*
435 * Make a second pass through the arguments, appending all the
436 * strings to the object.
437 */
438
439 TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
440 dst = objPtr->bytes + oldLength;
441 while (1) {
442 string = va_arg(argList, char *);
443 if (string == NULL) {
444 break;
445 }
446 while (*string != 0) {
447 *dst = *string;
448 dst++;
449 string++;
450 }
451 }
452
453 /*
454 * Add a null byte to terminate the string. However, be careful:
455 * it's possible that the object is totally empty (if it was empty
456 * originally and there was nothing to append). In this case dst is
457 * NULL; just leave everything alone.
458 */
459
460 if (dst != NULL) {
461 *dst = 0;
462 }
463 objPtr->length = newLength;
464 va_end(argList);
465}
466
467
468/*
469 *----------------------------------------------------------------------
470 *
471 * ConvertToStringType --
472 *
473 * This procedure converts the internal representation of an object
474 * to "expandable string" type.
475 *
476 * Results:
477 * None.
478 *
479 * Side effects:
480 * Any old internal reputation for objPtr is freed and the
481 * internal representation is set to that for an expandable string
482 * (the field internalRep.longValue holds 1 less than the allocated
483 * length of objPtr's string representation).
484 *
485 *----------------------------------------------------------------------
486 */
487
488static void
489ConvertToStringType(objPtr)
490 register Tcl_Obj *objPtr; /* Pointer to object. Must have a
491 * typePtr that isn't &tclStringType. */
492{
493 if (objPtr->typePtr != NULL) {
494 if (objPtr->bytes == NULL) {
495 objPtr->typePtr->updateStringProc(objPtr);
496 }
497 if (objPtr->typePtr->freeIntRepProc != NULL) {
498 objPtr->typePtr->freeIntRepProc(objPtr);
499 }
500 }
501 objPtr->typePtr = &tclStringType;
502 if (objPtr->bytes != NULL) {
503 objPtr->internalRep.longValue = (long)objPtr->length;
504 } else {
505 objPtr->internalRep.longValue = 0;
506 objPtr->length = 0;
507 }
508}
509
510
511/*
512 *----------------------------------------------------------------------
513 *
514 * DupStringInternalRep --
515 *
516 * Initialize the internal representation of a new Tcl_Obj to a
517 * copy of the internal representation of an existing string object.
518 *
519 * Results:
520 * None.
521 *
522 * Side effects:
523 * copyPtr's internal rep is set to a copy of srcPtr's internal
524 * representation.
525 *
526 *----------------------------------------------------------------------
527 */
528
529static void
530DupStringInternalRep(srcPtr, copyPtr)
531 register Tcl_Obj *srcPtr; /* Object with internal rep to copy. Must
532 * have an internal representation of type
533 * "expandable string". */
534 register Tcl_Obj *copyPtr; /* Object with internal rep to set. Must
535 * not currently have an internal rep.*/
536{
537 /*
538 * Tricky point: the string value was copied by generic object
539 * management code, so it doesn't contain any extra bytes that
540 * might exist in the source object.
541 */
542
543 copyPtr->internalRep.longValue = (long)copyPtr->length;
544 copyPtr->typePtr = &tclStringType;
545}
546
547
548/*
549 *----------------------------------------------------------------------
550 *
551 * SetStringFromAny --
552 *
553 * Create an internal representation of type "expandable string"
554 * for an object.
555 *
556 * Results:
557 * This operation always succeeds and returns TCL_OK.
558 *
559 * Side effects:
560 * This procedure does nothing; there is no advantage in converting
561 * the internal representation now, so we just defer it.
562 *
563 *----------------------------------------------------------------------
564 */
565
566static int
567SetStringFromAny(interp, objPtr)
568 Tcl_Interp *interp; /* Used for error reporting if not NULL. */
569 Tcl_Obj *objPtr; /* The object to convert. */
570{
571 return TCL_OK;
572}
573
574
575/*
576 *----------------------------------------------------------------------
577 *
578 * UpdateStringOfString --
579 *
580 * Update the string representation for an object whose internal
581 * representation is "expandable string".
582 *
583 * Results:
584 * None.
585 *
586 * Side effects:
587 * None.
588 *
589 *----------------------------------------------------------------------
590 */
591
592static void
593UpdateStringOfString(objPtr)
594 Tcl_Obj *objPtr; /* Object with string rep to update. */
595{
596 /*
597 * The string is almost always valid already, in which case there's
598 * nothing for us to do. The only case we have to worry about is if
599 * the object is totally null. In this case, set the string rep to
600 * an empty string.
601 */
602
603 if (objPtr->bytes == NULL) {
604 objPtr->bytes = tclEmptyStringRep;
605 objPtr->length = 0;
606 }
607 return;
608}
Note: See TracBrowser for help on using the repository browser.