OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclListObj.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
2
 * tclListObj.c --
3
 *
4
 *      This file contains procedures that implement the Tcl list object
5
 *      type.
6
 *
7
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
8
 * Copyright (c) 1998 by Scriptics Corporation.
9
 *
10
 * See the file "license.terms" for information on usage and redistribution
11
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12
 *
13
 * RCS: @(#) $Id: tclListObj.c,v 1.1.1.1 2002-01-16 10:25:28 markom Exp $
14
 */
15
 
16
#include "tclInt.h"
17
 
18
/*
19
 * Prototypes for procedures defined later in this file:
20
 */
21
 
22
static void             DupListInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
23
                            Tcl_Obj *copyPtr));
24
static void             FreeListInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
25
static int              SetListFromAny _ANSI_ARGS_((Tcl_Interp *interp,
26
                            Tcl_Obj *objPtr));
27
static void             UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
28
 
29
/*
30
 * The structure below defines the list Tcl object type by means of
31
 * procedures that can be invoked by generic object code.
32
 */
33
 
34
Tcl_ObjType tclListType = {
35
    "list",                             /* name */
36
    FreeListInternalRep,                /* freeIntRepProc */
37
    DupListInternalRep,                 /* dupIntRepProc */
38
    UpdateStringOfList,                 /* updateStringProc */
39
    SetListFromAny                      /* setFromAnyProc */
40
};
41
 
42
/*
43
 *----------------------------------------------------------------------
44
 *
45
 * Tcl_NewListObj --
46
 *
47
 *      This procedure is normally called when not debugging: i.e., when
48
 *      TCL_MEM_DEBUG is not defined. It creates a new list object from an
49
 *      (objc,objv) array: that is, each of the objc elements of the array
50
 *      referenced by objv is inserted as an element into a new Tcl object.
51
 *
52
 *      When TCL_MEM_DEBUG is defined, this procedure just returns the
53
 *      result of calling the debugging version Tcl_DbNewListObj.
54
 *
55
 * Results:
56
 *      A new list object is returned that is initialized from the object
57
 *      pointers in objv. If objc is less than or equal to zero, an empty
58
 *      object is returned. The new object's string representation
59
 *      is left NULL. The resulting new list object has ref count 0.
60
 *
61
 * Side effects:
62
 *      The ref counts of the elements in objv are incremented since the
63
 *      resulting list now refers to them.
64
 *
65
 *----------------------------------------------------------------------
66
 */
67
 
68
#ifdef TCL_MEM_DEBUG
69
#undef Tcl_NewListObj
70
 
71
Tcl_Obj *
72
Tcl_NewListObj(objc, objv)
73
    int objc;                   /* Count of objects referenced by objv. */
74
    Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
75
{
76
    return Tcl_DbNewListObj(objc, objv, "unknown", 0);
77
}
78
 
79
#else /* if not TCL_MEM_DEBUG */
80
 
81
Tcl_Obj *
82
Tcl_NewListObj(objc, objv)
83
    int objc;                   /* Count of objects referenced by objv. */
84
    Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
85
{
86
    register Tcl_Obj *listPtr;
87
    register Tcl_Obj **elemPtrs;
88
    register List *listRepPtr;
89
    int i;
90
 
91
    TclNewObj(listPtr);
92
 
93
    if (objc > 0) {
94
        Tcl_InvalidateStringRep(listPtr);
95
 
96
        elemPtrs = (Tcl_Obj **)
97
            ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
98
        for (i = 0;  i < objc;  i++) {
99
            elemPtrs[i] = objv[i];
100
            Tcl_IncrRefCount(elemPtrs[i]);
101
        }
102
 
103
        listRepPtr = (List *) ckalloc(sizeof(List));
104
        listRepPtr->maxElemCount = objc;
105
        listRepPtr->elemCount    = objc;
106
        listRepPtr->elements     = elemPtrs;
107
 
108
        listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
109
        listPtr->typePtr = &tclListType;
110
    }
111
    return listPtr;
112
}
113
#endif /* if TCL_MEM_DEBUG */
114
 
115
/*
116
 *----------------------------------------------------------------------
117
 *
118
 * Tcl_DbNewListObj --
119
 *
120
 *      This procedure is normally called when debugging: i.e., when
121
 *      TCL_MEM_DEBUG is defined. It creates new list objects. It is the
122
 *      same as the Tcl_NewListObj procedure above except that it calls
123
 *      Tcl_DbCkalloc directly with the file name and line number from its
124
 *      caller. This simplifies debugging since then the checkmem command
125
 *      will report the correct file name and line number when reporting
126
 *      objects that haven't been freed.
127
 *
128
 *      When TCL_MEM_DEBUG is not defined, this procedure just returns the
129
 *      result of calling Tcl_NewListObj.
130
 *
131
 * Results:
132
 *      A new list object is returned that is initialized from the object
133
 *      pointers in objv. If objc is less than or equal to zero, an empty
134
 *      object is returned. The new object's string representation
135
 *      is left NULL. The new list object has ref count 0.
136
 *
137
 * Side effects:
138
 *      The ref counts of the elements in objv are incremented since the
139
 *      resulting list now refers to them.
140
 *
141
 *----------------------------------------------------------------------
142
 */
