Tcl Source Code

/*
 * dirent.h --
 *
 *	This file is a replacement for <dirent.h> in systems that
 *	support the old BSD-style <sys/dir.h> with a "struct direct".
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _DIRENT
#define _DIRENT

#include <sys/dir.h>

#define dirent direct

#endif /* _DIRENT */

/*
 * dirent.h --
 *
 *	Declarations of a library of directory-reading procedures
 *	in the POSIX style ("struct dirent").
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _DIRENT
#define _DIRENT

/*
 * Dirent structure, which holds information about a single
 * directory entry.
 */

#define MAXNAMLEN 255
#define DIRBLKSIZ 512

struct dirent {
    long d_ino;			/* Inode number of entry */
    short d_reclen;		/* Length of this record */
    short d_namlen;		/* Length of string in d_name */
    char d_name[MAXNAMLEN + 1];	/* Name must be no longer than this */
};

/*
 * State that keeps track of the reading of a directory (clients
 * should never look inside this structure;  the fields should
 * only be accessed by the library procedures).
 */

typedef struct _dirdesc {
    int dd_fd;
    long dd_loc;
    long dd_size;
    char dd_buf[DIRBLKSIZ];
} DIR;

/*
 * Procedures defined for reading directories:
 */

extern void		closedir (DIR *dirp);
extern DIR *		opendir (char *name);
extern struct dirent *	readdir (DIR *dirp);

#endif /* _DIRENT */

/*
 * memcmp.c --
 *
 *	Source code for the "memcmp" library routine.
 *
 * Copyright (c) 1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclPort.h"

/*
 * Here is the prototype just in case it is not included in tclPort.h.
 */

int		memcmp(const void *s1, const void *s2, size_t n);

