Tcl Source Code

Tcl_Obj *
\fBTcl_DuplicateObj\fR(\fIobjPtr\fR)
.sp
\fBTcl_IncrRefCount\fR(\fIobjPtr\fR)
.sp
\fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
.sp
\fBTcl_BumpObj\fR(\fIobjPtr\fR)
.sp
int
\fBTcl_IsShared\fR(\fIobjPtr\fR)
.sp
\fBTcl_InvalidateStringRep\fR(\fIobjPtr\fR)
.SH ARGUMENTS
.AS Tcl_Obj *objPtr
.AP Tcl_Obj *objPtr in

.PP
The string representation of \fIx\fR's value is needed
and is recomputed.
The string representation is now \fB124\fR
and both representations are again valid.
.SH "STORAGE MANAGEMENT OF VALUES"
.PP
Tcl values are allocated on the heap and are shared as much as
possible to reduce storage requirements.  Reference counting is used

to determine when a value is no longer needed and can safely be freed.
A value just created by \fBTcl_NewObj\fR, \fBTcl_NewStringObj\fR, or
any Abstract List command or function, has \fIrefCount\fR 0, meaning
that the object can often be given to a function like
\fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
\fBTcl_DictObjPut\fR (as a value) without explicit reference
management, all of which are common use cases. (The latter two require
that the target list or dictionary be well-formed, but that is
often easy to arrange when the value is being initially constructed.)
The macro \fBTcl_IncrRefCount\fR increments the reference count when a
new reference to the value is created.
The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed.

If the value's reference count drops to zero, frees
its storage.
The macro \fBTcl_BumpObj\fR will check if the value has no references (i.e. in a "new" state) and free the value.
A value shared by different code or data structures has
\fIrefCount\fR greater than 1.  Incrementing a value's reference count

ensures that it will not be freed too early or have its value change
accidentally.
.PP
As an example, the bytecode interpreter shares argument values
between calling and called Tcl procedures to avoid having to copy values.
It assigns the call's argument values to the procedure's
formal parameter variables.
In doing so, it calls \fBTcl_IncrRefCount\fR to increment
the reference count of each argument since there is now a new
reference to it from the formal parameter.
When the called procedure returns,
the interpreter calls \fBTcl_DecrRefCount\fR to decrement
each argument's reference count.
When a value's reference count drops less than or equal to zero,
\fBTcl_DecrRefCount\fR reclaims its storage.

.PP
Most command procedures have not been concerned about reference
counting since they use a value's value immediately and do not retain
a pointer to the value after they return.  However, there are some
procedures that may return a new value, with a refCount of 0. In this
situation, it is the caller's responsibility to free the value before
the procedure returns.  One way to cover this is to always call
\fBTcl_IncrRefCount\fR before using the value, then call
\fBTcl_DecrRefCount\fR before returning. The other way is to use
\fBTcl_BumpObj\fR after the value is no longer needed or
referenced. This macro will free the value if there are no other
references to the value. When retaining a pointer to a value in a data
structure the procedure must be careful to increment its reference
count since the retained pointer is a new reference. Examples of
procedures that return new values are \fBTcl_NewIntObj\fR, and
commands like \fBlseq\fR, which creates an Abstract List, and an
lindex on this list may return a new Obj with a refCount of 0.

.PP
Command procedures that directly modify values
such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
copy a shared value before changing it.
They must first check whether the value is shared
by calling \fBTcl_IsShared\fR.
If the value is shared they must copy the value

.CE
.PP
As another example, \fBincr\fR's command procedure
must check whether the variable's value is shared before
incrementing the integer in its internal representation.
If it is shared, it needs to duplicate the value
in order to avoid accidentally changing values in other data structures.
.PP
In cases where a value is obtained, used, and not retained, the value
can be freed using \fBTcl_BumpObj\fR. This
is functionally equivalent to calling \fBTcl_IncrRefCount\fR followed
\fBTcl_DecrRefCount\fR.
.SH "SEE ALSO"
Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
.SH KEYWORDS
internal representation, value, value creation, value type,
reference counting, string representation, type conversion

'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_ObjType 3 9.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType  \- manipulate Tcl value types
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR

In many cases, the \fItypePtr->setFromAnyProc\fR routine will
set \fIobjPtr->typePtr\fR to the argument value \fItypePtr\fR,
but that is no longer guaranteed.  The \fIsetFromAnyProc\fR is
free to set the internal representation for \fIobjPtr\fR to make
use of another related Tcl_ObjType, if it sees fit.
.SH "THE TCL_OBJTYPE STRUCTURE"
.PP
Extension writers can define new value types by defining four to eight

procedures and initializing a Tcl_ObjType structure to describe the
type.  Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit other
extensions to look up their Tcl_ObjType by name with the
\fBTcl_GetObjType\fR routine.  The \fBTcl_ObjType\fR structure is
defined as follows:
.PP
.CS
typedef struct Tcl_ObjType {
    const char *\fIname\fR;
    Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
    Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
    Tcl_UpdateStringProc *\fIupdateStringProc\fR;
    Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
    size_t \fIversion\fR;
    /* List emulation functions - ObjType Version 1 & 2 */
    Tcl_ObjTypeLengthProc *lengthProc;
    /* List emulation functions - ObjType Version 2 */
    Tcl_ObjTypeIndexProc *\fIindexProc\fR;
    Tcl_ObjTypeSliceProc *\fIsliceProc\fR;
    Tcl_ObjTypeReverseProc *\fIreverseProc\fR;
    Tcl_ObjTypeGetElements *\fIgetElementsProc\fR;
    Tcl_ObjTypeSetElement *\fIsetElementProc\fR;
    Tcl_ObjTypeReplaceProc *\fIreplaceProc\fR;
} \fBTcl_ObjType\fR;
.CE
.SS "THE NAME FIELD"
.PP
The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
When a type is registered, this is the name used by callers
of \fBTcl_GetObjType\fR to lookup the type.  For unregistered

.PP
Note that if a subsidiary value has its reference count reduced to zero
during the running of a \fIfreeIntRepProc\fR, that value may be not freed
immediately, in order to limit stack usage. However, the value will be freed
before the outermost current \fBTcl_DecrRefCount\fR returns.
.SS "THE VERSION FIELD"
.PP
The \fIversion\fR member provides for future extensibility of the
structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatability
of ObjType definitions prior to version 9.0. Specifics about versions
will be described further in the sections below.
.SH "ABSTRACT LIST TYPES"
.PP
Additional fields in the Tcl_ObjType descriptor allow for control over
how custom data values can be manipulated using Tcl's List commands
without converting the value to a List type. This requires the custom
type to provide functions that will perform the given operation on the
custom data representation.  Not all functions are required. In the
absence of a particular function (set to NULL), the fallback is to
allow the internal List operation to perform the operation, most
likely causing the value type to be converted to a traditional list.
.SS "SCALAR VALUE TYPES"
.PP
For a custom value type that is scalar or atomic in nature, i.e., not
a divisible collection, version \fBTCL_OBJTYPE_V1\fR is
recommended. In this case, List commands will treat the scalar value
as if it where a list of length 1, and not convert the value to a List
type.
.SS "VERSION 2: ABSTRACT LISTS"
.PP
Version 2, \fBTCL_OBJTYPE_V2\fR, allows full List support when the
functions described below are provided.  This allows for script level
use of the List commands without causing the type of the Tcl_Obj value
to be converted to a list.
.SS "THE LENGTHPROC FIELD"
.PP
The \fBLengthProc\fR function correlates with the \fBllength\fR
command. The function returns the number of elements in the list. It
is used in every List operation and is required for all Abstract List
implementations.

.CS
typedef Tcl_Size
(Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr);
.CE

.PP
.SS "THE INDEXPROC FIELD"
.PP
The \fBIndexProc\fR function correlates with the \fBlindex\fR
command. The function returns a Tcl_Obj value for the element at the
specified index.
.CS
typedef int
(Tcl_ObjTypeIndexProc) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size index,
    Tcl_Obj** elemObj);
.CE
.SS "THE SLICEPROC FIELD"
.PP
The \fBSliceProc\fR correlates with the \fBlrange\fR command,
returning a new List or Abstract List for the portion of the original
list specifed.
.CS
typedef int
(Tcl_ObjTypeSliceProc) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size fromIdx,
    Tcl_Size toIdx,
    Tcl_Obj **newObjPtr);
.CE
.SS "THE REVERSEPROC FIELD"
.PP
The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
returning a List or Abstract List that has the same elements as the
input Abstract List, with the elements in the reverse order.
.CS
typedef int
(Tcl_ObjTypeReverseProc) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Obj **newObjPtr);
.CE
.SS "THE GETELEMENTS FIELD"
.PP
THe \fBGetElements\fR function returns a count and a pointer to an
array of Tcl_Obj values for the entire Abstract List. This is a
correlary to the \fBTcl_ListObjGetElements\fR C API call.
.CS
typedef int
(Tcl_ObjTypeGetElements) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size *objcptr,
    Tcl_Obj ***objvptr);
.CE
.SS "THE SETELEMENT FIELD"
.PP
The \fBSetElement\fR function replaces the element within the
specified list at the give index. This function correlates to the
\fBlset\fR command.  typedef Tcl_Obj*
.CS
Tcl_ObjTypeSetElement) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size indexCount,
    Tcl_Obj *const indexArray[],
    Tcl_Obj *valueObj);
.CE
.SS "REPLACEPROC FIELD"
.PP
The \fBReplaceProc\fR returns a new list after modfying the list
replacing the elements to be deleted, and adding the elements to be
inserted. This function correlates to the \fBlreplace\fR command.
.CS
typedef int
(Tcl_ObjTypeReplaceProc) (
    Tcl_Interp *interp,
    Tcl_Obj *listObj,
    Tcl_Size first,
    Tcl_Size numToDelete,
    Tcl_Size numToInsert,
    Tcl_Obj *const insertObjs[]);
.CE
.SH "REFERENCE COUNT MANAGEMENT"
.PP
The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared
value; this function will not modify the reference count of that value, but
will modify its contents. If \fIobjPtr\fR is not (interpretable as) a list,
this function will set the interpreter result and produce an error; using an
unshared empty value is strongly recommended.

\fBlseq \fIstart \fBcount\fR \fIcount\fR ??\fBby\fR? \fIstep\fR?

\fBlseq \fIcount\fR ?\fBby \fIstep\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR. The \fIoperation\fR
argument "\fB..\fR" or "\fBto\fR" defines the range. The "\fBcount\fR" option
is used to define a count of the number of elements in the list. A short form
use of the command, with a single count value, will create a range from 0 to
count-1.

The \fBlseq\fR command can produce both increasing and decreasing
sequences. When both \fIstart\fR and \fIend\fR are provided without a
\fIstep\fR value, then if \fIstart\fR <= \fIend\fR, the sequence will be
increasing and if \fIstart\fR > \fIend\fR it will be decreasing. If a
\fIstep\fR vale is included, it's sign should agree with the direction of the
sequence (descending -> negative and ascending -> positive), otherwise an
empty list is returned.  For example:

.CS \"
% \fBlseq\fR 1 to 5    ;# increasing
\fI\(-> 1 2 3 4 5

% \fBlseq\fR 5 to 1    ;# decreasing
\fI\(-> 5 4 3 2 1

% \fBlseq\fR 6 to 1 by 2   ;# decreasing, step wrong sign, empty list

% \fBlseq\fR 1 to 5 by 0   ;# all step sizes of 0 produce an empty list
.\"
.CE

The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
may also be a valid expression. The expression will be evaluated and the
numeric result will be used.  An expression that does not evaluate to a number
will produce an invalid argument error.
.PP
\fIStart\fR defines the initial value and \fIend\fR defines the limit, not
necessarily the last value. \fBlseq\fR produces a list with \fIcount\fR
elements, and if \fIcount\fR is not supplied, it is computed as

.CS \"
    \fIcount\fR = int( (\fIend\fR - \fIstart\fR + \fIstep\fR) / \fIstep\fR )
.\"
.CE

.PP
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
can also be a valid expression. the \fBlseq\fR command will evaluate the
expression (as if with \fBexpr\fR)
and use the numeric result, or return an error as with any invalid argument
value; a non-numeric expression result will result in an error.

.SH EXAMPLES
.CS
.\"
\fBlseq\fR 3
\fI\(-> 0 1 2\fR

\fBlseq\fR 3 0
\fI\(-> 3 2 1 0\fR

\fBlseq\fR 10 .. 1 by -2
\fI\(-> 10 8 6 4 2\fR

set l [\fBlseq\fR 0 -5]
\fI\(-> 0 -1 -2 -3 -4 -5\fR

foreach i [\fBlseq\fR [llength $l]] {
    puts l($i)=[lindex $l $i]
}
\fI\(-> l(0)=0\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(5)=-5\fR

foreach i [\fBlseq\fR {[llength $l]-1} 0] {
    puts l($i)=[lindex $l $i]
}
\fI\(-> l(5)=-5\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(0)=0\fR

set i 17
         \fI\(-> 17\fR
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i <= 50)
    puts "Ok"
} else {
    puts "outside :("
}
\fI\(-> Ok\fR

set sqrs [lmap i [\fBlseq\fR 1 10] { expr {$i*$i} }]
\fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
.\"
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, index, list
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

typedef void (Tcl_DeleteFileHandlerProc) (int fd);
typedef void (Tcl_AlertNotifierProc) (void *clientData);
typedef void (Tcl_ServiceModeHookProc) (int mode);
typedef void *(Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
typedef void (Tcl_MainLoopProc) (void);

/* Abstract List functions */
typedef	      Tcl_Size	(Tcl_ObjTypeLengthProc)  (struct Tcl_Obj *listPtr);
typedef		   int	(Tcl_ObjTypeIndexProc)   (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size index, struct Tcl_Obj** elemObj);
typedef		   int	(Tcl_ObjTypeSliceProc)   (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size fromIdx, Tcl_Size toIdx,
                                             struct Tcl_Obj **newObjPtr);
typedef		   int	(Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					     struct Tcl_Obj **newObjPtr);
typedef		   int	(Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					     Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
typedef	struct Tcl_Obj*	(Tcl_ObjTypeSetElement)  (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size indexCount,
                                             struct Tcl_Obj *const indexArray[],
                                             struct Tcl_Obj *valueObj);
typedef            int  (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
                                             Tcl_Size first, Tcl_Size numToDelete,
                                             Tcl_Size numToInsert,
                                             struct Tcl_Obj *const insertObjs[]);

#ifndef TCL_NO_DEPRECATED
#   define Tcl_PackageInitProc Tcl_LibraryInitProc
#   define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
#endif

/*
 *----------------------------------------------------------------------------

				/* Called to update the string rep from the
				 * type's internal representation. */
    Tcl_SetFromAnyProc *setFromAnyProc;
				/* Called to convert the object's internal rep
				 * to this type. Frees the internal rep of the
				 * old type. Returns TCL_ERROR on failure. */
    size_t version;

    /* List emulation functions - ObjType Version 1 */
    Tcl_ObjTypeLengthProc *lengthProc;	     /* Return the [llength] of the
					     ** AbstractList */
    Tcl_ObjTypeIndexProc *indexProc;	     /* Return a value (Tcl_Obj) for
					     ** [lindex $al $index] */
    Tcl_ObjTypeSliceProc *sliceProc;	     /* Return an AbstractList for
					     ** [lrange $al $start $end] */
    Tcl_ObjTypeReverseProc *reverseProc;     /* Return an AbstractList for
					     ** [lreverse $al] */
    Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in
					     ** the list */
    Tcl_ObjTypeSetElement *setElementProc;   /* Replace the element at the indicie
					     ** with the given valueObj. */
    Tcl_ObjTypeReplaceProc *replaceProc;     /* Replace subset with subset */
} Tcl_ObjType;

#define TCL_OBJTYPE_V0 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
#define TCL_OBJTYPE_V1(a) 1,a,0,0,0,0,0,0 /* Tcl 9 Version 1 */

#define TCL_OBJTYPE_V2(a,b,c,d,e,f,g)	 2, \
    a,b,c,d,e,f,g /* Tcl 9 - AbstractLists */

#define TCL_OBJTYPE_CURRENT 2


/*
 * The following structure stores an internal representation (internalrep) for
 * a Tcl value. An internalrep is associated with an Tcl_ObjType when both
 * are stored in the same Tcl_Obj.  The routines of the Tcl_ObjType govern
 * the handling of the internalrep.
 */

    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    Tcl_ObjInternalRep internalRep;	/* The internal representation: */
} Tcl_Obj;


/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).
 */

	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
/*
 * Free the Obj by effectively doing:
 *
 *   Tcl_IncrRefCount(objPtr);
 *   Tcl_DecrRefCount(objPtr);
 *
 * This will free the obj if there are no references to the obj.
 */
#   define Tcl_BumpObj(objPtr) \
    TclBumpObj(objPtr, __FILE__, __LINE__)

static inline void TclBumpObj(Tcl_Obj* objPtr, const char* fn, int line)
{
    if (objPtr) {
        if ((objPtr)->refCount == 0) {
            Tcl_DbDecrRefCount(objPtr, fn, line);
	}
    }
}
#else
#   undef Tcl_IncrRefCount
#   define Tcl_IncrRefCount(objPtr) \
	++(objPtr)->refCount
    /*
     * Use do/while0 idiom for optimum correctness without compiler warnings.
     * https://wiki.c2.com/?TrivialDoWhileLoop
     */
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	do { \
	    Tcl_Obj *_objPtr = (objPtr); \
	    if (_objPtr->refCount-- <= 1) { \
		TclFreeObj(_objPtr); \
	    } \
	} while(0)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	((objPtr)->refCount > 1)

/*
 * Declare that obj will no longer be used or referenced.
 * This will release the obj if there is no referece count,
 * otherwise let it be.
 */
#   define Tcl_BumpObj(objPtr)     \
    TclBumpObj(objPtr);

static inline void TclBumpObj(Tcl_Obj* objPtr)
{
    if (objPtr) {
        if ((objPtr)->refCount == 0) {
            Tcl_DecrRefCount(objPtr);
	}
    }
}

#endif

/*
 * Macros and definitions that help to debug the use of Tcl objects. When
 * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call
 * debugging versions of the object creation functions.
 */

/*
 * tclArithSeries.c --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tcl.h"
#include "tclInt.h"
#include <assert.h>
#include <math.h>

/*
 * The structure below defines the arithmetic series Tcl object type by
 * means of procedures that can be invoked by generic object code.
 *
 * The arithmetic series object is a special case of Tcl list representing
 * an interval of an arithmetic series in constant space.
 *
 * The arithmetic series is internally represented with three integers,
 * *start*, *end*, and *step*, Where the length is calculated with
 * the following algorithm:
 *
 * if RANGE == 0 THEN
 *   ERROR
 * if RANGE > 0
 *   LEN is (((END-START)-1)/STEP) + 1
 * else if RANGE < 0
 *   LEN is (((END-START)-1)/STEP) - 1
 *
 * And where the equivalent's list I-th element is calculated
 * as:
 *
 * LIST[i] = START + (STEP * i)
 *
 * Zero elements ranges, like in the case of START=10 END=10 STEP=1
 * are valid and will be equivalent to the empty list.
 */

/*
 * The structure used for the ArithSeries internal representation.
 * Note that the len can in theory be always computed by start,end,step
 * but it's faster to cache it inside the internal representation.
 */
typedef struct {
    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
    Tcl_WideInt start;
    Tcl_WideInt end;
    Tcl_WideInt step;
} ArithSeries;
typedef struct {
    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
    double start;
    double end;
    double step;
    int precision;
} ArithSeriesDbl;

/* -------------------------- ArithSeries object ---------------------------- */

static int TclArithSeriesObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
				  Tcl_Size index, Tcl_Obj **elemObj);

static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj);
static int TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesObj,
			    Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
static int TclArithSeriesObjReverse(Tcl_Interp *interp, Tcl_Obj *arithSeriesObj, Tcl_Obj **newObjPtr);
static int TclArithSeriesGetElements(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);
static void DupArithSeriesInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr);
static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr);
static int  SetArithSeriesFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

static const Tcl_ObjType arithSeriesType = {
    "arithseries",			/* name */
    FreeArithSeriesInternalRep,		/* freeIntRepProc */
    DupArithSeriesInternalRep,		/* dupIntRepProc */
    UpdateStringOfArithSeries,		/* updateStringProc */
    SetArithSeriesFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V2(
    ArithSeriesObjLength,
    TclArithSeriesObjIndex,
    TclArithSeriesObjRange,
    TclArithSeriesObjReverse,
    TclArithSeriesGetElements,
    NULL, // SetElement
    NULL) // Replace
};

/*
 * Helper functions
 *
 * - ArithRound -- Round doubles to the number of significant fractional
 *                 digits
 * - ArithSeriesIndexDbl -- base list indexing operation for doubles

    }
}

static inline ArithSeries*
ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
{
    const Tcl_ObjInternalRep *irPtr;
    irPtr = TclFetchInternalRep((objPtr), &arithSeriesType);
    return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;
}

/*
 * Compute number of significant factional digits
 */
static inline int

    int i  = Precision(start);
    dp = i>dp ? i : dp;
    i  = Precision(end);
    dp = i>dp ? i : dp;
    return dp;
}









static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesObj, Tcl_Obj **stepObj);








































/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesLen --
 *
 * 	Compute the length of the equivalent list where

    }
    istart = start * pow(10,precision);
    iend = end * pow(10,precision);
    istep = step * pow(10,precision);
    ilen = ((iend-istart+istep)/istep);
    return floor(ilen);
}