143
 
144
#ifdef TCL_MEM_DEBUG
145
 
146
Tcl_Obj *
147
Tcl_DbNewListObj(objc, objv, file, line)
148
    int objc;                   /* Count of objects referenced by objv. */
149
    Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
150
    char *file;                 /* The name of the source file calling this
151
                                 * procedure; used for debugging. */
152
    int line;                   /* Line number in the source file; used
153
                                 * for debugging. */
154
{
155
    register Tcl_Obj *listPtr;
156
    register Tcl_Obj **elemPtrs;
157
    register List *listRepPtr;
158
    int i;
159
 
160
    TclDbNewObj(listPtr, file, line);
161
 
162
    if (objc > 0) {
163
        Tcl_InvalidateStringRep(listPtr);
164
 
165
        elemPtrs = (Tcl_Obj **)
166
            ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
167
        for (i = 0;  i < objc;  i++) {
168
            elemPtrs[i] = objv[i];
169
            Tcl_IncrRefCount(elemPtrs[i]);
170
        }
171
 
172
        listRepPtr = (List *) ckalloc(sizeof(List));
173
        listRepPtr->maxElemCount = objc;
174
        listRepPtr->elemCount    = objc;
175
        listRepPtr->elements     = elemPtrs;
176
 
177
        listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
178
        listPtr->typePtr = &tclListType;
179
    }
180
    return listPtr;
181
}
182
 
183
#else /* if not TCL_MEM_DEBUG */
184
 
185
Tcl_Obj *
186
Tcl_DbNewListObj(objc, objv, file, line)
187
    int objc;                   /* Count of objects referenced by objv. */
188
    Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
189
    char *file;                 /* The name of the source file calling this
190
                                 * procedure; used for debugging. */
191
    int line;                   /* Line number in the source file; used
192
                                 * for debugging. */
193
{
194
    return Tcl_NewListObj(objc, objv);
195
}
196
#endif /* TCL_MEM_DEBUG */
197
 
198
/*
199
 *----------------------------------------------------------------------
200
 *
201
 * Tcl_SetListObj --
202
 *
203
 *      Modify an object to be a list containing each of the objc elements
204
 *      of the object array referenced by objv.
205
 *
206
 * Results:
207
 *      None.
208
 *
209
 * Side effects:
210
 *      The object is made a list object and is initialized from the object
211
 *      pointers in objv. If objc is less than or equal to zero, an empty
212
 *      object is returned. The new object's string representation
213
 *      is left NULL. The ref counts of the elements in objv are incremented
214
 *      since the list now refers to them. The object's old string and
215
 *      internal representations are freed and its type is set NULL.
216
 *
217
 *----------------------------------------------------------------------
218
 */
219
 
220
void
221
Tcl_SetListObj(objPtr, objc, objv)
222
    Tcl_Obj *objPtr;            /* Object whose internal rep to init. */
223
    int objc;                   /* Count of objects referenced by objv. */
224
    Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
225
{
226
    register Tcl_Obj **elemPtrs;
227
    register List *listRepPtr;
228
    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
229
    int i;
230
 
231
    if (Tcl_IsShared(objPtr)) {
232
        panic("Tcl_SetListObj called with shared object");
233
    }
234
 
235
    /*
236
     * Free any old string rep and any internal rep for the old type.
237
     */
238
 
239
    Tcl_InvalidateStringRep(objPtr);
240
    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
241
        oldTypePtr->freeIntRepProc(objPtr);
242
    }
243
    objPtr->typePtr = NULL;
244
 
245
    /*
246
     * Set the object's type to "list" and initialize the internal rep.
247
     */
248
 
249
    if (objc > 0) {
250
        elemPtrs = (Tcl_Obj **)
251
            ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
252
        for (i = 0;  i < objc;  i++) {
253
            elemPtrs[i] = objv[i];
254
            Tcl_IncrRefCount(elemPtrs[i]);
255
        }
256
 
257
        listRepPtr = (List *) ckalloc(sizeof(List));
258
        listRepPtr->maxElemCount = objc;
259
        listRepPtr->elemCount    = objc;
260
        listRepPtr->elements     = elemPtrs;
261
 
262
        objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
263
        objPtr->typePtr = &tclListType;
264
    } else {
265
        objPtr->bytes = tclEmptyStringRep;
266
    }