/*
 *----------------------------------------------------------------------
 *
 * memcmp --
 *
 *	Compares two bytes sequences.
 *
 * Results:
 *	Compares its arguments, looking at the first n bytes (each interpreted
 *	as an unsigned char), and returns an integer less than, equal to, or
 *	greater than 0, according as s1 is less than, equal to, or greater
 *	than s2 when taken to be unsigned 8 bit numbers.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
memcmp(
    const void *s1,		/* First string. */
    const void *s2,		/* Second string. */
    size_t n)			/* Length to compare. */
{
    const unsigned char *ptr1 = (const unsigned char *) s1;
    const unsigned char *ptr2 = (const unsigned char *) s2;

    for ( ; n-- ; ptr1++, ptr2++) {
	unsigned char u1 = *ptr1, u2 = *ptr2;

	if (u1 != u2) {
	    return (u1-u2);
	}
    }
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * opendir.c --
 *
 *	This file provides dirent-style directory-reading procedures for V7
 *	Unix systems that don't have such procedures. The origin of this code
 *	is unclear, but it seems to have come originally from Larry Wall.
 */

#include "tclInt.h"

#undef DIRSIZ
#define DIRSIZ(dp) \
    ((sizeof(struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))

/*
 * open a directory.
 */

DIR *
opendir(
    char *name)
{
    DIR *dirp;
    int fd;
    const char *myname;

    myname = ((*name == '\0') ? "." : name);
    if ((fd = open(myname, 0, 0)) == -1) {
	return NULL;
    }
    dirp = (DIR *) Tcl_AttemptAlloc(sizeof(DIR));
    if (dirp == NULL) {
	close(fd);
	return NULL;
    }
    dirp->dd_fd = fd;
    dirp->dd_loc = 0;
    return dirp;
}

/*
 * read an old style directory entry and present it as a new one
 */
#ifndef pyr
#define	ODIRSIZ	14

struct olddirect {
    ino_t od_ino;
    char od_name[ODIRSIZ];
};
#else	/* a Pyramid in the ATT universe */
#define	ODIRSIZ	248

struct olddirect {
    long od_ino;
    short od_fill1, od_fill2;
    char od_name[ODIRSIZ];
};
#endif

/*
 * get next entry in a directory.
 */

struct dirent *
readdir(
    DIR *dirp)
{
    struct olddirect *dp;
    static struct dirent dir;

    for (;;) {
	if (dirp->dd_loc == 0) {
	    dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ);
	    if (dirp->dd_size <= 0) {
		return NULL;
	    }
	}
	if (dirp->dd_loc >= dirp->dd_size) {
	    dirp->dd_loc = 0;
	    continue;
	}
	dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
	dirp->dd_loc += sizeof(struct olddirect);
	if (dp->od_ino == 0) {
	    continue;
	}
	dir.d_ino = dp->od_ino;
	strncpy(dir.d_name, dp->od_name, ODIRSIZ);
	dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
	dir.d_namlen = strlen(dir.d_name);
	dir.d_reclen = DIRSIZ(&dir);
	return &dir;
    }
}

/*
 * close a directory.
 */

void
closedir(
    DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    Tcl_Free(dirp);
}

/*  A portable stdint.h
 ****************************************************************************
 *  BSD License:
 ****************************************************************************
 *
 *  Copyright (c) 2005-2016 Paul Hsieh
 *  All rights reserved.
 *
 *  Redistribution and use in source and binary forms, with or without
 *  modification, are permitted provided that the following conditions
 *  are met:
 *
 *  1. Redistributions of source code must retain the above copyright
 *     notice, this list of conditions and the following disclaimer.
 *  2. Redistributions in binary form must reproduce the above copyright
 *     notice, this list of conditions and the following disclaimer in the
 *     documentation and/or other materials provided with the distribution.
 *  3. The name of the author may not be used to endorse or promote products
 *     derived from this software without specific prior written permission.
 *
 *  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 *  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 *  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 *  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 *  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 *  NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 *  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 *  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 *  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 *  THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 ****************************************************************************
 *
 *  Version 0.1.16.0
 *
 *  The ANSI C standard committee, for the C99 standard, specified the
 *  inclusion of a new standard include file called stdint.h.  This is
 *  a very useful and long desired include file which contains several
 *  very precise definitions for integer scalar types that is critically
 *  important for making several classes of applications portable
 *  including cryptography, hashing, variable length integer libraries
 *  and so on.  But for most developers its likely useful just for
 *  programming sanity.
 *
 *  The problem is that some compiler vendors chose to ignore the C99
 *  standard and some older compilers have no opportunity to be updated.
 *  Because of this situation, simply including stdint.h in your code
 *  makes it unportable.
 *
 *  So that's what this file is all about.  It's an attempt to build a
 *  single universal include file that works on as many platforms as
 *  possible to deliver what stdint.h is supposed to.  Even compilers
 *  that already come with stdint.h can use this file instead without
 *  any loss of functionality.  A few things that should be noted about
 *  this file:
 *
 *    1) It is not guaranteed to be portable and/or present an identical
 *       interface on all platforms.  The extreme variability of the
 *       ANSI C standard makes this an impossibility right from the
 *       very get go. Its really only meant to be useful for the vast
 *       majority of platforms that possess the capability of
 *       implementing usefully and precisely defined, standard sized
 *       integer scalars.  Systems which are not intrinsically 2s
 *       complement may produce invalid constants.
 *
 *    2) There is an unavoidable use of non-reserved symbols.
 *
 *    3) Other standard include files are invoked.
 *
 *    4) This file may come in conflict with future platforms that do
 *       include stdint.h.  The hope is that one or the other can be
 *       used with no real difference.
 *
 *    5) In the current version, if your platform can't represent
 *       int32_t, int16_t and int8_t, it just dumps out with a compiler
 *       error.
 *
 *    6) 64 bit integers may or may not be defined.  Test for their
 *       presence with the test: #ifdef INT64_MAX or #ifdef UINT64_MAX.
 *       Note that this is different from the C99 specification which
 *       requires the existence of 64 bit support in the compiler.  If
 *       this is not defined for your platform, yet it is capable of
 *       dealing with 64 bits then it is because this file has not yet
 *       been extended to cover all of your system's capabilities.
 *
 *    7) (u)intptr_t may or may not be defined.  Test for its presence
 *       with the test: #ifdef PTRDIFF_MAX.  If this is not defined
 *       for your platform, then it is because this file has not yet
 *       been extended to cover all of your system's capabilities, not
 *       because its optional.
 *
 *    8) The following might not been defined even if your platform is
 *       capable of defining it:
 *
 *       WCHAR_MIN
 *       WCHAR_MAX
 *       (u)int64_t
 *       PTRDIFF_MIN
 *       PTRDIFF_MAX
 *       (u)intptr_t
 *
 *    9) The following have not been defined:
 *
 *       WINT_MIN
 *       WINT_MAX
 *
 *   10) The criteria for defining (u)int_least(*)_t isn't clear,
 *       except for systems which don't have a type that precisely
 *       defined 8, 16, or 32 bit types (which this include file does
 *       not support anyways). Default definitions have been given.
 *
 *   11) The criteria for defining (u)int_fast(*)_t isn't something I
 *       would trust to any particular compiler vendor or the ANSI C
 *       committee.  It is well known that "compatible systems" are
 *       commonly created that have very different performance
 *       characteristics from the systems they are compatible with,
 *       especially those whose vendors make both the compiler and the
 *       system.  Default definitions have been given, but its strongly
 *       recommended that users never use these definitions for any
 *       reason (they do *NOT* deliver any serious guarantee of
 *       improved performance -- not in this file, nor any vendor's
 *       stdint.h).
 *
 *   12) The following macros:
 *
 *       PRINTF_INTMAX_MODIFIER
 *       PRINTF_INT64_MODIFIER
 *       PRINTF_INT32_MODIFIER
 *       PRINTF_INT16_MODIFIER
 *       PRINTF_LEAST64_MODIFIER
 *       PRINTF_LEAST32_MODIFIER
 *       PRINTF_LEAST16_MODIFIER
 *       PRINTF_INTPTR_MODIFIER
 *
 *       are strings which have been defined as the modifiers required
 *       for the "d", "u" and "x" printf formats to correctly output
 *       (u)intmax_t, (u)int64_t, (u)int32_t, (u)int16_t, (u)least64_t,
 *       (u)least32_t, (u)least16_t and (u)intptr_t types respectively.
 *       PRINTF_INTPTR_MODIFIER is not defined for some systems which
 *       provide their own stdint.h.  PRINTF_INT64_MODIFIER is not
 *       defined if INT64_MAX is not defined.  These are an extension
 *       beyond what C99 specifies must be in stdint.h.
 *
 *       In addition, the following macros are defined:
 *
 *       PRINTF_INTMAX_HEX_WIDTH
 *       PRINTF_INT64_HEX_WIDTH
 *       PRINTF_INT32_HEX_WIDTH
 *       PRINTF_INT16_HEX_WIDTH
 *       PRINTF_INT8_HEX_WIDTH
 *       PRINTF_INTMAX_DEC_WIDTH
 *       PRINTF_INT64_DEC_WIDTH
 *       PRINTF_INT32_DEC_WIDTH
 *       PRINTF_INT16_DEC_WIDTH
 *       PRINTF_UINT8_DEC_WIDTH
 *       PRINTF_UINTMAX_DEC_WIDTH
 *       PRINTF_UINT64_DEC_WIDTH
 *       PRINTF_UINT32_DEC_WIDTH
 *       PRINTF_UINT16_DEC_WIDTH
 *       PRINTF_UINT8_DEC_WIDTH
 *
 *       Which specifies the maximum number of characters required to
 *       print the number of that type in either hexadecimal or decimal.
 *       These are an extension beyond what C99 specifies must be in
 *       stdint.h.
 *
 *  Compilers tested (all with 0 warnings at their highest respective
 *  settings): Borland Turbo C 2.0, WATCOM C/C++ 11.0 (16 bits and 32
 *  bits), Microsoft Visual C++ 6.0 (32 bit), Microsoft Visual Studio
 *  .net (VC7), Intel C++ 4.0, GNU gcc v3.3.3
 *
 *  This file should be considered a work in progress.  Suggestions for
 *  improvements, especially those which increase coverage are strongly
 *  encouraged.
 *
 *  Acknowledgements
 *
 *  The following people have made significant contributions to the
 *  development and testing of this file:
 *
 *  Chris Howie
 *  John Steele Scott
 *  Dave Thorup
 *  John Dill
 *  Florian Wobbe
 *  Christopher Sean Morrison
 *  Mikkel Fahnoe Jorgensen
 *
 */

#include <stddef.h>
#include <limits.h>
#include <signal.h>

/*
 *  For gcc with _STDINT_H, fill in the PRINTF_INT*_MODIFIER macros, and
 *  do nothing else.  On the Mac OS X version of gcc this is _STDINT_H_.
 */

#if ((defined(__SUNPRO_C) && __SUNPRO_C >= 0x570) || (defined(_MSC_VER) && _MSC_VER >= 1600) || (defined(__STDC__) && __STDC__ && defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined (__WATCOMC__) && (defined (_STDINT_H_INCLUDED) || __WATCOMC__ >= 1250)) || (defined(__GNUC__) && (__GNUC__ > 3 || defined(_STDINT_H) || defined(_STDINT_H_) || defined (__UINT_FAST64_TYPE__)) )) && !defined (_PSTDINT_H_INCLUDED)
#include <stdint.h>
#define _PSTDINT_H_INCLUDED
# if defined(__GNUC__) && (defined(__x86_64__) || defined(__ppc64__)) && !(defined(__APPLE__) && defined(__MACH__))
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "l"
#  endif
#  ifndef PRINTF_INT32_MODIFIER
#   define PRINTF_INT32_MODIFIER ""
#  endif
# else
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
#  ifndef PRINTF_INT32_MODIFIER
#   if (UINT_MAX == UINT32_MAX)
#    define PRINTF_INT32_MODIFIER ""
#   else
#    define PRINTF_INT32_MODIFIER "l"
#   endif
#  endif
# endif
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
# ifndef PRINTF_INTMAX_MODIFIER
#  define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INT64_HEX_WIDTH
#  define PRINTF_INT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_UINT64_HEX_WIDTH
#  define PRINTF_UINT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_INT32_HEX_WIDTH
#  define PRINTF_INT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_UINT32_HEX_WIDTH
#  define PRINTF_UINT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_INT16_HEX_WIDTH
#  define PRINTF_INT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_UINT16_HEX_WIDTH
#  define PRINTF_UINT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_INT8_HEX_WIDTH
#  define PRINTF_INT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_UINT8_HEX_WIDTH
#  define PRINTF_UINT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_INT64_DEC_WIDTH
#  define PRINTF_INT64_DEC_WIDTH "19"
# endif
# ifndef PRINTF_UINT64_DEC_WIDTH
#  define PRINTF_UINT64_DEC_WIDTH "20"
# endif
# ifndef PRINTF_INT32_DEC_WIDTH
#  define PRINTF_INT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_UINT32_DEC_WIDTH
#  define PRINTF_UINT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_INT16_DEC_WIDTH
#  define PRINTF_INT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_UINT16_DEC_WIDTH
#  define PRINTF_UINT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_INT8_DEC_WIDTH
#  define PRINTF_INT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_UINT8_DEC_WIDTH
#  define PRINTF_UINT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_UINTMAX_HEX_WIDTH
#  define PRINTF_UINTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif
# ifndef PRINTF_UINTMAX_DEC_WIDTH
#  define PRINTF_UINTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif

/*
 *  Something really weird is going on with Open Watcom.  Just pull some of
 *  these duplicated definitions from Open Watcom's stdint.h file for now.
 */

# if defined (__WATCOMC__) && __WATCOMC__ >= 1250
#  if !defined (INT64_C)
#   define INT64_C(x)   (x + (INT64_MAX - INT64_MAX))
#  endif
#  if !defined (UINT64_C)
#   define UINT64_C(x)  (x + (UINT64_MAX - UINT64_MAX))
#  endif
#  if !defined (INT32_C)
#   define INT32_C(x)   (x + (INT32_MAX - INT32_MAX))
#  endif
#  if !defined (UINT32_C)
#   define UINT32_C(x)  (x + (UINT32_MAX - UINT32_MAX))
#  endif
#  if !defined (INT16_C)
#   define INT16_C(x)   (x)
#  endif
#  if !defined (UINT16_C)
#   define UINT16_C(x)  (x)
#  endif
#  if !defined (INT8_C)
#   define INT8_C(x)   (x)
#  endif
#  if !defined (UINT8_C)
#   define UINT8_C(x)  (x)
#  endif
#  if !defined (UINT64_MAX)
#   define UINT64_MAX  18446744073709551615ULL
#  endif
#  if !defined (INT64_MAX)
#   define INT64_MAX  9223372036854775807LL
#  endif
#  if !defined (UINT32_MAX)
#   define UINT32_MAX  4294967295UL
#  endif
#  if !defined (INT32_MAX)
#   define INT32_MAX  2147483647L
#  endif
#  if !defined (INTMAX_MAX)
#   define INTMAX_MAX INT64_MAX
#  endif
#  if !defined (INTMAX_MIN)
#   define INTMAX_MIN INT64_MIN
#  endif
# endif
#endif

/*
 *  I have no idea what is the truly correct thing to do on older Solaris.
 *  From some online discussions, this seems to be what is being
 *  recommended.  For people who actually are developing on older Solaris,
 *  what I would like to know is, does this define all of the relevant
 *  macros of a complete stdint.h?  Remember, in pstdint.h 64 bit is
 *  considered optional.
 */

#if (defined(__SUNPRO_C) && __SUNPRO_C >= 0x420) && !defined(_PSTDINT_H_INCLUDED)
#include <sys/inttypes.h>
#define _PSTDINT_H_INCLUDED
#endif

#ifndef _PSTDINT_H_INCLUDED
#define _PSTDINT_H_INCLUDED

#ifndef SIZE_MAX
# define SIZE_MAX ((size_t)-1)
#endif

/*
 *  Deduce the type assignments from limits.h under the assumption that
 *  integer sizes in bits are powers of 2, and follow the ANSI
 *  definitions.
 */

#ifndef UINT8_MAX
# define UINT8_MAX 0xff
#endif
#if !defined(uint8_t) && !defined(_UINT8_T) && !defined(vxWorks)
# if (UCHAR_MAX == UINT8_MAX) || defined (S_SPLINT_S)
    typedef unsigned char uint8_t;
#   define UINT8_C(v) ((uint8_t) v)
# else
#   error "Platform not supported"
# endif
#endif

#ifndef INT8_MAX
# define INT8_MAX 0x7f
#endif
#ifndef INT8_MIN
# define INT8_MIN INT8_C(0x80)
#endif
#if !defined(int8_t) && !defined(_INT8_T) && !defined(vxWorks)
# if (SCHAR_MAX == INT8_MAX) || defined (S_SPLINT_S)
    typedef signed char int8_t;
#   define INT8_C(v) ((int8_t) v)
# else
#   error "Platform not supported"
# endif
#endif

#ifndef UINT16_MAX
# define UINT16_MAX 0xffff
#endif
#if !defined(uint16_t) && !defined(_UINT16_T) && !defined(vxWorks)
#if (UINT_MAX == UINT16_MAX) || defined (S_SPLINT_S)
  typedef unsigned int uint16_t;
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER ""
# endif
# define UINT16_C(v) ((uint16_t) (v))
#elif (USHRT_MAX == UINT16_MAX)
  typedef unsigned short uint16_t;
# define UINT16_C(v) ((uint16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef INT16_MAX
# define INT16_MAX 0x7fff
#endif
#ifndef INT16_MIN
# define INT16_MIN INT16_C(0x8000)
#endif
#if !defined(int16_t) && !defined(_INT16_T) && !defined(vxWorks)
#if (INT_MAX == INT16_MAX) || defined (S_SPLINT_S)
  typedef signed int int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER ""
# endif
#elif (SHRT_MAX == INT16_MAX)
  typedef signed short int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef UINT32_MAX
# define UINT32_MAX (0xffffffffUL)
#endif
#if !defined(uint32_t) && !defined(_UINT32_T) && !defined(vxWorks)
#if (ULONG_MAX == UINT32_MAX) || defined (S_SPLINT_S)
  typedef unsigned long uint32_t;
# define UINT32_C(v) v ## UL
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER "l"
# endif
#elif (UINT_MAX == UINT32_MAX)
  typedef unsigned int uint32_t;
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
# define UINT32_C(v) v ## U
#elif (USHRT_MAX == UINT32_MAX)
  typedef unsigned short uint32_t;
# define UINT32_C(v) ((unsigned short) (v))
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef INT32_MAX
# define INT32_MAX (0x7fffffffL)
#endif
#ifndef INT32_MIN
# define INT32_MIN INT32_C(0x80000000)
#endif
#if !defined(int32_t) && !defined(_INT32_T) && !defined(vxWorks)
#if (LONG_MAX == INT32_MAX) || defined (S_SPLINT_S)
  typedef signed long int32_t;
# define INT32_C(v) v ## L
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER "l"
# endif
#elif (INT_MAX == INT32_MAX)
  typedef signed int int32_t;
# define INT32_C(v) v
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#elif (SHRT_MAX == INT32_MAX)
  typedef signed short int32_t;
# define INT32_C(v) ((short) (v))
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif

/*
 *  The macro stdint_int64_defined is temporarily used to record
 *  whether or not 64 integer support is available.  It must be
 *  defined for any 64 integer extensions for new platforms that are
 *  added.
 */

#undef stdint_int64_defined
#if (defined(__STDC__) && defined(__STDC_VERSION__)) || defined (S_SPLINT_S)
# if (__STDC__ && __STDC_VERSION__ >= 199901L) || defined (S_SPLINT_S)
#  define stdint_int64_defined
   typedef long long int64_t;
   typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# endif
#endif

#if !defined (stdint_int64_defined)
# if defined(__GNUC__) && !defined(vxWorks)
#  define stdint_int64_defined
   __extension__ typedef long long int64_t;
   __extension__ typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# elif defined(__MWERKS__) || defined (__SUNPRO_C) || defined (__SUNPRO_CC) || defined (__APPLE_CC__) || defined (_LONG_LONG) || defined (_CRAYC) || defined (S_SPLINT_S)
#  define stdint_int64_defined
   typedef long long int64_t;
   typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# elif (defined(__WATCOMC__) && defined(__WATCOM_INT64__)) || (defined(_MSC_VER) && _INTEGRAL_MAX_BITS >= 64) || (defined (__BORLANDC__) && __BORLANDC__ > 0x460) || defined (__alpha) || defined (__DECC)
#  define stdint_int64_defined
   typedef __int64 int64_t;
   typedef unsigned __int64 uint64_t;
#  define UINT64_C(v) v ## UI64
#  define  INT64_C(v) v ## I64
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "I64"
#  endif
# endif
#endif

#if !defined (LONG_LONG_MAX) && defined (INT64_C)
# define LONG_LONG_MAX INT64_C (9223372036854775807)
#endif
#ifndef ULONG_LONG_MAX
# define ULONG_LONG_MAX UINT64_C (18446744073709551615)
#endif

#if !defined (INT64_MAX) && defined (INT64_C)
# define INT64_MAX INT64_C (9223372036854775807)
#endif
#if !defined (INT64_MIN) && defined (INT64_C)
# define INT64_MIN INT64_C (-9223372036854775808)
#endif
#if !defined (UINT64_MAX) && defined (INT64_C)
# define UINT64_MAX UINT64_C (18446744073709551615)
#endif

/*
 *  Width of hexadecimal for number field.
 */

#ifndef PRINTF_INT64_HEX_WIDTH
# define PRINTF_INT64_HEX_WIDTH "16"
#endif
#ifndef PRINTF_INT32_HEX_WIDTH
# define PRINTF_INT32_HEX_WIDTH "8"
#endif
#ifndef PRINTF_INT16_HEX_WIDTH
# define PRINTF_INT16_HEX_WIDTH "4"
#endif
#ifndef PRINTF_INT8_HEX_WIDTH
# define PRINTF_INT8_HEX_WIDTH "2"
#endif
#ifndef PRINTF_INT64_DEC_WIDTH
# define PRINTF_INT64_DEC_WIDTH "19"
#endif
#ifndef PRINTF_INT32_DEC_WIDTH
# define PRINTF_INT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_INT16_DEC_WIDTH
# define PRINTF_INT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_INT8_DEC_WIDTH
# define PRINTF_INT8_DEC_WIDTH "3"
#endif
#ifndef PRINTF_UINT64_DEC_WIDTH
# define PRINTF_UINT64_DEC_WIDTH "20"
#endif
#ifndef PRINTF_UINT32_DEC_WIDTH
# define PRINTF_UINT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_UINT16_DEC_WIDTH
# define PRINTF_UINT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_UINT8_DEC_WIDTH
# define PRINTF_UINT8_DEC_WIDTH "3"
#endif

/*
 *  Ok, lets not worry about 128 bit integers for now.  Moore's law says
 *  we don't need to worry about that until about 2040 at which point
 *  we'll have bigger things to worry about.
 */

#ifdef stdint_int64_defined
  typedef int64_t intmax_t;
  typedef uint64_t uintmax_t;
# define  INTMAX_MAX   INT64_MAX
# define  INTMAX_MIN   INT64_MIN
# define UINTMAX_MAX  UINT64_MAX
# define UINTMAX_C(v) UINT64_C(v)
# define  INTMAX_C(v)  INT64_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
#   define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT64_DEC_WIDTH
# endif
#else
  typedef int32_t intmax_t;
  typedef uint32_t uintmax_t;
# define  INTMAX_MAX   INT32_MAX
# define UINTMAX_MAX  UINT32_MAX
# define UINTMAX_C(v) UINT32_C(v)
# define  INTMAX_C(v)  INT32_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
#   define PRINTF_INTMAX_MODIFIER PRINTF_INT32_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT32_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT32_DEC_WIDTH
# endif
#endif

/*
 *  Because this file currently only supports platforms which have
 *  precise powers of 2 as bit sizes for the default integers, the
 *  least definitions are all trivial.  Its possible that a future
 *  version of this file could have different definitions.
 */

#ifndef stdint_least_defined
  typedef   int8_t   int_least8_t;
  typedef  uint8_t  uint_least8_t;
  typedef  int16_t  int_least16_t;
  typedef uint16_t uint_least16_t;
  typedef  int32_t  int_least32_t;
  typedef uint32_t uint_least32_t;
# define PRINTF_LEAST32_MODIFIER PRINTF_INT32_MODIFIER
# define PRINTF_LEAST16_MODIFIER PRINTF_INT16_MODIFIER
# define  UINT_LEAST8_MAX  UINT8_MAX
# define   INT_LEAST8_MAX   INT8_MAX
# define UINT_LEAST16_MAX UINT16_MAX
# define  INT_LEAST16_MAX  INT16_MAX
# define UINT_LEAST32_MAX UINT32_MAX
# define  INT_LEAST32_MAX  INT32_MAX
# define   INT_LEAST8_MIN   INT8_MIN
# define  INT_LEAST16_MIN  INT16_MIN
# define  INT_LEAST32_MIN  INT32_MIN
# ifdef stdint_int64_defined
    typedef  int64_t  int_least64_t;
    typedef uint64_t uint_least64_t;
#   define PRINTF_LEAST64_MODIFIER PRINTF_INT64_MODIFIER
#   define UINT_LEAST64_MAX UINT64_MAX
#   define  INT_LEAST64_MAX  INT64_MAX
#   define  INT_LEAST64_MIN  INT64_MIN
# endif
#endif
#undef stdint_least_defined

/*
 *  The ANSI C committee has defined *int*_fast*_t types as well.  This,
 *  of course, defies rationality -- you can't know what will be fast
 *  just from the type itself.  Even for a given architecture, compatible
 *  implementations might have different performance characteristics.
 *  Developers are warned to stay away from these types when using this
 *  or any other stdint.h.
 */

typedef   int_least8_t   int_fast8_t;
typedef  uint_least8_t  uint_fast8_t;
typedef  int_least16_t  int_fast16_t;
typedef uint_least16_t uint_fast16_t;
typedef  int_least32_t  int_fast32_t;
typedef uint_least32_t uint_fast32_t;
#define  UINT_FAST8_MAX  UINT_LEAST8_MAX
#define   INT_FAST8_MAX   INT_LEAST8_MAX
#define UINT_FAST16_MAX UINT_LEAST16_MAX
#define  INT_FAST16_MAX  INT_LEAST16_MAX
#define UINT_FAST32_MAX UINT_LEAST32_MAX
#define  INT_FAST32_MAX  INT_LEAST32_MAX
#define   INT_FAST8_MIN   INT_LEAST8_MIN
#define  INT_FAST16_MIN  INT_LEAST16_MIN
#define  INT_FAST32_MIN  INT_LEAST32_MIN
#ifdef stdint_int64_defined
  typedef  int_least64_t  int_fast64_t;
  typedef uint_least64_t uint_fast64_t;
# define UINT_FAST64_MAX UINT_LEAST64_MAX
# define  INT_FAST64_MAX  INT_LEAST64_MAX
# define  INT_FAST64_MIN  INT_LEAST64_MIN
#endif

#undef stdint_int64_defined

/*
 *  Whatever piecemeal, per compiler thing we can do about the wchar_t
 *  type limits.
 */

#if defined(__WATCOMC__) || defined(_MSC_VER) || defined (__GNUC__) && !defined(vxWorks)
# include <wchar.h>
# ifndef WCHAR_MIN
#  define WCHAR_MIN 0
# endif
# ifndef WCHAR_MAX
#  define WCHAR_MAX ((wchar_t)-1)
# endif
#endif

/*
 *  Whatever piecemeal, per compiler/platform thing we can do about the
 *  (u)intptr_t types and limits.
 */

#if (defined (_MSC_VER) && defined (_UINTPTR_T_DEFINED)) || defined (_UINTPTR_T)
# define STDINT_H_UINTPTR_T_DEFINED
#endif

#ifndef STDINT_H_UINTPTR_T_DEFINED
# if defined (__alpha__) || defined (__ia64__) || defined (__x86_64__) || defined (_WIN64) || defined (__ppc64__)
#  define stdint_intptr_bits 64
# elif defined (__WATCOMC__) || defined (__TURBOC__)
#  if defined(__TINY__) || defined(__SMALL__) || defined(__MEDIUM__)
#    define stdint_intptr_bits 16
#  else
#    define stdint_intptr_bits 32
#  endif
# elif defined (__i386__) || defined (_WIN32) || defined (WIN32) || defined (__ppc64__)
#  define stdint_intptr_bits 32
# elif defined (__INTEL_COMPILER)
/* TODO -- what did Intel do about x86-64? */
# else
/* #error "This platform might not be supported yet" */
# endif

# ifdef stdint_intptr_bits
#  define stdint_intptr_glue3_i(a,b,c)  a##b##c
#  define stdint_intptr_glue3(a,b,c)    stdint_intptr_glue3_i(a,b,c)
#  ifndef PRINTF_INTPTR_MODIFIER
#    define PRINTF_INTPTR_MODIFIER      stdint_intptr_glue3(PRINTF_INT,stdint_intptr_bits,_MODIFIER)
#  endif
#  ifndef PTRDIFF_MAX
#    define PTRDIFF_MAX                 stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef PTRDIFF_MIN
#    define PTRDIFF_MIN                 stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
#  endif
#  ifndef UINTPTR_MAX
#    define UINTPTR_MAX                 stdint_intptr_glue3(UINT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef INTPTR_MAX
#    define INTPTR_MAX                  stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef INTPTR_MIN
#    define INTPTR_MIN                  stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
#  endif
#  ifndef INTPTR_C
#    define INTPTR_C(x)                 stdint_intptr_glue3(INT,stdint_intptr_bits,_C)(x)
#  endif
#  ifndef UINTPTR_C
#    define UINTPTR_C(x)                stdint_intptr_glue3(UINT,stdint_intptr_bits,_C)(x)
#  endif
  typedef stdint_intptr_glue3(uint,stdint_intptr_bits,_t) uintptr_t;
  typedef stdint_intptr_glue3( int,stdint_intptr_bits,_t)  intptr_t;
# else
/* TODO -- This following is likely wrong for some platforms, and does
   nothing for the definition of uintptr_t. */
  typedef ptrdiff_t intptr_t;
# endif
# define STDINT_H_UINTPTR_T_DEFINED
#endif

/*
 *  Assumes sig_atomic_t is signed and we have a 2s complement machine.
 */

#ifndef SIG_ATOMIC_MAX
# define SIG_ATOMIC_MAX ((((sig_atomic_t) 1) << (sizeof (sig_atomic_t)*CHAR_BIT-1)) - 1)
#endif

#endif

#if defined (__TEST_PSTDINT_FOR_CORRECTNESS)

/*
 *  Please compile with the maximum warning settings to make sure macros are
 *  not defined more than once.
 */

#include <stdlib.h>
#include <stdio.h>
#include <string.h>

#define glue3_aux(x,y,z) x ## y ## z
#define glue3(x,y,z) glue3_aux(x,y,z)

#define DECLU(bits) glue3(uint,bits,_t) glue3(u,bits,) = glue3(UINT,bits,_C) (0);
#define DECLI(bits) glue3(int,bits,_t) glue3(i,bits,) = glue3(INT,bits,_C) (0);

#define DECL(us,bits) glue3(DECL,us,) (bits)

#define TESTUMAX(bits) glue3(u,bits,) = ~glue3(u,bits,); if (glue3(UINT,bits,_MAX) != glue3(u,bits,)) printf ("Something wrong with UINT%d_MAX\n", bits)

#define REPORTERROR(msg) { err_n++; if (err_first <= 0) err_first = __LINE__; printf msg; }

#define X_SIZE_MAX ((size_t)-1)

int main () {
	int err_n = 0;
	int err_first = 0;
	DECL(I,8)
	DECL(U,8)
	DECL(I,16)
	DECL(U,16)
	DECL(I,32)
	DECL(U,32)
#ifdef INT64_MAX
	DECL(I,64)
	DECL(U,64)
#endif
	intmax_t imax = INTMAX_C(0);
	uintmax_t umax = UINTMAX_C(0);
	char str0[256], str1[256];

	sprintf (str0, "%" PRINTF_INT32_MODIFIER "d", INT32_C(2147483647));
	if (0 != strcmp (str0, "2147483647")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
	if (atoi(PRINTF_INT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_INT32_DEC_WIDTH : %s\n", PRINTF_INT32_DEC_WIDTH));
	sprintf (str0, "%" PRINTF_INT32_MODIFIER "u", UINT32_C(4294967295));
	if (0 != strcmp (str0, "4294967295")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
	if (atoi(PRINTF_UINT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_UINT32_DEC_WIDTH : %s\n", PRINTF_UINT32_DEC_WIDTH));
#ifdef INT64_MAX
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "d", INT64_C(9223372036854775807));
	if (0 != strcmp (str1, "9223372036854775807")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
	if (atoi(PRINTF_INT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_INT64_DEC_WIDTH : %s, %d\n", PRINTF_INT64_DEC_WIDTH, (int) strlen(str1)));
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "u", UINT64_C(18446744073709550591));
	if (0 != strcmp (str1, "18446744073709550591")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
	if (atoi(PRINTF_UINT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_UINT64_DEC_WIDTH : %s, %d\n", PRINTF_UINT64_DEC_WIDTH, (int) strlen(str1)));
#endif

	sprintf (str0, "%d %x\n", 0, ~0);

	sprintf (str1, "%d %x\n",  i8, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i8 : %s\n", str1));
	sprintf (str1, "%u %x\n",  u8, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u8 : %s\n", str1));
	sprintf (str1, "%d %x\n",  i16, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i16 : %s\n", str1));
	sprintf (str1, "%u %x\n",  u16, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u16 : %s\n", str1));
	sprintf (str1, "%" PRINTF_INT32_MODIFIER "d %x\n",  i32, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i32 : %s\n", str1));
	sprintf (str1, "%" PRINTF_INT32_MODIFIER "u %x\n",  u32, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u32 : %s\n", str1));
#ifdef INT64_MAX
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "d %x\n",  i64, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i64 : %s\n", str1));
#endif
	sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "d %x\n",  imax, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with imax : %s\n", str1));
	sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "u %x\n",  umax, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with umax : %s\n", str1));

	TESTUMAX(8);
	TESTUMAX(16);
	TESTUMAX(32);
#ifdef INT64_MAX
	TESTUMAX(64);
#endif

#define STR(v) #v
#define Q(v) printf ("sizeof " STR(v) " = %u\n", (unsigned) sizeof (v));
	if (err_n) {
		printf ("pstdint.h is not correct.  Please use sizes below to correct it:\n");
	}

	Q(int)
	Q(unsigned)
	Q(long int)
	Q(short int)
	Q(int8_t)
	Q(int16_t)
	Q(int32_t)
#ifdef INT64_MAX
	Q(int64_t)
#endif

#if UINT_MAX < X_SIZE_MAX
	printf ("UINT_MAX < X_SIZE_MAX\n");
#else
	printf ("UINT_MAX >= X_SIZE_MAX\n");
#endif
	printf ("%" PRINTF_INT64_MODIFIER "u vs %" PRINTF_INT64_MODIFIER "u\n", UINT_MAX, X_SIZE_MAX);

	return EXIT_SUCCESS;
}

#endif

/*
 * stdlib.h --
 *
 *	Declares facilities exported by the "stdlib" portion of the C library.
 *	This file isn't complete in the ANSI-C sense; it only declares things
 *	that are needed by Tcl. This file is needed even on many systems with
 *	their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
 *	all the procedures needed here (such as strtol/strtoul).
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _STDLIB
#define _STDLIB

extern void		abort(void);
extern double		atof(const char *string);
extern int		atoi(const char *string);
extern long		atol(const char *string);
extern void *		calloc(unsigned long numElements, unsigned long size);
extern void		exit(int status);
extern void		free(void *blockPtr);
extern char *		getenv(const char *name);
extern void *		malloc(unsigned long numBytes);
extern void		qsort(void *base, unsigned long n, unsigned long size, int (*compar)(
			    const void *element1, const void *element2));
extern void *		realloc(void *ptr, unsigned long numBytes);
extern char *		realpath(const char *path, char *resolved_path);
extern int		mkstemps(char *templ, int suffixlen);
extern int		mkstemp(char *templ);
extern char *		mkdtemp(char *templ);
extern long		strtol(const char *string, char **endPtr, int base);
extern unsigned long	strtoul(const char *string, char **endPtr, int base);

#endif /* _STDLIB */

/*
 * strstr.c --
 *
 *	Source code for the "strstr" library routine.
 *
 * Copyright (c) 1988-1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tcl.h"
#ifndef NULL
#define NULL 0
#endif

/*
 *----------------------------------------------------------------------
 *
 * strstr --
 *
 *	Locate the first instance of a substring in a string.
 *
 * Results:
 *	If string contains substring, the return value is the location of the
 *	first matching instance of substring in string. If string doesn't
 *	contain substring, the return value is 0. Matching is done on an exact
 *	character-for-character basis with no wildcards or special characters.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
strstr(
    const char *string,		/* String to search. */
    const char *substring)		/* Substring to try to find in string. */
{
    const char *a, *b;

    /*
     * First scan quickly through the two strings looking for a
     * single-character match. When it's found, then compare the rest of the
     * substring.
     */

    b = substring;
    if (*b == 0) {
	return (char *)string;
    }
    for ( ; *string != 0; string += 1) {
	if (*string != *b) {
	    continue;
	}
	a = string;
	while (1) {
	    if (*b == 0) {
		return (char *)string;
	    }
	    if (*a++ != *b++) {
		break;
	    }
	}
	b = substring;
    }
    return NULL;
}

/*
 * strtol.c --
 *
 *	Source code for the "strtol" library procedure.
 *
 * Copyright (c) 1988 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 *----------------------------------------------------------------------
 *
 * strtol --
 *
 *	Convert an ASCII string into an integer.
 *
 * Results:
 *	The return value is the integer equivalent of string. If endPtr is
 *	non-NULL, then *endPtr is filled in with the character after the last
 *	one that was part of the integer. If string doesn't contain a valid
 *	integer value, then zero is returned and *endPtr is set to string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

long int
strtol(
    const char *string,		/* String of ASCII digits, possibly preceded
				 * by white space. For bases greater than 10,
				 * either lower- or upper-case digits may be
				 * used. */
    char **endPtr,		/* Where to store address of terminating
				 * character, or NULL. */
    int base)			/* Base for conversion. Must be less than 37.
				 * If 0, then the base is chosen from the
				 * leading characters of string: "0x" means
				 * hex, "0" means octal, anything else means
				 * decimal. */
{
    const char *p;
    long result;

    /*
     * Skip any leading blanks.
     */

    p = string;
    while (isspace(UCHAR(*p))) {
	p += 1;
    }

    /*
     * Check for a sign.
     */

    if (*p == '-') {
	p += 1;
	result = -(strtoul(p, endPtr, base));
    } else {
	if (*p == '+') {
	    p += 1;
	}
	result = strtoul(p, endPtr, base);
    }
    if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
	*endPtr = (char *) string;
    }
    return result;
}

/*
 * strtoul.c --
 *
 *	Source code for the "strtoul" library procedure.
 *
 * Copyright (c) 1988 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * The table below is used to convert from ASCII digits to a numerical
 * equivalent. It maps from '0' through 'z' to integers (100 for non-digit
 * characters).
 */

static const char cvtIn[] = {
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,		/* '0' - '9' */
    100, 100, 100, 100, 100, 100, 100,		/* punctuation */
    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'A' - 'Z' */
    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
    30, 31, 32, 33, 34, 35,
    100, 100, 100, 100, 100, 100,		/* punctuation */
    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'a' - 'z' */
    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
    30, 31, 32, 33, 34, 35};

/*
 *----------------------------------------------------------------------
 *
 * strtoul --
 *
 *	Convert an ASCII string into an integer.
 *
 * Results:
 *	The return value is the integer equivalent of string. If endPtr is
 *	non-NULL, then *endPtr is filled in with the character after the last
 *	one that was part of the integer. If string doesn't contain a valid
 *	integer value, then zero is returned and *endPtr is set to string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned long int
strtoul(
    const char *string,		/* String of ASCII digits, possibly preceded
				 * by white space. For bases greater than 10,
				 * either lower- or upper-case digits may be
				 * used. */
    char **endPtr,		/* Where to store address of terminating
				 * character, or NULL. */
    int base)			/* Base for conversion.  Must be less than 37.
				 * If 0, then the base is chosen from the
				 * leading characters of string: "0x" means
				 * hex, "0" means octal, anything else means
				 * decimal. */
{
    const char *p;
    unsigned long int result = 0;
    unsigned digit;
    int anyDigits = 0;
    int negative=0;
    int overflow=0;

    /*
     * Skip any leading blanks.
     */

    p = string;
    while (isspace(UCHAR(*p))) {
	p += 1;
    }
    if (*p == '-') {
        negative = 1;
        p += 1;
    } else {
        if (*p == '+') {
            p += 1;
        }
    }

    /*
     * If no base was provided, pick one from the leading characters of the
     * string.
     */

    if (base == 0) {
	if (*p == '0') {
	    p += 1;
	    if ((*p == 'x') || (*p == 'X')) {
		p += 1;
		base = 16;
	    } else {
		/*
		 * Must set anyDigits here, otherwise "0" produces a "no
		 * digits" error.
		 */

		anyDigits = 1;
		base = 8;
	    }
	} else {
	    base = 10;
	}
    } else if (base == 16) {
	/*
	 * Skip a leading "0x" from hex numbers.
	 */

	if ((p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
	    p += 2;
	}
    }

    /*
     * Sorry this code is so messy, but speed seems important. Do different
     * things for base 8, 10, 16, and other.
     */

    if (base == 8) {
	unsigned long maxres = ULONG_MAX >> 3;

	for ( ; ; p += 1) {
	    digit = *p - '0';
	    if (digit > 7) {
		break;
	    }
	    if (result > maxres) { overflow = 1; }
	    result = (result << 3);
	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
	    result += digit;
	    anyDigits = 1;
	}
    } else if (base == 10) {
	unsigned long maxres = ULONG_MAX / 10;

	for ( ; ; p += 1) {
	    digit = *p - '0';
	    if (digit > 9) {
		break;
	    }
	    if (result > maxres) { overflow = 1; }
	    result *= 10;
	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
	    result += digit;
	    anyDigits = 1;
	}
    } else if (base == 16) {
	unsigned long maxres = ULONG_MAX >> 4;

	for ( ; ; p += 1) {
	    digit = *p - '0';
	    if (digit > ('z' - '0')) {
		break;
	    }
	    digit = cvtIn[digit];
	    if (digit > 15) {
		break;
	    }
	    if (result > maxres) { overflow = 1; }
	    result = (result << 4);
	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
	    result += digit;
	    anyDigits = 1;
	}
    } else if (base >= 2 && base <= 36) {
	unsigned long maxres = ULONG_MAX / base;

	for ( ; ; p += 1) {
	    digit = *p - '0';
	    if (digit > ('z' - '0')) {
		break;
	    }
	    digit = cvtIn[digit];
	    if (digit >= ( (unsigned) base )) {
		break;
	    }
	    if (result > maxres) { overflow = 1; }
	    result *= base;
	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
	    result += digit;
	    anyDigits = 1;
	}
    }

    /*
     * See if there were any digits at all.
     */

    if (!anyDigits) {
	p = string;
    }

    if (endPtr != 0) {
	/* unsafe, but required by the strtoul prototype */
	*endPtr = (char *) p;
    }

    if (overflow) {
	errno = ERANGE;
	return ULONG_MAX;
    }
    if (negative) {
	return -result;
    }
    return result;
}

\fBchan eof \fIchannelName\fR
.
Returns 1 if the last read on the channel failed because the end of the data
was already reached, and 0 otherwise.
.TP
\fBchan event \fIchannelName event\fR ?\fIscript\fR?
.
Arranges for the given script, called a \fBchannel event hndler\fR, to be
called whenever the given event, one of
.QW \fBreadable\fR
or
.QW \fBwritable\fR
occurs on the given channel, replacing any script that was previously set.  If
\fIscript\fR is the empty string the current handler is deleted.  It is also
deleted when the channel is closed.  If \fIscript\fR is omitted, either the

.PP
For example, to print the contents of the \fBtcl_platform\fR array, do:
.PP
.CS
\fBparray\fR tcl_platform
.CE
.RE



.TP
\fBtcl_endOfWord \fIstr start\fR
.
Returns the index of the first end-of-word location that occurs after
a starting index \fIstart\fR in the string \fIstr\fR.  An end-of-word
location is defined to be the first non-word character following the
first word character after the starting point.  Returns -1 if there

.PP
.CS
\fIcommandPrefix name1 name2 op\fR
.CE
.PP
\fIName1\fR gives the name for the variable being accessed.
This is not necessarily the same as the name used in the
\fBtrace variable\fR command:  the \fBupvar\fR command allows a
procedure to reference a variable under a different name.
If the trace was originally set on an array or array element,
\fIname2\fR provides which index into the array was affected.
This information is present even when \fIname1\fR refers to a
scalar, which may happen if the \fBupvar\fR command was used to
create a reference to a single array element.
If an entire array is being deleted and the trace was registered

    puts $name
}
proc \fIsetByUpvar\fR { name value } {
    \fBupvar\fR $name localVar
    set localVar $value
}
set originalVar 1
trace variable originalVar w \fItraceproc\fR
\fIsetByUpvar\fR originalVar 2
.CE
.PP
If \fIotherVar\fR refers to an element of an array, then the element
name is passed as the second argument to the trace procedure. This
may be important information in case of traces set on an entire array.
.SH EXAMPLE

typedef struct Tcl_ChannelType {
    const char *typeName;	/* The name of the channel type in Tcl
				 * commands. This storage is owned by channel
				 * type. */
    Tcl_ChannelTypeVersion version;
				/* Version of the channel type. */
    void *closeProc;
				/* Not used any more. */
    Tcl_DriverInputProc *inputProc;
				/* Function to call for input on channel. */
    Tcl_DriverOutputProc *outputProc;
				/* Function to call for output on channel. */
    void *seekProc;
				/* Not used any more. */
    Tcl_DriverSetOptionProc *setOptionProc;
				/* Set an option on a channel. */
    Tcl_DriverGetOptionProc *getOptionProc;
				/* Get an option from a channel. */
    Tcl_DriverWatchProc *watchProc;
				/* Set up the notifier to watch for events on
				 * this channel. */

    baPtr = GET_BYTEARRAY(irPtr);

    if (numBytesPtr != NULL) {
	*numBytesPtr = baPtr->used;
    }
    return baPtr->bytes;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetByteArrayLength --
 *
 *	This procedure changes the length of the byte array for this object.

    unsigned char *dst = byteArrayPtr->bytes;
    unsigned char *dstEnd = dst + numBytes;
    const char *srcEnd = src + length;
    int proper = 1;

    for (; src < srcEnd && dst < dstEnd; ) {
	int ch;
	int count = Tcl_UtfToUniChar(src, &ch);

	if (ch > 255) {
	    proper = 0;
	    if (demandProper) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "expected byte sequence but character %"

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

int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
    size_t before,
    size_t after,
    int *indexPtr)
{
    Tcl_Obj *tmpObj;
    int result = TCL_ERROR;

    TclNewObj(tmpObj);
    if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {

				 * compiled. Commands and their compile procs
				 * are specific to an interpreter so the code
				 * emitted will depend on the interpreter. */
    const char *source;		/* The source string being compiled by
				 * SetByteCodeFromAny. This pointer is not
				 * owned by the CompileEnv and must not be
				 * freed or changed by it. */
    Tcl_Size numSrcBytes;		/* Number of bytes in source. */
    Proc *procPtr;		/* If a procedure is being compiled, a pointer
				 * to its Proc structure; otherwise NULL. Used
				 * to compile local variables. Set from
				 * information provided by ObjInterpProc in
				 * tclProc.c. */
    Tcl_Size numCommands;		/* Number of commands compiled. */
    Tcl_Size exceptDepth;		/* Current exception range nesting level; TCL_INDEX_NONE

				 * if not in any range currently. */
    Tcl_Size maxExceptDepth;		/* Max nesting level of exception ranges; TCL_INDEX_NONE
				 * if no ranges have been compiled. */

    Tcl_Size maxStackDepth;		/* Maximum number of stack elements needed to
				 * execute the code. Set by compilation
				 * procedures before returning. */
    Tcl_Size currStackDepth;		/* Current stack depth. */
    LiteralTable localLitTable;	/* Contains LiteralEntry's describing all Tcl
				 * objects referenced by this compiled code.
				 * Indexed by the string representations of
				 * the literals. Used to avoid creating
				 * duplicate objects. */
    unsigned char *codeStart;	/* Points to the first byte of the code. */
    unsigned char *codeNext;	/* Points to next code array byte to use. */

    ExceptionRange *exceptArrayPtr;
    				/* Points to start of the ExceptionRange
				 * array. */
    Tcl_Size exceptArrayNext;	/* Next free ExceptionRange array index.
				 * exceptArrayNext is the number of ranges and
				 * (exceptArrayNext-1) is the index of the
				 * current range's array entry. */
    Tcl_Size exceptArrayEnd;		/* Index after the last ExceptionRange array
				 * entry. */
    ExceptionAux *exceptAuxArrayPtr;
				/* Array of information used to restore the
				 * state when processing BREAK/CONTINUE
				 * exceptions. Must be the same size as the
				 * exceptArrayPtr. */
    CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.

    CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
				/* Initial storage for cmd location map. */
    AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
				/* Initial storage for aux data array. */
    /* TIP #280 */
    ExtCmdLoc *extCmdMapPtr;	/* Extended command location information for
				 * 'info frame'. */
    Tcl_Size line;			/* First line of the script, based on the
				 * invoking context, then the line of the
				 * command currently compiled. */
    int atCmdStart;		/* Flag to say whether an INST_START_CMD
				 * should be issued; they should never be
				 * issued repeatedly, as that is significantly
				 * inefficient. If set to 2, that instruction
				 * should not be issued at all (by the generic
				 * part of the command compiler). */
    Tcl_Size expandCount;		/* Number of INST_EXPAND_START instructions
				 * encountered that have not yet been paired
				 * with a corresponding
				 * INST_INVOKE_EXPANDED. */
    int *clNext;		/* If not NULL, it refers to the next slot in
				 * clLoc to check for an invisible
				 * continuation line. */
} CompileEnv;

			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    size_t numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);

			    Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
			    Tcl_Interp *interp, Tcl_Size objc,
			    Tcl_Obj *const objv[], int isLambda);


/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

DisassembleByteCodeObj(
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    ByteCode *codePtr;
    unsigned char *codeStart, *codeLimit, *pc;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;

    Interp *iPtr;
    Tcl_Obj *bufferObj, *fileObj;

    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);

    iPtr = (Interp *) *codePtr->interpHandle;

    numCmds = codePtr->numCommands;

    /*
     * Print header lines describing the ByteCode.
     */

    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n",
	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", -1);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
    if (line >= 0 && fileObj != NULL) {
	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
		TclGetString(fileObj), line);
    }
    Tcl_AppendPrintfToObj(bufferObj,
	    "\n  Cmds %d, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n",
	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
	    codePtr->numLitObjects, codePtr->numAuxDataItems,
	    codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    Tcl_AppendPrintfToObj(bufferObj,
	    "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %"
	    TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
	    codePtr->structureSize,
	    offsetof(ByteCode, localCachePtr),
	    codePtr->numCodeBytes,
	    codePtr->numLitObjects * sizeof(Tcl_Obj *),
	    codePtr->numExceptRanges*sizeof(ExceptionRange),
	    codePtr->numAuxDataItems * sizeof(AuxData),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */

    /*
     * If the ByteCode is the compiled body of a Tcl procedure, print
     * information about that procedure. Note that we don't know the
     * procedure's name since ByteCode's can be shared among procedures.
     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	int numCompiledLocals = procPtr->numCompiledLocals;

	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc %p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		numCompiledLocals);
	if (numCompiledLocals > 0) {
	    CompiledLocal *localPtr = procPtr->firstLocalPtr;

	    for (i = 0;  i < numCompiledLocals;  i++) {
		Tcl_AppendPrintfToObj(bufferObj,
			"      slot %d%s%s%s%s%s%s", i,
			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
			(localPtr->flags & VAR_LINK) ? ", link" : "",
			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
			(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
			(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
		if (TclIsVarTemporary(localPtr)) {

    }

    /*
     * Print the ExceptionRange array.
     */

    if ((int)codePtr->numExceptRanges > 0) {
	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %" TCL_Z_MODIFIER "u, depth %" TCL_Z_MODIFIER "u:\n",
		codePtr->numExceptRanges, codePtr->maxExceptDepth);
	for (i = 0;  i < (int)codePtr->numExceptRanges;  i++) {
	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];

	    Tcl_AppendPrintfToObj(bufferObj,
		    "      %d: level %" TCL_Z_MODIFIER "u, %s, pc %" TCL_Z_MODIFIER "u-%" TCL_Z_MODIFIER "u, ",
		    i, rangePtr->nestingLevel,
		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
		    rangePtr->codeOffset,
		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
	    switch (rangePtr->type) {
	    case LOOP_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_Z_MODIFIER "u, break %" TCL_Z_MODIFIER "u\n",
			rangePtr->continueOffset, rangePtr->breakOffset);
		break;
	    case CATCH_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_Z_MODIFIER "u\n",
			rangePtr->catchOffset);
		break;
	    default:
		Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d",
			rangePtr->type);
	    }
	}

	    srcLen = TclGetInt4AtPtr(srcLengthNext);
	    srcLengthNext += 4;
	} else {
	    srcLen = TclGetInt1AtPtr(srcLengthNext);
	    srcLengthNext++;
	}

	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
		((i % 2)? "     " : "\n   "),
		(i+1), codeOffset, (codeOffset + codeLen - 1),
		srcOffset, (srcOffset + srcLen - 1));
    }
    if (numCmds > 0) {
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }

	 */

	while ((pc-codeStart) < codeOffset) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}

	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
		TclMin(srcLen, 55));
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }
    if (pc < codeLimit) {
	/*
	 * Print instructions after the last command.

{
    Proc *procPtr = codePtr->procPtr;
    unsigned char opCode = *pc;
    const InstructionDesc *instDesc = &tclInstructionTable[opCode];
    unsigned char *codeStart = codePtr->codeStart;
    unsigned pcOffset = pc - codeStart;
    int opnd = 0, i, j, numBytes = 1;
    int localCt = procPtr ? (int)procPtr->numCompiledLocals : 0;
    CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
    char suffixBuffer[128];	/* Additional info to print after main opcode
				 * and immediates. */
    char *suffixSrc = NULL;
    Tcl_Obj *suffixObj = NULL;
    AuxData *auxPtr = NULL;

	    goto printLVTindex;
	case OPERAND_LVT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	printLVTindex:
	    if (localPtr != NULL) {
		if (opnd >= localCt) {
		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
			    opnd, localCt);
		}
		for (j = 0;  j < opnd;  j++) {
		    localPtr = localPtr->nextPtr;
		}
		if (TclIsVarTemporary(localPtr)) {
		    snprintf(suffixBuffer, sizeof(suffixBuffer), "temp var %u", opnd);

DisassembleByteCodeAsDicts(
    Tcl_Obj *objPtr)		/* The bytecode-holding value to take apart */
{
    ByteCode *codePtr;
    Tcl_Obj *description, *literals, *variables, *instructions, *inst;
    Tcl_Obj *aux, *exn, *commands, *file;
    unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
    int codeOffset, codeLength, sourceOffset, sourceLength;
    int i, val, line;

    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);

    /*
     * Get the literals from the bytecode.
     */

    TclNewObj(literals);
    for (i=0 ; i<(int)codePtr->numLitObjects ; i++) {
	Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
    }

    /*
     * Get the variables from the bytecode.
     */

    TclNewObj(variables);
    if (codePtr->procPtr) {
	int localCount = codePtr->procPtr->numCompiledLocals;
	CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;

	for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
	    Tcl_Obj *descriptor[2];

	    TclNewObj(descriptor[0]);
	    if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) {

    TclNewObj(exn);
    for (i=0 ; i<(int)codePtr->numExceptRanges ; i++) {
	ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];

	switch (rangePtr->type) {
	case LOOP_EXCEPTION_RANGE:
	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
		    "type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u break %" TCL_Z_MODIFIER "u continue %" TCL_Z_MODIFIER "u",
		    "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
		    rangePtr->breakOffset, rangePtr->continueOffset));
	    break;
	case CATCH_EXCEPTION_RANGE:
	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
		    "type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u catch %" TCL_Z_MODIFIER "u",
		    "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
		    rangePtr->catchOffset));
	    break;
	}
    }

	    *dst++ = (ch & 0xFF);
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src += 4;
    }

    /*
     * If we had a truncated code unit at the end AND this is the last
     * fragment AND profile is not "strict", stick FFFD in its place.
     */
    if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {

	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	} else {

	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_SYNTAX;
	    } else {
		/* PROFILE_REPLACE or PROFILE_TCL8 */
		result = TCL_OK;
		dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
		numChars++;

{
    Tcl_MutexLock(&execMutex);
    execInitialized = 0;
    Tcl_MutexUnlock(&execMutex);
}

/*
 * Auxiliary code to insure that GrowEvaluationStack always returns correctly
 * aligned memory.
 *
 * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
 * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
 * multiple of the wordsize 'sizeof(Tcl_Obj *)'.
 */

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
    TclReleaseByteCode(codePtr);
    TclStackFree(interp, TD);	/* free my stack */

    return result;

    /*
     * INST_START_CMD failure case removed where it doesn't bother that much
     *
     * Remark that if the interpreter is marked for deletion its
     * compileEpoch is modified, so that the epoch check also verifies
     * that the interp is not deleted. If no outside call has been made
     * since the last check, it is safe to omit the check.

     * case INST_START_CMD:
     */

	instStartCmdFailed:

    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	unsigned limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (unsigned)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

	Tcl_Size length;
	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	const unsigned int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (unsigned int)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

    Tcl_DecrRefCount(objPtr);
    return result;
}


#include "tclPort.h"

#include <stdio.h>

#include <ctype.h>
#include <stdarg.h>
#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
#include <string.h>
#endif
#include <locale.h>

 */

typedef struct CompiledLocal {
    struct CompiledLocal *nextPtr;
				/* Next compiler-recognized local variable for
				 * this procedure, or NULL if this is the last
				 * local. */
    Tcl_Size nameLength;		/* The number of bytes in local variable's name.
				 * Among others used to speed up var lookups. */
    Tcl_Size frameIndex;		/* Index in the array of compiler-assigned
				 * variables in the procedure call frame. */
    Tcl_Obj *defValuePtr;	/* Pointer to the default value of an
				 * argument, if any. NULL if not an argument
				 * or, if an argument, no default value. */
    Tcl_ResolvedVarInfo *resolveInfo;
				/* Customized variable resolution info
				 * supplied by the Tcl_ResolveCompiledVarProc
				 * associated with a namespace. Each variable
				 * is marked by a unique tag during
				 * compilation, and that same tag is used to
				 * find the variable at runtime. */
    int flags;			/* Flag bits for the local variable. Same as
				 * the flags for the Var structure above,
				 * although only VAR_ARGUMENT, VAR_TEMPORARY,
				 * and VAR_RESOLVED make sense. */
    char name[TCLFLEXARRAY];		/* Name of the local variable starts here. If
				 * the name is NULL, this will just be '\0'.
				 * The actual size of this field will be large
				 * enough to hold the name. MUST BE THE LAST
				 * FIELD IN THE STRUCTURE! */
} CompiledLocal;

/*

    Tcl_Obj *returnOpts;	/* A dictionary holding the options to the
				 * last [return] command. */

    Tcl_Obj *errorInfo;		/* errorInfo value (now as a Tcl_Obj). */
    Tcl_Obj *eiVar;		/* cached ref to ::errorInfo variable. */
    Tcl_Obj *errorCode;		/* errorCode value (now as a Tcl_Obj). */
    Tcl_Obj *ecVar;		/* cached ref to ::errorInfo variable. */
    int returnLevel;		/* [return -level] parameter. */

    /*
     * Resource limiting framework support (TIP#143).
     */

    struct {

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);
MODULE_SCOPE int TclClose(Tcl_Interp *,	Tcl_Channel chan);

/*
 * TIP #508: [array default]
 */

MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);

MODULE_SCOPE int	TclIndexInvalidError(Tcl_Interp *interp,
			    const char *idxType, Tcl_Size idx);

/*
 * Error message utility functions
 */
MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count);


/* Constants used in index value encoding routines. */
#define TCL_INDEX_END           ((Tcl_Size)-2)
#define TCL_INDEX_START         ((Tcl_Size)0)

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

 *			    const Tcl_UniChar *ct, unsigned long n);
 *----------------------------------------------------------------
 */