/*
 *----------------------------------------------------------------------
 *
 * DupArithSeriesInternalRep --
 *
 *	Initialize the internal representation of a arithseries Tcl_Obj to a
 *	copy of the internal representation of an existing arithseries object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	We set "copyPtr"s internal rep to a pointer to a
 *	newly allocated ArithSeries structure.
 *----------------------------------------------------------------------
 */

static void
DupArithSeriesInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    ArithSeries *srcArithSeriesRepPtr =
	(ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
    /*
     * Allocate a new ArithSeries structure. */

    if (srcArithSeriesRepPtr->isDouble) {
	ArithSeriesDbl *srcArithSeriesDblRepPtr =
	    (ArithSeriesDbl *)srcArithSeriesRepPtr;
	ArithSeriesDbl *copyArithSeriesDblRepPtr =
	    (ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl));
	*copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr;
	copyArithSeriesDblRepPtr->elements = NULL;
	copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr;
    } else {
	ArithSeries *copyArithSeriesRepPtr =
	    (ArithSeries *) Tcl_Alloc(sizeof(ArithSeries));
	*copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
	copyArithSeriesRepPtr->elements = NULL;
	copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
    }
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &arithSeriesType;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeArithSeriesInternalRep --
 *
 *	Free any allocated memory in the ArithSeries Rep
 *
 * Results:
 *	None.
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */
static void
FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr)  /* Free any allocated memory */
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;

    if (arithSeriesRepPtr) {
	if (arithSeriesRepPtr->elements) {
	    Tcl_WideInt i, len = arithSeriesRepPtr->len;
	    for (i=0; i<len; i++) {
		Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
	    }
	    Tcl_Free((char*)arithSeriesRepPtr->elements);
	    arithSeriesRepPtr->elements = NULL;
	}
	Tcl_Free((char*)arithSeriesRepPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * NewArithSeriesInt --
 *
 *	Creates a new ArithSeries object. The returned object has

    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;
    arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    arithSeriesObj->typePtr = &arithSeriesType;
    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesObj);

    return arithSeriesObj;
}

/*

    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;
    arithSeriesRepPtr->precision = maxPrecision(start,end,step);
    arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    arithSeriesObj->typePtr = &arithSeriesType;

    if (length > 0) {
    	Tcl_InvalidateStringRep(arithSeriesObj);
    }

    return arithSeriesObj;
}

    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *






































 * TclArithSeriesObjIndex --
 *
 *	Returns the element with the specified index in the list
 *	represented by the specified Arithmetic Sequence object.
 *	If the index is out of range, TCL_ERROR is returned,
 *	otherwise TCL_OK is returned and the integer value of the
 *	element is stored in *element.
 *
 * Results:
 *
 * 	TCL_OK on success, TCL_ERROR on index out of range.
 *
 * Side Effects:
 *
 * 	On success, the integer pointed by *element is modified.
 *
 *----------------------------------------------------------------------
 */


int
TclArithSeriesObjIndex(
    TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
    Tcl_Obj *arithSeriesObj, /* List obj */
    Tcl_Size index,          /* index to element of interest */
    Tcl_Obj **elemObj)       /* Return value */
{
    ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);





    if (index < 0 || arithSeriesRepPtr->len <= index) {
	*elemObj = Tcl_NewObj();
    } else {
	/* List[i] = Start + (Step * index) */
	if (arithSeriesRepPtr->isDouble) {
	    *elemObj = Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
	} else {
	    *elemObj = Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesObjLength
 *

 */
Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries*)
	    arithSeriesObj->internalRep.twoPtrValue.ptr1;
    return arithSeriesRepPtr->len;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjStep --
 *












 *	Return a Tcl_Obj with the step value from the give ArithSeries Obj.


















 *	refcount = 0.




 *



 * Results:

 *


 * 	A Tcl_Obj pointer to the created ArithSeries object.


 * 	A NULL pointer of the range is invalid.







 *


 * Side Effects:


















 *










 * 	None.














 *----------------------------------------------------------------------















 */







int
TclArithSeriesObjStep(
    Tcl_Obj *arithSeriesObj,










    Tcl_Obj **stepObj)



{
    ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);



    if (arithSeriesRepPtr->isDouble) {


	*stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);

    } else {



	*stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
    }


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetArithSeriesFromAny --
 *

 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */


int
TclArithSeriesObjRange(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to take a range from. */
    Tcl_Size fromIdx,		/* Index of first element to include. */
    Tcl_Size toIdx,		/* Index of last element to include. */
    Tcl_Obj **newObjPtr)        /* return value */
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;

    (void)interp; /* silence compiler */

    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }

    if (toIdx >= arithSeriesRepPtr->len) {
	toIdx = arithSeriesRepPtr->len-1;
    }

    if (fromIdx > toIdx ||
	fromIdx >= arithSeriesRepPtr->len) {


	TclNewObj(*newObjPtr);
	return TCL_OK;
    }

    if (fromIdx < 0) {
	fromIdx = 0;
    }
    if (toIdx < 0) {
	toIdx = 0;
    }
    if (toIdx > arithSeriesRepPtr->len-1) {
	toIdx = arithSeriesRepPtr->len-1;
    }

    TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx, &startObj);



    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(interp, arithSeriesObj, toIdx, &endObj);



    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesObj, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (Tcl_IsShared(arithSeriesObj) ||
	    ((arithSeriesObj->refCount > 1))) {

	int status = TclNewArithSeriesObj(NULL, newObjPtr,
		arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);



	Tcl_DecrRefCount(startObj);
	Tcl_DecrRefCount(endObj);
	Tcl_DecrRefCount(stepObj);
	return status;
    }

    /*
     * In-place is possible.
     */

    /*

	arithSeriesRepPtr->elements = NULL;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = arithSeriesObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesGetElements --
 *

    Tcl_Obj *objPtr,		/* ArithSeries object for which an element
				 * array is to be returned. */
    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    if (TclHasInternalRep(objPtr,&arithSeriesType)) {
	ArithSeries *arithSeriesRepPtr;
	Tcl_Obj **objv;
	int i, objc;

	arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr);

	objc = arithSeriesRepPtr->len;
	if (objc > 0) {
	    if (arithSeriesRepPtr->elements) {
		/* If this exists, it has already been populated */
		objv = arithSeriesRepPtr->elements;
	    } else {
		/* Construct the elements array */
		objv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * objc);
		if (objv == NULL) {
		    if (interp) {
			Tcl_SetObjResult(
			    interp,
			    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
			Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		    }
		    return TCL_ERROR;
		}
		arithSeriesRepPtr->elements = objv;
		for (i = 0; i < objc; i++) {
		    int status = TclArithSeriesObjIndex(interp, objPtr, i, &objv[i]);
		    if (status) {
			return TCL_ERROR;
		    }
		    Tcl_IncrRefCount(objv[i]);
		}
	    }
	} else {
	    objv = NULL;

}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjReverse --
 *
 *	Reverse the order of the ArithSeries value. The arithSeriesObj is
 *	assumed to be a valid ArithSeries. The new Obj has the Start and End
 *	values appropriately swapped and the Step value sign is changed.
 *
 * Results:

 *      The result will be an ArithSeries in the reverse order.
 *
 * Side effects:
 *      The ogiginal obj will be modified and returned if it is not Shared.

 *
 *----------------------------------------------------------------------
 */
int

TclArithSeriesObjReverse(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to reverse. */
    Tcl_Obj **newObjPtr)
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;
    Tcl_Obj *resultObj;
    Tcl_WideInt start, end, step, len;
    double dstart, dend, dstep;
    int isDouble;

    (void)interp;

    if (newObjPtr == NULL) {
	return TCL_ERROR;
    }

    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    isDouble = arithSeriesRepPtr->isDouble;
    len = arithSeriesRepPtr->len;

    TclArithSeriesObjIndex(NULL, arithSeriesObj, (len-1), &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(NULL, arithSeriesObj, 0, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesObj, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (isDouble) {
	Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
	Tcl_GetDoubleFromObj(NULL, endObj, &dend);
	Tcl_GetDoubleFromObj(NULL, stepObj, &dstep);
	dstep = -dstep;
	TclSetDoubleObj(stepObj, dstep);
    } else {
	Tcl_GetWideIntFromObj(NULL, startObj, &start);
	Tcl_GetWideIntFromObj(NULL, endObj, &end);
	Tcl_GetWideIntFromObj(NULL, stepObj, &step);
	step = -step;
	TclSetIntObj(stepObj, step);
    }

    if (Tcl_IsShared(arithSeriesObj) ||
	    ((arithSeriesObj->refCount > 1))) {
	Tcl_Obj *lenObj;
	TclNewIntObj(lenObj, len);
	if (TclNewArithSeriesObj(NULL, &resultObj, isDouble,
		startObj, endObj, stepObj, lenObj) != TCL_OK) {
	    resultObj = NULL;
	}
	Tcl_DecrRefCount(lenObj);
    } else {

	/*
	 * In-place is possible.

	resultObj = arithSeriesObj;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = resultObj;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfArithSeries --
 *
 *	Update the string representation for an arithseries object.
 *	Note: This procedure does not invalidate an existing old string rep
 *	so storage will be lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from
 *	the list-to-string conversion. This string will be empty if the
 *	list has no elements. The list internal representation
 *	should not be NULL and we assume it is not NULL.
 *
 * Notes:
 * 	At the cost of overallocation it's possible to estimate
 * 	the length of the string representation and make this procedure
 * 	much faster. Because the programmer shouldn't expect the
 * 	string conversion of a big arithmetic sequence to be fast
 * 	this version takes more care of space than time.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
    char *p;
    Tcl_Obj *eleObj;
    Tcl_Size i, bytlen = 0;

    /*
     * Pass 1: estimate space.
     */
    if (!arithSeriesRepPtr->isDouble) {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
	    size_t slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1;
	    bytlen += slen;
	}
    } else {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
	    char tmp[TCL_DOUBLE_SPACE+2];
	    tmp[0] = 0;
	    Tcl_PrintDouble(NULL,d,tmp);
	    if ((bytlen + strlen(tmp)) > TCL_SIZE_MAX) {
		break; // overflow
	    }
	    bytlen += strlen(tmp);
	}
    }
    bytlen += arithSeriesRepPtr->len; // Space for each separator

    /*
     * Pass 2: generate the string repr.
     */

    p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, bytlen);
    for (i = 0; i < arithSeriesRepPtr->len; i++) {
	if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) {
	    Tcl_Size slen;
	    char *str = Tcl_GetStringFromObj(eleObj, &slen);
	    strcpy(p, str);
	    p[slen] = ' ';
	    p += slen+1;
	    Tcl_DecrRefCount(eleObj);
	} // else TODO: report error here?
    }
    if (bytlen > 0) arithSeriesObjPtr->bytes[bytlen-1] = '\0';
    arithSeriesObjPtr->length = bytlen-1;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	 * both listPtr and objPtr.
	 *
	 * TODO: Create a test to demo this need, or eliminate it.
	 * FIXME OPT: preserve just the internal rep?
	 */

	Tcl_IncrRefCount(objPtr);
	listPtr = TclDuplicatePureObj(interp, objPtr, &tclListType);
	if (!listPtr) {
	    Tcl_DecrRefCount(objPtr);
	    return TCL_ERROR;
	}
	Tcl_IncrRefCount(listPtr);

	if (word != INT_MIN) {

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
    }
#endif

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
    }
#endif

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
    }
#endif

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    d = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	}
    }

    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    d1 = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	}
    }