267
}
268
 
269
/*
270
 *----------------------------------------------------------------------
271
 *
272
 * Tcl_ListObjGetElements --
273
 *
274
 *      This procedure returns an (objc,objv) array of the elements in a
275
 *      list object.
276
 *
277
 * Results:
278
 *      The return value is normally TCL_OK; in this case *objcPtr is set to
279
 *      the count of list elements and *objvPtr is set to a pointer to an
280
 *      array of (*objcPtr) pointers to each list element. If listPtr does
281
 *      not refer to a list object and the object can not be converted to
282
 *      one, TCL_ERROR is returned and an error message will be left in
283
 *      the interpreter's result if interp is not NULL.
284
 *
285
 *      The objects referenced by the returned array should be treated as
286
 *      readonly and their ref counts are _not_ incremented; the caller must
287
 *      do that if it holds on to a reference. Furthermore, the pointer
288
 *      and length returned by this procedure may change as soon as any
289
 *      procedure is called on the list object; be careful about retaining
290
 *      the pointer in a local data structure.
291
 *
292
 * Side effects:
293
 *      The possible conversion of the object referenced by listPtr
294
 *      to a list object.
295
 *
296
 *----------------------------------------------------------------------
297
 */
298
 
299
int
300
Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
301
    Tcl_Interp *interp;         /* Used to report errors if not NULL. */
302
    register Tcl_Obj *listPtr;  /* List object for which an element array
303
                                 * is to be returned. */
304
    int *objcPtr;               /* Where to store the count of objects
305
                                 * referenced by objv. */
306
    Tcl_Obj ***objvPtr;         /* Where to store the pointer to an array
307
                                 * of pointers to the list's objects. */
308
{
309
    register List *listRepPtr;
310
 
311
    if (listPtr->typePtr != &tclListType) {
312
        int result = SetListFromAny(interp, listPtr);
313
        if (result != TCL_OK) {
314
            return result;
315
        }
316
    }
317
    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
318
    *objcPtr = listRepPtr->elemCount;
319
    *objvPtr = listRepPtr->elements;
320
    return TCL_OK;
321
}
322
 
323
/*
324
 *----------------------------------------------------------------------
325
 *
326
 * Tcl_ListObjAppendList --
327
 *
328
 *      This procedure appends the objects in the list referenced by
329
 *      elemListPtr to the list object referenced by listPtr. If listPtr is
330
 *      not already a list object, an attempt will be made to convert it to
331
 *      one.
332
 *
333
 * Results:
334
 *      The return value is normally TCL_OK. If listPtr or elemListPtr do
335
 *      not refer to list objects and they can not be converted to one,
336
 *      TCL_ERROR is returned and an error message is left in
337
 *      the interpreter's result if interp is not NULL.
338
 *
339
 * Side effects:
340
 *      The reference counts of the elements in elemListPtr are incremented
341
 *      since the list now refers to them. listPtr and elemListPtr are
342
 *      converted, if necessary, to list objects. Also, appending the
343
 *      new elements may cause listObj's array of element pointers to grow.
344
 *      listPtr's old string representation, if any, is invalidated.
345
 *
346
 *----------------------------------------------------------------------
347
 */
348
 
349
int
350
Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
351
    Tcl_Interp *interp;         /* Used to report errors if not NULL. */
352
    register Tcl_Obj *listPtr;  /* List object to append elements to. */
353
    Tcl_Obj *elemListPtr;       /* List obj with elements to append. */
354
{
355
    register List *listRepPtr;
356
    int listLen, objc, result;
357
    Tcl_Obj **objv;
358
 
359
    if (Tcl_IsShared(listPtr)) {
360
        panic("Tcl_ListObjAppendList called with shared object");
361
    }
362
    if (listPtr->typePtr != &tclListType) {
363
        result = SetListFromAny(interp, listPtr);
364
        if (result != TCL_OK) {
365
            return result;
366
        }
367
    }
368
    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
369
    listLen = listRepPtr->elemCount;
370
 
371
    result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
372
    if (result != TCL_OK) {
373
        return result;
374
    }
375
 
376
    /*
377
     * Insert objc new elements starting after the lists's last element.
378
     * Delete zero existing elements.
379
     */
380
 
381
    return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
382
}
383
 