#if defined(WORDS_BIGENDIAN)
#   define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
#endif /* WORDS_BIGENDIAN */

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to increment a namespace's export epoch
 * counter. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateNsCmdLookup(Namespace *nsPtr);
 *----------------------------------------------------------------

 *----------------------------------------------------------------
 * 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:
 *
 * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, w) \

#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    (ptr = (Tcl_Alloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  Tcl_Free(ptr)
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)

	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++; /* Why bother with this increment? TBD */
	    break;
	}
	indexArray++;




	if (index < 0 || index > elemCount
	    || (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		                 Tcl_ObjPrintf("index \"%s\" out of range",
		                               Tcl_GetString(indexArray[-1])));

"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t}\n"
"\t\tmethod -appendifnew -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\tset args [lmap a $args {\n"
"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
"\t\t\t\tif {$a in $current} continue\n"

"\t\t\t\tset a\n"
"\t\t\t}]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t}\n"
"\t\tmethod -clear -export {} {tailcall my Set {}}\n"
"\t\tmethod -prepend -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"

 *
 * Side effects:
 *	May call the object's updateStringProc to update the string
 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */


char *
Tcl_GetStringFromObj(
    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    Tcl_Size *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.

	(tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */
#define Tcl_WinConvertError \
	(tclPlatStubsPtr->tcl_WinConvertError) /* 3 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */


#ifdef MAC_OSX_TCL /* MACOSX */
#undef Tcl_MacOSXOpenBundleResources
#define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e)
#endif

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT











#ifdef _WIN32
#   undef Tcl_CreateFileHandler
#   undef Tcl_DeleteFileHandler
#   undef Tcl_GetOpenFile
#endif
#ifndef MAC_OSX_TCL

    if (result != TCL_OK) {
	goto procError;
    }

    if (precompiled) {
	if (numArgs > procPtr->numArgs) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "procedure \"%s\": arg list contains %" TCL_Z_MODIFIER "u entries, "
		    "precompiled header expects %" TCL_Z_MODIFIER "u", procName, numArgs,
		    procPtr->numArgs));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "BYTECODELIES", NULL);
	    goto procError;
	}
	localPtr = procPtr->firstLocalPtr;
    } else {

	    if ((localPtr->nameLength != nameLength)
		    || (memcmp(localPtr->name, argname, nameLength) != 0)
		    || (localPtr->frameIndex != i)
		    || !(localPtr->flags & VAR_ARGUMENT)
		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"procedure \"%s\": formal parameter %" TCL_Z_MODIFIER "u is "
			"inconsistent with precompiled body", procName, i));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"BYTECODELIES", NULL);
		goto procError;
	    }

	    /*

static int
ProcWrongNumArgs(
    Tcl_Interp *interp,
    int skip)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, i;
    Tcl_Obj **desiredObjs;
    const char *final = NULL;

    /*
     * Build up desired argument list for Tcl_WrongNumArgs
     */

    int skip)			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr;
    Var *varPtr, *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
    Tcl_Obj *const *argObjs;

    ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .

/*
 * tclTestObjInterfce.c --
 *
 *	This file contains C command functions for the additional Tcl commands
 *	that are used for testing implementations of the Tcl object types.
 *	These commands are not normally included in Tcl applications; they're
 *	only used for testing.
 *
 * Copyright © 2021 Nathan Coulter
 *

    ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
static Tcl_Obj* NewTestListInteger();
static void	DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);

static void	FreeTestListIntegerInternalRep(Tcl_Obj *objPtr);
static int	SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void	UpdateStringOfTestListInteger(Tcl_Obj *listPtr);




static int ListIntegerListStringIndex (tclObjTypeInterfaceArgsStringIndex);
static int ListIntegerListStringIndexEnd(tclObjTypeInterfaceArgsStringIndexEnd);
static Tcl_Size ListIntegerListStringLength(tclObjTypeInterfaceArgsStringLength);
/*
static int ListIntegerStringListIndexFromStringIndex(
    Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);

	&ListIntegerListStringIndex,
	&ListIntegerListStringIndexEnd,
	&ListIntegerListStringLength,
	&ListIntegerListStringRange,
	&ListIntegerListStringRangeEnd
    },
    {



	&ListIntegerListObjGetElements,


	&ListIntegerListObjAppendElement,
	&ListIntegerListObjAppendList,
	&ListIntegerListObjIndex,
	&ListIntegerListObjIndexEnd,
	&ListIntegerListObjIsSorted,
	&ListIntegerListObjLength,
	&ListIntegerListObjRange,

const Tcl_ObjType *testListIntegerTypePtr = (Tcl_ObjType *)&testListIntegerType;



int TcltestObjectInterfaceListIntegerInit(Tcl_Interp *interp) {
    Tcl_CreateObjCommand2(interp, "testlistinteger", TestListInteger, NULL, NULL);

    return TCL_OK;
}

int TestListInteger(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_Size argc,
    Tcl_Obj *const objv[])
{
    int status;
    if (argc != 2) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # arguments", -1));
	}
	return TCL_ERROR;
    }
    status = Tcl_ConvertToType(interp, objv[1], testListIntegerTypePtr);
    Tcl_SetObjResult(interp, objv[1]);
    return status;
}











Tcl_Obj*
NewTestListInteger() {
    Tcl_ObjInternalRep intrep;
    Tcl_Obj *listPtr = Tcl_NewObj();
    Tcl_InvalidateStringRep(listPtr);

	for (i = 0; i < length; i++) {
	    status = Tcl_ListObjIndex(interp, objPtr, i, &itemPtr);
	    if (status != TCL_OK) {
		Tcl_DecrRefCount(listPtr);
		return status;
	    }
	    status = ListIntegerListObjReplace(interp, listPtr, i, 0, 1, &itemPtr);

	    if (status != TCL_OK) {
		Tcl_DecrRefCount(listPtr);
		return status;
	    }
	}
	listRepPtr = ListGetInternalRep(listPtr);
	intrep.twoPtrValue.ptr1 = listRepPtr;

    TCL_UNUSED(Tcl_Obj *),/* The Tcl object to find the range of. */
    TCL_UNUSED(Tcl_Size),/* First index of the range. */
    TCL_UNUSED(Tcl_Size) /* Last index of the range. */
) {
    return NULL;
}