#endif
    if (code != TCL_OK) {
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    d2 = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	}
    }

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
	if (TclHasInternalRep(objv[1], &tclDoubleType)) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
#endif
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));

	/*
	 * Double-precision floating point values. Tcl_GetDoubleFromObj
	 * returns TCL_ERROR for NaN, but we can check by comparing the
	 * object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
	    if (irPtr == NULL) {
		return TCL_ERROR;
	    }
	    dvalue = irPtr->doubleValue;
	}
	CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
	*cursorPtr += sizeof(double);
	return TCL_OK;

    case 'f':
    case 'r':
    case 'R':
	/*
	 * Single-precision floating point values. Tcl_GetDoubleFromObj
	 * returns TCL_ERROR for NaN, but we can check by comparing the
	 * object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);

	    if (irPtr == NULL) {
		return TCL_ERROR;
	    }
	    dvalue = irPtr->doubleValue;
	}

    }

    /*
     * fields.seconds could be an unsigned number that overflowed. Make sure
     * that it isn't.
     */

    if (TclHasInternalRep(objv[1], &tclBignumType)) {
	Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /*
     * Convert UTC time to local.
     */

#include "tclInt.h"
#include "tclIO.h"
#include "tclTomMath.h"
#ifdef _WIN32
#   include "tclWinInt.h"
#endif


/*
 * The state structure used by [foreach]. Note that the actual structure has
 * all its working arrays appended afterwards so they can be allocated and
 * freed in a single step.
 */

     * Break up the value lists and variable lists into elements.
     */

    for (i=0 ; i<numLists ; i++) {
	/* List */
	/* Variables */
	statePtr->vCopyList[i] = TclDuplicatePureObj(
	    interp, objv[1+i*2], &tclListType);
	if (!statePtr->vCopyList[i]) {
	    result = TCL_ERROR;
	    goto done;
	}
	result = TclListObjLengthM(interp, statePtr->vCopyList[i],
	    &statePtr->varcList[i]);
	if (result != TCL_OK) {

	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElementsM(NULL, statePtr->vCopyList[i],
	    &statePtr->varcList[i], &statePtr->varvList[i]);

	/* Values */
	if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
	    /* Special case for AbstractList */
	    statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    /* Don't compute values here, wait until the last moment */
	    statePtr->argcList[i] = TclObjTypeHasProc(statePtr->aCopyList[i], lengthProc)(statePtr->aCopyList[i]);
	} else {

	    statePtr->aCopyList[i] = TclDuplicatePureObj(
		interp, objv[2+i*2], &tclListType);
	    if (!statePtr->aCopyList[i]) {
		result = TCL_ERROR;
		goto done;
	    }
	    result = TclListObjGetElementsM(interp, statePtr->aCopyList[i],
		&statePtr->argcList[i], &statePtr->argvList[i]);
	    if (result != TCL_OK) {

    struct ForeachState *statePtr)
{
    int i;
    Tcl_Size v, k;
    Tcl_Obj *valuePtr, *varValuePtr;

    for (i=0 ; i<statePtr->numLists ; i++) {
	int isAbstractList =
		TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL;

	for (v=0 ; v<statePtr->varcList[i] ; v++) {
	    k = statePtr->index[i]++;
	    if (k < statePtr->argcList[i]) {
		if (isAbstractList) {
		    if (Tcl_ObjTypeIndex(interp, statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {

			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
				"\n    (setting %s loop variable \"%s\")",
				(statePtr->resultList != NULL ? "lmap" : "foreach"),
				TclGetString(statePtr->varvList[i][v])));
			return TCL_ERROR;
		    }
		} else {
		    valuePtr = statePtr->argvList[i][k];
		}
	    } else {
		TclNewObj(valuePtr);	/* Empty string */

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclRegexp.h"

#include "tclTomMath.h"
#include <math.h>
#include <assert.h>

/*
 * During execution of the "lsort" command, structures of the following type
 * are used to arrange the objects being sorted into a collection of linked

Tcl_JoinObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Size length, listLen;
    int isAbstractList = 0;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    if (TclObjTypeHasProc(objv[1], getElementsProc)) {

	listLen = TclObjTypeHasProc(objv[1], lengthProc)(objv[1]);
	isAbstractList = (listLen ? 1 : 0);
	if (listLen > 1 &&
	    Tcl_ObjTypeGetElements(interp, objv[1], &listLen, &elemPtrs)
	    != TCL_OK) {
	    return TCL_ERROR;
	}
    } else if (TclListObjGetElementsM(interp, objv[1], &listLen,
	    &elemPtrs) != TCL_OK) {
	return TCL_ERROR;
    }

    if (listLen == 0) {
	/* No elements to join; default empty result is correct. */
	return TCL_OK;
    }
    if (listLen == 1) {
	/* One element; return it */
	if (!isAbstractList) {
	    Tcl_SetObjResult(interp, elemPtrs[0]);
	} else {
            Tcl_Obj *elemObj;
            if (Tcl_ObjTypeIndex(interp, objv[1], 0, &elemObj)
		!= TCL_OK) {
                return TCL_ERROR;
            }
	    Tcl_SetObjResult(interp, elemObj);


	}
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) Tcl_GetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	Tcl_Size i;

	TclNewObj(resObjPtr);


	for (i = 0;  i < listLen;  i++) {
	    if (i > 0) {

		/*
		 * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		 * to shimmer joinObjPtr.  If it did, then the case where
		 * objv[1] and objv[2] are the same value would not be safe.
		 * Accessing elemPtrs would crash.
		 */

		Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
	    }




















	    Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);

	}
    }
    Tcl_DecrRefCount(joinObjPtr);
    if (resObjPtr) {
	Tcl_SetObjResult(interp, resObjPtr);
	return TCL_OK;
    }

    int code;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
	return TCL_ERROR;
    }

    listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType);
    if (!listCopyPtr) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(listCopyPtr); /* Important! fs */

    code = TclListObjGetElementsM(
	interp, listCopyPtr, &listObjc, &listObjv);

    /*
     * If the list object is unshared we can modify it directly. Otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
	if (!listPtr) {
	    return TCL_ERROR;
	}
	copied = 1;
    }

    if ((objc == 4) && (index == len)) {

    /*
     * Second, remove the element.
     * TclLsetFlat adds a ref count which is handled.
     */

    if (objc == 2) {
	if (Tcl_IsShared(listPtr)) {
	    listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
	    if (!listPtr) {
		return TCL_ERROR;
	    }
	    copied = 1;
	}
	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
	if (result != TCL_OK) {

    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
    if (result != TCL_OK) {
	return result;
    }

    if (TclObjTypeHasProc(objv[1], sliceProc)) {
	Tcl_Obj *resultObj;
	int status = Tcl_ObjTypeSlice(interp, objv[1], first, last, &resultObj);
	if (status == TCL_OK) {
	    Tcl_SetObjResult(interp, resultObj);
	} else {
	    return TCL_ERROR;
	}
    } else {
	Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last);
	if (resultObj == NULL) {
	    return TCL_ERROR;

    }

    /*
     * Make our working copy, then do the actual removes piecemeal.
     */

    if (Tcl_IsShared(listObj)) {
	listObj = TclDuplicatePureObj(interp, listObj, &tclListType);
	if (!listObj) {
	    status = TCL_ERROR;
	    goto done;
	}
	copied = 1;
    }
    num = 0;

    /*
     * If the list object is unshared we can modify it directly, otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
	if (!listPtr) {
	    return TCL_ERROR;
	}
    }

    /*
     * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");
	return TCL_ERROR;
    }

    /*
     *  Handle AbstractList special case - do not shimmer into a list, if it
     *  supports a private Reverse function, just to reverse it.
     */
    if (TclObjTypeHasProc(objv[1], reverseProc)) {
	Tcl_Obj *resultObj;

	if (Tcl_ObjTypeReverse(interp, objv[1], &resultObj) == TCL_OK) {
	    Tcl_SetObjResult(interp, resultObj);
	    return TCL_OK;


	}
    } /* end Abstract List */


    if (TclListObjLengthM(interp, objv[1], &elemc) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * If the list is empty, just return it. [Bug 1876793]
     */

    Tcl_Size groupOffset, lower, upper;
    int allocatedIndexVector = 0;
    int isIncreasing;
    Tcl_WideInt patWide, objWide, wide, groupSize;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr = NULL;
    SortStrCmpFn_t strCmpFn = TclUtfCmp;
    Tcl_RegExp regexp = NULL;
    static const char *const options[] = {
	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
	"-exact",   "-glob",    "-increasing", "-index",
	"-inline",  "-integer", "-nocase",     "-not",
	"-real",    "-regexp",  "-sorted",     "-start", "-stride",

	/*
	 * With -stride, lower, upper and i are kept as multiples of groupSize.
	 */

	lower = start - groupSize;
	upper = listc;
	itemPtr = NULL;
	while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
	    i = (lower + upper)/2;
	    i -= i % groupSize;

	    Tcl_BumpObj(itemPtr);
	    itemPtr = NULL;

	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    result = sortInfo.resultCode;
		    goto done;
		}
	    } else {

	 */

	if (allMatches) {
	    listPtr = Tcl_NewListObj(0, NULL);
	}
	for (i = start; i < listc; i += groupSize) {
	    match = 0;
	    Tcl_BumpObj(itemPtr);
	    itemPtr = NULL;

	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    if (listPtr != NULL) {
			Tcl_DecrRefCount(listPtr);
		    }
		    result = sortInfo.resultCode;

		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    } else {
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
	    }
	}
    }

    Tcl_BumpObj(itemPtr);
    itemPtr = NULL;

    /*
     * Return everything or a single value.
     */

    if (allMatches) {
	Tcl_SetObjResult(interp, listPtr);
    } else if (!inlineReturn) {

	Tcl_DecrRefCount(startPtr);
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    return result;
}






















































































/*
 *----------------------------------------------------------------------
 *
 * SequenceIdentifyArgument --
 *   (for [lseq] command)
 *

    Tcl_Obj *const objv[]) /* The argument objects. */
{
    Tcl_Obj *elementCount = NULL;
    Tcl_Obj *start = NULL, *end = NULL, *step = NULL;
    Tcl_WideInt values[5];
    Tcl_Obj *numValues[5];
    Tcl_Obj *numberObj;
    int status = TCL_ERROR, keyword, useDoubles = 0;
    Tcl_Obj *arithSeriesPtr;
    SequenceOperators opmode;
    SequenceDecoded decoded;
    int i, arg_key = 0, value_i = 0;
    // Default constants
    Tcl_Obj *zero = Tcl_NewIntObj(0);
    Tcl_Obj *one = Tcl_NewIntObj(1);

     */
    switch (arg_key) {

/*    No argument */
    case 0:
	 Tcl_WrongNumArgs(interp, 1, objv,
	     "n ??op? n ??by? n??");

	 goto done;
	 break;

/*    lseq n */
    case 1:
	start = zero;
	elementCount = numValues[0];
	end = NULL;
	step = one;
	break;

/*    lseq n n */
    case 11:
	start = numValues[0];
	end = numValues[1];
	break;

/*    lseq n n n */
    case 111:
	start = numValues[0];
	end = numValues[1];
	step = numValues[2];
	break;

/*    lseq n 'to' n    */
/*    lseq n 'count' n */
/*    lseq n 'by' n    */
    case 121:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    break;
	case LSEQ_BY:
	    start = zero;
	    elementCount = numValues[0];
	    step = numValues[2];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    step = one;
	    break;
	default:

	    goto done;
	}
	break;

/*    lseq n 'to' n n    */
/*    lseq n 'count' n n */
    case 1211:
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    step = numValues[3];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    step = numValues[3];
	    break;
	case LSEQ_BY:
	    /* Error case */

	    goto done;
	    break;
	default:

	    goto done;
	    break;
	}
	break;

/*    lseq n n 'by' n */
    case 1121:
	start = numValues[0];
	end = numValues[1];
	opmode = (SequenceOperators)values[2];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[3];
	    break;
	case LSEQ_DOTS:
	case LSEQ_TO:
	case LSEQ_COUNT:
	default:

	    goto done;
	    break;
	}
	break;

/*    lseq n 'to' n 'by' n    */
/*    lseq n 'count' n 'by' n */
    case 12121:
	start = numValues[0];
	opmode = (SequenceOperators)values[3];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[4];
	    break;
	default:

	    goto done;
	    break;
	}
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    break;
	default:

	    goto done;
	    break;
	}
	break;

/*    Error cases: incomplete arguments */
    case 12:
	 opmode = (SequenceOperators)values[1]; goto KeywordError; break;
    case 112:
	 opmode = (SequenceOperators)values[2]; goto KeywordError; break;
    case 1212:
	 opmode = (SequenceOperators)values[3]; goto KeywordError; break;
    KeywordError:

	 switch (opmode) {
	 case LSEQ_DOTS:
	 case LSEQ_TO:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"to\" value."));
	      break;
	 case LSEQ_COUNT:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"count\" value."));
	      break;
	 case LSEQ_BY:
	      Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		  "missing \"by\" value."));
	      break;
	 }

	 goto done;
	 break;