384
/*
385
 *----------------------------------------------------------------------
386
 *
387
 * Tcl_ListObjAppendElement --
388
 *
389
 *      This procedure is a special purpose version of
390
 *      Tcl_ListObjAppendList: it appends a single object referenced by
391
 *      objPtr to the list object referenced by listPtr. If listPtr is not
392
 *      already a list object, an attempt will be made to convert it to one.
393
 *
394
 * Results:
395
 *      The return value is normally TCL_OK; in this case objPtr is added
396
 *      to the end of listPtr's list. If listPtr does not refer to a list
397
 *      object and the object can not be converted to one, TCL_ERROR is
398
 *      returned and an error message will be left in the interpreter's
399
 *      result if interp is not NULL.
400
 *
401
 * Side effects:
402
 *      The ref count of objPtr is incremented since the list now refers
403
 *      to it. listPtr will be converted, if necessary, to a list object.
404
 *      Also, appending the new element may cause listObj's array of element
405
 *      pointers to grow. listPtr's old string representation, if any,
406
 *      is invalidated.
407
 *
408
 *----------------------------------------------------------------------
409
 */
410
 
411
int
412
Tcl_ListObjAppendElement(interp, listPtr, objPtr)
413
    Tcl_Interp *interp;         /* Used to report errors if not NULL. */
414
    Tcl_Obj *listPtr;           /* List object to append objPtr to. */
415
    Tcl_Obj *objPtr;            /* Object to append to listPtr's list. */
416
{
417
    register List *listRepPtr;
418
    register Tcl_Obj **elemPtrs;
419
    int numElems, numRequired;
420
 
421
    if (Tcl_IsShared(listPtr)) {
422
        panic("Tcl_ListObjAppendElement called with shared object");
423
    }
424
    if (listPtr->typePtr != &tclListType) {
425
        int result = SetListFromAny(interp, listPtr);
426
        if (result != TCL_OK) {
427
            return result;
428
        }
429
    }
430
 
431
    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
432
    elemPtrs = listRepPtr->elements;
433
    numElems = listRepPtr->elemCount;
434
    numRequired = numElems + 1 ;
435
 
436
    /*
437
     * If there is no room in the current array of element pointers,
438
     * allocate a new, larger array and copy the pointers to it.
439
     */
440
 
441
    if (numRequired > listRepPtr->maxElemCount) {
442
        int newMax = (2 * numRequired);
443
        Tcl_Obj **newElemPtrs = (Tcl_Obj **)
444
            ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
445
 
446
        memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
447
               (size_t) (numElems * sizeof(Tcl_Obj *)));
448
 
449
        listRepPtr->maxElemCount = newMax;
450
        listRepPtr->elements = newElemPtrs;
451
        ckfree((char *) elemPtrs);
452
        elemPtrs = newElemPtrs;
453
    }
454
 
455
    /*
456
     * Add objPtr to the end of listPtr's array of element
457
     * pointers. Increment the ref count for the (now shared) objPtr.
458
     */
459
 
460
    elemPtrs[numElems] = objPtr;
461
    Tcl_IncrRefCount(objPtr);
462
    listRepPtr->elemCount++;
463
 
464
    /*
465
     * Invalidate any old string representation since the list's internal
466
     * representation has changed.
467
     */
468
 
469
    Tcl_InvalidateStringRep(listPtr);
470
    return TCL_OK;
471
}
472
 
473
/*
474
 *----------------------------------------------------------------------
475
 *
476
 * Tcl_ListObjIndex --
477
 *
478
 *      This procedure returns a pointer to the index'th object from the
479
 *      list referenced by listPtr. The first element has index 0. If index
480
 *      is negative or greater than or equal to the number of elements in
481
 *      the list, a NULL is returned. If listPtr is not a list object, an
482
 *      attempt will be made to convert it to a list.
483
 *
484
 * Results:
485
 *      The return value is normally TCL_OK; in this case objPtrPtr is set
486
 *      to the Tcl_Obj pointer for the index'th list element or NULL if
487
 *      index is out of range. This object should be treated as readonly and
488
 *      its ref count is _not_ incremented; the caller must do that if it
489
 *      holds on to the reference. If listPtr does not refer to a list and
490
 *      can't be converted to one, TCL_ERROR is returned and an error
491
 *      message is left in the interpreter's result if interp is not NULL.
492
 *
493
 * Side effects:
494
 *      listPtr will be converted, if necessary, to a list object.
495
 *
496
 *----------------------------------------------------------------------
497
 */
498
 
499
int
500
Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
501
    Tcl_Interp *interp;         /* Used to report errors if not NULL. */
502
    register Tcl_Obj *listPtr;  /* List object to index into. */
503
    register int index;         /* Index of element to return. */
504
    Tcl_Obj **objPtrPtr;        /* The resulting Tcl_Obj* is stored here. */