static int ListIntegerListObjGetElements(
    TCL_UNUSEDVAR(Tcl_Interp *interp),	/* Used to report errors if not NULL. */
    TCL_UNUSEDVAR(Tcl_Obj *listPtr),	/* List object for which an element array
					 * is to be returned. */
    TCL_UNUSEDVAR(Tcl_Size *objcPtr),	/* Where to store the count of objects
					 * referenced by objv. */
    TCL_UNUSEDVAR(Tcl_Obj ***objvPtr)	/* Where to store the pointer to an
					 * array of */
) {
    ListInteger *listRepPtr;
    listRepPtr = ListGetInternalRep(listPtr);
    *objcPtr = listRepPtr->used;
    *objvPtr = listRepPtr->values;
    return TCL_OK;
}

static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend) {
    int status;
    Tcl_Size length;
    status = Tcl_ListObjLength(interp, listPtr, &length);
    if (status != TCL_OK) {
	return TCL_ERROR;

    }

    status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
    if (status != TCL_OK) {
	return TCL_ERROR;
    }

    /* Currently this duplicates checks found in of Tcl_ListObjReplace, but
     * maybe in the future Tcl remove those checks
    */

    if (first >= used) {
	first = used;
    } else if (first < 0) {
	first = 0;
    }

#ifndef BN_TCL_H_
#define BN_TCL_H_

#ifdef MP_NO_STDINT
#   ifdef HAVE_STDINT_H
#	include <stdint.h>
#   else
#	include "../compat/stdint.h"
#   endif
#endif
#if defined(TCL_NO_TOMMATH_H)
    typedef size_t mp_digit;
    typedef int mp_sign;
#   define MP_ZPOS       0   /* positive integer */
#   define MP_NEG        1   /* negative */
    typedef int mp_ord;
#   define MP_LT        -1   /* less than */

	if (ch <= 0x7FF) {
	    buf[1] = (char) (0x80 | (0x3F & ch));
	    buf[0] = (char) (0xC0 | (ch >> 6));
	    return 2;
	}
	if (ch <= 0xFFFF) {
	    if (
		    (flags & TCL_COMBINE) &&
		    ((ch & 0xF800) == 0xD800)) {

		if (ch & 0x0400) {
		    /* Low surrogate */
		    if (   (0x80 == (0xC0 & buf[0]))
			&& (0    == (0xCF & buf[1]))) {
			/* Previous Tcl_UniChar was a high surrogate, so combine */
			buf[2]  = (char) (0x80 | (0x3F & ch));
			buf[1] |= (char) (0x80 | (0x0F & (ch >> 6)));

    if (index < 0) {
	return -1;
    }
    while (index--) {
	i = TclUtfToUniChar(src, &ch);
	src += i;
    }
    Tcl_UtfToUniChar(src, &i);
    return i;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfAtIndex --

    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL,				/* setFromAnyProc */
	0
};


/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
 * generating the string representation of lists must be known.  Here we
 * describe them in one place.

char *
Tcl_Merge(
    Tcl_Size argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Tcl_Size i, bytesNeeded = 0;

    char *result, *dst;

    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */

    if (argc <= 0) {



	result = (char *)Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.

     * room to grow before we have to allocate again. SPECIAL NOTE: must use
     * memcpy, not strcpy, to copy the string to a larger buffer, since there
     * may be embedded NULLs in the string in some cases.
     */
    newSize += 1; /* For terminating nul */
    if (newSize > dsPtr->spaceAvl) {
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString;
	    newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (element >= dsPtr->string
		    && element <= dsPtr->string + dsPtr->length) {
		/* Source string is within this DString. Note offset */
		offset = element - dsPtr->string;
	    }
	    dsPtr->string =
		(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
    }
    dst = dsPtr->string + dsPtr->length;

void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    char *bytes = TclGetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
}

/*

    void *cd;
    int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;



	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
	    return TCL_OK;
	}
    }

    /* objPtr does not hold a number, check the end+/- format... */
    return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr);
}

 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *
 *	If the computed index lies within the valid range of Tcl indices
 *	(0..TCL_SIZE_MAX) it is returned. Higher values are returned as
 *	TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1).
 *
 *	Callers should pass reasonable values for endValue - one in the
 *      valid index range or TCL_INDEX_NONE (-1), for example for an empty
 *	list.
 *
 * Results:
 * 	TCL_OK
 *
 * 	    The index is stored at the address given by by 'indexPtr'.

 *
 * 	TCL_ERROR
 *
 * 	    The value of 'objPtr' does not have one of the expected formats. If
 * 	    'interp' is non-NULL, an error message is left in the interpreter's
 * 	    result object.
 *
 * Side effects:
 *
 * 	The internal representation contained within objPtr may shimmer.

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

int
Tcl_GetIntForIndex(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If

{
    Tcl_WideInt wide;

    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (indexPtr != NULL) {
	/* Note: check against TCL_SIZE_MAX needed for 32-bit builds */
	if (wide >= 0 && wide <= TCL_SIZE_MAX) {
	    *indexPtr = (Tcl_Size)wide;
	} else if (wide > TCL_SIZE_MAX) {
	    *indexPtr = TCL_SIZE_MAX;


	} else {
	    *indexPtr = TCL_INDEX_NONE;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

	ir.wideValue = offset;
	Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	/*
	 * Encodes end+1. This is distinguished from end+n as noted above
	 * NOTE: this may wrap around if the caller passes (as lset does)
	 * listLen-1 as endValue and and listLen is 0. The -1 will be
	 * interpreted as FF...FF and adding 1 will result in 0 which
	 * is what we want. 2's complements shenanigans but it is what
	 * it is ...
	 */
	*widePtr = endValue + 1;
    } else if (offset == WIDE_MIN) {
	/* -1 - position before first */
	*widePtr = -1;


    } else if (offset < 0) {
	/* end-(n-1) - Different signs, sum cannot overflow */
	*widePtr = endValue + offset + 1;
    } else if (offset < WIDE_MAX) {
	/* 0:WIDE_MAX-1 - plain old index. */
	*widePtr = offset;
    } else {
	/* Huh, what case remains here? */
	*widePtr = WIDE_MAX;
    }
    return TCL_OK;

    /* Report a parse error. */
  parseError:
    if (interp != NULL) {

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexEncode --
 *      IMPORTANT: function only encodes indices in the range that fits within
 *      an "int" type. Do NOT change this as the byte code compiler and engine
 *      which call this function cannot handle wider index types. Indices
 *      outside the range will result in the function returning an error.
 *
 *      Parse objPtr to determine if it is an index value. Two cases
 *	are possible.  The value objPtr might be parsed as an absolute
 *	index value in the Tcl_Size range.  This includes
 *	index values that are integers as presented and it includes index
 *      arithmetic expressions.


 *
 *      The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX.
 *      This means the largest supported character length is also TCL_SIZE_MAX,
 *      and the index of the last character in a string of length TCL_SIZE_MAX
 *      is TCL_SIZE_MAX-1. Thus the absolute index values that can be
 *	directly meaningful as an index into either a list or a string are
 *	integer values in the range 0 to TCL_SIZE_MAX - 1.
 *
 *      This function however can only handle integer indices in the range
 *      0 : INT_MAX-1.
 *
 *      Any absolute index value parsed outside that range is encoded
 *      using the before and after values passed in by the
 *      caller as the encoding to use for indices that are either
 *      less than or greater than the usable index range. TCL_INDEX_NONE
 *      is available as a good choice for most callers to use for
 *      after. Likewise, the value TCL_INDEX_NONE is good for

 *      index "end" is encoded as -2, down to the index "end-0x7FFFFFFE"
 *      which is encoded as INT_MIN. Since the largest index into a
 *      string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of
 *      "end-0x7FFFFFFE" for that largest string would be 0.  Thus,
 *      if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed,
 *      they can be encoded with the before value.
 *




 * Returns:
 *      TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the
 *      index does not fit in an int type.
 *
 * Side effects:
 *      When TCL_OK is returned, the encoded index value is written
 *      to *indexPtr.
 *
 *----------------------------------------------------------------------
 */

int
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    int before,		/* Value to return for index before beginning */
    int after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{
    Tcl_WideInt wide;
    int idx;
    const Tcl_WideInt ENDVALUE = 2 * (Tcl_WideInt) INT_MAX;

TclIndexDecode(
    int encoded,	/* Value to decode */
    Tcl_Size endValue)	/* Meaning of "end" to use, > TCL_INDEX_END */
{
    if (encoded > TCL_INDEX_END) {
	return encoded;
    }
    endValue += encoded - TCL_INDEX_END;
    if (endValue >= 0) {
	return endValue;
    }
    return TCL_INDEX_NONE;
}

int TclIndexIsFromEnd(Tcl_Size index) {
    return index <= 0;
}

    Var *varPtr,		/* Pointer to variable that may be a candidate
				 * for being expunged. */
    Var *arrayPtr)		/* Array that contains the variable, or NULL
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == (unsigned)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    Tcl_Free(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == (unsigned)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    Tcl_Free(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }

    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;		/* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
				 * the variable. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    int isNew, i, result;
    Tcl_Size varLen;
    const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {

		*indexPtr = -1;
	    } else {
		*indexPtr = -2;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    Tcl_Size localLen;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {

void
TclDeleteCompiledLocalVars(
    Interp *iPtr,		/* Interpreter to which variables belong. */
    CallFrame *framePtr)	/* Procedure call frame containing compiler-
				 * assigned local variables to delete. */
{
    Var *varPtr;
    size_t numLocals, i;
    Tcl_Obj **namePtrPtr;

    numLocals = framePtr->numCompiledLocals;
    varPtr = framePtr->compiledLocals;
    namePtrPtr = &localName(framePtr, 0);
    for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,

/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef BN_H_
#define BN_H_

#if !defined(MP_NO_STDINT) && !defined(_STDINT_H) && !defined(_STDINT_H_) \
	&& !defined(__CLANG_STDINT_H) && !defined(_STDINT)
#  include <stdint.h>
#endif
#include <stddef.h>
#include <limits.h>

#ifdef LTM_NO_FILE
#  warning LTM_NO_FILE has been deprecated, use MP_NO_FILE.
#  define MP_NO_FILE
#endif

/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_

#ifdef MP_NO_STDINT
#ifdef HAVE_STDINT_H
#  include <stdint.h>
#else
#  include "../compat/stdint.h"
#endif
#endif
#include "tclTomMath.h"
#include "tommath_class.h"

/*
 * Private symbols
 * ---------------
 *

    lappend x(0) 44
} -result {can't set "x(0)": variable isn't array}

test append-7.1 {lappend-created var and error in trace on that var} -setup {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    trace variable x w foo
    proc foo {} {global x; unset x}
    catch {lappend x 1}
    proc foo {args} {global x; unset x}
    info exists x
    set x
    lappend x 1
    list [info exists x] [catch {set x} msg] $msg
} -result {0 1 {can't read "x": no such variable}}
test append-7.2 {lappend var triggers read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar a
    return $::result
} -result {myvar {} r}
test append-7.3 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them, and was changed back in 8.4.
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar(b) a
    return $::result
} -result {myvar b r}
test append-7.4 {lappend var triggers read trace, array var exists} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    set myvar(0) 1
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar(b) a
    return $::result
} -result {myvar b r}
test append-7.5 {append var does not trigger read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    append myvar a
    info exists ::result
} -result {0}

# THERE ARE NO append-8.* TESTS

test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    proc bar {} {
	global x
	trace variable x w foo
	proc foo {} {global x; unset x}
	catch {lappend x 1}
	proc foo {args} {global x; unset x}
	info exists x
	set x
	lappend x 1
	list [info exists x] [catch {set x} msg] $msg
    }
    bar
} -result {0 1 {can't read "x": no such variable}}
test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar a
	return $::result
    }
    bar
} -result {myvar {} r} -constraints {bug-3057639}
test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
    unset -nocomplain ::result
    unset -nocomplain ::myvar
} -body {
    proc bar {} {
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar a
	return $::result
    }
    bar
} -result {::myvar {} r} -constraints {bug-3057639}
test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them. Maybe not correct, but been there a while.
    proc bar {} {
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a
	return $::result
    }
    bar
} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them. Maybe not correct, but been there a while.
    proc bar {} {
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a b
	return $::result
    }
    bar
} -result {myvar b r}
test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	set myvar(0) 1
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a
	return $::result
    }
    bar
} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
    unset -nocomplain ::myvar
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar(b) a
	return $::result
    }
    bar
} -result {::myvar b r} -constraints {bug-3057639}
test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
    unset -nocomplain ::myvar
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar(b) a b
	return $::result
    }
    bar
} -result {::myvar b r}
test appendComp-7.9 {append var does not trigger read trace} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	append myvar a
	info exists ::result
    }
    bar
} -result {0}

    set patlen [bigPatLen]
    return [expr {($limit/$patlen)*$patlen}]
}

set ::bigLengths(intmax) 0x7fffffff
set ::bigLengths(uintmax) 0xffffffff
# Some tests are more convenient if operands are multiple of pattern length

set ::bigLengths(patlenmultiple) [bigPatlenMultiple $::bigLengths(intmax)]
set ::bigLengths(upatlenmultiple) [bigPatlenMultiple $::bigLengths(uintmax)]


#
# script limits
bigtestRO script-length-bigdata-1 {Test script length limit} b -body {
    try [string cat [string repeat " " 0x7ffffff7] "set a b"]
}
# TODO - different behaviour between compiled and uncompiled

		chan copy $b $a -command [list geof $b]
		chan puts stderr 2COPY
	    }
	    chan puts stderr ...
	}
	chan puts stderr SRV
	set l {}
	set srv [socket -server new 9999]

	chan puts stderr WAITING
	chan event stdin readable bye
	chan puts OK
	vwait forever
    }
    # wait for OK from server.
    chan gets $pipe
    # Now the two clients.
    proc done {sock} {
	if {[chan eof $sock]} { chan close $sock ; return }
	lappend ::forever [chan gets $sock]
	return
    }
    set a [socket 127.0.0.1 9999]
    set b [socket 127.0.0.1 9999]
    chan configure $a -translation binary -buffering none
    chan configure $b -translation binary -buffering none
    chan event  $a readable [namespace code "done $a"]
    chan event  $b readable [namespace code "done $b"]
} -constraints {stdio fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}

    set y [encoding convertto cesu-8 \u3FF]
    binary scan $y H* z
    list [string length $y] $z
} {2 cfbf}
test encoding-15.25 {UtfToUtfProc CESU-8} {
    encoding convertfrom cesu-8 \x00
} \x00



test {encoding-15.26 cesu-8 tclnull strict} {UtfToUtfProc CESU-8} {
    encoding convertfrom -profile tcl8 cesu-8 \xC0\x80
} \x00

test {encoding-15.26 cesu-8 tclnull tcl8} {UtfToUtfProc CESU-8} {
    encoding convertfrom -profile tcl8 cesu-8 \xC0\x80
} \x00
test encoding-15.27 {UtfToUtfProc -profile strict CESU-8} {
    encoding convertfrom -profile strict cesu-8 \x00
} \x00
test encoding-15.28 {UtfToUtfProc -profile strict CESU-8} -body {

test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
    encoding convertfrom -profile strict utf-16le \x00\xD8
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
    encoding convertfrom -profile strict utf-16le \x00\xDC
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}




test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
    string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"]
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
    encoding convertfrom -profile tcl8 utf-8 \xC0\x80
} \x00






test encoding-16.25 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32 "\x01\x00\x00\x01"
} -result \uFFFD

test encoding-17.1 {UtfToUtf16Proc} -body {
    encoding convertto utf-16 "\U460DC"
} -result "\xD8\xD8\xDC\xDC"
test encoding-17.2 {UtfToUcs2Proc} -body {

    set count [gets $f line]
    close $f
    removeFile iso2022.tcl
    list $count [viewable $line]
} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]

test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
    string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"]
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
    encoding convertfrom -profile tcl8 utf-8 \xC0\x80
} \x00
test encoding-24.5 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"]
} 2

       upvar 1 $name var
       if {[incr counter] % 2 == 1} {
           set var "$counter oops [concat $extraargs]"
       } else {
           set var "$counter + [concat $extraargs]"
       }
    }
    trace variable exprtracevar r [list exprtraceproc 10]
    list [catch {expr "$exprtracevar + 20"} a] $a \
        [catch {expr "$exprtracevar + 20"} b] $b \
        [unset exprtracevar exprtracecounter]
} -match glob -result {1 * 0 32 {}}
test expr-20.3 {broken substitution of integer digits} {
    # fails with 8.0.x, but not 8.1b2
    list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]

       upvar 1 $name var
       if {[incr counter] % 2 == 1} {
           set var "$counter oops [concat $extraargs]"
       } else {
           set var "$counter + [concat $extraargs]"
       }
    }
    trace variable iftracevar r [list iftraceproc 10]
    list [catch {if "$iftracevar + 20" {}} a] $a \
        [catch {if "$iftracevar + 20" {}} b] $b
} -cleanup {
    unset iftracevar iftracecounter a b
} -match glob -result {1 {*} 0 {}}

# cleanup

} {1 {expected integer but got "1a"} {expected integer but got "1a"
    (reading increment)
    invoked from within
"incr x 1a"}}
test incr-old-2.6 {incr errors} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace var x w readonly
    list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"incr x 1"}}
catch {unset x}
test incr-old-2.7 {incr errors} {

    testgetintforindex end 2147483646
} 2147483646
test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483647
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -1
} -1
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -2
} -1
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -2
} -1
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -1
} 0
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -2
} -1







# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

	catch {parray a b $arg}
	list $first $::errorInfo
    } -match pairwise -result equal
    test init-4.$count.1 {::errorInfo produced by [unknown]} -setup {
	auto_reset
    } -body {
	namespace eval junk [list array set $arg [list 1 2 3 4]]
	trace variable ::junk::$arg r \
		"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
	catch {parray ::junk::$arg}
	set first $::errorInfo
	catch {parray ::junk::$arg}
	list $first $::errorInfo
    } -match pairwise -result equal

    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}
test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
	writable so we can't change -eofchar or -translation } {
    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    fconfigure $sock -eofchar D -translation lf
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}

		fcopy $b $a -command [list geof $b]
		puts stderr 2COPY
	    }
	    puts stderr ...
	}
	puts stderr SRV
	set l {}
	set srv [socket -server new 9999]

	puts stderr WAITING
	fileevent stdin readable bye
	puts OK
	vwait forever
    }
    # wait for OK from server.
    gets $pipe
    # Now the two clients.
    proc ::done {sock} {
	if {[eof $sock]} { close $sock ; return }
	lappend ::forever [gets $sock]
	return
    }
    set a [socket 127.0.0.1 9999]
    set b [socket 127.0.0.1 9999]
    fconfigure $a -translation binary -buffering none
    fconfigure $b -translation binary -buffering none
    fileevent  $a readable [list ::done $a]
    fileevent  $b readable [list ::done $b]
} -constraints {stdio fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}

    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    trace var int w x
    testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    trace vdelete int w x
    return $x
} {{int {} w} 32 -2.0 0 xyzzy 995511}
test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink delete
    trace var int w x
    testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    trace vdelete int w x
    return $x
} {}
test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    list [catch {
	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
    } msg] $msg $int

		    @linsert@ [newlist $list] 1 "x y"
		    return "a b c"
		}
		p
	    } "a b c"
	    test linsert-3.2-@mode@ {linsert won't modify shared argument objects} {
		catch {unset lis}
		puts boom
		set lis [format "a \"%s\" c" "b"]
		@linsert@ [newlist $lis] 0 [string length $lis]
	    } "7 a b c"

	    # cleanup
	    catch {unset lis}
	    catch {rename p ""}

    lindex [lseq 0x7fffffff] 0x80000000
} -result {}

test lseq-4.12 {bug lseq} -constraints has64BitLengths -body {
    llength [lseq 0x100000000]
} -result {4294967296}

test lseq-4.13 {bug lseq} -constraints has64BitLengths -body {
    set l [lseq 0x7fffffffffffffff]
    list \
    [llength $l] \
    [lindex $l end] \
        [lindex $l 9223372036854775800]
} -cleanup {unset l} -result {9223372036854775807 9223372036854775806 9223372036854775800}

            variable x ""
        }
        variable status ""
        proc monitor {name1 name2 op} {
            variable status
            lappend status "$op: $name1"
        }
        trace variable foo::x rwu [namespace code monitor]
    }
    set test_ns_trace::foo::x "yes!"
    set test_ns_trace::foo::x
    unset test_ns_trace::foo::x
    namespace eval test_ns_trace { set status }
} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}

# -----------------------------------------------------------------------
# TEST: imported commands
# -----------------------------------------------------------------------
test namespace-old-9.1 {empty "namespace export" list} {
    list [catch "namespace export" msg] $msg
} {0 {}}

				catch {unset list}
			} -result {7 8 9 10 11 12 13}
		}]
		#try $script

    }

	set suites {linsert lset}  

	foreach suite {linsert lset} {
		set namespace [list $suite tests]
		namespace eval $namespace [list source [
			file join [file dirname [file dirname [
				file normalize [file join [info script] ...]]]] $suite.test]]
		namespace eval $namespace {
			proc newlist list {
				if {[string is list $list]} {
					set integer 1
					foreach item $list {
						if {![string is integer $item]} {
							set integer 0
							break
						}
					}
					if {$integer} {
						testlistinteger $list
					}
				}
				return $list
			}
			try $tests
		}
		namespace delete $namespace
	}


    # cleanup
    ::tcltest::cleanupTests
} [namespace current]]

return

    do {global a; do {global a; unset a}; set a(z) 22}
    list [catch {array names a} msg] $msg
} {0 z}
test proc-old-3.7 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    set info {}
    do {global a; trace var a(1) w t1}
    set a(1) 44
    set info
} 1
test proc-old-3.8 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    trace var a(1) w t1
    set info {}
    do {global a; trace vdelete a(1) w t1}
    set a(1) 44
    set info
} {}
test proc-old-3.9 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    trace var a(1) w t1
    do {global a; trace vinfo a(1)}
} {{w t1}}
catch {unset a}

test proc-old-30.1 {arguments and defaults} {
    proc tproc {x y z} {
	return [list $x $y $z]
    }
    tproc 11 12 13

test proc-old-5.16 {error conditions} {
    proc foo args {
	global fooMsg
	set fooMsg "foo was called: $args"
    }
    proc tproc {} {
	set x 44
	trace var x u foo
	while {$x < 100} {
	    error "Nested error"
	}
    }
    set fooMsg "foo not called"
    list [catch tproc msg] $msg $::errorInfo $fooMsg
} {1 {Nested error} {Nested error
    while executing
"error "Nested error""
    (procedure "tproc" line 5)
    invoked from within
"tproc"} {foo was called: x {} u}}

# The tests below will really only be useful when run under Purify or
# some other system that can detect accesses to freed memory...

test proc-old-6.1 {procedure that redefines itself} {
    proc tproc {} {
	proc tproc {} {

    list [catch {set a} msg] $msg
} {1 {can't read "a": variable is array}}

# Errors and other special cases in writing variables

test set-old-6.1 {creating array during write} {
    catch {unset a}
    trace var a rwu ignore
    list [catch {set a(14) 186} msg] $msg [array names a]
} {0 186 14}
test set-old-6.2 {errors in writing variables} {
    catch {unset a}
    set a xxx
    list [catch {set a(14) 186} msg] $msg
} {1 {can't set "a(14)": variable isn't array}}

    set a(22) 3
    set {a(long name)} {}
    lsort [array get a]
} {{} 22 3 {long name}}
test set-old-8.19 {array command, get option (unset variable)} {
    catch {unset a}
    set a(x) 3
    trace var a(y) w ignore
    array get a
} {x 3}
test set-old-8.20 {array command, get option, with pattern} {
    catch {unset a}
    set a(x1) 3
    set a(x2) 4
    set a(x3) 5

    catch {unset a}
    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 Textual_name {name with spaces}}}
test set-old-8.25 {array command, names option} {
    catch {unset a}
    set a(22) 3; set a(33) 44;
    trace var a(xxx) w ignore
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 33}}
test set-old-8.26 {array command, names option} {
    catch {unset a}
    set a(22) 3; set a(33) 44;
    trace var a(xxx) w ignore
    set a(xxx) value
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 33 xxx}}
test set-old-8.27 {array command, names option} {
    catch {unset a}
    set a(axy) 3
    set a(bxy) 44

    set a(22) 3; set a(xx) 44; set a(y) xxx
    unset a(22) a(y) a(xx)
    list [catch {array size a} msg] $msg
} {0 0}
test set-old-8.44 {array command, size option} {
    catch {unset a}
    set a(22) 3;
    trace var a(33) rwu ignore
    list [catch {array size a} msg] $msg
} {0 1}
test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {
            return [array size a]
        }

	    [catch {array next a $y} msg2] $msg2
} {0 a 0 a}
test set-old-9.10 {array enumeration: searches automatically stopped} {
    catch {unset a}
    set a(a) 1
    set x [array startsearch a]
    set y [array startsearch a]
    trace var a(b) r {}
    list [catch {array next a $x} msg] $msg \
	    [catch {array next a $y} msg2] $msg2
} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
test set-old-9.11 {array enumeration: searches automatically stopped} {
    catch {unset a}
    set a(a) 1
    set x [array startsearch a]
    set y [array startsearch a]
    trace var a(a) r {}
    list [catch {array next a $x} msg] $msg \
	    [catch {array next a $y} msg2] $msg2
} {0 a 0 a}
test set-old-9.12 {array enumeration with traced undefined elements} {
    catch {unset a}
    set a(a) 1
    trace var a(b) r {}
    set x [array startsearch a]
    lsort [list [array next a $x] [array next a $x]]
} {{} a}

test set-old-10.1 {array enumeration errors} {
    list [catch {array start} msg] $msg
} {1 {wrong # args: should be "array startsearch arrayName"}}

    list [catch {set a(18)} msg] $msg
} -result {1 {can't read "a(18)": no such element in array}}
test set-2.4 {set command: runtime error, readonly variable} -setup {
    unset -nocomplain x
} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace var x w readonly
    list [catch {set x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"set x 1"}}
test set-2.5 {set command: runtime error, basic array operations} -setup {
    unset -nocomplain a

    $z a(6) 44
    list [catch {$z a(18)} msg] $msg
} -result {1 {can't read "a(18)": no such element in array}}
test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
    set z set
    proc readonly args {error "variable is read-only"}
    $z x 123
    trace var x w readonly
    list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"$z x 1"}}
test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
    unset -nocomplain a

test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
    # You may need Purify or Electric Fence to reliably
    # see this one fail.
    unset -nocomplain z
    trace add variable z array {set z(foo) 1 ;#}
    set res "names: [array names z]"
    unset -nocomplain ::z
    trace variable ::z w {unset ::z; error "memory corruption";#}
    list [catch {set ::z 1} msg] $msg
} {1 {can't set "::z": memory corruption}}

# Read-tracing on variables

test trace-1.1 {trace variable reads} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalar
    list [catch {set x} msg] $msg $info
} {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}}
test trace-1.2 {trace variable reads} {
    unset -nocomplain x
    set x 123
    set info {}
    trace add variable x read traceScalar
    list [catch {set x} msg] $msg $info
} {0 123 {x {} read 0 123}}
test trace-1.3 {trace variable reads} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalar
    set x 123
    set info
} {}
test trace-1.4 {trace array element reads} {

test trace-1.9 {trace reads on whole arrays} {
    unset -nocomplain x
    set x(2) zzz
    set info {}
    trace add variable x read traceArray
    list [catch {set x(2)} msg] $msg $info
} {0 zzz {x 2 read 0 zzz}}
test trace-1.10 {trace variable reads} {
    unset -nocomplain x
    set x 444
    set info {}
    trace add variable x read traceScalar
    unset x
    set info
} {}
test trace-1.11 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {set x(foo) 1 ;#}
    trace variable x r {unset -nocomplain x(bar) ;#}
    array get x
} {}
test trace-1.12 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {unset -nocomplain x(bar) ;#}
    trace variable x r {set x(foo) 1 ;#}
    array get x
} {}
test trace-1.13 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {set x(foo) 1 ;#}
    trace variable x r {unset -nocomplain x;#}
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}
test trace-1.14 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {unset -nocomplain x;#}
    trace variable x r {set x(foo) 1 ;#}
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}

# Basic write-tracing on variables

test trace-2.1 {trace variable writes} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceScalar
    set x 123
    set info
} {x {} write 0 123}
test trace-2.2 {trace writes to array elements} {
    unset -nocomplain x
    set info {}
    trace add variable x(33) write traceArray
    set x(33) 444
    set info
} {x 33 write 0 444}
test trace-2.3 {trace writes on whole arrays} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceArray
    set x(abc) qq
    set info
} {x abc write 0 qq}
test trace-2.4 {trace variable writes} {
    unset -nocomplain x
    set x 1234
    set info {}
    trace add variable x write traceScalar
    set x
    set info
} {}
test trace-2.5 {trace variable writes} {
    unset -nocomplain x
    set x 1234
    set info {}
    trace add variable x write traceScalar
    unset x
    set info
} {}
test trace-2.6 {trace variable writes on compiled local} {
    #
    # Check correct function of whole array traces on compiled local
    # arrays [Bug 1770591]. The corresponding function for read traces is
    # already indirectly tested in trace-1.7
    #
    unset -nocomplain x
    set info {}
    proc p {} {
	trace add variable x write traceArray
	set x(X) willy
    }
    p
    set info
} {x X write 0 willy}
test trace-2.7 {trace variable writes on errorInfo} -body {
   #
   # Check correct behaviour of write traces on errorInfo.
   # [Bug 1773040]
   trace add variable ::errorInfo write traceScalar
   catch {set dne}
   lrange [set info] 0 2
} -cleanup {
   # always remove trace on errorInfo otherwise further tests will fail
   unset ::errorInfo
} -result {::errorInfo {} write}



# append no longer triggers read traces when fetching the old values of
# variables before doing the append operation. However, lappend _does_
# still trigger these read traces. Also lappend triggers only one write
# trace: after appending all arguments to the list.

test trace-3.1 {trace variable read-modify-writes} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalarAppend
    append x 123
    append x 456
    lappend x 789
    set info
} {x {} read 0 123456}
test trace-3.2 {trace variable read-modify-writes} {
    unset -nocomplain x
    set info {}
    trace add variable x {read write} traceScalarAppend
    append x 123
    lappend x 456
    set info
} {x {} write 0 123 x {} read 0 123 x {} write 0 {123 456}}

# Basic unset-tracing on variables

test trace-4.1 {trace variable unsets} {
    unset -nocomplain x
    set info {}
    trace add variable x unset traceScalar
    unset -nocomplain x
    set info
} {x {} unset 1 {can't read "x": no such variable}}
test trace-4.2 {variable mustn't exist during unset trace} {

    unset -nocomplain x
    trace add variable x array traceArray2
    set result [trace info variable x]
    set result
} [list [list array traceArray2]]
test trace-5.5 {array traces properly listed in trace information} {
    unset -nocomplain x
    trace variable x a traceArray2
    set result [trace vinfo x]
    set result
} [list [list a traceArray2]]
test trace-5.6 {array traces don't fire on scalar variables} {
    unset -nocomplain x
    set x foo
    trace add variable x array traceArray2
    set ::info {}
    catch {array set x {a 1}}
    set ::info

test trace-18.2 {namespace delete / trace vdelete combo} {
    namespace eval ::foo {
	variable x 123
    }
    proc p1 args {
	trace vdelete ::foo::x u p1
    }
    trace variable ::foo::x u p1
    namespace delete ::foo
    info exists ::foo::x
} 0
test trace-18.3 {namespace delete / trace vdelete combo, Bug \#1337229} {
    namespace eval ::ns {}
    trace add variable ::ns::var unset {unset ::ns::var ;#}
    namespace delete ::ns

    set result [trace info command foo]
    rename foo {}
    set result
} [list [list delete foo]]

test trace-33.1 {variable match with remove variable} {
    unset -nocomplain x
    trace variable x w foo
    trace remove variable x write foo
    llength [trace info variable x]
} 0

test trace-34.1 {Bug 1201035} {
    set ::x [list]
    proc foo {} {lappend ::x foo}

	set b bar
    }
    list [p1 14 15] $x1
} {{14 15 bar 33} foo}

proc tproc {args} {global x; set x [list $args [uplevel info vars]]}
test upvar-5.1 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
    proc p2 {} {upvar c x1; set x1 22}
    set x ---
    p1 foo bar
    set x
} {{x1 {} w} x1}
test upvar-5.2 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
    proc p2 {} {upvar c x1; set x1}
    set x ---
    p1 foo bar
    set x
} {{x1 {} r} x1}
test upvar-5.3 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace var c rwu tproc; p2}
    proc p2 {} {upvar c x1; unset x1}
    set x ---
    p1 foo bar
    set x
} {{x1 {} u} x1}
test upvar-5.4 {read trace on upvar array element} -body {
    proc p1 {a b} {
	array set foo {c 22 d 33}
	trace add variable foo {read write unset} tproc
	p2
	trace remove variable foo {read write unset} tproc
    }

    p1
} -result {can't upvar from variable to itself}
test upvar-8.6 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {set a 33; upvar b a}
    p1
} -result {variable "a" already exists}
test upvar-8.7 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {trace variable a w foo; upvar b a}
    p1
} -result {variable "a" has traces: can't use for upvar}
test upvar-8.8 {create nested array with upvar} -body {
    proc p1 {} {upvar x(a) b; set b(2) 44}
    catch {unset x}
    p1
} -returnCodes error -cleanup {

    namespace eval test_ns_var {
        variable v 123
        variable info ""
        proc traceUnset {name1 name2 op} {
            variable info
            set info [concat $info [list $name1 $name2 $op]]
        }
        trace var v u [namespace code traceUnset]
    }
    list [unset test_ns_var::v] $test_ns_var::info
} -result {{} {test_ns_var::v {} u}}
test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup {
    catch {namespace delete test_ns_var}
    catch {unset a}
} -body {
    set info ""
    namespace eval test_ns_var {
        variable v 123 1
        trace var v u ::traceUnset
    }
    proc traceUnset {name1 name2 op} {
	set ::info [concat $::info [list $name1 $name2 $op]]
    }
    list [namespace delete test_ns_var] $::info
} -result {{} {::test_ns_var::v {} u}}

test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup {
    proc ::t {a i o} {
	set $a 321
    }
} -body {
    leaktest {
	namespace eval n {
	    variable v 123
	    trace variable v u ::t
	}
	namespace delete n
    }
} -cleanup {
    rename ::t {}
} -result 0

} -result {1 {before set} 1 {can't set "arr": variable is array}}
test var-9.9 {behaviour of TclGetVar read trace success} -setup {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
    set u 10
    trace var u r [list resetvar 1]
    trace var v r [list resetvar 2]
    list \
	[testsetnoerr u] \
	[testseterr v]
} -result {{before get 1} {before get 2}}
test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
    proc writeonly args {error "write-only"}
    set v 456
    trace var v r writeonly
    list \
	[catch {testsetnoerr v} msg] $msg \
	[catch {testseterr v} msg] $msg
} {1 {before get} 1 {can't read "v": write-only}}
test var-9.11 {behaviour of TclSetVar write trace success} -setup {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
    set v 1
    trace var v w doubleval
    trace var u w doubleval
    list \
	[testsetnoerr u 2] \
	[testseterr v 3]
} -result {{before set 4} {before set 6}}
test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
    proc readonly args {error "read-only"}
    set v 456
    trace var v w readonly
    list \
	[catch {testsetnoerr v 2} msg] $msg $v \
	[catch {testseterr v 3} msg] $msg $v
} {1 {before set} 2 1 {can't set "v": read-only} 3}

test var-10.1 {can't nest arrays with array set} -setup {
   catch {unset arr}

} -body {
    proc foo {var ind op} {
	global t
	set foo bar
    }
    namespace eval :: {
	set t(1) 1
	trace variable t(1) u foo
	unset t
    }
    set x "If you see this, it worked"
} -result "If you see this, it worked"
test var-13.2 {unset array with search, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}

# The information below should be usable as is. The configure script won't
# modify it and you shouldn't need to modify it either.
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
	${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
	${AC_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ \
	${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT

CC_SWITCHES = $(STUB_CC_SWITCHES) -DBUILD_tcl

APP_CC_SWITCHES = $(STUB_CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@

LIBS		= @TCL_LIBS@

#--------------------------------------------------------------------------
# Compat binaries, these must be compiled for use in a shared library even
# though they may be placed in a static executable or library. Since they are
# included in both the tcl library and the stub library, they need to be
# relocatable.
#--------------------------------------------------------------------------

opendir.o: $(COMPAT_DIR)/opendir.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c

mkstemp.o: $(COMPAT_DIR)/mkstemp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/mkstemp.c

memcmp.o: $(COMPAT_DIR)/memcmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/memcmp.c

strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c

strstr.o: $(COMPAT_DIR)/strstr.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c

strtol.o: $(COMPAT_DIR)/strtol.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c

strtoul.o: $(COMPAT_DIR)/strtoul.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c

waitpid.o: $(COMPAT_DIR)/waitpid.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c

fake-rfc2553.o: $(COMPAT_DIR)/fake-rfc2553.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fake-rfc2553.c

# For building zlib, only used in some build configurations

	ac_retval=1
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_compile

# ac_fn_c_try_link LINENO
# -----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_link ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext
  if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest$ac_exeext && {
	 test "$cross_compiling" = yes ||
	 test -x conftest$ac_exeext
       }
then :
  ac_retval=0
else $as_nop
  printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	ac_retval=1
fi
  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
  # interfere with the next link command; also delete a directory that is
  # left behind by Apple's compiler.  We do this before executing the actions.
  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_link

# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
# Tests whether HEADER exists and can be compiled using the include files in
# INCLUDES, setting the cache variable VAR accordingly.
ac_fn_c_check_header_compile ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack

    ac_retval=1
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_cpp
















































# ac_fn_c_check_func LINENO FUNC VAR
# ----------------------------------
# Tests whether FUNC exists, setting the cache variable VAR accordingly
ac_fn_c_check_func ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
printf "%s\n" "$ac_cv_path_EGREP" >&6; }
 EGREP="$ac_cv_path_EGREP"



    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking dirent.h" >&5
printf %s "checking dirent.h... " >&6; }
if test ${tcl_cv_dirent_h+y}
then :
  printf %s "(cached) " >&6
else $as_nop

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
#include <dirent.h>
int
main (void)
{

#ifndef _POSIX_SOURCE
#   ifdef __Lynx__
	/*
	 * Generate compilation error to make the test fail:  Lynx headers
	 * are only valid if really in the POSIX environment.
	 */

	missing_procedure();
#   endif
#endif
DIR *d;
struct dirent *entryPtr;
char *p;
d = opendir("foobar");
entryPtr = readdir(d);
p = entryPtr->d_name;
closedir(d);

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_dirent_h=yes
else $as_nop
  tcl_cv_dirent_h=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_dirent_h" >&5
printf "%s\n" "$tcl_cv_dirent_h" >&6; }

    if test $tcl_cv_dirent_h = no; then

printf "%s\n" "#define NO_DIRENT_H 1" >>confdefs.h

    fi

    ac_fn_c_check_header_compile "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default"
if test "x$ac_cv_header_stdlib_h" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "strtol" >/dev/null 2>&1
then :

else $as_nop
  tcl_ok=0
fi
rm -rf conftest*

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "strtoul" >/dev/null 2>&1
then :

else $as_nop
  tcl_ok=0
fi
rm -rf conftest*

    if test $tcl_ok = 0; then

printf "%s\n" "#define NO_STDLIB_H 1" >>confdefs.h

    fi
    ac_fn_c_check_header_compile "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default"
if test "x$ac_cv_header_string_h" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi

else $as_nop
  case " $LIBOBJS " in
  *" mkstemp.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext"
 ;;
esac

fi
ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir"
if test "x$ac_cv_func_opendir" = xyes
then :
  printf "%s\n" "#define HAVE_OPENDIR 1" >>confdefs.h

else $as_nop
  case " $LIBOBJS " in
  *" opendir.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS opendir.$ac_objext"
 ;;
esac

fi
ac_fn_c_check_func "$LINENO" "strtol" "ac_cv_func_strtol"
if test "x$ac_cv_func_strtol" = xyes
then :
  printf "%s\n" "#define HAVE_STRTOL 1" >>confdefs.h

else $as_nop
  case " $LIBOBJS " in
  *" strtol.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS strtol.$ac_objext"
 ;;
esac

fi
ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid"
if test "x$ac_cv_func_waitpid" = xyes
then :
  printf "%s\n" "#define HAVE_WAITPID 1" >>confdefs.h

else $as_nop

else $as_nop

printf "%s\n" "#define NO_FSTATFS 1" >>confdefs.h

fi


#--------------------------------------------------------------------
#       Some system have no memcmp or it does not work with 8 bit data, this
#       checks it and add memcmp.o to LIBOBJS if needed
#--------------------------------------------------------------------

{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working memcmp" >&5
printf %s "checking for working memcmp... " >&6; }
if test ${ac_cv_func_memcmp_working+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  if test "$cross_compiling" = yes
then :
  ac_cv_func_memcmp_working=no
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main (void)
{

  /* Some versions of memcmp are not 8-bit clean.  */
  char c0 = '\100', c1 = '\200', c2 = '\201';
  if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0)
    return 1;

  /* The Next x86 OpenStep bug shows up only when comparing 16 bytes
     or more and with at least one buffer not starting on a 4-byte boundary.
     William Lewis provided this test program.   */
  {
    char foo[21];
    char bar[21];
    int i;
    for (i = 0; i < 4; i++)
      {
	char *a = foo + i;
	char *b = bar + i;
	strcpy (a, "--------01111111");
	strcpy (b, "--------10000000");
	if (memcmp (a, b, 16) >= 0)
	  return 1;
      }
    return 0;
  }

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"
then :
  ac_cv_func_memcmp_working=yes
else $as_nop
  ac_cv_func_memcmp_working=no
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_memcmp_working" >&5
printf "%s\n" "$ac_cv_func_memcmp_working" >&6; }
test $ac_cv_func_memcmp_working = no && case " $LIBOBJS " in
  *" memcmp.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS memcmp.$ac_objext"
 ;;
esac



#--------------------------------------------------------------------
#       Some system like SunOS 4 and other BSD like systems have no memmove
#       (we assume they have bcopy instead). {The replacement define is in
#       compat/string.h}
#--------------------------------------------------------------------

printf "%s\n" "#define NO_MEMMOVE 1" >>confdefs.h


printf "%s\n" "#define NO_STRING_H 1" >>confdefs.h

fi


#--------------------------------------------------------------------
#	On some systems strstr is broken: it returns a pointer even if
#	the original string is empty.
#--------------------------------------------------------------------


    ac_fn_c_check_func "$LINENO" "strstr" "ac_cv_func_strstr"
if test "x$ac_cv_func_strstr" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi

    if test "$tcl_ok" = 1; then
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking proper strstr implementation" >&5
printf %s "checking proper strstr implementation... " >&6; }
if test ${tcl_cv_strstr_unbroken+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  if test "$cross_compiling" = yes
then :
  tcl_cv_strstr_unbroken=unknown
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#include <stdlib.h>
#include <string.h>
int main() {
    exit(strstr("\0test", "test") ? 1 : 0);
}
_ACEOF
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_strstr_unbroken=ok
else $as_nop
  tcl_cv_strstr_unbroken=broken
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strstr_unbroken" >&5
printf "%s\n" "$tcl_cv_strstr_unbroken" >&6; }
	if test "$tcl_cv_strstr_unbroken" = "ok"; then
	    tcl_ok=1
	else
	    tcl_ok=0
	fi
    fi
    if test "$tcl_ok" = 0; then
	case " $LIBOBJS " in
  *" strstr.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS strstr.$ac_objext"
 ;;
esac

	USE_COMPAT=1
    fi


#--------------------------------------------------------------------
#	Check for strtoul function.  This is tricky because under some
#	versions of AIX strtoul returns an incorrect terminator
#	pointer for the string "0".
#--------------------------------------------------------------------


    ac_fn_c_check_func "$LINENO" "strtoul" "ac_cv_func_strtoul"
if test "x$ac_cv_func_strtoul" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi

    if test "$tcl_ok" = 1; then
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking proper strtoul implementation" >&5
printf %s "checking proper strtoul implementation... " >&6; }
if test ${tcl_cv_strtoul_unbroken+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  if test "$cross_compiling" = yes
then :
  tcl_cv_strtoul_unbroken=unknown
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#include <stdlib.h>
#include <string.h>
int main() {
    char *term, *string = "0";
    exit(strtoul(string,&term,0) != 0 || term != string+1);
}
_ACEOF
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_strtoul_unbroken=ok
else $as_nop
  tcl_cv_strtoul_unbroken=broken
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtoul_unbroken" >&5
printf "%s\n" "$tcl_cv_strtoul_unbroken" >&6; }
	if test "$tcl_cv_strtoul_unbroken" = "ok"; then
	    tcl_ok=1
	else
	    tcl_ok=0
	fi
    fi
    if test "$tcl_ok" = 0; then
	case " $LIBOBJS " in
  *" strtoul.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS strtoul.$ac_objext"
 ;;
esac

	USE_COMPAT=1
    fi


#--------------------------------------------------------------------
#	Check for various typedefs and provide substitutes if
#	they don't exist.
#--------------------------------------------------------------------

ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"

"
if test "x$ac_cv_type_uintptr_t" = xyes
then :

printf "%s\n" "#define HAVE_UINTPTR_T 1" >>confdefs.h


fi


#--------------------------------------------------------------------
#	If a system doesn't have an opendir function (man, that's old!)
#	then we have to supply a different version of dirent.h which
#	is compatible with the substitute version of opendir that's
#	provided.  This version only works with V7-style directories.
#--------------------------------------------------------------------

ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir"
if test "x$ac_cv_func_opendir" = xyes
then :

else $as_nop

printf "%s\n" "#define USE_DIRENT2_H 1" >>confdefs.h

fi


#--------------------------------------------------------------------
#	The check below checks whether <sys/wait.h> defines the type
#	"union wait" correctly.  It's needed because of weirdness in
#	HP-UX where "union wait" is defined in both the BSD and SYS-V

#--------------------------------------------------------------------

# Check if Posix compliant getcwd exists, if not we'll use getwd.
AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD, 1, [Is getcwd Posix-compliant?])])
# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
# define USEGETWD even if the posix getcwd exists. Add a test ?

AC_REPLACE_FUNCS(mkstemp opendir strtol waitpid)
AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])])
AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])
AC_CHECK_FUNC(fork, , [AC_DEFINE(NO_FORK, 1, [Do we have fork()])])
AC_CHECK_FUNC(mknod, , [AC_DEFINE(NO_MKNOD, 1, [Do we have mknod()])])
AC_CHECK_FUNC(tcdrain, , [AC_DEFINE(NO_TCDRAIN, 1, [Do we have tcdrain()])])
AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])