/*    All other argument errors */
    default:
	 Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");

	 goto done;
	 break;
    }

    /*
     * Success!  Now lets create the series object.
     */

    // Free constants
    Tcl_DecrRefCount(zero);
    Tcl_DecrRefCount(one);

    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LsetObjCmd --
 *
 *	This procedure is invoked to process the "lset" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LsetObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */

    /*
     * Check parameter count.
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"listVar ?index? ?index ...? value");
	return TCL_ERROR;
    }

    /*
     * Look up the list variable's value.
     */

    listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
    if (listPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Substitute the value in the value. Return either the value or else an
     * unshared copy of it.
     */

    if (objc == 4) {
	finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
    } else {
	if (TclObjTypeHasProc(listPtr, setElementProc)) {
	    finalValuePtr = Tcl_ObjTypeSetElement(interp, listPtr,
						       objc-3, objv+2, objv[objc-1]);
	    if (finalValuePtr) {
		Tcl_IncrRefCount(finalValuePtr);
	    }
	} else {
	    finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
					objv[objc-1]);
	}
    }

    /*
     * If substitution has failed, bail out.
     */

    if (finalValuePtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Finally, update the variable so that traces fire.
     */

    listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
	    TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(finalValuePtr);
    if (listPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Return the new value of the variable as the interpreter result.
     */

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LsortObjCmd --
 *
 *	This procedure is invoked to process the "lsort" Tcl command. See the

	/*
	 * When sorting using a command, we are reentrant and therefore might
	 * have the representation of the list being sorted shimmered out from
	 * underneath our feet. Take a copy (cheap) to prevent this. [Bug
	 * 1675116]
	 */

	listObj = TclDuplicatePureObj(interp ,listObj, &tclListType);
	if (listObj == NULL) {
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}

	/*
	 * The existing command is a list. We want to flatten it, append two

	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
	sortInfo.compareCmdPtr = newCommandPtr;
    }

    if (TclObjTypeHasProc(objv[1], getElementsProc)) {
	sortInfo.resultCode =
	    Tcl_ObjTypeGetElements(interp, listObj, &length, &listObjPtrs);
    } else {
	sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
	    &length, &listObjPtrs);
    }
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }

    if (first <= last) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
	if (!listPtr) {
	    return TCL_ERROR;
	}
	createdNewObj = 1;
    } else {
	createdNewObj = 0;
    }

     * Iterate over the indices, traversing through the nested sublists as we
     * go.
     */

    for (i=0 ; i<infoPtr->indexc ; i++) {
	Tcl_Size listLen;
	int index;
	Tcl_Obj *currentObj, *lastObj=NULL;

	if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}

	index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);

	    }
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "INDEXFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	objPtr = currentObj;
	Tcl_BumpObj(lastObj);
	lastObj = currentObj;
    }
    return objPtr;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

	break;
    case STR_IS_ASCII:
	chcomp = UniCharIsAscii;
	break;
    case STR_IS_BOOL:
    case STR_IS_TRUE:
    case STR_IS_FALSE:
	if (!TclHasInternalRep(objPtr, &tclBooleanType)
		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = Tcl_GetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }

	}
	break;
    }
    case STR_IS_DIGIT:
	chcomp = Tcl_UniCharIsDigit;
	break;
    case STR_IS_DOUBLE: {
	if (TclHasInternalRep(objPtr, &tclDoubleType) ||
		TclHasInternalRep(objPtr, &tclIntType) ||
		TclHasInternalRep(objPtr, &tclBignumType)) {
	    break;
	}
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }

	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
    case STR_IS_ENTIER:
	if (TclHasInternalRep(objPtr, &tclIntType) ||
		TclHasInternalRep(objPtr, &tclBignumType)) {
	    break;
	}
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }

	    /*
	     * We have a number followed directly by bareword characters
	     * (alpha, digit, underscore).  Is this a number followed by
	     * bareword syntax error?  Or should we join into one bareword?
	     * Example: Inf + luence + () becomes a valid function call.
	     * [Bug 3401704]
	     */
	    if (TclHasInternalRep(literal, &tclDoubleType)) {
		const char *p = start;

		while (p < end) {
		    if (!TclIsBareword(*p++)) {
			/*
			 * The number has non-bareword characters, so we
			 * must treat it as a number.

					Tcl_Obj *keyPtr);
static Tcl_NRPostProc		FinalizeDictUpdate;
static Tcl_NRPostProc		FinalizeDictWith;
static Tcl_ObjCmdProc		DictForNRCmd;
static Tcl_ObjCmdProc		DictMapNRCmd;
static Tcl_NRPostProc		DictForLoopCallback;
static Tcl_NRPostProc		DictMapLoopCallback;
static Tcl_ObjTypeLengthProc    DictAsListLength;
static Tcl_ObjTypeIndexProc     DictAsListIndex;

/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },

/*
 * The structure below defines the dictionary object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclDictType = {
    "dict",
    FreeDictInternalRep,	/* freeIntRepProc */
    DupDictInternalRep,		/* dupIntRepProc */
    UpdateStringOfDict,		/* updateStringProc */
    SetDictFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V2(		/* Extended type for AbstractLists */
    DictAsListLength,		/* return "list" length of dict value w/o
				 * shimmering */
    DictAsListIndex,		/* return key or value at "list" index
				 * location.  (keysare at even indicies,
				 * values at odd indicies) */
    NULL,
    NULL,
    NULL,
    NULL,
    NULL)
};

#define DictSetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
        Tcl_ObjInternalRep ir;                                               \
        ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
        ir.twoPtrValue.ptr2 = NULL;                                     \

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
     */

    if (TclHasInternalRep(objPtr, &tclListType)) {
	Tcl_Size objc, i;
	Tcl_Obj **objv;

	/* Cannot fail, we already know the Tcl_ObjType is "list". */
	TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
	if (objc & 1) {
	    goto missingValue;

Tcl_Command
TclInitDictCmd(
    Tcl_Interp *interp)
{
    return TclMakeEnsemble(interp, "dict", implementationMap);
}

/*
 *----------------------------------------------------------------------
 *
 * DictAsListLength --
 *
 *   Compute the length of a list as if the dict value were converted to a
 *   list.
 *
 *   Note: the list length may not match the dict size * 2.  This occurs when
 *   there are duplicate keys in the original string representation.
 *
 * Side Effects --
 *
 *   The intent is to have no side effects.
 */

static Tcl_Size
DictAsListLength(
    Tcl_Obj *objPtr)
{
    Tcl_Size estCount, length, llen;
    const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_Obj *elemPtr;

    /*
     * Allocate enough space to hold a (Tcl_Obj *) for each
     * (possible) list element.
     */

    estCount = TclMaxListLength(nextElem, length, &limit);
    estCount += (estCount == 0); /* Smallest list struct holds 1
				  * element. */
    elemPtr = Tcl_NewObj();

    llen = 0;

    while (nextElem < limit) {
	const char *elemStart;
	char *check;
	Tcl_Size elemSize;
	int literal;

	if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
		          &elemStart, &nextElem, &elemSize, &literal)) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (elemStart == limit) {
	    break;
	}

	TclInvalidateStringRep(elemPtr);
	check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
				  elemSize);
	if (elemSize && check == NULL) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (!literal) {
	    Tcl_InitStringRep(elemPtr, NULL,
			      TclCopyAndCollapse(elemSize, elemStart, check));
	}
	llen++;
    }
    Tcl_DecrRefCount(elemPtr);
    return llen;
}


/*
 *----------------------------------------------------------------------
 *
 * DictAsListIndex --
 *
 *   Return the key or value at the given "list" index, i.e., as if the string
 *   value where treated as a list. The intent is to support this list
 *   operation w/o causing the Obj value to shimmer into a List.
 *
 * Side Effects --
 *
 *   The intent is to have no side effects.
 *
 */

static int
DictAsListIndex(
    Tcl_Interp *interp,
    struct Tcl_Obj *objPtr,
    Tcl_Size index,
    Tcl_Obj** elemObjPtr)
{
    Tcl_Size /*estCount,*/ length, llen;
    const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_Obj *elemPtr;

    /*
     * Compute limit of the list string
     */

    TclMaxListLength(nextElem, length, &limit);
    elemPtr = Tcl_NewObj();

    llen = 0;

    /*
     * parse out each element until reaching the "index"th element.
     * Sure this is slow, but shimmering is slower.
     */
    while (nextElem < limit) {
	const char *elemStart;
	char *check;
	Tcl_Size elemSize;
	int literal;

	if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
		          &elemStart, &nextElem, &elemSize, &literal)) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (elemStart == limit) {
	    break;
	}

	TclInvalidateStringRep(elemPtr);
	check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
				  elemSize);
	if (elemSize && check == NULL) {
	    Tcl_DecrRefCount(elemPtr);
	    if (interp) {
		// Need error message here
	    }
	    return TCL_ERROR;
	}
	if (!literal) {
	    Tcl_InitStringRep(elemPtr, NULL,
			      TclCopyAndCollapse(elemSize, elemStart, check));
	}
	if (llen == index) {
	    *elemObjPtr = elemPtr;
	    return TCL_OK;
	}
	llen++;
    }

    /*
     * Index is beyond end of list - return empty
     */
    Tcl_InitStringRep(elemPtr, NULL, 0);
    *elemObjPtr = elemPtr;
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			cmd = TclGetString(listv[0]);
			if (!(cmd[0] == ':' && cmd[1] == ':')) {
			    Tcl_Obj *newList = TclDuplicatePureObj(
				interp, listObj, &tclListType);
			    if (!newList) {
				if (patchedDict) {
				    Tcl_DecrRefCount(patchedDict);
				}
				goto freeMapAndError;
			    }
			    Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);

			    if (nsPtr->parentPtr) {
				Tcl_AppendStringsToObj(newCmd, "::", NULL);
			    }
			    Tcl_AppendObjToObj(newCmd, listv[0]);
			    Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
				    &newCmd);
			    if (patchedDict == NULL) {
				patchedDict = TclDuplicatePureObj(
				    interp, objv[1], &tclListType);
				if (!patchedDict) {
				    goto freeMapAndError;
				}
			    }
			    Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				    newList);
			}

	Tcl_Obj **copyObjv;
	Tcl_Size copyObjc, prefixObjc;

	TclListObjLengthM(NULL, prefixObj, &prefixObjc);

	if (objc == 2) {
	    copyPtr = TclDuplicatePureObj(
		interp, prefixObj, &tclListType);
	    if (!copyPtr) {
		return TCL_ERROR;
	    }
	} else {
	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,

    Tcl_Obj **paramv, *unknownCmd, *ensObj;

    /*
     * Create the "unknown" command callback to determine what to do.
     */

    unknownCmd = TclDuplicatePureObj(
	interp, ensemblePtr->unknownHandler, &tclListType);
    if (!unknownCmd) {
	return TCL_ERROR;
    }
    TclNewObj(ensObj);
    Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
    Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
    for (i = 1 ; i < objc ; i++) {

	/*
	 * Note we copy the handler command prefix each pass through, so we do
	 * support one handler setting another handler.
	 */

	Tcl_Obj *copyObj = TclDuplicatePureObj(
	    interp, assocPtr->cmdPrefix, &tclListType);
	if (!copyObj) {
	    return;
	}

	errPtr = assocPtr->firstBgPtr;

	TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv);

 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"

#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating

 * Tcl_GetNumberFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			void **ptrPtr, int *tPtr);
 */

#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    ((TclHasInternalRep((objPtr), &tclIntType))					\
	?	(*(tPtr) = TCL_NUMBER_INT,				\
		*(ptrPtr) = (void *)				\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    TclHasInternalRep((objPtr), &tclDoubleType)				\
	?	(((isnan((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (void *)				\
		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
	? TCL_ERROR :			\

 * Custom object type only used in this file; values of its type should never
 * be seen by user scripts.
 */

static const Tcl_ObjType dictIteratorType = {
    "dictIterator",
    ReleaseDictIterator,
    NULL, NULL, NULL,
    TCL_OBJTYPE_V0
};

/*
 *----------------------------------------------------------------------
 *
 * ReleaseDictIterator --
 *

	NEXT_INST_F(5, 0, 0);
    }
    break;

    case INST_STR_CONCAT1:

	opnd = TclGetUInt1AtPtr(pc+1);
	DECACHE_STACK_INFO();
	objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
		TCL_STRING_IN_PLACE);
	if (objResultPtr == NULL) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	CACHE_STACK_INFO();
	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(2, opnd, 1);
    break;

    case INST_CONCAT_STK:
	/*
	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,

	objResultPtr = varPtr->value.objPtr;
	if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (Tcl_IsShared(objResultPtr)) {
	    Tcl_Obj *newValue = TclDuplicatePureObj(
		    interp, objResultPtr, &tclListType);
	    if (!newValue) {
		TRACE_ERROR(interp);
		goto gotError;
	    }

	    TclDecrRefCount(objResultPtr);
	    varPtr->value.objPtr = objResultPtr = newValue;

		valueToAssign = valuePtr;
	    } else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    } else {
		if (Tcl_IsShared(objResultPtr)) {
		    valueToAssign = TclDuplicatePureObj(
			interp, objResultPtr, &tclListType);
		    if (!valueToAssign) {
			goto errorInLappendListPtr;
		    }
		    createdNewObj = 1;
		} else {
		    valueToAssign = objResultPtr;
		}

	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));


	/* special case for AbstractList */
	if (TclObjTypeHasProc(valuePtr,indexProc)) {
	    DECACHE_STACK_INFO();
	    length = TclObjTypeHasProc(valuePtr, lengthProc)(valuePtr);
	    if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    if (Tcl_ObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {

		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    Tcl_IncrRefCount(objResultPtr); // reference held here
	    goto lindexDone;
	}

	/*
	 * Extract the desired list element.
	 */

	{
	    Tcl_Size value2Length;
	    Tcl_Obj *indexListPtr = value2Ptr;
	    if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& (
		    !TclHasInternalRep(value2Ptr, &tclListType)
		    ||
		    ((Tcl_ListObjLength(interp,value2Ptr,&value2Length),
			value2Length == 1
			    ? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1)
			    : 0
		    ))
		)

	 * Pop the list and get the index.
	 */

	valuePtr = OBJ_AT_TOS;
	opnd = TclGetInt4AtPtr(pc+1);
	TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * in the process.
	 */

	/* special case for AbstractList */
	if (TclObjTypeHasProc(valuePtr,indexProc)) {
	    length = TclObjTypeHasProc(valuePtr, lengthProc)(valuePtr);

	    /* Decode end-offset index values. */

	    index = TclIndexDecode(opnd, length-1);

	    /* Compute value @ index */

	    DECACHE_STACK_INFO();
	    if (Tcl_ObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {

		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }


	    CACHE_STACK_INFO();

	    pcAdjustment = 5;
	    goto lindexFastPath2;
	}





	/* List case */
	if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/* Decode end-offset index values. */

	valuePtr = POP_OBJECT();
	Tcl_DecrRefCount(valuePtr); /* This one should be done here */

	/*
	 * Compute the new variable value.
	 */

	if (TclObjTypeHasProc(valuePtr, setElementProc)) {

	    DECACHE_STACK_INFO();
	    objResultPtr = Tcl_ObjTypeSetElement(interp,
		valuePtr, numIndices,
	        &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	} else {
	    objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	}
	if (!objResultPtr) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/*
	 * Set result.
	 */
	CACHE_STACK_INFO();
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_V(5, numIndices+1, -1);

    case INST_LSET_LIST:	/* 'lset' with 4 args */
	/*
	 * Get the old value of variable, and remove the stack ref. This is
	 * safe because the variable still references the object; the ref

	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, objc - 1);

	if (TclObjTypeHasProc(valuePtr, sliceProc)) {
	    DECACHE_STACK_INFO();
	    if (Tcl_ObjTypeSlice(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
		objResultPtr = NULL;
	    }
	} else {
	    objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
	}
	if (objResultPtr == NULL) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	CACHE_STACK_INFO();
	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    Tcl_Size i = 0;
	    Tcl_Obj *o;
	    int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL;

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		if (isAbstractList) {
		    DECACHE_STACK_INFO();
		    if (Tcl_ObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
			CACHE_STACK_INFO();
			TRACE_ERROR(interp);
			goto gotError;
		    }
		    CACHE_STACK_INFO();
		} else {
		    Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		}
		if (o != NULL) {
		    s2 = Tcl_GetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}

		/* Could be an ephemeral abstract obj */
		Tcl_BumpObj(o);

		i++;
	    } while (i < length && match == 0);
	}

	if (*pc == INST_LIST_NOT_IN) {
	    match = !match;
	}

    /*
     *	   End of numeric operator instructions.
     * -----------------------------------------------------------------
     */

    case INST_TRY_CVT_TO_BOOLEAN:
	valuePtr = OBJ_AT_TOS;
	if (TclHasInternalRep(valuePtr,  &tclBooleanType)) {
	    objResultPtr = TCONST(1);
	} else {
	    int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
	    objResultPtr = TCONST(res);
	}
	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
	NEXT_INST_F(1, 0, 1);

	iterMax = 0;
	listTmpDepth = numLists-1;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;
	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
	    DECACHE_STACK_INFO();
	    if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s",
			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    if (Tcl_IsShared(listPtr)) {
		objPtr = TclDuplicatePureObj(
		    interp, listPtr, &tclListType);
		if (!objPtr) {
		    goto gotError;
		}
		Tcl_IncrRefCount(objPtr);
		Tcl_DecrRefCount(listPtr);
		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
	    }

	/*
	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
	 * falls through.
	 */

	pc += 5 - infoPtr->loopCtTemp;

    case INST_FOREACH_STEP: /* TODO: address abstract list indexing here! */
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	tmpPtr = OBJ_AT_TOS;
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;

	    listTmpDepth = numLists + 1;

	    for (i = 0;  i < numLists;  i++) {
		varListPtr = infoPtr->varLists[i];
		numVars = varListPtr->numVars;

		listPtr = OBJ_AT_DEPTH(listTmpDepth);
		DECACHE_STACK_INFO();
		status = TclListObjGetElementsM(
		    interp, listPtr, &listLen, &elements);
		if (status != TCL_OK) {
		    CACHE_STACK_INFO();
		    goto gotError;
		}
		CACHE_STACK_INFO();


		valIndex = (iterNum * numVars);
		for (j = 0;  j < numVars;  j++) {
		    if (valIndex >= listLen) {
			TclNewObj(valuePtr);
		    } else {

		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
		|| (value2Ptr->typePtr != &tclIntType)
		|| (Tcl_WideUInt)w2 >= (1<<28)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	err = mp_init(&bigResult);

    double totalCodeBytes, currentCodeBytes;
    double totalLiteralBytes, currentLiteralBytes;
    double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
    double strBytesSharedMultX, strBytesSharedOnce;
    double numInstructions, currentHeaderBytes;
    size_t numCurrentByteCodes, numByteCodeLits;
    size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
    size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade;
    Tcl_Size i;
    size_t ui;
    char *litTableStats;
    LiteralEntry *entryPtr;
    Tcl_Obj *objPtr;

#define Percent(a,b) ((a) * 100.0 / (b))

    TclNewObj(objPtr);

    refCountSum = 0;
    numSharedMultX = 0;
    numSharedOnce = 0;
    objBytesIfUnshared = 0.0;
    strBytesIfUnshared = 0.0;
    strBytesSharedMultX = 0.0;
    strBytesSharedOnce = 0.0;
    for (ui = 0;  ui < globalTablePtr->numBuckets;  ui++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
		numByteCodeLits++;
	    }
	    (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;

    while (i-- > 0) {
	if (statsPtr->literalCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	}
    }
    sum = 0;
    for (ui = 0;  ui <= maxSizeDecade;  ui++) {
	decadeHigh = (1 << (ui+1)) - 1;
	sum += statsPtr->literalCount[ui];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);

	if (statsPtr->srcCount[i] > 0) {
	    break;		/* maxSizeDecade to consume 'i' value
				 * below... */
	}
    }
    maxSizeDecade = i;
    sum = 0;
    for (ui = minSizeDecade;  ui <= maxSizeDecade;  ui++) {
	decadeHigh = (1 << (ui+1)) - 1;
	sum += statsPtr->srcCount[ui];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;

	if (statsPtr->byteCodeCount[i] > 0) {
	    break;		/* maxSizeDecade to consume 'i' value
				 * below... */
	}
    }
    maxSizeDecade = i;
    sum = 0;
    for (ui = minSizeDecade;  ui <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (ui+1)) - 1;
	sum += statsPtr->byteCodeCount[ui];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
    Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;

	if (statsPtr->lifetimeCount[i] > 0) {
	    break;		/* maxSizeDecade to consume 'i' value
				 * below... */
	}
    }
    maxSizeDecade = i;
    sum = 0;
    for (ui = minSizeDecade;  ui <= maxSizeDecade;  ui++) {
	decadeHigh = (1 << (ui+1)) - 1;
	sum += statsPtr->lifetimeCount[ui];
	Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
		decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
    }

    /*
     * Instruction counts.
     */

{
    Tcl_Obj *resObj;		/* See below, switch (transmit). */
    Tcl_Size resLen = 0;
    unsigned char *resBuf;
    Tcl_InterpState state = NULL;
    int res = TCL_OK;
    Tcl_Obj *command = TclDuplicatePureObj(
	interp, dataPtr->command, &tclListType);
    if (!command) {
	return TCL_ERROR;
    }
    Tcl_Interp *eval = dataPtr->interp;

    Tcl_Preserve(eval);

    rcPtr->writeTimer = 0;
#if TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, &tclListType);
    if (!rcPtr->cmd) {
	return NULL;
    }
    Tcl_IncrRefCount(rcPtr->cmd);
    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
    while (mn <= (int)METH_WRITE) {
	Tcl_ListObjAppendElement(NULL, rcPtr->methods,

    }

    /*
     * Insert method into the callback command, after the command prefix,
     * before the channel id.
     */

    cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, &tclListType);
    if (!cmd) {
	return TCL_ERROR;
    }
    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
    Tcl_ListObjAppendElement(NULL, cmd, methObj);
    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);

    Tcl_Obj *pathPtr,		/* Pathname of the file to process.
				 * Tilde-substitution is performed on this
				 * pathname. */
    const char *encodingName)	/* Either the name of an encoding or NULL to
				   use the utf-8 encoding. */
{
    Tcl_Size length;
    int result = TCL_ERROR;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    const char *string;
    Tcl_Channel chan;
    Tcl_Obj *objPtr;

 * 				- passed to Tcl_CreateObjTrace to set up
 *				  "leavestep" traces.
 */

#define TCL_TRACE_ENTER_EXEC	1
#define TCL_TRACE_LEAVE_EXEC	2

/*
 * Versions 0, 1, and 2 are currently supported concurrently for now
 */
#define TclObjTypeHasProc(objPtr, proc)		\
    (((objPtr)->typePtr				\
      && (   (objPtr)->typePtr->version == 1	\
	  || (objPtr)->typePtr->version == 2))	\
     ?	((objPtr)->typePtr)->proc		\
     : NULL)


MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);


/*
 * Abstract List
 *
 *  This structure provides the functions used in List operations to emulate a
 *  List for AbstractList types.
 */


#define Tcl_ObjTypeLength(objPtr) (objPtr)->typePtr->lengthProc(objPtr)
#define Tcl_ObjTypeIndex(interp, objPtr, index, elemObjPtr) \
    (objPtr)->typePtr->indexProc((interp),(objPtr),(index),(elemObjPtr))
#define Tcl_ObjTypeSlice(interp, objPtr, fromIdx, toIdx, newObjPtr) \
    (objPtr)->typePtr->sliceProc((interp),(objPtr),(fromIdx),(toIdx),(newObjPtr))
#define Tcl_ObjTypeReverse(interp, objPtr, newObjPtr) \
    (objPtr)->typePtr->reverseProc((interp),(objPtr),(newObjPtr))
#define Tcl_ObjTypeGetElements(interp, objPtr, objCPtr, objVPtr) \
    (objPtr)->typePtr->getElementsProc((interp),(objPtr),(objCPtr),(objVPtr))
#define Tcl_ObjTypeSetElement(interp, objPtr, indexCount, indexArray, valueObj) \
    (objPtr)->typePtr->setElementProc((interp), (objPtr), (indexCount), (indexArray), (valueObj))
#define Tcl_ObjTypeReplace(interp, objPtr, first, numToDelete, numToInsert, insertObjs) \
    (objPtr)->typePtr->replaceProc((interp), (objPtr), (first), (numToDelete), (numToInsert), (insertObjs))



/*
 * The structure below defines an entry in the assocData hash table which is
 * associated with an interpreter. The entry contains a pointer to a function
 * to call when the interpreter is deleted, and a pointer to a user-defined
 * piece of data.
 */

/*
 * Converts the Tcl_Obj to a list if it isn't one and stores the element
 * count and base address of this list's elements in objcPtr_ and objvPtr_.
 * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be
 * converted to a list.
 */
#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_)    \
    (((listObj_)->typePtr == &tclListType)                              \
	 ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
	    TCL_OK)                                                     \
	 : Tcl_ListObjGetElements(                                      \
	     (interp_), (listObj_), (objcPtr_), (objvPtr_)))

/*
 * Converts the Tcl_Obj to a list if it isn't one and stores the element
 * count in lenPtr_.  Returns TCL_OK on success or TCL_ERROR if the
 * Tcl_Obj cannot be converted to a list.
 */
#define TclListObjLengthM(interp_, listObj_, lenPtr_)         \
    (((listObj_)->typePtr == &tclListType)                   \
	 ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
	 : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))

#define TclListObjIsCanonical(listObj_) \
    (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)

/*
 * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
 * TclNRLmapCmd and their compilations.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
#define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */

/*
 * Macros providing a faster path to booleans and integers:
 * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
 * and Tcl_GetIntForIndex.
 *
 * WARNING: these macros eval their args more than once.
 */

#if TCL_MAJOR_VERSION > 8
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    || (objPtr)->typePtr == &tclBooleanType) \
	? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
	: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#else
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType)			\
	? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
	: ((objPtr)->typePtr == &tclBooleanType)			\
	? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
	: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#endif

#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
	    ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#endif

#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
	    && ((objPtr)->internalRep.wideValue <= endValue)) \
	    ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			Tcl_WideInt *wideIntPtr);
 */

#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
    (((objPtr)->typePtr == &tclIntType)					\
	? (*(wideIntPtr) =						\
		((objPtr)->internalRep.wideValue), TCL_OK) :		\
	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))

/*
 * Flag values for TclTraceDictPath().
 *

MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
MODULE_SCOPE void *tclTimeClientData;

/*
 * Variables denoting the Tcl object types defined in the core.
 */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;

MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE void 	TclUndoRefCount(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp,
			    Tcl_Obj* pathPtr);
MODULE_SCOPE int	TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
                            int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
                            Tcl_Obj *stepObj, Tcl_Obj *lenObj);
MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    Tcl_Size len);
MODULE_SCOPE void	TclpAlertNotifier(void *clientData);
MODULE_SCOPE void *TclpNotifierData(void);
MODULE_SCOPE void	TclpServiceModeHook(int mode);
MODULE_SCOPE void	TclpSetTimer(const Tcl_Time *timePtr);
MODULE_SCOPE int	TclpWaitForEvent(const Tcl_Time *timePtr);

 */

MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *

 */

#define TclSetIntObj(objPtr, i) \
    do {						\
	Tcl_ObjInternalRep ir;				\
	ir.wideValue = (Tcl_WideInt) i;			\
	TclInvalidateStringRep(objPtr);			\
	Tcl_StoreInternalRep(objPtr, &tclIntType, &ir);	\
    } while (0)

#define TclSetDoubleObj(objPtr, d) \
    do {						\
	Tcl_ObjInternalRep ir;				\
	ir.doubleValue = (double) d;			\
	TclInvalidateStringRep(objPtr);			\
	Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir);	\
    } while (0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and initialise objects of standard
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:

#define TclNewIntObj(objPtr, w) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewUIntObj(objPtr, uw) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	Tcl_WideUInt uw_ = (uw);		\
	if (uw_ > WIDE_MAX) {			\
	    mp_int bignumValue_;		\
	    if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) {	\
		Tcl_Panic("%s: memory overflow", "TclNewUIntObj");	\
	    }	\
	    TclSetBignumInternalRep((objPtr), &bignumValue_);	\
	} else {	\
	    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_);	\
	    (objPtr)->typePtr = &tclIntType;		\
	}	\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    TclNewIntObj(objPtr, w)

#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\
	(objPtr)->refCount = 0;					\
	(objPtr)->bytes = NULL;					\
	(objPtr)->internalRep.doubleValue = (double)(d);	\
	(objPtr)->typePtr = &tclDoubleType;			\
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    } while (0)

#define TclNewStringObj(objPtr, s, len) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\

    Tcl_Obj *objPtr,
    double *dblPtr)
{
    if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
	return 0;
    } else {
#ifdef ACCEPT_NAN
	Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType);

	if (irPtr != NULL) {
	    *dblPtr = irPtr->doubleValue;
	    return 0;
	}
#endif /* ACCEPT_NAN */
	return GetInvalidDoubleFromObj(objPtr, dblPtr) != TCL_OK;

 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <assert.h>
#include "tclInt.h"
#include "tclTomMath.h"


/*
 * TODO - memmove is fast. Measure at what size we should prefer memmove
 * (for unshared objects only) in lieu of range operations. On the other
 * hand, more cache dirtied?
 */

#define LIST_INDEX_ASSERT(idx_) ((void) 0)
#define LIST_COUNT_ASSERT(count_) ((void) 0)

#endif

/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \
    LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType))

/*
 * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the
 * command line), the entire list internal representation is checked for
 * inconsistencies. This has a non-trivial cost so has to be separately
 * enabled and not part of assertions checking. However, the test suite does
 * invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS.

/*
 * The structure below defines the list Tcl object type by means of functions
 * that can be invoked by generic object code.
 *
 * The internal representation of a list object is ListRep defined in tcl.h.
 */

const Tcl_ObjType tclListType = {
    "list",			/* name */
    FreeListInternalRep,	/* freeIntRepProc */
    DupListInternalRep,		/* dupIntRepProc */
    UpdateStringOfList,		/* updateStringProc */
    SetListFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V2(
    ListLength,

    NULL,
    NULL,
    NULL,
    NULL,
    NULL,
    NULL)
};

/* Macros to manipulate the List internal rep */
#define ListRepIncrRefs(repPtr_)            \
    do {                                    \
	(repPtr_)->storePtr->refCount++;    \
	if ((repPtr_)->spanPtr)             \

 * passed ListRep) and frees it first. Additionally invalidates the string
 * representation. Generally used when modifying a Tcl_Obj value.
 */
#define ListObjStompRep(objPtr_, repPtr_)                              \
    do {                                                               \
	(objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \
	(objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr;  \
	(objPtr_)->typePtr = &tclListType;                             \
    } while (0)

#define ListObjOverwriteRep(objPtr_, repPtr_) \
    do {                                      \
	ListRepIncrRefs(repPtr_);             \
	ListObjStompRep(objPtr_, repPtr_);    \
    } while (0)

static int
TclListObjGetRep(
    Tcl_Interp *interp, /* Used to report errors if not NULL. */
    Tcl_Obj *listObj,   /* List object for which an element array is
			 * to be returned. */
    ListRep *repPtr) /* Location to store descriptor */
{
    if (!TclHasInternalRep(listObj, &tclListType)) {
	int result;
	result = SetListFromAny(interp, listObj);
	if (result != TCL_OK) {
	    /* Init to keep gcc happy wrt uninitialized fields at call site */
	    repPtr->storePtr = NULL;
	    repPtr->spanPtr = NULL;
	    return result;

    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    ListRep listRep;

    if (TclObjTypeHasProc(objPtr, getElementsProc) &&
	objPtr->typePtr->getElementsProc(interp, objPtr, objcPtr, objvPtr) == TCL_OK) {
	return TCL_OK;
    }

    if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) {
    	return TCL_ERROR;
    }
    ListRepElements(&listRep, *objcPtr, *objvPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    Tcl_Interp *interp,  /* Used to report errors if not NULL. */
    Tcl_Obj *listObj,    /* List object to index into. */
    Tcl_Size index,      /* Index of element to return. */
    Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
    Tcl_Obj **elemObjs;
    Tcl_Size numElems;
    int hasAbstractList = TclObjTypeHasProc(listObj,indexProc) != 0;

    /* Empty string => empty list. Avoid unnecessary shimmering */
    if (listObj->bytes == &tclEmptyString) {
	*objPtrPtr = NULL;
	return TCL_OK;
    }

    if (hasAbstractList) {
	return Tcl_ObjTypeIndex(interp, listObj, index, objPtrPtr);
    }

    if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs)
	!= TCL_OK) {
	return TCL_ERROR;
    }
    if (index < 0 || index >= numElems) {
	*objPtrPtr = NULL;

    /* Empty string => empty list. Avoid unnecessary shimmering */
    if (listObj->bytes == &tclEmptyString) {
	*lenPtr = 0;
	return TCL_OK;
    }

    Tcl_Size (*lengthProc)(Tcl_Obj *obj) =  TclObjTypeHasProc(listObj, lengthProc);
    if (lengthProc) {
	*lenPtr = lengthProc(listObj);
	return TCL_OK;
    }


    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {

    Tcl_Size tailShift;
    Tcl_Obj **listObjs;
    int favor;

    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    if (TclObjTypeHasProc(listObj, replaceProc)) {
	return Tcl_ObjTypeReplace(interp, listObj, first,
				  numToDelete, numToInsert, insertObjs);
    }

    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
	return TCL_ERROR; /* Cannot be converted to a list */

    /* Make limits sane */
    origListLen = ListRepLength(&listRep);
    if (first < 0) {

    /*
     * Determine whether argPtr designates a list or a single index. We have
     * to be careful about the order of the checks to avoid repeated
     * shimmering; if internal rep is already a list do not shimmer it.
     * see TIP#22 and TIP#33 for the details.
     */
    if (!TclHasInternalRep(argObj, &tclListType)
	&& TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index)
	       == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }

    /*
     * Make a private copy of the index list argument to keep the internal
     * representation of th indices array unchanged while it is in use.  This
     * is probably unnecessary. It does not appear that any damaging change to
     * the internal representation is possible, and no test has been devised to
     * show any error when this private copy is not made, But it's cheap, and
     * it offers some future-proofing insurance in case the TclLindexFlat
     * implementation changes in some unexpected way, or some new form of trace
     * or callback permits things to happen that the current implementation
     * does not.
     */

    indexListCopy = TclDuplicatePureObj(interp, argObj, &tclListType);
    if (!indexListCopy) {
	/*
	 * The argument is neither an index nor a well-formed list.
	 * Report the error via TclLindexFlat.
	 * TODO - This is as original code. why not directly return an error?
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);

    Tcl_Size indexCount,	/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{
    int status;
    Tcl_Size i;

    /* Handle AbstractList as special case */
    if (TclObjTypeHasProc(listObj,indexProc)) {
	Tcl_Size listLen = TclObjTypeHasProc(listObj,lengthProc)(listObj);
	Tcl_Size index;
	Tcl_Obj *elemObj = NULL;
	for (i=0 ; i<indexCount && listObj ; i++) {
	    if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
				   &index) == TCL_OK) {
	    }
	    if (i==0) {
		if (Tcl_ObjTypeIndex(interp, listObj, index, &elemObj) != TCL_OK) {
		    return NULL;
		}
	    } else if (index > 0) {
		// TODO: support nested lists
		Tcl_Obj *e2Obj = TclLindexFlat(interp, elemObj, 1, &indexArray[i]);
		Tcl_DecrRefCount(elemObj);
		elemObj = e2Obj;

	    }
	}
	Tcl_IncrRefCount(elemObj);
	return elemObj;
    }

    Tcl_IncrRefCount(listObj);

		Tcl_IncrRefCount(listObj);
	    } else {
		Tcl_Obj *itemObj;
		/*
		 * Must set the internal rep again because it may have been
		 * changed by TclGetIntForIndexM. See test lindex-8.4.
		 */
		if (!TclHasInternalRep(listObj, &tclListType)) {
		    status = SetListFromAny(interp, listObj);
		    if (status != TCL_OK) {
			/* The list is not a list at all => error.  */
			Tcl_DecrRefCount(listObj);
			return NULL;
		    }
		}

    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    if (!TclHasInternalRep(indexArgObj, &tclListType) &&
	TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
	== TCL_OK) {

	if (TclObjTypeHasProc(listObj, setElementProc)) {
	    indices = &indexArgObj;
	    retValueObj =
		Tcl_ObjTypeSetElement(interp, listObj, 1, indices, valueObj);
	    if (retValueObj) Tcl_IncrRefCount(retValueObj);
	} else {

	    /* indexArgPtr designates a single index. */
	    /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
	    retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
	}

    } else {

	indexListCopy = TclDuplicatePureObj(
	    interp, indexArgObj, &tclListType);
	if (!indexListCopy) {
	    /*
	     * indexArgPtr designates something that is neither an index nor a
	     * well formed list. Report the error via TclLsetFlat.
	     */
	    retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
	} else {
	    if (TCL_OK != TclListObjGetElementsM(
		    interp, indexListCopy, &indexCount, &indices)) {
		Tcl_DecrRefCount(indexListCopy);
		/*
		 * indexArgPtr designates something that is neither an index nor a
		 * well formed list. Report the error via TclLsetFlat.
		 */
		retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
	    } else {

		/*
		 * Let TclLsetFlat perform the actual lset operation.
		 */

		retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);
		if (indexListCopy) {
		    Tcl_DecrRefCount(indexListCopy);
		}
	    }
	}
    }
    assert (retValueObj==NULL || retValueObj->typePtr || retValueObj->bytes);
    return retValueObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --

    /*
     * If the list is shared, make a copy to modify (copy-on-write). The string
     * representation and internal representation of listObj remains unchanged.
     */

    subListObj = Tcl_IsShared(listObj)
	? TclDuplicatePureObj(interp, listObj, &tclListType) : listObj;
    if (!subListObj) {
	return NULL;
    }

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.

	    if (index == elemCount) {
		TclNewObj(subListObj);
	    } else {
		subListObj = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListObj)) {
		subListObj = TclDuplicatePureObj(
		    interp, subListObj, &tclListType);
		if (!subListObj) {
		    return NULL;
		}
		copied = 1;
	    }

	    /*

		Tcl_ListObjAppendElement(NULL, parentList, subListObj);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }
	    if (Tcl_IsShared(subListObj)) {
		Tcl_Obj * newSubListObj;
		newSubListObj = TclDuplicatePureObj(
		    interp, subListObj, &tclListType);
		if (copied) {
		    Tcl_DecrRefCount(subListObj);
		}
		if (newSubListObj) {
		    subListObj = newSubListObj;
		} else {
		    return NULL;

	while (!done) {
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else if (TclObjTypeHasProc(objPtr,indexProc)) {
	Tcl_Size elemCount, i;





	elemCount = TclObjTypeHasProc(objPtr,lengthProc)(objPtr);


	if (ListRepInitAttempt(interp, elemCount, NULL, &listRep) != TCL_OK) {


	    return TCL_ERROR;
	}

	LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
	LIST_ASSERT(listRep.storePtr->firstUsed == 0);



	elemPtrs = listRep.storePtr->slots;

	/* Each iteration, store a list element */
        for (i = 0; i < elemCount; i++) {
	    if (Tcl_ObjTypeIndex(interp, objPtr, i, elemPtrs) != TCL_OK) {

                return TCL_ERROR;
            }
	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}

	LIST_ASSERT((Tcl_Size)(elemPtrs - listRep.storePtr->slots) == elemCount);

	listRep.storePtr->numUsed = elemCount;

    } else {
	Tcl_Size estCount, length;
	const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each

     * So do NOT use ListObjReplaceRepAndInvalidate. InternalRep to be freed AFTER
     * IncrRefs so do not use ListObjOverwriteRep
     */
    ListRepIncrRefs(&listRep);
    TclFreeInternalRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = listRep.storePtr;
    objPtr->internalRep.twoPtrValue.ptr2 = listRep.spanPtr;
    objPtr->typePtr = &tclListType;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

/*
 * The structures below defines the Tcl object types defined in this file by
 * means of functions that can be invoked by generic object code. See also
 * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
 * implementations.
 */

const Tcl_ObjType tclBooleanType= {
    "boolean",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny,	/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)


};
const Tcl_ObjType tclDoubleType= {
    "double",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfDouble,	/* updateStringProc */
    SetDoubleFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)


};
const Tcl_ObjType tclIntType = {
    "int",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInt,		/* updateStringProc */
    SetIntFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)


};
const Tcl_ObjType tclBignumType = {
    "bignum",			/* name */
    FreeBignum,			/* freeIntRepProc */
    DupBignum,			/* dupIntRepProc */
    UpdateStringOfBignum,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)


};