505
{
506
    register List *listRepPtr;
507
 
508
    if (listPtr->typePtr != &tclListType) {
509
        int result = SetListFromAny(interp, listPtr);
510
        if (result != TCL_OK) {
511
            return result;
512
        }
513
    }
514
 
515
    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
516
    if ((index < 0) || (index >= listRepPtr->elemCount)) {
517
        *objPtrPtr = NULL;
518
    } else {
519
        *objPtrPtr = listRepPtr->elements[index];
520
    }
521
 
522
    return TCL_OK;
523
}
524
 
525
/*
526
 *----------------------------------------------------------------------
527
 *
528
 * Tcl_ListObjLength --
529
 *
530
 *      This procedure returns the number of elements in a list object. If
531
 *      the object is not already a list object, an attempt will be made to
532
 *      convert it to one.
533
 *
534
 * Results:
535
 *      The return value is normally TCL_OK; in this case *intPtr will be
536
 *      set to the integer count of list elements. If listPtr does not refer
537
 *      to a list object and the object can not be converted to one,
538
 *      TCL_ERROR is returned and an error message will be left in
539
 *      the interpreter's result if interp is not NULL.
540
 *
541
 * Side effects:
542
 *      The possible conversion of the argument object to a list object.
543
 *
544
 *----------------------------------------------------------------------
545
 */
546
 
547
int
548
Tcl_ListObjLength(interp, listPtr, intPtr)
549
    Tcl_Interp *interp;         /* Used to report errors if not NULL. */
550
    register Tcl_Obj *listPtr;  /* List object whose #elements to return. */
551
    register int *intPtr;       /* The resulting int is stored here. */
552
{
553
    register List *listRepPtr;
554
 
555
    if (listPtr->typePtr != &tclListType) {
556
        int result = SetListFromAny(interp, listPtr);
557
        if (result != TCL_OK) {
558
            return result;
559
        }
560
    }
561
 
562
    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
563
    *intPtr = listRepPtr->elemCount;
564
    return TCL_OK;
565
}
566
 
567
/*
568
 *----------------------------------------------------------------------
569
 *
570
 * Tcl_ListObjReplace --
571
 *
572
 *      This procedure replaces zero or more elements of the list referenced
573
 *      by listPtr with the objects from an (objc,objv) array.
574
 *      The objc elements of the array referenced by objv replace the
575
 *      count elements in listPtr starting at first.
576
 *
577
 *      If the argument first is zero or negative, it refers to the first
578
 *      element. If first is greater than or equal to the number of elements
579
 *      in the list, then no elements are deleted; the new elements are
580
 *      appended to the list. Count gives the number of elements to
581
 *      replace. If count is zero or negative then no elements are deleted;
582
 *      the new elements are simply inserted before first.
583
 *
584
 *      The argument objv refers to an array of objc pointers to the new
585
 *      elements to be added to listPtr in place of those that were
586
 *      deleted. If objv is NULL, no new elements are added. If listPtr is
587
 *      not a list object, an attempt will be made to convert it to one.
588
 *
589
 * Results:
590
 *      The return value is normally TCL_OK. If listPtr does
591
 *      not refer to a list object and can not be converted to one,
592
 *      TCL_ERROR is returned and an error message will be left in
593
 *      the interpreter's result if interp is not NULL.
594
 *
595
 * Side effects:
596
 *      The ref counts of the objc elements in objv are incremented since
597
 *      the resulting list now refers to them. Similarly, the ref counts for
598
 *      replaced objects are decremented. listPtr is converted, if
599
 *      necessary, to a list object. listPtr's old string representation, if
600
 *      any, is freed.
601
 *
602
 *----------------------------------------------------------------------
603
 */
604
 
605
int
606
Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
607
    Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
608
    Tcl_Obj *listPtr;           /* List object whose elements to replace. */
609
    int first;                  /* Index of first element to replace. */
610
    int count;                  /* Number of elements to replace. */
611
    int objc;                   /* Number of objects to insert. */
612
    Tcl_Obj *CONST objv[];      /* An array of objc pointers to Tcl objects
613
                                 * to insert. */