if test "$ac_cv_cygwin" != "yes"; then
    AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize, struct stat.st_rdev])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])

#--------------------------------------------------------------------
#       Some system have no memcmp or it does not work with 8 bit data, this
#       checks it and add memcmp.o to LIBOBJS if needed
#--------------------------------------------------------------------

AC_FUNC_MEMCMP

#--------------------------------------------------------------------
#       Some system like SunOS 4 and other BSD like systems have no memmove
#       (we assume they have bcopy instead). {The replacement define is in
#       compat/string.h}
#--------------------------------------------------------------------

AC_CHECK_FUNC(memmove, , [
    AC_DEFINE(NO_MEMMOVE, 1, [Do we have memmove()?])
    AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?]) ])

#--------------------------------------------------------------------
#	On some systems strstr is broken: it returns a pointer even if
#	the original string is empty.
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strstr, [
    exit(strstr("\0test", "test") ? 1 : 0);
])

#--------------------------------------------------------------------
#	Check for strtoul function.  This is tricky because under some
#	versions of AIX strtoul returns an incorrect terminator
#	pointer for the string "0".
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strtoul, [
    char *term, *string = "0";
    exit(strtoul(string,&term,0) != 0 || term != string+1);
])

#--------------------------------------------------------------------
#	Check for various typedefs and provide substitutes if
#	they don't exist.
#--------------------------------------------------------------------