/*
 * The structure below defines the Tcl obj hash key type.
 */

const Tcl_HashKeyType tclObjHashKeyType = {

TclInitObjSubsystem(void)
{
    Tcl_MutexLock(&tableMutex);
    typeTableInitialized = 1;
    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
    Tcl_MutexUnlock(&tableMutex);

    Tcl_RegisterObjType(&tclDoubleType);
    Tcl_RegisterObjType(&tclStringType);
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclProcBodyType);

    /* For backward compatibility only ... */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_RegisterObjType(&tclIntType);
#if !defined(TCL_WIDE_INT_IS_LONG)
    Tcl_RegisterObjType(&oldIntType);
#endif
    Tcl_RegisterObjType(&oldBooleanType);
#endif

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
    tclObjsFreed = 0;
    {
	int i;

    Tcl_Interp *interp,
    Tcl_Obj *dupPtr,
    Tcl_Obj *objPtr,
    const Tcl_ObjType *typePtr)
{
    char *bytes = objPtr->bytes;
    int status = TCL_OK;
    const Tcl_ObjType *useTypePtr =
        objPtr->typePtr ? objPtr->typePtr : typePtr;

    TclInvalidateStringRep(dupPtr);
    assert(dupPtr->typePtr == NULL);

    if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
	objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
    } else {
	dupPtr->internalRep = objPtr->internalRep;
	dupPtr->typePtr = objPtr->typePtr;
    }

    if (typePtr != NULL && dupPtr->typePtr != useTypePtr) {
	if (bytes) {
	    dupPtr->bytes = bytes;
	    dupPtr->length = objPtr->length;
	}
	/* borrow bytes from original object */
	status = Tcl_ConvertToType(interp, dupPtr, useTypePtr);
	if (bytes) {
	    dupPtr->bytes = NULL;
	    dupPtr->length = 0;
	}
	if (status != TCL_OK) {
	    return status;
	}

     * Perhaps in the future this can be remedied and this special treatment
     * removed.
     */


    if (bytes && (dupPtr->typePtr == NULL
	|| dupPtr->typePtr->updateStringProc == NULL
	|| useTypePtr == &tclStringType
	)
    ) {
	if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"insufficient memory to initialize string", -1));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);

	    TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK)
		    ? "boolean value or \"\"" : "boolean value", NULL, TCL_INDEX_NONE, NULL, 0);
	    Tcl_DecrRefCount(objPtr);
	}
	return TCL_ERROR;
    }
    do {
	if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
	    result = (objPtr->internalRep.wideValue != 0);
	    goto boolEnd;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    /*
	     * Caution: Don't be tempted to check directly for the "double"
	     * Tcl_ObjType and then compare the internalrep to 0.0. This isn't
	     * reliable because a "double" Tcl_ObjType can hold the NaN value.
	     * Use the API Tcl_GetDoubleFromObj, which does the checking and
	     * sets the proper error message for us.
	     */

	    double d;

	    if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
		return TCL_ERROR;
	    }
	    result = (d != 0.0);
	    goto boolEnd;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    result = 1;
	boolEnd:
	    if (charPtr != NULL) {
		flags &= (TCL_NULL_OK-2);
		if (flags) {
		    if (flags == (int)sizeof(int)) {
			*(int *)charPtr = result;

    /*
     * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
     * whether a boolean conversion is possible without generating the string
     * rep.
     */

    if (objPtr->bytes == NULL) {
	if (objPtr->typePtr == &tclIntType) {
	    if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
		return TCL_OK;
	    }
	    goto badBoolean;
	}

	if (objPtr->typePtr == &tclBignumType) {
	    goto badBoolean;
	}

	if (objPtr->typePtr == &tclDoubleType) {
	    goto badBoolean;
	}
    }

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

     * as possible to allow the conversion code, in particular
     * Tcl_GetStringFromObj, to use that old internalRep.
     */

  goodBoolean:
    TclFreeInternalRep(objPtr);
    objPtr->internalRep.wideValue = newBool;
    objPtr->typePtr = &tclBooleanType;
    return TCL_OK;

  numericBoolean:
    TclFreeInternalRep(objPtr);
    objPtr->internalRep.wideValue = newBool;
    objPtr->typePtr = &tclIntType;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewDoubleObj --

    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    /* Optimized TclInvalidateStringRep() */
    objPtr->bytes = NULL;

    objPtr->internalRep.doubleValue = dblValue;
    objPtr->typePtr = &tclDoubleType;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewDoubleObj(

int
Tcl_GetDoubleFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a double. */
    double *dblPtr)	/* Place to store resulting double. */
{
    do {
	if (objPtr->typePtr == &tclDoubleType) {
	    if (isnan(objPtr->internalRep.doubleValue)) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "floating point value is Not a Number", -1));
                    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
                            NULL);
		}
		return TCL_ERROR;
	    }
	    *dblPtr = (double) objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    *dblPtr = (double) objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;

	    TclUnpackBignum(objPtr, big);
	    *dblPtr = TclBignumToDouble(&big);
	    return TCL_OK;
	}
    } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);

Tcl_GetLongFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a long. */
    long *longPtr)	/* Place to store resulting long. */
{
    do {
#ifdef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclIntType) {
	    *longPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#else
	if (objPtr->typePtr == &tclIntType) {
	    /*
	     * We return any integer in the range LONG_MIN to ULONG_MAX
	     * converted to a long, ignoring overflow. The rule preserves
	     * existing semantics for conversion of integers on input, but
	     * avoids inadvertent demotion of wide integers to 32-bit ones in
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (w >= (Tcl_WideInt)(LONG_MIN)
		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
		*longPtr = (long)w;
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a long, even
	     * when auto-narrowing is enabled. Only those values in the signed
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

Tcl_GetWideIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    Tcl_WideInt *wideIntPtr)
				/* Place to store resulting long. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;
	    Tcl_WideUInt value = 0;

Tcl_GetWideUIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    Tcl_WideUInt *wideUIntPtr)
				/* Place to store resulting long. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    if (objPtr->internalRep.wideValue < 0) {
	wideUIntOutOfRange:
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "expected unsigned integer but got \"%s\"",
			    TclGetString(objPtr)));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
		}
		return TCL_ERROR;
	    }
	    *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    goto wideUIntOutOfRange;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideUInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;
	    Tcl_WideUInt value = 0;

int
TclGetWideBitsFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,            /* Object from which to get a wide int. */
    Tcl_WideInt *wideIntPtr)    /* Place to store resulting wide integer. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;
	    mp_err err;

	    Tcl_WideUInt value = 0, scratch;
	    size_t numBytes;
	    unsigned char *bytes = (unsigned char *) &scratch;

DupBignum(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    mp_int bignumVal;
    mp_int bignumCopy;

    copyPtr->typePtr = &tclBignumType;
    TclUnpackBignum(srcPtr, bignumVal);
    if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
	Tcl_Panic("initialization failure in DupBignum");
    }
    PACK_BIGNUM(bignumCopy, copyPtr);
}


GetBignumFromObj(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj *objPtr,		/* Object to read */
    int copy,			/* Whether to copy the returned bignum value */
    mp_int *bignumValue)	/* Returned bignum value. */
{
    do {
	if (objPtr->typePtr == &tclBignumType) {
	    if (copy || Tcl_IsShared(objPtr)) {
		mp_int temp;

		TclUnpackBignum(objPtr, temp);
		if (mp_init_copy(bignumValue, &temp) != MP_OKAY) {
		    return TCL_ERROR;
		}

		 */
		if (objPtr->bytes == NULL) {
		    TclInitEmptyStringRep(objPtr);
		}
	    }
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    if (mp_init_i64(bignumValue,
		    objPtr->internalRep.wideValue) != MP_OKAY) {
		return TCL_ERROR;
	    }
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
	    }
	    return TCL_ERROR;

void
TclSetBignumInternalRep(
    Tcl_Obj *objPtr,
    void *big)
{
    mp_int *bignumValue = (mp_int *)big;
    objPtr->typePtr = &tclBignumType;
    PACK_BIGNUM(*bignumValue, objPtr);

    /*
     * Clear the mp_int value.
     *
     * Don't call mp_clear() because it would free the digit array we just
     * packed into the Tcl_Obj.

Tcl_GetNumberFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    void **clientDataPtr,
    int *typePtr)
{
    do {
	if (objPtr->typePtr == &tclDoubleType) {
	    if (isnan(objPtr->internalRep.doubleValue)) {
		*typePtr = TCL_NUMBER_NAN;
	    } else {
		*typePtr = TCL_NUMBER_DOUBLE;
	    }
	    *clientDataPtr = &objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    *typePtr = TCL_NUMBER_INT;
	    *clientDataPtr = &objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
		    sizeof(mp_int));

	    TclUnpackBignum(objPtr, *bigPtr);
	    *typePtr = TCL_NUMBER_BIG;
	    *clientDataPtr = bigPtr;

    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
	    " object pointer at %p",
	    objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
	    objv[1]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
		    objv[1]->internalRep.doubleValue);
	} else {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
		    (void *) objv[1]->internalRep.twoPtrValue.ptr1,
		    (void *) objv[1]->internalRep.twoPtrValue.ptr2);
	}

		Tcl_DecrRefCount(objPtr);
		string = end;
	    } else {
		double dvalue;
		if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
		    const Tcl_ObjInternalRep *irPtr
			    = TclFetchInternalRep(objPtr, &tclDoubleType);
		    if (irPtr) {
			dvalue = irPtr->doubleValue;
		    } else
#endif
		    {
			Tcl_DecrRefCount(objPtr);
			goto done;

    if (bytes == NULL) {
	if (interp == NULL && endPtrPtr == NULL) {
	    if (TclHasInternalRep(objPtr, &tclDictType)) {
		/* A dict can never be a (single) number */
		return TCL_ERROR;
	    }
	    if (TclHasInternalRep(objPtr, &tclListType)) {
		Tcl_Size length;
		/* A list can only be a (single) number if its length == 1 */
		TclListObjLengthM(NULL, objPtr, &length);
		if (length != 1) {
		    return TCL_ERROR;
		}
	    }

	    }
	    if (!octalSignificandOverflow) {
		if ((err == MP_OKAY) && (octalSignificandWide > (MOST_BITS + signum))) {
		    err = mp_init_u64(&octalSignificandBig,
			    octalSignificandWide);
		    octalSignificandOverflow = 1;
		} else {
		    objPtr->typePtr = &tclIntType;
		    if (signum) {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt)(-octalSignificandWide);
		    } else {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt)octalSignificandWide;
		    }

	returnInteger:
	    if (!significandOverflow) {
		if ((err == MP_OKAY) && (significandWide > MOST_BITS+signum)) {
		    err = mp_init_u64(&significandBig,
			    significandWide);
		    significandOverflow = 1;
		} else {
		    objPtr->typePtr = &tclIntType;
		    if (signum) {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt)(-significandWide);
		    } else {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt)significandWide;
		    }

	     * Here, we're parsing a floating-point number. 'significandWide'
	     * or 'significandBig' contains the exact significand, according
	     * to whether 'significandOverflow' is set. The desired floating
	     * point value is significand * 10**k, where
	     * k = numTrailZeros+exponent-numDigitsAfterDp.
	     */

	    objPtr->typePtr = &tclDoubleType;
	    if (exponentSignum) {
		/*
		 * At this point exponent>=0, so the following calculation
		 * cannot underflow.
		 */
		exponent = -exponent;
	    }

	case sINF:
	case sINFINITY:
	    if (signum) {
		objPtr->internalRep.doubleValue = -HUGE_VAL;
	    } else {
		objPtr->internalRep.doubleValue = HUGE_VAL;
	    }
	    objPtr->typePtr = &tclDoubleType;
	    break;

#ifdef IEEE_FLOATING_POINT
	case sNAN:
	case sNANFINISH:
	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
	    objPtr->typePtr = &tclDoubleType;
	    break;
#endif
	case INITIAL:
	    /* This case only to silence compiler warning. */
	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
	}
    }