614
{
615
    List *listRepPtr;
616
    register Tcl_Obj **elemPtrs, **newPtrs;
617
    Tcl_Obj *victimPtr;
618
    int numElems, numRequired, numAfterLast;
619
    int start, shift, newMax, i, j, result;
620
 
621
    if (Tcl_IsShared(listPtr)) {
622
        panic("Tcl_ListObjReplace called with shared object");
623
    }
624
    if (listPtr->typePtr != &tclListType) {
625
        result = SetListFromAny(interp, listPtr);
626
        if (result != TCL_OK) {
627
            return result;
628
        }
629
    }
630
    listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
631
    elemPtrs = listRepPtr->elements;
632
    numElems = listRepPtr->elemCount;
633
 
634
    if (first < 0)  {
635
        first = 0;
636
    }
637
    if (first >= numElems) {
638
        first = numElems;       /* so we'll insert after last element */
639
    }
640
    if (count < 0) {
641
        count = 0;
642
    }
643
 
644
    numRequired = (numElems - count + objc);
645
    if (numRequired <= listRepPtr->maxElemCount) {
646
        /*
647
         * Enough room in the current array. First "delete" count
648
         * elements starting at first.
649
         */
650
 
651
        for (i = 0, j = first;  i < count;  i++, j++) {
652
            victimPtr = elemPtrs[j];
653
            TclDecrRefCount(victimPtr);
654
        }
655
 
656
        /*
657
         * Shift the elements after the last one removed to their
658
         * new locations.
659
         */
660
 
661
        start = (first + count);
662
        numAfterLast = (numElems - start);
663
        shift = (objc - count); /* numNewElems - numDeleted */
664
        if ((numAfterLast > 0) && (shift != 0)) {
665
            Tcl_Obj **src, **dst;
666
 
667
            if (shift < 0) {
668
                for (src = elemPtrs + start, dst = src + shift;
669
                        numAfterLast > 0; numAfterLast--, src++, dst++) {
670
                    *dst = *src;
671
                }
672
            } else {
673
                for (src = elemPtrs + numElems - 1, dst = src + shift;
674
                        numAfterLast > 0; numAfterLast--, src--, dst--) {
675
                    *dst = *src;
676
                }
677
            }
678
        }
679
 
680
        /*
681
         * Insert the new elements into elemPtrs before "first".
682
         */
683
 
684
        for (i = 0, j = first;  i < objc;  i++, j++) {
685
            elemPtrs[j] = objv[i];
686
            Tcl_IncrRefCount(objv[i]);
687
        }
688
 
689
        /*
690
         * Update the count of elements.
691
         */
692
 
693
        listRepPtr->elemCount = numRequired;
694
    } else {
695
        /*
696
         * Not enough room in the current array. Allocate a larger array and
697
         * insert elements into it.
698
         */
699
 
700
        newMax = (2 * numRequired);
701
        newPtrs = (Tcl_Obj **)
702
            ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
703
 
704
        /*
705
         * Copy over the elements before "first".
706
         */
707
 
708
        if (first > 0) {
709
            memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
710
                    (size_t) (first * sizeof(Tcl_Obj *)));
711
        }
712
 
713
        /*
714
         * "Delete" count elements starting at first.
715
         */
716
 
717
        for (i = 0, j = first;  i < count;  i++, j++) {
718
            victimPtr = elemPtrs[j];
719
            TclDecrRefCount(victimPtr);
720
        }
721
 
722
        /*
723
         * Copy the elements after the last one removed, shifted to
724
         * their new locations.
725
         */
726
 
727
        start = (first + count);
728
        numAfterLast = (numElems - start);
729
        if (numAfterLast > 0) {
730
            memcpy((VOID *) &(newPtrs[first + objc]),
731
                    (VOID *) &(elemPtrs[start]),
732
                    (size_t) (numAfterLast * sizeof(Tcl_Obj *)));
733
        }
734
 
735
        /*
736
         * Insert the new elements before "first" and update the
737
         * count of elements.
738
         */
739
 
740
        for (i = 0, j = first;  i < objc;  i++, j++) {
741
            newPtrs[j] = objv[i];
742
            Tcl_IncrRefCount(objv[i]);
743
        }
744
 
745
        listRepPtr->elemCount = numRequired;
746
        listRepPtr->maxElemCount = newMax;
747
        listRepPtr->elements = newPtrs;
748
        ckfree((char *) elemPtrs);
749
    }
750
 
751
    /*
752
     * Invalidate and free any old string representation since it no longer
753
     * reflects the list's internal representation.
754
     */
755
 
756
    Tcl_InvalidateStringRep(listPtr);
757
    return TCL_OK;
758
}
759
 
760
/*
761
 *----------------------------------------------------------------------
762
 *
763
 * FreeListInternalRep --
764
 *
765
 *      Deallocate the storage associated with a list object's internal
766
 *      representation.
767
 *
768
 * Results:
769
 *      None.
770
 *
771
 * Side effects:
772
 *      Frees listPtr's List* internal representation and sets listPtr's
773
 *      internalRep.otherValuePtr to NULL. Decrements the ref counts
774
 *      of all element objects, which may free them.
775
 *
776
 *----------------------------------------------------------------------
777
 */
778
 
779
static void
780
FreeListInternalRep(listPtr)
781
    Tcl_Obj *listPtr;           /* List object with internal rep to free. */