AC_TYPE_MODE_T
AC_TYPE_PID_T

    AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available])
fi

AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[
#include <stdint.h>
]])

#--------------------------------------------------------------------
#	If a system doesn't have an opendir function (man, that's old!)
#	then we have to supply a different version of dirent.h which
#	is compatible with the substitute version of opendir that's
#	provided.  This version only works with V7-style directories.
#--------------------------------------------------------------------

AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H, 1, [May we include <dirent2.h>?])])

#--------------------------------------------------------------------
#	The check below checks whether <sys/wait.h> defines the type
#	"union wait" correctly.  It's needed because of weirdness in
#	HP-UX where "union wait" is defined in both the BSD and SYS-V
#	environments.  Checking the usability of WIFEXITED seems to do
#	the trick.
#--------------------------------------------------------------------

#
# Arguments:
#	none
#
# Results:
#
#	Defines some of the following vars:
#		NO_DIRENT_H
#		NO_STDLIB_H
#		NO_STRING_H
#		NO_SYS_WAIT_H
#		NO_DLFCN_H
#		HAVE_SYS_PARAM_H
#		HAVE_STRING_H ?
#
#--------------------------------------------------------------------

AC_DEFUN([SC_MISSING_POSIX_HEADERS], [
    AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [
    AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#include <dirent.h>]], [[
#ifndef _POSIX_SOURCE
#   ifdef __Lynx__
	/*
	 * Generate compilation error to make the test fail:  Lynx headers
	 * are only valid if really in the POSIX environment.
	 */

	missing_procedure();
#   endif
#endif
DIR *d;
struct dirent *entryPtr;
char *p;
d = opendir("foobar");
entryPtr = readdir(d);
p = entryPtr->d_name;
closedir(d);
]])],[tcl_cv_dirent_h=yes],[tcl_cv_dirent_h=no])])

    if test $tcl_cv_dirent_h = no; then
	AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?])
    fi

    AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
    AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
    AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
    if test $tcl_ok = 0; then
	AC_DEFINE(NO_STDLIB_H, 1, [Do we have <stdlib.h>?])
    fi
    AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
    AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
    AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)

    # See also memmove check below for a place where NO_STRING_H can be
    # set and why.

	# See if we could use long anyway  Note that we substitute in the
	# type that is our current guess for a 64-bit type inside this check
	# program, so it should be modified only carefully...
        AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[switch (0) {
            case 1: case (sizeof(long long)==sizeof(long)): ;
        }]])],[tcl_cv_type_64bit="long long"],[])])
    if test "${tcl_cv_type_64bit}" = none ; then
	AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, ['long' and 'long long' have the same size])
	AC_MSG_RESULT([yes])
    else
	AC_MSG_RESULT([no])
	# Now check for auxiliary declarations
	AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#include <dirent.h>]], [[struct dirent64 p;]])],