#define TclUnusedStubEntry 0


#if TCL_UTF_MAX < 4
static void uniCodePanic() {
    Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}

#   define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, Tcl_Size *))(void *)uniCodePanic
#   define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
#   define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
#   define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
#   define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
#endif

	return TCL_ERROR;
    }
#if TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#endif

    if (Tcl_ABSListTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Check for special options used in ../tests/main.test
     */

    objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
    if (objPtr != NULL) {

 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

// Tcl Abstract List test command: "lstring"

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <string.h>
#include <limits.h>
#include "tclInt.h"

/*
 * Forward references
 */

Tcl_Obj *myNewLStringObj(Tcl_WideInt start,
			 Tcl_WideInt length);
static void freeRep(Tcl_Obj* alObj);
static Tcl_Obj* my_LStringObjSetElem(Tcl_Interp *interp,
				     Tcl_Obj *listPtr,
				     Tcl_Size numIndcies,
				     Tcl_Obj *const indicies[],
				     Tcl_Obj *valueObj);
static void DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static Tcl_Size my_LStringObjLength(Tcl_Obj *lstringObjPtr);
static int my_LStringObjIndex(Tcl_Interp *interp,
			      Tcl_Obj *lstringObj,
			      Tcl_Size index,
			      Tcl_Obj **charObjPtr);
static int my_LStringObjRange(Tcl_Interp *interp, Tcl_Obj *lstringObj,
			      Tcl_Size fromIdx, Tcl_Size toIdx,
			      Tcl_Obj **newObjPtr);
static int my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj,
			  Tcl_Obj **newObjPtr);
static int my_LStringReplace(Tcl_Interp *interp,
		      Tcl_Obj *listObj,
		      Tcl_Size first,
		      Tcl_Size numToDelete,
		      Tcl_Size numToInsert,
		      Tcl_Obj *const insertObjs[]);
static int my_LStringGetElements(Tcl_Interp *interp,
				 Tcl_Obj *listPtr,
				 Tcl_Size *objcptr,
				 Tcl_Obj ***objvptr);
static void lstringFreeElements(Tcl_Obj* lstringObj);
static void UpdateStringOfLString(Tcl_Obj *objPtr);

/*
 * Internal Representation of an lstring type value
 */

typedef struct LString {
    char *string;	// NULL terminated utf-8 string
    Tcl_Size strlen;	// num bytes in string
    Tcl_Size allocated; // num bytes allocated
    Tcl_Obj**elements;	// elements array, allocated when GetElements is
			// called
} LString;

/*
 * AbstractList definition of an lstring type
 */
static const Tcl_ObjType lstringTypes[11] = {
    {/*0*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*1*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    NULL,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*2*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    NULL,                  /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*3*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    NULL,                  /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*4*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    NULL,                  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*5*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    NULL,                  /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*6*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    NULL,                  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*7*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    NULL)                  /* Replace */
    },
    {/*8*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*9*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*10*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    }
};


/*
 *----------------------------------------------------------------------
 *
 * my_LStringObjIndex --
 *
 *	Implements the AbstractList Index function for the lstring type.  The
 *	Index function returns the value at the index position given. Caller
 *	is resposible for freeing the Obj.
 *
 * Results:
 *	TCL_OK on success. Returns a new Obj, with a 0 refcount in the
 *	supplied charObjPtr location. Call has ownership of the Obj.
 *
 * Side effects:
 *	Obj allocated.
 *
 *----------------------------------------------------------------------
 */

static int
my_LStringObjIndex(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size index,
    Tcl_Obj **charObjPtr)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;

  (void)interp;

  if (index < lstringRepPtr->strlen) {
      char cchar[2];
      cchar[0] = lstringRepPtr->string[index];
      cchar[1] = 0;
      *charObjPtr = Tcl_NewStringObj(cchar,1);
  } else {
      *charObjPtr = Tcl_NewObj();
  }

  return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * my_LStringObjLength --
 *
 *	Implements the AbstractList Length function for the lstring type.
 *	The Length function returns the number of elements in the list.
 *
 * Results:
 *	WideInt number of elements in the list.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Size
my_LStringObjLength(Tcl_Obj *lstringObjPtr)
{
    LString *lstringRepPtr = (LString *)lstringObjPtr->internalRep.twoPtrValue.ptr1;
    return lstringRepPtr->strlen;
}


/*
 *----------------------------------------------------------------------
 *
 * DupLStringRep --
 *
 *	Replicates the internal representation of the src value, and storing
 *	it in the copy
 *
 * Results:
 *	void
 *
 * Side effects:
 *	Modifies the rep of the copyObj.
 *
 *----------------------------------------------------------------------
 */

static void
DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
{
  LString *srcLString = (LString*)srcPtr->internalRep.twoPtrValue.ptr1;
  LString *copyLString = (LString*)Tcl_Alloc(sizeof(LString));

  memcpy(copyLString, srcLString, sizeof(LString));
  copyLString->string = (char*)Tcl_Alloc(srcLString->allocated);
  strncpy(copyLString->string, srcLString->string, srcLString->strlen);
  copyLString->string[srcLString->strlen] = '\0';
  copyLString->elements = NULL;
  Tcl_ObjInternalRep itr;
  itr.twoPtrValue.ptr1 = copyLString;
  itr.twoPtrValue.ptr2 = NULL;
  Tcl_StoreInternalRep(copyPtr, srcPtr->typePtr, &itr);

  return;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringObjSetElem --
 *
 *	Replace the element value at the given (nested) index with the
 *	valueObj provided.  If the lstring obj is shared, a new list is
 *	created conntaining the modifed element.
 *
 * Results:
 *	The modifed lstring is returned, either new or original. If the
 *	index is invalid, NULL is returned, and an error is added to the
 *	interp, if provided.
 *
 * Side effects:
 *	A new obj may be created.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj*
my_LStringObjSetElem(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size numIndicies,
    Tcl_Obj *const indicies[],
    Tcl_Obj *valueObj)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    Tcl_Size index;
    const char *newvalue;
    int status;
    Tcl_Obj *returnObj;

    if (numIndicies > 1) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("Multiple indicies not supported by lstring."));
	return NULL;
    }

    status = Tcl_GetIntForIndex(interp, indicies[0], lstringRepPtr->strlen, &index);
    if (status != TCL_OK) {
	return NULL;
    }

    returnObj = Tcl_IsShared(lstringObj) ? Tcl_DuplicateObj(lstringObj) : lstringObj;
    lstringRepPtr = (LString*)returnObj->internalRep.twoPtrValue.ptr1;

    if (index >= lstringRepPtr->strlen) {
	index = lstringRepPtr->strlen;
	lstringRepPtr->strlen++;
	lstringRepPtr->string = (char*)Tcl_Realloc(lstringRepPtr->string, lstringRepPtr->strlen+1);
    }

    newvalue = Tcl_GetString(valueObj);
    lstringRepPtr->string[index] = newvalue[0];

    Tcl_InvalidateStringRep(returnObj);

    return returnObj;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringObjRange --
 *
 *	Creates a new Obj with a slice of the src listPtr.
 *
 * Results:
 *	A new Obj is assigned to newObjPtr. Returns TCL_OK
 *
 * Side effects:
 *	A new Obj is created.
 *
 *----------------------------------------------------------------------
 */

static int my_LStringObjRange(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size fromIdx,
    Tcl_Size toIdx,
    Tcl_Obj **newObjPtr)
{
    Tcl_Obj *rangeObj;
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    LString *rangeRep;
    Tcl_WideInt len = toIdx - fromIdx + 1;

    if (lstringRepPtr->strlen < fromIdx ||
	lstringRepPtr->strlen < toIdx) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("Range out of bounds "));
	return TCL_ERROR;
    }

    if (len <= 0) {
	// Return empty value;
	*newObjPtr = Tcl_NewObj();
    } else {
	rangeRep = (LString*)Tcl_Alloc(sizeof(LString));
	rangeRep->allocated = len+1;
	rangeRep->strlen = len;
	rangeRep->string = (char*)Tcl_Alloc(rangeRep->allocated);
	strncpy(rangeRep->string,&lstringRepPtr->string[fromIdx],len);
	rangeRep->string[len] = 0;
	rangeRep->elements = NULL;
	rangeObj = Tcl_NewObj();
	Tcl_ObjInternalRep itr;
	itr.twoPtrValue.ptr1 = rangeRep;
	itr.twoPtrValue.ptr2 = NULL;
	Tcl_StoreInternalRep(rangeObj, lstringObj->typePtr, &itr);
	if (rangeRep->strlen > 0) {
	    Tcl_InvalidateStringRep(rangeObj);
	} else {
	    Tcl_InitStringRep(rangeObj, NULL, 0);
	}
	*newObjPtr = rangeObj;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringObjReverse --
 *
 *	Creates a new Obj with the the order of the elements in the lstring
 *	value reversed, where first is last and last is first, etc.
 *
 * Results:
 *	A new Obj is assigned to newObjPtr. Returns TCL_OK
 *
 * Side effects:
 *	A new Obj is created.
 *
 *----------------------------------------------------------------------
 */

static int
my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj, Tcl_Obj **newObjPtr)
{
    LString *srcRep = (LString*)srcObj->internalRep.twoPtrValue.ptr1;
    Tcl_Obj *revObj;
    LString *revRep = (LString*)Tcl_Alloc(sizeof(LString));
    Tcl_ObjInternalRep itr;
    Tcl_Size len;
    char *srcp, *dstp, *endp;
    (void)interp;
    len = srcRep->strlen;
    revRep->strlen = len;
    revRep->allocated = len+1;
    revRep->string = (char*)Tcl_Alloc(revRep->allocated);
    revRep->elements = NULL;
    srcp = srcRep->string;
    endp = &srcRep->string[len];
    dstp = &revRep->string[len];
    *dstp-- = 0;
    while (srcp < endp) {
	*dstp-- = *srcp++;
    }
    revObj = Tcl_NewObj();
    itr.twoPtrValue.ptr1 = revRep;
    itr.twoPtrValue.ptr2 = NULL;
    Tcl_StoreInternalRep(revObj, srcObj->typePtr, &itr);
    if (revRep->strlen > 0) {
	Tcl_InvalidateStringRep(revObj);
    } else {
	Tcl_InitStringRep(revObj, NULL, 0);
    }
    *newObjPtr = revObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringReplace --
 *
 *	Delete and/or Insert elements in the list, starting at index first.
 *	See more details in the comments below. This should not be called with
 *	a Shared Obj.
 *
 * Results:
 *	The value of the listObj is modified.
 *
 * Side effects:
 *	The string rep is invalidated.
 *
 *----------------------------------------------------------------------
 */

static int
my_LStringReplace(
    Tcl_Interp *interp,
    Tcl_Obj *listObj,
    Tcl_Size first,
    Tcl_Size numToDelete,
    Tcl_Size numToInsert,
    Tcl_Obj *const insertObjs[])
{
    LString *lstringRep = (LString*)listObj->internalRep.twoPtrValue.ptr1;
    Tcl_Size newLen;
    Tcl_Size x, ix, kx;
    char *newStr;
    char *oldStr = lstringRep->string;
    (void)interp;

    newLen = lstringRep->strlen - numToDelete + numToInsert;

    if (newLen >= lstringRep->allocated) {
	lstringRep->allocated = newLen+1;
	newStr = (char*)Tcl_Alloc(lstringRep->allocated);
	newStr[newLen] = 0;
    } else {
	newStr = oldStr;
    }

    /* Tcl_ListObjReplace replaces zero or more elements of the list
     * referenced by listPtr with the objc values in the array referenced by
     * objv.
     *
     * If listPtr does not point to a list value, Tcl_ListObjReplace
     * will attempt to convert it to one; if the conversion fails, it returns
     * TCL_ERROR and leaves an error message in the interpreter's result value
     * if interp is not NULL. Otherwise, it returns TCL_OK after replacing the
     * values.
     *
     *    * If objv is NULL, no new elements are added.
     *
     *    * If the argument first is zero or negative, it refers to the first
     *      element.
     *
     *    * If first is greater than or equal to the number of elements in the
     *      list, then no elements are deleted; the new elements are appended
     *      to the list. count gives the number of elements to replace.
     *
     *    * If count is zero or negative then no elements are deleted; the new
     *      elements are simply inserted before the one designated by first.
     *      Tcl_ListObjReplace invalidates listPtr's old string representation.
     *
     *    * The reference counts of any elements inserted from objv are
     *      incremented since the resulting list now refers to them. Similarly,
     *      the reference counts for any replaced values are decremented.
     */

    // copy 0 to first-1
    if (newStr != oldStr) {
	strncpy(newStr, oldStr, first);
    }

    // move front elements to keep
    for(x=0, kx=0; x<newLen && kx<first; kx++, x++) {
	newStr[x] = oldStr[kx];
    }
    // Insert new elements into new string
    for(x=first, ix=0; ix<numToInsert; x++, ix++) {
	char const *svalue = Tcl_GetString(insertObjs[ix]);
	newStr[x] = svalue[0];
    }
    // Move remaining elements
    if ((first+numToDelete) < newLen) {
	for(/*x,*/ kx=first+numToDelete; (kx <lstringRep->strlen && x<newLen); x++, kx++) {
	    newStr[x] = oldStr[kx];
	}
    }

    // Terminate new string.
    newStr[newLen] = 0;


    if (oldStr != newStr) {
	Tcl_Free(oldStr);
    }
    lstringRep->string = newStr;
    lstringRep->strlen = newLen;

    /* Changes made to value, string rep and elements array no longer valid */
    Tcl_InvalidateStringRep(listObj);
    lstringFreeElements(listObj);

    return TCL_OK;
}

static const Tcl_ObjType *
my_SetAbstractProc(int ptype)
{
    const Tcl_ObjType *typePtr = &lstringTypes[0]; /* default value */
    if (4 <= ptype && ptype <= 11) {
	/* Table has no entries for the slots upto setfromany */
	typePtr = &lstringTypes[(ptype-3)];
    }
    return typePtr;
}


/*
 *----------------------------------------------------------------------
 *
 * my_NewLStringObj --
 *
 *	Creates a new lstring Obj using the string value of objv[0]
 *
 * Results:
 *	results
 *
 * Side effects:
 *	side effects
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
my_NewLStringObj(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[])
{
    LString *lstringRepPtr;
    Tcl_ObjInternalRep itr;
    size_t repSize;
    Tcl_Obj *lstringPtr;
    const char *string;
    static const char* procTypeNames[] = {
	"FREEREP", "DUPREP", "UPDATESTRING", "SETFROMANY",
	"LENGTH", "INDEX", "SLICE", "REVERSE", "GETELEMENTS",
	"SETELEMENT", "REPLACE", NULL
    };
    int i = 0;
    int ptype;
    const Tcl_ObjType *lstringTypePtr = &lstringTypes[10];

    repSize = sizeof(LString);
    lstringRepPtr = (LString*)Tcl_Alloc(repSize);

    while (i<objc) {
	const char *s = Tcl_GetString(objv[i]);
	if (strcmp(s, "-not")==0) {
	    i++;
	    if (Tcl_GetIndexFromObj(interp, objv[i], procTypeNames, "proctype", 0, &ptype)==TCL_OK) {
		lstringTypePtr = my_SetAbstractProc(ptype);
	    }
	} else if (strcmp(s, "--") == 0) {
	    // End of options
	    i++;
	    break;
	} else {
	    break;
	}
	i++;
    }
    if (i != objc-1) {
	Tcl_WrongNumArgs(interp, 0, objv, "lstring string");
	return NULL;
    }
    string = Tcl_GetString(objv[i]);

    lstringRepPtr->strlen = strlen(string);
    lstringRepPtr->allocated = lstringRepPtr->strlen + 1;
    lstringRepPtr->string = (char*)Tcl_Alloc(lstringRepPtr->allocated);
    strcpy(lstringRepPtr->string, string);
    lstringRepPtr->elements = NULL;
    lstringPtr = Tcl_NewObj();
    itr.twoPtrValue.ptr1 = lstringRepPtr;
    itr.twoPtrValue.ptr2 = NULL;
    Tcl_StoreInternalRep(lstringPtr, lstringTypePtr, &itr);
    if (lstringRepPtr->strlen > 0) {
	Tcl_InvalidateStringRep(lstringPtr);
    } else {
	Tcl_InitStringRep(lstringPtr, NULL, 0);
    }
    return lstringPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * freeElements --
 *
 *      Free the element array
 *
 */

static void
lstringFreeElements(Tcl_Obj* lstringObj)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    if (lstringRepPtr->elements) {
	Tcl_Obj **objptr = lstringRepPtr->elements;
	while (objptr < &lstringRepPtr->elements[lstringRepPtr->strlen]) {
	    Tcl_DecrRefCount(*objptr++);
	}
	Tcl_Free((char*)lstringRepPtr->elements);
	lstringRepPtr->elements = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * freeRep --
 *
 *	Free the value storage of the lstring Obj.
 *
 * Results:
 *	void
 *
 * Side effects:
 *	Memory free'd.
 *
 *----------------------------------------------------------------------
 */

static void
freeRep(Tcl_Obj* lstringObj)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    if (lstringRepPtr->string) {
	Tcl_Free(lstringRepPtr->string);
    }
    lstringFreeElements(lstringObj);
    Tcl_Free((char*)lstringRepPtr);
    lstringObj->internalRep.twoPtrValue.ptr1 = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringGetElements --
 *
 *	Get the elements of the list in an array.
 *
 * Results:
 *	objc, objv return values
 *
 * Side effects:
 *	A Tcl_Obj is stored for every element of the abstract list
 *
 *----------------------------------------------------------------------
 */

static int my_LStringGetElements(Tcl_Interp *interp,
				 Tcl_Obj *lstringObj,
				 Tcl_Size *objcptr,
				 Tcl_Obj ***objvptr)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    Tcl_Obj **objPtr;
    char *cptr = lstringRepPtr->string;
    (void)interp;
    if (lstringRepPtr->strlen == 0) {
	*objcptr = 0;
	*objvptr = NULL;
	return TCL_OK;
    }
    if (lstringRepPtr->elements == NULL) {
	lstringRepPtr->elements = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*) * lstringRepPtr->strlen);
	objPtr=lstringRepPtr->elements;
	while (objPtr < &lstringRepPtr->elements[lstringRepPtr->strlen]) {
	    *objPtr = Tcl_NewStringObj(cptr++,1);
	    Tcl_IncrRefCount(*objPtr++);
	}
    }
    *objvptr = lstringRepPtr->elements;
    *objcptr = lstringRepPtr->strlen;
    return TCL_OK;
}