782
{
783
    register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
784
    register Tcl_Obj **elemPtrs = listRepPtr->elements;
785
    register Tcl_Obj *objPtr;
786
    int numElems = listRepPtr->elemCount;
787
    int i;
788
 
789
    for (i = 0;  i < numElems;  i++) {
790
        objPtr = elemPtrs[i];
791
        Tcl_DecrRefCount(objPtr);
792
    }
793
    ckfree((char *) elemPtrs);
794
    ckfree((char *) listRepPtr);
795
}
796
 
797
/*
798
 *----------------------------------------------------------------------
799
 *
800
 * DupListInternalRep --
801
 *
802
 *      Initialize the internal representation of a list Tcl_Obj to a
803
 *      copy of the internal representation of an existing list object.
804
 *
805
 * Results:
806
 *      None.
807
 *
808
 * Side effects:
809
 *      "srcPtr"s list internal rep pointer should not be NULL and we assume
810
 *      it is not NULL. We set "copyPtr"s internal rep to a pointer to a
811
 *      newly allocated List structure that, in turn, points to "srcPtr"s
812
 *      element objects. Those element objects are not actually copied but
813
 *      are shared between "srcPtr" and "copyPtr". The ref count of each
814
 *      element object is incremented.
815
 *
816
 *----------------------------------------------------------------------
817
 */
818
 
819
static void
820
DupListInternalRep(srcPtr, copyPtr)
821
    Tcl_Obj *srcPtr;            /* Object with internal rep to copy. */
822
    Tcl_Obj *copyPtr;           /* Object with internal rep to set. */
823
{
824
    List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr;
825
    int numElems = srcListRepPtr->elemCount;
826
    int maxElems = srcListRepPtr->maxElemCount;
827
    register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
828
    register Tcl_Obj **copyElemPtrs;
829
    register List *copyListRepPtr;
830
    int i;
831
 
832
    /*
833
     * Allocate a new List structure that points to "srcPtr"s element
834
     * objects. Increment the ref counts for those (now shared) element
835
     * objects.
836
     */
837
 
838
    copyElemPtrs = (Tcl_Obj **)
839
        ckalloc((unsigned) maxElems * sizeof(Tcl_Obj *));
840
    for (i = 0;  i < numElems;  i++) {
841
        copyElemPtrs[i] = srcElemPtrs[i];
842
        Tcl_IncrRefCount(copyElemPtrs[i]);
843
    }
844
 
845
    copyListRepPtr = (List *) ckalloc(sizeof(List));
846
    copyListRepPtr->maxElemCount = maxElems;
847
    copyListRepPtr->elemCount    = numElems;
848
    copyListRepPtr->elements     = copyElemPtrs;
849
 
850
    copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
851
    copyPtr->typePtr = &tclListType;
852
}
853
 
854
/*
855
 *----------------------------------------------------------------------
856
 *
857
 * SetListFromAny --
858
 *
859
 *      Attempt to generate a list internal form for the Tcl object
860
 *      "objPtr".
861
 *
862
 * Results:
863
 *      The return value is TCL_OK or TCL_ERROR. If an error occurs during
864
 *      conversion, an error message is left in the interpreter's result
865
 *      unless "interp" is NULL.
866
 *
867
 * Side effects:
868
 *      If no error occurs, a list is stored as "objPtr"s internal
869
 *      representation.
870
 *
871
 *----------------------------------------------------------------------
872
 */
873
 
874
static int
875
SetListFromAny(interp, objPtr)
876
    Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
877
    Tcl_Obj *objPtr;            /* The object to convert. */
878
{
879
    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
880
    char *string, *elemStart, *nextElem, *s;
881
    int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
882
    char *limit;                /* Points just after string's last byte. */
883
    register char *p;
884
    register Tcl_Obj **elemPtrs;
885
    register Tcl_Obj *elemPtr;
886
    List *listRepPtr;
887
 
888
    /*
889
     * Get the string representation. Make it up-to-date if necessary.
890
     */
891
 
892
    string = Tcl_GetStringFromObj(objPtr, &length);
893
 
894
    /*
895
     * Parse the string into separate string objects, and create a List
896
     * structure that points to the element string objects. We use a
897
     * modified version of Tcl_SplitList's implementation to avoid one
898
     * malloc and a string copy for each list element. First, estimate the
899
     * number of elements by counting the number of space characters in the
900
     * list.
901
     */
902
 
903
    limit = (string + length);
904
    estCount = 1;
905
    for (p = string;  p < limit;  p++) {
906
        if (isspace(UCHAR(*p))) {
907
            estCount++;
908
        }
909
    }
910
 
911
    /*
912
     * Allocate a new List structure with enough room for "estCount"
913
     * elements. Each element is a pointer to a Tcl_Obj with the appropriate
914
     * string rep. The initial "estCount" elements are set using the
915
     * corresponding "argv" strings.
916
     */
917
 
918
    elemPtrs = (Tcl_Obj **)
919
            ckalloc((unsigned) (estCount * sizeof(Tcl_Obj *)));
920
    for (p = string, lenRemain = length, i = 0;
921
            lenRemain > 0;
922
            p = nextElem, lenRemain = (limit - nextElem), i++) {
923
        result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
924
                                &elemSize, &hasBrace);
925
        if (result != TCL_OK) {
926
            for (j = 0;  j < i;  j++) {
927
                elemPtr = elemPtrs[j];
928
                Tcl_DecrRefCount(elemPtr);
929
            }
930
            ckfree((char *) elemPtrs);
931
            return result;
932
        }
933
        if (elemStart >= limit) {
934
            break;
935
        }
936
        if (i > estCount) {
937
            panic("SetListFromAny: bad size estimate for list");
938
        }
939
 
940
        /*
941
         * Allocate a Tcl object for the element and initialize it from the
942
         * "elemSize" bytes starting at "elemStart".
943
         */
944
 
945
        s = ckalloc((unsigned) elemSize + 1);
946
        if (hasBrace) {
947
            memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);
948
            s[elemSize] = 0;
949
        } else {
950
            elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
951
        }