/* Do we have <net/errno.h>? */
#undef HAVE_NET_ERRNO_H

/* Define to 1 if you have the `open64' function. */
#undef HAVE_OPEN64

/* Define to 1 if you have the `opendir' function. */
#undef HAVE_OPENDIR

/* Define to 1 if you have the `OSSpinLockLock' function. */
#undef HAVE_OSSPINLOCKLOCK

/* Should we use pselect()? */
#undef HAVE_PSELECT

/* Define to 1 if you have the `pthread_atfork' function. */

/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H

/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H

/* Define to 1 if you have the `strtol' function. */
#undef HAVE_STRTOL

/* Define to 1 if the system has the type `struct addrinfo'. */
#undef HAVE_STRUCT_ADDRINFO

/* Is 'struct dirent64' in <sys/types.h>? */
#undef HAVE_STRUCT_DIRENT64

/* Define to 1 if the system has the type `struct in6_addr'. */

#undef HAVE_STRUCT_STAT64

/* Define to 1 if `st_blksize' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLKSIZE

/* Define to 1 if `st_blocks' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLOCKS




/* Define to 1 if you have the <sys/epoll.h> header file. */
#undef HAVE_SYS_EPOLL_H

/* Define to 1 if you have the <sys/eventfd.h> header file. */
#undef HAVE_SYS_EVENTFD_H

/* Is kqueue(2) supported? */
#undef NOTIFIER_KQUEUE

/* Is Darwin CoreFoundation unavailable for 64-bit? */
#undef NO_COREFOUNDATION_64

/* Do we have <dirent.h>? */
#undef NO_DIRENT_H

/* Do we have <dlfcn.h>? */
#undef NO_DLFCN_H

/* Do we have fd_set? */
#undef NO_FD_SET

/* Do we have fork() */

/* Do we have mknod() */
#undef NO_MKNOD

/* Do we have realpath() */
#undef NO_REALPATH

/* Do we have <stdlib.h>? */
#undef NO_STDLIB_H

/* Do we have strerror() */
#undef NO_STRERROR

/* Do we have <string.h>? */
#undef NO_STRING_H

/* Do we have <sys/wait.h>? */

/* Tcl with external libtommath */
#undef TCL_WITH_EXTERNAL_TOMMATH

/* Is getcwd Posix-compliant? */
#undef USEGETWD

/* May we include <dirent2.h>? */
#undef USE_DIRENT2_H

/* Are we building with DTrace support? */
#undef USE_DTRACE

/* Should we use FIONBIO? */
#undef USE_FIONBIO

/* Should we use vfork() instead of fork()? */

/*
 * tclUnixPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between systems. It reads in UNIX-related header files and
 *	sets up UNIX-related macros for Tcl's UNIX core. It should be the only
 *	file that contains #ifdefs to handle different flavors of UNIX. This
 *	file sets up the union of all UNIX-related things needed by any of the
 *	Tcl core files. This file depends on configuration #defines such as
 *	NO_DIRENT_H that are set up by the "configure" script.
 *
 *	Much of the material in this file was originally contributed by Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *

#endif
#include <pwd.h>
#include <signal.h>
#ifdef HAVE_SYS_PARAM_H
#   include <sys/param.h>
#endif
#include <sys/types.h>
#ifdef USE_DIRENT2_H
#   include "../compat/dirent2.h"
#else
#ifdef NO_DIRENT_H
#   include "../compat/dirent.h"
#else
#   include <dirent.h>
#endif
#endif

/*
 *---------------------------------------------------------------------------
 * Parameterize for 64-bit filesystem support.
 *---------------------------------------------------------------------------
 */

#ifndef NO_SYS_WAIT_H
#   include <sys/wait.h>
#endif
#ifdef HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#include <limits.h>
#ifdef HAVE_STDINT_H
#   include <stdint.h>
#else
#   include "../compat/stdint.h"
#endif
#include <unistd.h>

MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);

#include <utime.h>

/*

CFLAGS_OPTIMIZE	= @CFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = 		$(CFLAGS_DEBUG)
#CFLAGS = 		$(CFLAGS_OPTIMIZE)
#CFLAGS = 		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = 		@CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0 -DMP_NO_STDINT

# To enable compilation debugging reverse the comment characters on one of the
# following lines.
COMPILE_DEBUG_FLAGS =
#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG
#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS

	$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
	    "$(GENERIC_DIR_NATIVE)" \
	    "$(GENERIC_DIR_NATIVE)/tclOO.decls"

#
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# tk8.* up two directories from the TOOL_DIR.
#

TOOL_DIR=$(ROOT_DIR)/tools
HTML_INSTALL_DIR=$(ROOT_DIR)/html
html:
	$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
printf "%s\n" "$tcl_cv_eh_disposition" >&6; }
	if test "$tcl_cv_eh_disposition" = "no" ; then

printf "%s\n" "#define EXCEPTION_DISPOSITION int" >>confdefs.h

	fi

	# Check to see if winnt.h defines CHAR, SHORT, and LONG
	# even if VOID has already been #defined. The win32api
	# used by mingw and cygwin is known to do this.

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5
printf %s "checking for winnt.h that ignores VOID define... " >&6; }
if test ${tcl_cv_winnt_ignore_void+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		#define VOID void
		#define WIN32_LEAN_AND_MEAN
		#include <windows.h>
		#undef WIN32_LEAN_AND_MEAN

int
main (void)
{

		CHAR c;
		SHORT s;
		LONG l;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_winnt_ignore_void=yes
else $as_nop
  tcl_cv_winnt_ignore_void=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5
printf "%s\n" "$tcl_cv_winnt_ignore_void" >&6; }
	if test "$tcl_cv_winnt_ignore_void" = "yes" ; then

printf "%s\n" "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h

	fi

	ac_fn_c_check_header_compile "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default"
if test "x$ac_cv_header_stdbool_h" = xyes
then :

printf "%s\n" "#define HAVE_STDBOOL_H 1" >>confdefs.h

!ENDIF

# Begin Group "compat"

# PROP Default_Filter ""
# Begin Source File

SOURCE=..\compat\dirent.h
# End Source File
# Begin Source File

SOURCE=..\compat\dirent2.h
# End Source File
# Begin Source File

SOURCE=..\compat\dlfcn.h
# End Source File
# Begin Source File

SOURCE=..\compat\gettod.c
# End Source File
# Begin Source File

SOURCE=..\compat\limits.h
# End Source File
# Begin Source File

SOURCE=..\compat\memcmp.c
# End Source File
# Begin Source File

SOURCE=..\compat\opendir.c
# End Source File
# Begin Source File

SOURCE=..\compat\README
# End Source File
# Begin Source File

SOURCE=..\compat\stdlib.h
# End Source File
# Begin Source File

SOURCE=..\compat\string.h
# End Source File
# Begin Source File

SOURCE=..\compat\strncasecmp.c
# End Source File
# Begin Source File

SOURCE=..\compat\strstr.c
# End Source File
# Begin Source File

SOURCE=..\compat\strtol.c
# End Source File
# Begin Source File

SOURCE=..\compat\strtoul.c
# End Source File
# Begin Source File

SOURCE=..\compat\tclErrno.h
# End Source File
# Begin Source File

SOURCE=..\compat\waitpid.c
# End Source File
# End Group
# Begin Group "doc"

# PROP Default_Filter ""
# Begin Source File

SOURCE=..\doc\Access.3

		[tcl_cv_eh_disposition=no])
	)
	if test "$tcl_cv_eh_disposition" = "no" ; then
	AC_DEFINE(EXCEPTION_DISPOSITION, int,
		[Defined when cygwin/mingw does not support EXCEPTION DISPOSITION])
	fi

	# Check to see if winnt.h defines CHAR, SHORT, and LONG
	# even if VOID has already been #defined. The win32api
	# used by mingw and cygwin is known to do this.

	AC_CACHE_CHECK(for winnt.h that ignores VOID define,
	    tcl_cv_winnt_ignore_void,
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#define VOID void
		#define WIN32_LEAN_AND_MEAN
		#include <windows.h>
		#undef WIN32_LEAN_AND_MEAN
	    ]], [[
		CHAR c;
		SHORT s;
		LONG l;
	    ]])],
	    [tcl_cv_winnt_ignore_void=yes],
	    [tcl_cv_winnt_ignore_void=no])
	)
	if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
	    AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1,
		    [Defined when cygwin/mingw ignores VOID define in winnt.h])
	fi

	AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],)

	# See if the compiler supports casting to a union type.
	# This is used to stop gcc from printing a compiler
	# warning when initializing a union member.

	AC_CACHE_CHECK(for cast to union support,

#include <malloc.h>
#include <process.h>
#include <signal.h>
#ifdef HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#include <limits.h>
#ifdef HAVE_STDINT_H
#   include <stdint.h>
#else
#   include "../compat/stdint.h"
#endif

#ifndef __GNUC__
#    define strncasecmp _strnicmp
#    define strcasecmp _stricmp
#endif

/*
 * Need to block out these includes for building extensions with MetroWerks