/*
** UpdateStringRep
*/

static void
UpdateStringOfLString(Tcl_Obj *objPtr)
{
#   define LOCAL_SIZE 64
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Tcl_ObjType const *typePtr = objPtr->typePtr;
    char *p;
    int bytesNeeded = 0;
    int llen, i;


    /*
     * Handle empty list case first, so rest of the routine is simpler.
     */
    llen = typePtr->lengthProc(objPtr);
    if (llen <= 0) {
	Tcl_InitStringRep(objPtr, NULL, 0);
	return;
    }

    /*
     * Pass 1: estimate space.
     */
    if (llen <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/* We know numElems <= LIST_MAX, so this is safe. */
	flagPtr = (int *) Tcl_Alloc(llen*sizeof(int));
    }
    for (bytesNeeded = 0, i = 0; i < llen; i++) {
        Tcl_Obj *elemObj;
        const char *elemStr;
        Tcl_Size elemLen;
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, objPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
        elemStr = Tcl_GetStringFromObj(elemObj, &elemLen);
        /* Note TclScanElement updates flagPtr[i] */
	bytesNeeded += Tcl_ScanCountedElement(elemStr, elemLen, &flagPtr[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
	Tcl_DecrRefCount(elemObj);
    }
    if (bytesNeeded > INT_MAX - llen + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += llen; /* Separating spaces and terminating nul */

    /*
     * Pass 2: generate the string repr.
     */
    objPtr->bytes = (char *) Tcl_Alloc(bytesNeeded);
    p = objPtr->bytes;
    for (i = 0; i < llen; i++) {
        Tcl_Obj *elemObj;
        const char *elemStr;
        Tcl_Size elemLen;
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, objPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
	elemStr = Tcl_GetStringFromObj(elemObj, &elemLen);
	p += Tcl_ConvertCountedElement(elemStr, elemLen, p, flagPtr[i]);
	*p++ = ' ';
	Tcl_DecrRefCount(elemObj);
    }
    p[-1] = '\0'; /* Overwrite last space added */

    /* Length of generated string */
    objPtr->length = p - 1 - objPtr->bytes;

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * lLStringObjCmd --
 *
 *	Script level command that creats an lstring Obj value.
 *
 * Results:
 *	Returns and lstring Obj value in the interp results.
 *
 * Side effects:
 *	Interp results modified.
 *
 *----------------------------------------------------------------------
 */

static int
lLStringObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[])
{
  Tcl_Obj *lstringObj;

  (void)clientData;
  if (objc < 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "string");
      return TCL_ERROR;
  }

  lstringObj = my_NewLStringObj(interp, objc-1, &objv[1]);

  if (lstringObj) {
      Tcl_SetObjResult(interp, lstringObj);
      return TCL_OK;
  }
  return TCL_ERROR;
}

/*
** lgen - Derived from TIP 192 - Lazy Lists
** Generate a list using a command provided as argument(s).
** The command computes the value for a given index.
*/

/*
 * Internal rep for the Generate Series
 */
typedef struct LgenSeries {
    Tcl_Interp *interp; // used to evaluate gen script
    Tcl_Size len;       // list length
    Tcl_Size nargs;     // Number of arguments in genFn including "index"
    Tcl_Obj *genFnObj;  // The preformed command as a list. Index is set in
			// the last element (last argument)
} LgenSeries;

/*
 * Evaluate the generation function.
 * The provided funtion computes the value for a give index
 */
static Tcl_Obj*
lgen(
    Tcl_Obj* objPtr,
    Tcl_Size index)
{
    LgenSeries *lgenSeriesPtr = (LgenSeries*)objPtr->internalRep.twoPtrValue.ptr1;
    Tcl_Obj *elemObj = NULL;
    Tcl_Interp *intrp = lgenSeriesPtr->interp;
    Tcl_Obj *genCmd = lgenSeriesPtr->genFnObj;
    Tcl_Size endidx = lgenSeriesPtr->nargs-1;

    if (0 <= index && index < lgenSeriesPtr->len) {
	Tcl_Obj *indexObj = Tcl_NewWideIntObj(index);
	Tcl_ListObjReplace(intrp, genCmd, endidx, 1, 1, &indexObj);
	// EVAL DIRECT to avoid interfering with bytecode compile which may be
	// active on the stack
	int flags = TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT;
	int status = Tcl_EvalObjEx(intrp, genCmd, flags);
	elemObj = Tcl_GetObjResult(intrp);
	if (status != TCL_OK) {
	    Tcl_SetObjResult(intrp, Tcl_ObjPrintf(
	        "Error: %s\nwhile executing %s\n",
		elemObj ? Tcl_GetString(elemObj) : "NULL", Tcl_GetString(genCmd)));
	    return NULL;
	}
    }
    return elemObj;
}

/*
 *  Abstract List Length function
 */
static Tcl_Size
lgenSeriesObjLength(Tcl_Obj *objPtr)
{
    LgenSeries *lgenSeriesRepPtr = (LgenSeries *)objPtr->internalRep.twoPtrValue.ptr1;
    return lgenSeriesRepPtr->len;
}

/*
 *  Abstract List Index function
 */
static int
lgenSeriesObjIndex(
    Tcl_Interp *interp,
    Tcl_Obj *lgenSeriesObjPtr,
    Tcl_Size index,
    Tcl_Obj **elemPtr)
{
    LgenSeries *lgenSeriesRepPtr;
    Tcl_Obj *element;

    lgenSeriesRepPtr = (LgenSeries*)lgenSeriesObjPtr->internalRep.twoPtrValue.ptr1;

    if (index < 0 || index >= lgenSeriesRepPtr->len)
	return TCL_ERROR;

    if (lgenSeriesRepPtr->interp == NULL && interp == NULL) {
	return TCL_ERROR;
    }

    lgenSeriesRepPtr->interp = interp;

    element = lgen(lgenSeriesObjPtr, index);
    if (element) {
	*elemPtr = element;
    } else {
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
** UpdateStringRep
*/

static void
UpdateStringOfLgen(Tcl_Obj *objPtr)
{
    LgenSeries *lgenSeriesRepPtr;
    Tcl_Obj *element;
    Tcl_Size i;
    size_t bytlen;
    Tcl_Obj *tmpstr = Tcl_NewObj();

    lgenSeriesRepPtr = (LgenSeries*)objPtr->internalRep.twoPtrValue.ptr1;

    for (i=0, bytlen=0; i<lgenSeriesRepPtr->len; i++) {
	element = lgen(objPtr, i);
	if (element) {
	    if (i) {
		Tcl_AppendToObj(tmpstr," ",1);
	    }
	    Tcl_AppendObjToObj(tmpstr,element);
	}
    }

    bytlen = Tcl_GetCharLength(tmpstr);
    Tcl_InitStringRep(objPtr, Tcl_GetString(tmpstr), bytlen);
    Tcl_DecrRefCount(tmpstr);

    return;
}

/*
 *  ObjType Free Internal Rep function
 */
static void
FreeLgenInternalRep(Tcl_Obj *objPtr)
{
    LgenSeries *lgenSeries = (LgenSeries*)objPtr->internalRep.twoPtrValue.ptr1;
    if (lgenSeries->genFnObj) {
	Tcl_DecrRefCount(lgenSeries->genFnObj);
    }
    lgenSeries->interp = NULL;
    Tcl_Free(lgenSeries);
    objPtr->internalRep.twoPtrValue.ptr1 = 0;
}

static void DupLgenSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);

/*
 *  Abstract List ObjType definition
 */

static Tcl_ObjType lgenType = {
    "lgenseries",
    FreeLgenInternalRep,
    DupLgenSeriesRep,
    UpdateStringOfLgen,
    NULL, /* SetFromAnyProc */
    TCL_OBJTYPE_V2(
	lgenSeriesObjLength,
	lgenSeriesObjIndex,
	NULL, /* slice */
	NULL, /* reverse */
	NULL, /* get elements */
        NULL, /* set element */
        NULL) /* replace */
};

/*
 *  ObjType Duplicate Internal Rep Function
 */
static void
DupLgenSeriesRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    LgenSeries *srcLgenSeries = (LgenSeries*)srcPtr->internalRep.twoPtrValue.ptr1;
    Tcl_Size repSize = sizeof(LgenSeries);
    LgenSeries *copyLgenSeries = (LgenSeries*)Tcl_Alloc(repSize);

    copyLgenSeries->interp = srcLgenSeries->interp;
    copyLgenSeries->nargs = srcLgenSeries->nargs;
    copyLgenSeries->len = srcLgenSeries->len;
    copyLgenSeries->genFnObj = Tcl_DuplicateObj(srcLgenSeries->genFnObj);
    Tcl_IncrRefCount(copyLgenSeries->genFnObj);
    copyPtr->typePtr = &lgenType;
    copyPtr->internalRep.twoPtrValue.ptr1 = copyLgenSeries;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    return;
}

/*
 *  Create a new lgen Tcl_Obj
 */
Tcl_Obj *
newLgenObj(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[])
{
    Tcl_WideInt length;
    LgenSeries *lGenSeriesRepPtr;
    Tcl_Size repSize;
    Tcl_Obj *lGenSeriesObj;

    if (objc < 2) {
	return NULL;
    }

    if (Tcl_GetWideIntFromObj(NULL, objv[0], &length) != TCL_OK
	|| length < 0) {
	return NULL;
    }

    lGenSeriesObj = Tcl_NewObj();
    repSize = sizeof(LgenSeries);
    lGenSeriesRepPtr = (LgenSeries*)Tcl_Alloc(repSize);
    lGenSeriesRepPtr->interp = interp; //Tcl_CreateInterp();
    lGenSeriesRepPtr->len = length;

    // Allocate array of *obj for cmd + index + args
    // objv  length cmd arg1 arg2 arg3 ...
    // argsv         0   1    2    3   ... index

    lGenSeriesRepPtr->nargs = objc;
    lGenSeriesRepPtr->genFnObj = Tcl_NewListObj(objc-1, objv+1);
    // Addd 0 placeholder for index
    Tcl_ListObjAppendElement(interp, lGenSeriesRepPtr->genFnObj, Tcl_NewIntObj(0));
    Tcl_IncrRefCount(lGenSeriesRepPtr->genFnObj);
    lGenSeriesObj->internalRep.twoPtrValue.ptr1 = lGenSeriesRepPtr;
    lGenSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    lGenSeriesObj->typePtr = &lgenType;

    if (length > 0) {
	Tcl_InvalidateStringRep(lGenSeriesObj);
    } else {
	Tcl_InitStringRep(lGenSeriesObj, NULL, 0);
    }
    return lGenSeriesObj;
}

/*
 *  The [lgen] command
 */
static int
lGenObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[])
{
    Tcl_Obj *genObj = newLgenObj(interp, objc-1, &objv[1]);
    if (genObj) {
	Tcl_SetObjResult(interp, genObj);
	return TCL_OK;
    }
    Tcl_WrongNumArgs(interp, 1, objv, "length cmd ?args?");
    return TCL_ERROR;
}

/*
 *  lgen package init
 */
int Lgen_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.7", 0) == NULL) {
	return TCL_ERROR;
    }
    Tcl_CreateObjCommand(interp, "lgen", lGenObjCmd, NULL, NULL);
    Tcl_PkgProvide(interp, "lgen", "1.0");
    return TCL_OK;
}



/*
 *----------------------------------------------------------------------
 *
 * ABSListTest_Init --
 *
 *	Provides Abstract List implemenations via new commands
 *
 * lstring command
 * Usage:
 *      lstring /string/
 *
 * Description:
 *      Creates a list where each character in the string is treated as an
 *      element. The string is kept as a string, not an actual list. Indexing
 *      is done by char.
 *
 * lgen command
 * Usage:
 *      lgen /length/ /cmd/ ?args...?
 *
 *      The /cmd/ should take the last argument as the index value, and return
 *      a value for that element.
 *
 * Results:
 *	The commands listed above are added to the interp.
 *
 * Side effects:
 *	New commands defined.
 *
 *----------------------------------------------------------------------
 */

int Tcl_ABSListTest_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;
    }
    Tcl_CreateObjCommand(interp, "lstring", lLStringObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "lgen", lGenObjCmd, NULL, NULL);
    Tcl_PkgProvide(interp, "abstractlisttest", "1.0.0");
    return TCL_OK;
}

	}
	for (i = 0; i < len; ++i) {
	    Tcl_Obj *objP;
	    if (Tcl_ListObjIndex(interp, varPtr[varIndex], i, &objP)
		!= TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objP->refCount < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"Tcl_ListObjIndex returned object with ref count < 0",
			TCL_INDEX_NONE));
		/* Keep looping since we are also looping for leaks */
	    }
	    Tcl_BumpObj(objP);
	}
	break;

    case LISTOBJ_GETELEMENTSMEMCHECK:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;

 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching internalrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

static const Tcl_ObjType endOffsetType = {
    "end-offset",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL,				/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)


};

Tcl_Size
TclLengthOne(
    TCL_UNUSED(Tcl_Obj *))
{
    return 1;
}


     * is only valid when the lists are in canonical form.
     */

    for (i = 0;  i < objc;  i++) {
	Tcl_Size length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr) ||
            TclObjTypeHasProc(objPtr,indexProc)) {
	    continue;
	}
	(void)Tcl_GetStringFromObj(objPtr, &length);
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    objPtr = objv[i];
	    if (!TclListObjIsCanonical(objPtr) &&
		!TclObjTypeHasProc(objPtr,indexProc)) {
		continue;
	    }
	    if (resPtr) {
		Tcl_Obj *elemPtr = NULL;

		Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr);
		if (elemPtr == NULL) {
		    continue;
		}
		if (Tcl_GetString(elemPtr)[0] == '#' || TCL_OK
			!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
		    /* Abandon ship! */
		    Tcl_DecrRefCount(resPtr);
		    goto slow;
		}
	    } else {
		resPtr = TclDuplicatePureObj(
		    NULL, objPtr, &tclListType);
		if (!resPtr) {
		    return NULL;
		}
	    }
	}
	if (!resPtr) {
	    TclNewObj(resPtr);

    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                 * representing an index. */
{
    Tcl_ObjInternalRep *irPtr;
    Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
    void *cd;

    while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
	Tcl_ObjInternalRep ir;
	Tcl_Size length;
	const char *bytes = Tcl_GetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;