952
 
953
        TclNewObj(elemPtr);
954
        elemPtr->bytes  = s;
955
        elemPtr->length = elemSize;
956
        elemPtrs[i] = elemPtr;
957
        Tcl_IncrRefCount(elemPtr); /* since list now holds ref to it */
958
    }
959
 
960
    listRepPtr = (List *) ckalloc(sizeof(List));
961
    listRepPtr->maxElemCount = estCount;
962
    listRepPtr->elemCount    = i;
963
    listRepPtr->elements     = elemPtrs;
964
 
965
    /*
966
     * Free the old internalRep before setting the new one. We do this as
967
     * late as possible to allow the conversion code, in particular
968
     * Tcl_GetStringFromObj, to use that old internalRep.
969
     */
970
 
971
    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
972
        oldTypePtr->freeIntRepProc(objPtr);
973
    }
974
 
975
    objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
976
    objPtr->typePtr = &tclListType;
977
    return TCL_OK;
978
}
979
 
980
/*
981
 *----------------------------------------------------------------------
982
 *
983
 * UpdateStringOfList --
984
 *
985
 *      Update the string representation for a list object.
986
 *      Note: This procedure does not invalidate an existing old string rep
987
 *      so storage will be lost if this has not already been done.
988
 *
989
 * Results:
990
 *      None.
991
 *
992
 * Side effects:
993
 *      The object's string is set to a valid string that results from
994
 *      the list-to-string conversion. This string will be empty if the
995
 *      list has no elements. The list internal representation
996
 *      should not be NULL and we assume it is not NULL.
997
 *
998
 *----------------------------------------------------------------------
999
 */
1000
 
1001
static void
1002
UpdateStringOfList(listPtr)
1003
    Tcl_Obj *listPtr;           /* List object with string rep to update. */
1004
{
1005
#   define LOCAL_SIZE 20
1006
    int localFlags[LOCAL_SIZE], *flagPtr;
1007
    List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
1008
    int numElems = listRepPtr->elemCount;
1009
    register int i;
1010
    char *elem, *dst;
1011
    int length;
1012
 
1013
    /*
1014
     * Convert each element of the list to string form and then convert it
1015
     * to proper list element form, adding it to the result buffer.
1016
     */
1017
 
1018
    /*
1019
     * Pass 1: estimate space, gather flags.
1020
     */
1021
 
1022
    if (numElems <= LOCAL_SIZE) {
1023
        flagPtr = localFlags;
1024
    } else {
1025
        flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
1026
    }
1027
    listPtr->length = 1;
1028
    for (i = 0; i < numElems; i++) {
1029
        elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
1030
        listPtr->length += Tcl_ScanCountedElement(elem, length,
1031
                &flagPtr[i]) + 1;
1032
    }
1033
 
1034
    /*
1035
     * Pass 2: copy into string rep buffer.
1036
     */
1037
 
1038
    listPtr->bytes = ckalloc((unsigned) listPtr->length);
1039
    dst = listPtr->bytes;
1040
    for (i = 0; i < numElems; i++) {
1041
        elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
1042
        dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
1043
        *dst = ' ';
1044
        dst++;
1045
    }
1046
    if (flagPtr != localFlags) {
1047
        ckfree((char *) flagPtr);
1048
    }
1049
    if (dst == listPtr->bytes) {
1050
        *dst = 0;
1051
    } else {
1052
        dst--;
1053
        *dst = 0;
1054
    }
1055
    listPtr->length = dst - listPtr->bytes;
1056
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.