Tcl Source Code

README:  Tcl

    This is the Tcl 9.0a0 source distribution.


	http://sourceforge.net/projects/tcl/files/Tcl/
    You can get any source release of Tcl from the URL above.



Contents
--------
    1. Introduction
    2. Documentation
    3. Compiling and installing Tcl
    4. Development tools
    5. Tcl newsgroup
    6. The Tcler's Wiki
    7. Mailing lists
    8. Support and Training
    9. Tracking Development
    10. Thank You

1. Introduction
---------------
Tcl provides a powerful platform for creating integration applications that
tie together diverse applications, protocols, devices, and frameworks.
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.

Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests
takes place at:

	http://core.tcl-lang.org/

Tcl/Tk release and mailing list services are hosted by SourceForge:

	http://sourceforge.net/projects/tcl/

with the Tcl Developer Xchange hosted at:

	http://www.tcl-lang.org/

Tcl is a freely available open source package.  You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part.  See the file
"license.terms" for complete information.

2. Documentation
----------------

Extensive documentation is available at our website.
The home page for this release, including new features, is
	http://www.tcl-lang.org/software/tcltk/9.0.html

Detailed release notes can be found at the file distributions page

by clicking on the relevant version.
	http://sourceforge.net/projects/tcl/files/Tcl/

Information about Tcl itself can be found at
	http://www.tcl-lang.org/about/

There have been many Tcl books on the market.  Many are mentioned in the Wiki:
	http://wiki.tcl-lang.org/_/ref?N=25206

To view the complete set of reference manual entries for Tcl 9.0 online,
visit the URL:
	http://www.tcl-lang.org/man/tcl9.0/

2a. Unix Documentation
----------------------

The "doc" subdirectory in this release contains a complete set of
reference manual entries for Tcl.  Files with extension ".1" are for
programs (for example, tclsh.1); files with extension ".3" are for C

library procedures; and files with extension ".n" describe Tcl
commands.  The file "doc/Tcl.n" gives a quick summary of the Tcl
language syntax.  To print any of the man pages on Unix, cd to the
"doc" directory and invoke your favorite variant of troff using the
normal -man macros, for example

		ditroff -man Tcl.n

to print Tcl.n.  If Tcl has been installed correctly and your "man" program
supports it, you should be able to access the Tcl manual entries using the
normal "man" mechanisms, such as

		man Tcl

2b. Windows Documentation
-------------------------

The "doc" subdirectory in this release contains a complete set of Windows
help files for Tcl.  Once you install this Tcl release, a shortcut to the
Windows help Tcl documentation will appear in the "Start" menu:

	Start | Programs | Tcl | Tcl Help

3. Compiling and installing Tcl
-------------------------------

There are brief notes in the unix/README, win/README, and macosx/README about
compiling on these different platforms.  There is additional information
about building Tcl from sources at

	http://www.tcl-lang.org/doc/howto/compile.html

4. Development tools
---------------------------

ActiveState produces a high quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler and
more.  More information can be found at

	http://www.ActiveState.com/Tcl

5. Tcl newsgroup
----------------

There is a USENET news group, "comp.lang.tcl", intended for the exchange of
information about Tcl, Tk, and related applications.  The newsgroup is a
great place to ask general information questions.  For bug reports, please
see the "Support and bug fixes" section below.

6. Tcl'ers Wiki
---------------

A Wiki-based open community site covering all aspects of Tcl/Tk is at:

	http://wiki.tcl-lang.org/

It is dedicated to the Tcl programming language and its extensions.  A
wealth of useful information can be found there.  It contains code
snippets, references to papers, books, and FAQs, as well as pointers to
development tools, extensions, and applications.  You can also recommend
additional URLs by editing the wiki yourself.

7. Mailing lists
----------------

Several mailing lists are hosted at SourceForge to discuss development or
use issues (like Macintosh and Windows topics).  For more information and
to subscribe, visit:

	http://sourceforge.net/projects/tcl/

and go to the Mailing Lists page.

8. Support and Training
------------------------

We are very interested in receiving bug reports, patches, and suggestions
for improvements.  We prefer that you send this information to us as
tickets entered into our tracker at:

	http://core.tcl-lang.org/tcl/reportlist

We will log and follow-up on each bug, although we cannot promise a
specific turn-around time.  Enhancements may take longer and may not happen
at all unless there is widespread support for them (we're trying to
slow the rate at which Tcl/Tk turns into a kitchen sink).  It's very
difficult to make incompatible changes to Tcl/Tk at this point, due to
the size of the installed base.

The Tcl community is too large for us to provide much individual support
for users.  If you need help we suggest that you post questions to


comp.lang.tcl.  We read the newsgroup and will attempt to answer esoteric
questions for which no one else is likely to know the answer.  In addition,
see the following Web site for links to other organizations that offer
Tcl/Tk training:

	http://wiki.tcl-lang.org/training

9. Tracking Development
-----------------------

Tcl is developed in public.  To keep an eye on how Tcl is changing, see
	http://core.tcl-lang.org/

10. Thank You
-------------

We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.

# README:  Tcl

This is the **Tcl 9.0a0** source distribution.
	
You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).


[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=master)](https://travis-ci.org/tcltk/tcl)

## Contents

 1. [Introduction](#intro)
 2. [Documentation](#doc)
 3. [Compiling and installing Tcl](#build)
 4. [Development tools](#devtools)
 5. [Tcl newsgroup](#complangtcl)
 6. [The Tcler's Wiki](#wiki)
 7. [Mailing lists](#email)
 8. [Support and Training](#support)
 9. [Tracking Development](#watch)
 10. [Thank You](#thanks)

## <a id="intro">1.</a> Introduction

Tcl provides a powerful platform for creating integration applications that
tie together diverse applications, protocols, devices, and frameworks.
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.

Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests


takes place at [core.tcl-lang.org](https://core.tcl-lang.org/).

Tcl/Tk release and mailing list services are [hosted by

SourceForge](https://sourceforge.net/projects/tcl/)

with the Tcl Developer Xchange hosted at

[www.tcl-lang.org](https://www.tcl-lang.org).

Tcl is a freely available open source package.  You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part.  See the file
`license.terms` for complete information.

## <a id="doc">2.</a> Documentation


Extensive documentation is available at our website.
The home page for this release, including new features, is
[here](https://www.tcl.tk/software/tcltk/9.0.html).

Detailed release notes can be found at the
[file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/)
by clicking on the relevant version.


Information about Tcl itself can be found at the [Developer
Xchange](https://www.tcl-lang.org/about/).

There have been many Tcl books on the market.  Many are mentioned in
[the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206).

The complete set of reference manual entries for Tcl 9.0 is [online,

here](https://www.tcl-lang.org/man/tcl9.0/).

### <a id="doc.unix">2a.</a> Unix Documentation


The `doc` subdirectory in this release contains a complete set of
reference manual entries for Tcl.  Files with extension "`.1`" are for

programs (for example, `tclsh.1`); files with extension "`.3`" are for C
library procedures; and files with extension "`.n`" describe Tcl
commands.  The file "`doc/Tcl.n`" gives a quick summary of the Tcl
language syntax.  To print any of the man pages on Unix, cd to the
"doc" directory and invoke your favorite variant of troff using the
normal -man macros, for example

		groff -man -Tpdf Tcl.n >output.pdf

to print Tcl.n to PDF.  If Tcl has been installed correctly and your "man" program
supports it, you should be able to access the Tcl manual entries using the
normal "man" mechanisms, such as

		man Tcl

### <a id="doc.win">2b.</a> Windows Documentation


The "doc" subdirectory in this release contains a complete set of Windows
help files for Tcl.  Once you install this Tcl release, a shortcut to the
Windows help Tcl documentation will appear in the "Start" menu:

		Start | Programs | Tcl | Tcl Help

## <a id="build">3.</a> Compiling and installing Tcl


There are brief notes in the `unix/README`, `win/README`, and `macosx/README`
about compiling on these different platforms.  There is additional information
about building Tcl from sources

[online](https://www.tcl-lang.org/doc/howto/compile.html).

## <a id="devtools">4.</a> Development tools


ActiveState produces a high quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler and
more.  More information can be found at

	http://www.ActiveState.com/Tcl

## <a id="complangtcl">5.</a> Tcl newsgroup


There is a USENET news group, "`comp.lang.tcl`", intended for the exchange of
information about Tcl, Tk, and related applications.  The newsgroup is a
great place to ask general information questions.  For bug reports, please
see the "Support and bug fixes" section below.

## <a id="wiki">6.</a> Tcl'ers Wiki
There is a [wiki-based open community site](https://wiki.tcl-lang.org/)

covering all aspects of Tcl/Tk.



It is dedicated to the Tcl programming language and its extensions.  A
wealth of useful information can be found there.  It contains code
snippets, references to papers, books, and FAQs, as well as pointers to
development tools, extensions, and applications.  You can also recommend
additional URLs by editing the wiki yourself.

## <a id="email">7.</a> Mailing lists


Several mailing lists are hosted at SourceForge to discuss development or use
issues (like Macintosh and Windows topics).  For more information and to


subscribe, visit [here](https://sourceforge.net/projects/tcl/) and go to the

Mailing Lists page.

## <a id="support">8.</a> Support and Training


We are very interested in receiving bug reports, patches, and suggestions for
improvements.  We prefer that you send this information to us as tickets


entered into [our issue tracker](https://core.tcl-lang.org/tcl/reportlist).

We will log and follow-up on each bug, although we cannot promise a
specific turn-around time.  Enhancements may take longer and may not happen
at all unless there is widespread support for them (we're trying to
slow the rate at which Tcl/Tk turns into a kitchen sink).  It's very
difficult to make incompatible changes to Tcl/Tk at this point, due to
the size of the installed base.

The Tcl community is too large for us to provide much individual support for
users.  If you need help we suggest that you post questions to `comp.lang.tcl`
or ask a question on [Stack
Overflow](https://stackoverflow.com/questions/tagged/tcl).  We read the
newsgroup and will attempt to answer esoteric questions for which no one else
is likely to know the answer.  In addition, see the wiki for [links to other



organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training.

## <a id="watch">9.</a> Tracking Development


Tcl is developed in public.  You can keep an eye on how Tcl is changing at
[core.tcl-lang.org](https://core.tcl-lang.org/).

## <a id="thanks">10.</a> Thank You


We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.

'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewIntObj\fR(\fIintValue\fR)
.sp
................................................................................
\fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR)
.sp
\fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR)
.sp
int
\fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR)
.sp



int
\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
.sp
int
\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
.sp
.sp
................................................................................
int
\fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
.sp
int
\fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR)
.SH ARGUMENTS
.AS Tcl_WideInt doubleValue in/out


.AP int intValue in
Integer value used to initialize or set a Tcl value.
.AP long longValue in
Long integer value used to initialize or set a Tcl value.
.AP Tcl_WideInt wideValue in
Wide integer value used to initialize or set a Tcl value.
.AP Tcl_Obj *objPtr in/out
................................................................................
and \fBTcl_SetBignumObj\fR routines each set the value of an existing
Tcl value pointed to by \fIobjPtr\fR to the integral value provided
by the other argument.  The \fIobjPtr\fR argument must point to an
unshared Tcl value.  Any attempt to set the value of a shared Tcl value
violates Tcl's copy-on-write policy.  Any existing string representation
or internal representation in the unshared Tcl value will be freed
as a consequence of setting the new value.










.PP
The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and
\fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral
value of the appropriate type from the Tcl value \fIobjPtr\fR.  If the
attempt succeeds, then \fBTCL_OK\fR is returned, and the value is
written to the storage provided by the caller.  The attempt might

'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewIntObj\fR(\fIintValue\fR)
.sp
................................................................................
\fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR)
.sp
\fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR)
.sp
int
\fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR)
.sp
int
\fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, intPtr\fR)
.sp
int
\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
.sp
int
\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
.sp
.sp
................................................................................
int
\fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
.sp
int
\fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR)
.SH ARGUMENTS
.AS Tcl_WideInt doubleValue in/out
.AP int endValue in
\fBTcl_GetIntForIndex\fR will return this when the input value is "end".
.AP int intValue in
Integer value used to initialize or set a Tcl value.
.AP long longValue in
Long integer value used to initialize or set a Tcl value.
.AP Tcl_WideInt wideValue in
Wide integer value used to initialize or set a Tcl value.
.AP Tcl_Obj *objPtr in/out
................................................................................
and \fBTcl_SetBignumObj\fR routines each set the value of an existing
Tcl value pointed to by \fIobjPtr\fR to the integral value provided
by the other argument.  The \fIobjPtr\fR argument must point to an
unshared Tcl value.  Any attempt to set the value of a shared Tcl value
violates Tcl's copy-on-write policy.  Any existing string representation
or internal representation in the unshared Tcl value will be freed
as a consequence of setting the new value.
.PP
The \fBTcl_GetIntForIndex\fR routine attempts to retrieve an index
value from the Tcl value \fIobjPtr\fR.  If the attempt succeeds,
then \fBTCL_OK\fR is returned, and the value is written to the
storage provided by the caller.  The attempt might fail if
\fIobjPtr\fR does not hold an index value.  If the attempt fails,
then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL,
an error message is left in \fIinterp\fR.  The \fBTcl_ObjType\fR
of \fIobjPtr\fR may be changed to make subsequent calls to the
same routine more efficient.
.PP
The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and
\fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral
value of the appropriate type from the Tcl value \fIobjPtr\fR.  If the
attempt succeeds, then \fBTCL_OK\fR is returned, and the value is
written to the storage provided by the caller.  The attempt might

In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BYTES\fR may be used.
.VE "TIP 312"
.sp
All the above for both functions may be
optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl
variable read-only.
.AP int size in
.VS "TIP 312"
The number of elements in the C array. Must be greater than zero.
.VE "TIP 312"
.BE
.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable

In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BYTES\fR may be used.
.VE "TIP 312"
.sp
All the above for both functions may be
optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl
variable read-only.
.AP size_t size in
.VS "TIP 312"
The number of elements in the C array. Must be greater than zero.
.VE "TIP 312"
.BE
.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable

by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
.AP char *start in
If \fItext\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
If it is not the same as \fItext\fR, then no
.QW \fB^\fR
matches will be allowed.
.AP int index in
Specifies which range is desired:  0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
sub-expression.
.AP "const char" **startPtr out
The address of the first character in the range is stored here, or
NULL if there is no such range.
.AP "const char" **endPtr out
................................................................................
is stored here, or NULL if there is no such range.
.AP int cflags in
OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR,
\fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR,
\fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR,
\fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and
\fBTCL_REG_CANMATCH\fR. See below for more information.
.AP int offset in
The character offset into the text where matching should begin.
The value of the offset has no impact on \fB^\fR matches.  This
behavior is controlled by \fIeflags\fR.
.AP int nmatches in
The number of matching subexpressions that should be remembered for
later use.  If this value is 0, then no subexpression match
information will be computed.  If the value is \-1, then
all of the matching subexpressions will be remembered.  Any other
value will be taken as the maximum number of subexpressions to
remember.
.AP int eflags in
OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and
\fBTCL_REG_NOTEOL\fR. See below for more information.
.AP Tcl_RegExpInfo *infoPtr out
................................................................................
\fBTcl_RegExpGetInfo\fR retrieves information about the last match
performed with a given regular expression \fIregexp\fR.  The
\fIinfoPtr\fR argument contains a pointer to a structure that is
defined as follows:
.PP
.CS
typedef struct Tcl_RegExpInfo {
    int \fInsubs\fR;
    Tcl_RegExpIndices *\fImatches\fR;
    long \fIextendStart\fR;
} \fBTcl_RegExpInfo\fR;
.CE
.PP
The \fInsubs\fR field contains a count of the number of parenthesized
subexpressions within the regular expression.  If the \fBTCL_REG_NOSUB\fR
was used, then this value will be zero.  The \fImatches\fR field
points to an array of \fInsubs\fR+1 values that indicate the bounds of each
................................................................................
range matched by the entire regular expression, and subsequent elements
refer to the parenthesized subexpressions in the order that they
appear in the pattern.  Each element is a structure that is defined as
follows:
.PP
.CS
typedef struct Tcl_RegExpIndices {
    long \fIstart\fR;
    long \fIend\fR;
} \fBTcl_RegExpIndices\fR;
.CE
.PP
The \fIstart\fR and \fIend\fR values are Unicode character indices
relative to the offset location within \fIobjPtr\fR where matching began.
The \fIstart\fR index identifies the first character of the matched
subexpression.  The \fIend\fR index identifies the first character

by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
.AP char *start in
If \fItext\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
If it is not the same as \fItext\fR, then no
.QW \fB^\fR
matches will be allowed.
.AP size_t index in
Specifies which range is desired:  0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
sub-expression.
.AP "const char" **startPtr out
The address of the first character in the range is stored here, or
NULL if there is no such range.
.AP "const char" **endPtr out
................................................................................
is stored here, or NULL if there is no such range.
.AP int cflags in
OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR,
\fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR,
\fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR,
\fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and
\fBTCL_REG_CANMATCH\fR. See below for more information.
.AP size_t offset in
The character offset into the text where matching should begin.
The value of the offset has no impact on \fB^\fR matches.  This
behavior is controlled by \fIeflags\fR.
.AP size_t nmatches in
The number of matching subexpressions that should be remembered for
later use.  If this value is 0, then no subexpression match
information will be computed.  If the value is TCL_INDEX_NONE, then
all of the matching subexpressions will be remembered.  Any other
value will be taken as the maximum number of subexpressions to
remember.
.AP int eflags in
OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and
\fBTCL_REG_NOTEOL\fR. See below for more information.
.AP Tcl_RegExpInfo *infoPtr out
................................................................................
\fBTcl_RegExpGetInfo\fR retrieves information about the last match
performed with a given regular expression \fIregexp\fR.  The
\fIinfoPtr\fR argument contains a pointer to a structure that is
defined as follows:
.PP
.CS
typedef struct Tcl_RegExpInfo {
    size_t \fInsubs\fR;
    Tcl_RegExpIndices *\fImatches\fR;
    size_t \fIextendStart\fR;
} \fBTcl_RegExpInfo\fR;
.CE
.PP
The \fInsubs\fR field contains a count of the number of parenthesized
subexpressions within the regular expression.  If the \fBTCL_REG_NOSUB\fR
was used, then this value will be zero.  The \fImatches\fR field
points to an array of \fInsubs\fR+1 values that indicate the bounds of each
................................................................................
range matched by the entire regular expression, and subsequent elements
refer to the parenthesized subexpressions in the order that they
appear in the pattern.  Each element is a structure that is defined as
follows:
.PP
.CS
typedef struct Tcl_RegExpIndices {
    size_t \fIstart\fR;
    size_t \fIend\fR;
} \fBTcl_RegExpIndices\fR;
.CE
.PP
The \fIstart\fR and \fIend\fR values are Unicode character indices
relative to the offset location within \fIobjPtr\fR where matching began.
The \fIstart\fR index identifies the first character of the matched
subexpression.  The \fIend\fR index identifies the first character

specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR.  The source string must
contain at least \fIindex\fR characters.  This is equivalent to calling
\fBTcl_UtfNext\fR \fIindex\fR times.  If \fIindex\fR is TCL_AUTO_LENGTH,
the return pointer points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands.  It parses a backslash sequence and stores the properly formed
UTF-8 character represented by the backslash sequence in the output
buffer \fIdst\fR.  At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number

specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR.  The source string must
contain at least \fIindex\fR characters.  This is equivalent to calling
\fBTcl_UtfNext\fR \fIindex\fR times.  If \fIindex\fR is TCL_INDEX_NONE,
the return pointer points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands.  It parses a backslash sequence and stores the properly formed
UTF-8 character represented by the backslash sequence in the output
buffer \fIdst\fR.  At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number

'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
coroutine, yield, yieldto \- Create and produce values from coroutines
.SH SYNOPSIS
.nf
\fBcoroutine \fIname command\fR ?\fIarg...\fR?
\fByield\fR ?\fIvalue\fR?
.VS TIP396
\fByieldto\fR \fIcommand\fR ?\fIarg...\fR?
\fIname\fR ?\fIvalue...\fR?

.VE TIP396



.fi
.BE
.SH DESCRIPTION
.PP
The \fBcoroutine\fR command creates a new coroutine context (with associated
command) named \fIname\fR and executes that context by calling \fIcommand\fR,
passing in the other remaining arguments without further interpretation. Once
................................................................................
of the context can then be resumed by calling the context command, optionally
passing in the \fIsingle\fR value to use as the result of the \fByield\fR call
that caused
the context to be suspended. If the coroutine context never yields and instead
returns conventionally, the result of the \fBcoroutine\fR command will be the
result of the evaluation of the context.
.PP
.VS TIP396
The coroutine may also suspend its execution by use of the \fByieldto\fR
command, which instead of returning, cedes execution to some command called
\fIcommand\fR (resolved in the context of the coroutine) and to which \fIany
number\fR of arguments may be passed. Since every coroutine has a context
command, \fByieldto\fR can be used to transfer control directly from one
coroutine to another (this is only advisable if the two coroutines are
expecting this to happen) but \fIany\fR command may be the target. If a
................................................................................
decide what to do with those values.
.PP
The recommended way of writing a version of \fByield\fR that allows resumption
with multiple arguments is by using \fByieldto\fR and the \fBreturn\fR
command, like this:
.PP
.CS
proc yieldm {value} {
    \fByieldto\fR return -level 0 $value
}
.CE
.VE TIP396
.PP
The coroutine can also be deleted by destroying the command \fIname\fR, and
the name of the current coroutine can be retrieved by using
\fBinfo coroutine\fR.
If there are deletion traces on variables in the coroutine's
implementation, they will fire at the point when the coroutine is explicitly
deleted (or, naturally, if the command returns conventionally).
.PP
At the point when \fIcommand\fR is called, the current namespace will be the
global namespace and there will be no stack frames above it (in the sense of
\fBupvar\fR and \fBuplevel\fR). However, which command to call will be
determined in the namespace that the \fBcoroutine\fR command was called from.













































.SH EXAMPLES
.PP
This example shows a coroutine that will produce an infinite sequence of
even values, and a loop that consumes the first ten of them.
.PP
.CS
proc allNumbers {} {
................................................................................
    }
}} allNumbers
for {set i 1} {$i <= 20} {incr i} {
    puts "prime#$i = [\fIeratosthenes\fR]"
}
.CE
.PP
.VS TIP396
This example shows how a value can be passed around a group of three
coroutines that yield to each other:
.PP
.CS
proc juggler {name target {value ""}} {
    if {$value eq ""} {
        set value [\fByield\fR [info coroutine]]
    }
    while {$value ne ""} {
        puts "$name : $value"
        set value [string range $value 0 end-1]
        lassign [\fByieldto\fR $target $value] value
    }
}
\fBcoroutine\fR j1 juggler Larry [
    \fBcoroutine\fR j2 juggler Curly [
        \fBcoroutine\fR j3 juggler Moe j1]] "Nyuck!Nyuck!Nyuck!"
.CE
.VE TIP396











































.SS "DETAILED SEMANTICS"
.PP
This example demonstrates that coroutines start from the global namespace, and
that \fIcommand\fR resolution happens before the coroutine stack is created.
.PP
.CS
proc report {where level} {

'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
coroutine, yield, yieldto \- Create and produce values from coroutines
.SH SYNOPSIS
.nf
\fBcoroutine \fIname command\fR ?\fIarg...\fR?
\fByield\fR ?\fIvalue\fR?

\fByieldto\fR \fIcommand\fR ?\fIarg...\fR?
\fIname\fR ?\fIvalue...\fR?
.sp
.VS "8.7, TIP383"
\fBcoroinject \fIcoroName command\fR ?\fIarg...\fR?
\fBcoroprobe \fIcoroName command\fR ?\fIarg...\fR?
.VE "8.7, TIP383"
.fi
.BE
.SH DESCRIPTION
.PP
The \fBcoroutine\fR command creates a new coroutine context (with associated
command) named \fIname\fR and executes that context by calling \fIcommand\fR,
passing in the other remaining arguments without further interpretation. Once
................................................................................
of the context can then be resumed by calling the context command, optionally
passing in the \fIsingle\fR value to use as the result of the \fByield\fR call
that caused
the context to be suspended. If the coroutine context never yields and instead
returns conventionally, the result of the \fBcoroutine\fR command will be the
result of the evaluation of the context.
.PP

The coroutine may also suspend its execution by use of the \fByieldto\fR
command, which instead of returning, cedes execution to some command called
\fIcommand\fR (resolved in the context of the coroutine) and to which \fIany
number\fR of arguments may be passed. Since every coroutine has a context
command, \fByieldto\fR can be used to transfer control directly from one
coroutine to another (this is only advisable if the two coroutines are
expecting this to happen) but \fIany\fR command may be the target. If a
................................................................................
decide what to do with those values.
.PP
The recommended way of writing a version of \fByield\fR that allows resumption
with multiple arguments is by using \fByieldto\fR and the \fBreturn\fR
command, like this:
.PP
.CS
proc yieldMultiple {value} {
    tailcall \fByieldto\fR string cat $value
}
.CE

.PP
The coroutine can also be deleted by destroying the command \fIname\fR, and
the name of the current coroutine can be retrieved by using
\fBinfo coroutine\fR.
If there are deletion traces on variables in the coroutine's
implementation, they will fire at the point when the coroutine is explicitly
deleted (or, naturally, if the command returns conventionally).
.PP
At the point when \fIcommand\fR is called, the current namespace will be the
global namespace and there will be no stack frames above it (in the sense of
\fBupvar\fR and \fBuplevel\fR). However, which command to call will be
determined in the namespace that the \fBcoroutine\fR command was called from.
.PP
.VS "8.7, TIP383"
A suspended coroutine (i.e., one that has \fByield\fRed or \fByieldto\fR-d)
may have its state inspected (or modified) at that point by using
\fBcoroprobe\fR to run a command at the point where the coroutine is at. The
command takes the name of the coroutine to run the command in, \fIcoroName\fR,
and the name of a command (any any arguments it requires) to immediately run
at that point. The result of that command is the result of the \fBcoroprobe\fR
command, and the gross state of the coroutine remains the same afterwards
(i.e., the coroutine is still expecting the results of a \fByield\fR or
\fByieldto\fR as before) though variables may have been changed.
.PP
Similarly, the \fBcoroinject\fR command may be used to place a command to be
run inside a suspended coroutine (when it is resumed) to process arguments,
with quite a bit of similarity to \fBcoroprobe\fR. However, with
\fBcoroinject\fR there are several key differences:
.VE "8.7, TIP383"
.IP \(bu
.VS "8.7, TIP383"
The coroutine is not immediately resumed after the injection has been done.  A
consequence of this is that multiple injections may be done before the
coroutine is resumed. There injected commands are performed in \fIreverse
order of definition\fR (that is, they are internally stored on a stack).
.VE "8.7, TIP383"
.IP \(bu
.VS "8.7, TIP383"
An additional two arguments are appended to the list of arguments to be run
(that is, the \fIcommand\fR and its \fIargs\fR are extended by two elements).
The first is the name of the command that suspended the coroutine (\fByield\fR
or \fByieldto\fR), and the second is the argument (or list of arguments, in
the case of \fByieldto\fR) that is the current resumption value.
.VE "8.7, TIP383"
.IP \(bu
.VS "8.7, TIP383"
The result of the injected command is used as the result of the \fByield\fR or
\fByieldto\fR that caused the coroutine to become suspended. Where there are
multiple injected commands, the result of one becomes the resumption value
processed by the next.
.PP
The injection is a one-off. It is not retained once it has been executed. It
may \fByield\fR or \fByieldto\fR as part of its execution.
.PP
Note that running coroutines may be neither probed nor injected; the
operations may only be applied to
.VE "8.7, TIP383"
.SH EXAMPLES
.PP
This example shows a coroutine that will produce an infinite sequence of
even values, and a loop that consumes the first ten of them.
.PP
.CS
proc allNumbers {} {
................................................................................
    }
}} allNumbers
for {set i 1} {$i <= 20} {incr i} {
    puts "prime#$i = [\fIeratosthenes\fR]"
}
.CE
.PP

This example shows how a value can be passed around a group of three
coroutines that yield to each other:
.PP
.CS
proc juggler {name target {value ""}} {
    if {$value eq ""} {
        set value [\fByield\fR [info coroutine]]
    }
    while {$value ne ""} {
        puts "$name : $value"
        set value [string range $value 0 end-1]
        lassign [\fByieldto\fR \fI$target\fR $value] value
    }
}
\fBcoroutine\fR j1 juggler Larry [
    \fBcoroutine\fR j2 juggler Curly [
        \fBcoroutine\fR j3 juggler Moe j1]] "Nyuck!Nyuck!Nyuck!"
.CE
.PP
.VS "8.7, TIP383"
This example shows a simple coroutine that collects non-empty values and
returns a list of them when not given an argument. It also shows how we can
look inside the coroutine to find out what it is doing, and how we can modify
the input on a one-off basis.
.PP
.CS
proc collectorImpl {} {
    set me [info coroutine]
    set accumulator {}
    for {set val [\fByield\fR $me]} {$val ne ""} {set val [\fByield\fR]} {
        lappend accumulator $val
    }
    return $accumulator
}

\fBcoroutine\fR collect collectorImpl
\fIcollect\fR 123
\fIcollect\fR "abc def"
\fIcollect\fR 456

puts [\fBcoroprobe \fIcollect\fR set accumulator]
# ==> 123 {abc def} 456

\fIcollect\fR "pqr"

\fBcoroinject \fIcollect\fR apply {{type value} {
    puts "Received '$value' at a $type in [info coroutine]"
    return [string toupper $value]
}}

\fIcollect\fR rst
# ==> Received 'rst' at a yield in ::collect
\fIcollect\fR xyz

puts [\fIcollect\fR]
# ==> 123 {abc def} 456 pqr RST xyz
.CE
.PP
This example shows a simple coroutine that collects non-empty values and
returns a list of them when not given an argument. It also shows how we can
look inside the coroutine to find out what it is doing.
.VE "8.7, TIP383"
.SS "DETAILED SEMANTICS"
.PP
This example demonstrates that coroutines start from the global namespace, and
that \fIcommand\fR resolution happens before the coroutine stack is created.
.PP
.CS
proc report {where level} {

\fBTcl\fR.
.PP
Below are some examples of simple expressions where the value of \fBa\fR is 3
and the value of \fBb\fR is 6.  The command on the left side of each line
produces the value on the right side.
.PP
.CS
.ta 6c
\fBexpr\fR 3.1 + $a	\fI6.1\fR
\fBexpr\fR 2 + "$a.$b"	\fI5.6\fR
\fBexpr\fR 4*[llength "6 2"]	\fI8\fR
\fBexpr\fR {{word one} < "word $a"}	\fI0\fR
.CE
.SS OPERATORS
.PP
................................................................................
\fB|\fR
.
Bit-wise OR.  Valid for integer operands.
.TP 20
\fB&&\fR
.
Logical AND.  If both operands are true, the result is 1, or 0 otherwise.





.TP 20
\fB||\fR
.
Logical OR.  If both operands are false, the result is 0, or 1 otherwise.


.TP 20
\fIx\fB?\fIy\fB:\fIz\fR

.
If-then-else, as in C.  If \fIx\fR is false , the result is the value of
\fIy\fR.  Otherwise the result is the value of \fIz\fR.

.PP
The exponentiation operator promotes types in the same way that the multiply
and divide operators do, and the result is is the same as the result of
\fBpow\fR.
Exponentiation groups right-to-left within a precedence level. Other binary
operators group left-to-right.  For example, the value of

.PP
.CS
\fBexpr\fR {4*2 < 7}
.CE
.PP
is 0, while the value of
.PP
................................................................................
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.
This also avoids issues that can arise if Tcl is allowed to perform
substitution on the value before \fBexpr\fR is called.
.PP
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR.  Enclosing the



expression in braces would result in a syntax error.


.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
.CE
.PP

When an expression is generated at runtime, like the one above is, the bytcode
compiler must ensure that new code is generated each time the expression
is evaluated.  This is the most costly kind of expression from a performance
perspective.  In such cases, consider directly using the commands described in
the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR.

Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions.  To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.




















.SH EXAMPLES
.PP
A numeric comparison whose result is 1:

.CS
\fBexpr\fR {"0x03" > "2"}
.CE
.PP
A string comparison whose result is 1:

.CS
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
Define a procedure that computes an
.QW interesting
mathematical function:

\fBTcl\fR.
.PP
Below are some examples of simple expressions where the value of \fBa\fR is 3
and the value of \fBb\fR is 6.  The command on the left side of each line
produces the value on the right side.
.PP
.CS
.ta 9c
\fBexpr\fR 3.1 + $a	\fI6.1\fR
\fBexpr\fR 2 + "$a.$b"	\fI5.6\fR
\fBexpr\fR 4*[llength "6 2"]	\fI8\fR
\fBexpr\fR {{word one} < "word $a"}	\fI0\fR
.CE
.SS OPERATORS
.PP
................................................................................
\fB|\fR
.
Bit-wise OR.  Valid for integer operands.
.TP 20
\fB&&\fR
.
Logical AND.  If both operands are true, the result is 1, or 0 otherwise.

This operator evaluates lazily; it only evaluates its second operand if it
must in order to determine its result.
This operator evaluates lazily; it only evaluates its second operand if it
must in order to determine its result.
.TP 20
\fB||\fR
.
Logical OR.  If both operands are false, the result is 0, or 1 otherwise.
This operator evaluates lazily; it only evaluates its second operand if it
must in order to determine its result.
.TP 20

\fIx \fB?\fI y \fB:\fI z\fR
.
If-then-else, as in C.  If \fIx\fR is false , the result is the value of
\fIy\fR.  Otherwise the result is the value of \fIz\fR.
This operator evaluates lazily; it evaluates only one of \fIy\fR or \fIz\fR.
.PP
The exponentiation operator promotes types in the same way that the multiply
and divide operators do, and the result is is the same as the result of
\fBpow\fR.
Exponentiation groups right-to-left within a precedence level. Other binary
operators group left-to-right.  For example, the value of
.PP
.PP
.CS
\fBexpr\fR {4*2 < 7}
.CE
.PP
is 0, while the value of
.PP
................................................................................
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.
This also avoids issues that can arise if Tcl is allowed to perform
substitution on the value before \fBexpr\fR is called.
.PP
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part
of evaluating the expression
.QW "$a + 2*4" .
Enclosing the
expression in braces would result in a syntax error as \fB$b\fR does
not evaluate to a numeric value.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
.CE
.PP

When an expression is generated at runtime, like the one above is, the bytecode
compiler must ensure that new code is generated each time the expression
is evaluated.  This is the most costly kind of expression from a performance
perspective.  In such cases, consider directly using the commands described in
the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR.
.PP
Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions.  To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
.PP
If it is necessary to include a non-constant expression string within the
wider context of an otherwise-constant expression, the most efficient
technique is to put the varying part inside a recursive \fBexpr\fR, as this at
least allows for the compilation of the outer part, though it does mean that
the varying part must itself be evaluated as a separate expression. Thus, in
this example the result is 20 and the outer expression benefits from fully
cached bytecode compilation.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR {[\fBexpr\fR $b] * 4}
.CE
.PP
In general, you should enclose your expression in braces wherever possible,
and where not possible, the argument to \fBexpr\fR should be an expression
defined elsewhere as simply as possible. It is usually more efficient and
safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR
namespace) than it is to do complex expression generation.
.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
.CE
.PP
A string comparison whose result is 1:
.PP
.CS
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
Define a procedure that computes an
.QW interesting
mathematical function:

\fBfile tail \fIname\fR
.
Returns all of the characters in the last filesystem component of
\fIname\fR.  Any trailing directory separator in \fIname\fR is ignored.
If \fIname\fR contains no separators then returns \fIname\fR.  So,
\fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all
return \fBb\fR.






























.TP
\fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR?
'\" TIP #210
.VS 8.6
Creates a temporary file and returns a read-write channel opened on that file.
If the \fInameVar\fR is given, it specifies a variable that the name of the
temporary file will be written into; if absent, Tcl will attempt to arrange

\fBfile tail \fIname\fR
.
Returns all of the characters in the last filesystem component of
\fIname\fR.  Any trailing directory separator in \fIname\fR is ignored.
If \fIname\fR contains no separators then returns \fIname\fR.  So,
\fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all
return \fBb\fR.
.TP
\fBfile tempdir\fR ?\fItemplate\fR?
.VS "8.7, TIP 431"
Creates a temporary directory (guaranteed to be newly created and writable by
the current script) and returns its name. If \fItemplate\fR is given, it
specifies one of or both of the existing directory (on a filesystem controlled
by the operating system) to contain the temporary directory, and the base part
of the directory name; it is considered to have the location of the directory
if there is a directory separator in the name, and the base part is everything
after the last directory separator (if non-empty).  The default containing
directory is determined by system-specific operations, and the default base
name prefix is
.QW \fBtcl\fR .
.RS
.PP
The following output is typical and illustrative; the actual output will vary
between platforms:
.PP
.CS
% \fBfile tempdir\fR
/var/tmp/tcl_u0kuy5
 % \fBfile tempdir\fR /tmp/myapp
/tmp/myapp_8o7r9L
% \fBfile tempdir\fR /tmp/
/tmp/tcl_1mOJHD
% \fBfile tempdir\fR myapp
/var/tmp/myapp_0ihS0n
.CE
.RE
.VE "8.7, TIP 431"
.TP
\fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR?
'\" TIP #210
.VS 8.6
Creates a temporary file and returns a read-write channel opened on that file.
If the \fInameVar\fR is given, it specifies a variable that the name of the
temporary file will be written into; if absent, Tcl will attempt to arrange

by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evalution will stop either this count of
iterations is reached or the time is exceeded.
.sp
It will then return a canonical tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
.CE
.PP
which indicates:
.IP \(bu 3
the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0])
.IP \(bu 3
the count how many times it was executed ([\fBlindex\fR $result 2])

by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evalution will stop either this count of
iterations is reached or the time is exceeded.
.sp
It will then return a canonical tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 net-ms\fR
.CE
.PP
which indicates:
.IP \(bu 3
the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0])
.IP \(bu 3
the count how many times it was executed ([\fBlindex\fR $result 2])

    v->cv = NULL;
    v->cv2 = NULL;
    v->lacons = NULL;
    v->nlacons = 0;
    v->spaceused = 0;
    re->re_magic = REMAGIC;
    re->re_info = 0;		/* bits get set during parse */
    re->re_csize = sizeof(chr);
    re->re_guts = NULL;
    re->re_fns = (void*)(&functions);

    /*
     * More complex setup, malloced things.
     */

................................................................................
    g = (struct guts *) re->re_guts;
    if (g->magic != GUTSMAGIC) {
	fprintf(f, "bad guts magic number (0x%x not 0x%x)\n",
		g->magic, GUTSMAGIC);
    }

    fprintf(f, "\n\n\n========= DUMP ==========\n");
    fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
	    (int) re->re_nsub, re->re_info, re->re_csize, g->ntree);

    dumpcolors(&g->cmap, f);
    if (!NULLCNFA(g->search)) {
	fprintf(f, "\nsearch:\n");
	dumpcnfa(&g->search, f);
    }
    for (i = 1; i < g->nlacons; i++) {

    v->cv = NULL;
    v->cv2 = NULL;
    v->lacons = NULL;
    v->nlacons = 0;
    v->spaceused = 0;
    re->re_magic = REMAGIC;
    re->re_info = 0;		/* bits get set during parse */

    re->re_guts = NULL;
    re->re_fns = (void*)(&functions);

    /*
     * More complex setup, malloced things.
     */

................................................................................
    g = (struct guts *) re->re_guts;
    if (g->magic != GUTSMAGIC) {
	fprintf(f, "bad guts magic number (0x%x not 0x%x)\n",
		g->magic, GUTSMAGIC);
    }

    fprintf(f, "\n\n\n========= DUMP ==========\n");
    fprintf(f, "nsub %" TCL_Z_MODIFIER "d, info 0%lo, ntree %d\n",
	    re->re_nsub, re->re_info, g->ntree);

    dumpcolors(&g->cmap, f);
    if (!NULLCNFA(g->search)) {
	fprintf(f, "\nsearch:\n");
	dumpcnfa(&g->search, f);
    }
    for (i = 1; i < g->nlacons; i++) {

/*
 * other interface types
 */

/* the biggie, a compiled RE (or rather, a front end to same) */
typedef struct {
    int re_magic;		/* magic number */
    size_t re_nsub;		/* number of subexpressions */
    long re_info;		/* information about RE */

#define	REG_UBACKREF		000001
#define	REG_ULOOKAHEAD		000002
#define	REG_UBOUNDS		000004
#define	REG_UBRACES		000010
#define	REG_UBSALNUM		000020
#define	REG_UPBOTCH		000040
#define	REG_UBBS		000100
................................................................................
#define	REG_UNONPOSIX		000200
#define	REG_UUNSPEC		000400
#define	REG_UUNPORT		001000
#define	REG_ULOCALE		002000
#define	REG_UEMPTYMATCH		004000
#define	REG_UIMPOSSIBLE		010000
#define	REG_USHORTEST		020000
    int re_csize;		/* sizeof(character) */
    char *re_endp;		/* backward compatibility kludge */
    /* the rest is opaque pointers to hidden innards */
    char *re_guts;		/* `char *' is more portable than `void *' */
    char *re_fns;
} regex_t;

/* result reporting (may acquire more fields later) */
typedef struct {
    long rm_so;		/* start of substring */
    long rm_eo;		/* end of substring */
} regmatch_t;

/* supplementary control and reporting */
typedef struct {
    regmatch_t rm_extend;	/* see REG_EXPECT */
} rm_detail_t;

/*
 * other interface types
 */

/* the biggie, a compiled RE (or rather, a front end to same) */
typedef struct {
    int re_magic;		/* magic number */

    long re_info;		/* information about RE */
    size_t re_nsub;		/* number of subexpressions */
#define	REG_UBACKREF		000001
#define	REG_ULOOKAHEAD		000002
#define	REG_UBOUNDS		000004
#define	REG_UBRACES		000010
#define	REG_UBSALNUM		000020
#define	REG_UPBOTCH		000040
#define	REG_UBBS		000100
................................................................................
#define	REG_UNONPOSIX		000200
#define	REG_UUNSPEC		000400
#define	REG_UUNPORT		001000
#define	REG_ULOCALE		002000
#define	REG_UEMPTYMATCH		004000
#define	REG_UIMPOSSIBLE		010000
#define	REG_USHORTEST		020000

    char *re_endp;		/* backward compatibility kludge */
    /* the rest is opaque pointers to hidden innards */
    char *re_guts;		/* `char *' is more portable than `void *' */
    char *re_fns;
} regex_t;

/* result reporting (may acquire more fields later) */
typedef struct {
    size_t rm_so;		/* start of substring */
    size_t rm_eo;		/* end of substring */
} regmatch_t;

/* supplementary control and reporting */
typedef struct {
    regmatch_t rm_extend;	/* see REG_EXPECT */
} rm_detail_t;

     * Sanity checks.
     */

    if (re == NULL || string == NULL || re->re_magic != REMAGIC) {
	FreeVars(v);
	return REG_INVARG;
    }
    if (re->re_csize != sizeof(chr)) {
	FreeVars(v);
	return REG_MIXED;
    }

    /*
     * Setup.
     */

    v->re = re;
    v->g = (struct guts *)re->re_guts;
................................................................................
    assert(t->op == 'b');
    assert(n >= 0);
    assert((size_t)n < v->nmatch);

    MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max));

    /* get the backreferenced string */
    if (v->pmatch[n].rm_so == -1) {
	return REG_NOMATCH;
    }
    brstring = v->start + v->pmatch[n].rm_so;
    brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;

    /* special cases for zero-length strings */
    if (brlen == 0) {

     * Sanity checks.
     */

    if (re == NULL || string == NULL || re->re_magic != REMAGIC) {
	FreeVars(v);
	return REG_INVARG;
    }





    /*
     * Setup.
     */

    v->re = re;
    v->g = (struct guts *)re->re_guts;
................................................................................
    assert(t->op == 'b');
    assert(n >= 0);
    assert((size_t)n < v->nmatch);

    MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max));

    /* get the backreferenced string */
    if (v->pmatch[n].rm_so == TCL_INDEX_NONE) {
	return REG_NOMATCH;
    }
    brstring = v->start + v->pmatch[n].rm_so;
    brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;

    /* special cases for zero-length strings */
    if (brlen == 0) {

declare 643 {
    int Tcl_IsShared(Tcl_Obj *objPtr)
}

# TIP#312 New Tcl_LinkArray() function
declare 644 {
    int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr,
	    int type, int size)





}

# ----- BASELINE -- FOR -- 8.7.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only

declare 643 {
    int Tcl_IsShared(Tcl_Obj *objPtr)
}

# TIP#312 New Tcl_LinkArray() function
declare 644 {
    int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr,
	    int type, size_t size)
}

declare 645 {
    int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    size_t endValue, size_t *indexPtr)
}

# ----- BASELINE -- FOR -- 8.7.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

typedef struct Tcl_RegExpIndices {
    long start;			/* Character offset of first character in
				 * match. */
    long end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    int nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
    long extendStart;		/* The offset at which a subsequent match
				 * might begin. */
    long reserved;		/* Reserved for later use. */
} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

................................................................................

/*
 * Constants for special size_t-typed values, see TIP #494
 */

#define TCL_IO_FAILURE	((size_t)-1)
#define TCL_AUTO_LENGTH	((size_t)-1)


/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

typedef struct Tcl_RegExpIndices {
    size_t start;			/* Character offset of first character in
				 * match. */
    size_t end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    size_t nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
    size_t extendStart;		/* The offset at which a subsequent match
				 * might begin. */

} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

................................................................................

/*
 * Constants for special size_t-typed values, see TIP #494
 */

#define TCL_IO_FAILURE	((size_t)-1)
#define TCL_AUTO_LENGTH	((size_t)-1)
#define TCL_INDEX_NONE  ((size_t)-1)

/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,

 * The instructions must be in ascending order by numeric operation code.
 */

static const unsigned char NonThrowingByteCodes[] = {
    INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP,			/* 1-4 */
    INST_JUMP1, INST_JUMP4,					/* 34-35 */
    INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE,	/* 70-72 */

    INST_LIST,							/* 79 */
    INST_OVER,							/* 95 */
    INST_PUSH_RETURN_OPTIONS,					/* 108 */
    INST_REVERSE,						/* 126 */
    INST_NOP,							/* 132 */
    INST_STR_MAP,						/* 143 */
    INST_STR_FIND,						/* 144 */

 * The instructions must be in ascending order by numeric operation code.
 */

static const unsigned char NonThrowingByteCodes[] = {
    INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP,			/* 1-4 */
    INST_JUMP1, INST_JUMP4,					/* 34-35 */
    INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE,	/* 70-72 */
    INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN,	/* 73-76 */
    INST_LIST,							/* 79 */
    INST_OVER,							/* 95 */
    INST_PUSH_RETURN_OPTIONS,					/* 108 */
    INST_REVERSE,						/* 126 */
    INST_NOP,							/* 132 */
    INST_STR_MAP,						/* 143 */
    INST_STR_FIND,						/* 144 */

static Tcl_NRPostProc	TEOV_Exception;
static Tcl_NRPostProc	TEOV_NotFoundCallback;
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
static Tcl_NRPostProc	EvalObjvCore;
static Tcl_NRPostProc	Dispatch;

static Tcl_ObjCmdProc NRCoroInjectObjCmd;
static Tcl_NRPostProc NRPostInvoke;
static Tcl_ObjCmdProc CoroTypeObjCmd;





MODULE_SCOPE const TclStubs tclStubs;

/*
 * Magical counts for the number of arguments accepted by a coroutine command
 * after particular kinds of [yield].
 */
................................................................................

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},


    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
................................................................................
    {"file", "readable"},
    {"file", "readlink"},
    {"file", "rename"},
    {"file", "rootname"},
    {"file", "size"},
    {"file", "stat"},
    {"file", "tail"},

    {"file", "tempfile"},
    {"file", "type"},
    {"file", "volumes"},
    {"file", "writable"},
    /* [info] has two unsafe commands */
    {"info", "cmdtype"},
    {"info", "nameofexecutable"},
................................................................................
    }

#if defined(_WIN32) && !defined(_WIN64)
    if (sizeof(time_t) != 4) {
	/*NOTREACHED*/
	Tcl_Panic("<time.h> is not compatible with MSVC");
    }
    if ((TclOffset(Tcl_StatBuf,st_atime) != 32)
	    || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) {
	/*NOTREACHED*/
	Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
    }
#endif

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);
................................................................................
    cmdPtr = (Command *) Tcl_NRCreateCommand(interp,
            "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
            TclNRAssembleObjCmd, NULL, NULL);
    cmdPtr->compileProc = &TclCompileAssembleCmd;

    /* Coroutine monkeybusiness */
    Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
	    NRCoroInjectObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype",
            CoroTypeObjCmd, NULL, NULL);

    /* Export unsupported commands */
    nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
    if (nsPtr) {
	Tcl_Export(interp, nsPtr, "*", 1);
................................................................................
        return TCL_ERROR;
    }
}
 
/*
 *----------------------------------------------------------------------
 *





























 * NRCoroInjectObjCmd --







 *































































































































































































































 *      Implementation of [::tcl::unsupported::inject] command.
 *
 *----------------------------------------------------------------------
 */

static int
NRCoroInjectObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;

    /*
     * Usage more or less like tailcall:
     *   inject coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a coroutine", -1));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objv[1]), NULL);

        return TCL_ERROR;
    }

    corPtr = cmdPtr->objClientData;
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
        return TCL_ERROR;
    }

static Tcl_NRPostProc	TEOV_Exception;
static Tcl_NRPostProc	TEOV_NotFoundCallback;
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
static Tcl_NRPostProc	EvalObjvCore;
static Tcl_NRPostProc	Dispatch;

static Tcl_ObjCmdProc NRInjectObjCmd;
static Tcl_NRPostProc NRPostInvoke;
static Tcl_ObjCmdProc CoroTypeObjCmd;
static Tcl_ObjCmdProc TclNRCoroInjectObjCmd;
static Tcl_ObjCmdProc TclNRCoroProbeObjCmd;
static Tcl_NRPostProc InjectHandler;
static Tcl_NRPostProc InjectHandlerPostCall;

MODULE_SCOPE const TclStubs tclStubs;

/*
 * Magical counts for the number of arguments accepted by a coroutine command
 * after particular kinds of [yield].
 */
................................................................................

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroinject",	NULL,			NULL,                   TclNRCoroInjectObjCmd,	CMD_IS_SAFE},
    {"coroprobe",	NULL,			NULL,                   TclNRCoroProbeObjCmd,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
................................................................................
    {"file", "readable"},
    {"file", "readlink"},
    {"file", "rename"},
    {"file", "rootname"},
    {"file", "size"},
    {"file", "stat"},
    {"file", "tail"},
    {"file", "tempdir"},
    {"file", "tempfile"},
    {"file", "type"},
    {"file", "volumes"},
    {"file", "writable"},
    /* [info] has two unsafe commands */
    {"info", "cmdtype"},
    {"info", "nameofexecutable"},
................................................................................
    }

#if defined(_WIN32) && !defined(_WIN64)
    if (sizeof(time_t) != 4) {
	/*NOTREACHED*/
	Tcl_Panic("<time.h> is not compatible with MSVC");
    }
    if ((offsetof(Tcl_StatBuf,st_atime) != 32)
	    || (offsetof(Tcl_StatBuf,st_ctime) != 40)) {
	/*NOTREACHED*/
	Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
    }
#endif

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);
................................................................................
    cmdPtr = (Command *) Tcl_NRCreateCommand(interp,
            "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
            TclNRAssembleObjCmd, NULL, NULL);
    cmdPtr->compileProc = &TclCompileAssembleCmd;

    /* Coroutine monkeybusiness */
    Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
	    NRInjectObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype",
            CoroTypeObjCmd, NULL, NULL);

    /* Export unsupported commands */
    nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
    if (nsPtr) {
	Tcl_Export(interp, nsPtr, "*", 1);
................................................................................
        return TCL_ERROR;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd --
 *
 *      Implementation of [coroinject] and [coroprobe] commands.
 *
 *----------------------------------------------------------------------
 */

static inline CoroutineData *
GetCoroutineFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    const char *errMsg)
{
    /*
     * How to get a coroutine from its handle.
     */

    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);

    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objPtr), NULL);
        return NULL;
    }
    return cmdPtr->objClientData;
}

static int
TclNRCoroInjectObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;

    /*
     * Usage more or less like tailcall:
     *   coroinject coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.
     */

    iPtr->execEnvPtr = corPtr->eePtr;
    TclNRAddCallback(interp, InjectHandler, corPtr,
            Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL);
    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

static int
TclNRCoroProbeObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
    int numLevels, unused;
    int *stackLevel = &unused;

    /*
     * Usage more or less like tailcall:
     *   coroprobe coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a probe command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a probe command into a suspended coroutine",
                -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.
     */

    iPtr->execEnvPtr = corPtr->eePtr;
    TclNRAddCallback(interp, InjectHandler, corPtr,
            Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr);
    iPtr->execEnvPtr = savedEEPtr;

    /*
     * Now we immediately transfer control to the coroutine to run our probe.
     * TRICKY STUFF copied from the [yield] implementation.
     *
     * Push the callback to restore the caller's context on yield back.
     */

    TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr,
            NULL, NULL, NULL);

    /*
     * Record the stackLevel at which the resume is happening, then swap
     * the interp's environment to make it suitable to run this coroutine.
     */

    corPtr->stackLevel = stackLevel;
    numLevels = corPtr->auxNumLevels;
    corPtr->auxNumLevels = iPtr->numLevels;

    /*
     * Do the actual stack swap.
     */

    SAVE_CONTEXT(corPtr->caller);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    RESTORE_CONTEXT(corPtr->running);
    iPtr->execEnvPtr = corPtr->eePtr;
    iPtr->numLevels += numLevels;
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * InjectHandler, InjectHandlerPostProc --
 *
 *      Part of the implementation of [coroinject] and [coroprobe]. These are
 *      run inside the context of the coroutine being injected/probed into.
 *
 *      InjectHandler runs a script (possibly adding arguments) in the context
 *      of the coroutine. The script is specified as a one-shot list (with
 *      reference count equal to 1) in data[1]. This function also arranges
 *      for InjectHandlerPostProc to be the part that runs after the script
 *      completes.
 *
 *      InjectHandlerPostProc cleans up after InjectHandler (deleting the
 *      list) and, for the [coroprobe] command *only*, yields back to the
 *      caller context (i.e., where [coroprobe] was run).
 *s
 *----------------------------------------------------------------------
 */

static int
InjectHandler(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    Tcl_Obj *listPtr = data[1];
    int nargs = PTR2INT(data[2]);
    ClientData isProbe = data[3];
    int objc;
    Tcl_Obj **objv;

    if (!isProbe) {
        /*
         * If this is [coroinject], add the extra arguments now.
         */

        if (nargs == COROUTINE_ARGUMENTS_SINGLE_OPTIONAL) {
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yield", -1));
        } else if (nargs == COROUTINE_ARGUMENTS_ARBITRARY) {
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yieldto", -1));
        } else {
            /*
             * I don't think this is reachable...
             */

            Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewIntObj(nargs));
        }
        Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp));
    }

    /*
     * Call the user's script; we're in the right place.
     */

    Tcl_IncrRefCount(listPtr);
    TclMarkTailcall(interp);
    TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr,
            INT2PTR(nargs), isProbe);
    TclListObjGetElements(NULL, listPtr, &objc, &objv);
    return TclNREvalObjv(interp, objc, objv, 0, NULL);
}

static int
InjectHandlerPostCall(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    Tcl_Obj *listPtr = data[1];
    int nargs = PTR2INT(data[2]);
    ClientData isProbe = data[3];
    int numLevels;

    /*
     * Delete the command words for what we just executed.
     */

    Tcl_DecrRefCount(listPtr);

    /*
     * If we were doing a probe, splice ourselves back out of the stack
     * cleanly here. General injection should instead just look after itself.
     *
     * Code from guts of [yield] implementation.
     */

    if (isProbe) {
        if (result == TCL_ERROR) {
            Tcl_AddErrorInfo(interp,
                    "\n    (injected coroutine probe command)");
        }
        corPtr->nargs = nargs;
        corPtr->stackLevel = NULL;
        numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * NRInjectObjCmd --
 *
 *      Implementation of [::tcl::unsupported::inject] command.
 *
 *----------------------------------------------------------------------
 */

static int
NRInjectObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{

    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;

    /*
     * Usage more or less like tailcall:
     *   inject coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],


            "can only inject a command into a coroutine");


    if (!corPtr) {
        return TCL_ERROR;
    }


    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
        return TCL_ERROR;
    }

    { "hex",      BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryDecodeUu,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "base64",   BinaryDecode64,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};

/*
 * The following object types represent an array of bytes. The intent is
 * to allow arbitrary binary data to pass through Tcl as a Tcl value
 * without loss or damage. Such values are useful for things like
 * encoded strings or Tk images to name just two.
 *
 * It's strange to have two Tcl_ObjTypes in place for this task when
 * one would do, so a bit of detail and history how we got to this point
 * and where we might go from here.
 *
 * A bytearray is an ordered sequence of bytes. Each byte is an integer
 * value in the range [0-255].  To be a Tcl value type, we need a way to
 * encode each value in the value set as a Tcl string.  The simplest
 * encoding is to represent each byte value as the same codepoint value.
 * A bytearray of N bytes is encoded into a Tcl string of N characters
 * where the codepoint of each character is the value of corresponding byte.
 * This approach creates a one-to-one map between all bytearray values
 * and a subset of Tcl string values.
 *
 * When converting a Tcl string value to the bytearray internal rep, the
 * question arises what to do with strings outside that subset?  That is,
 * those Tcl strings containing at least one codepoint greater than 255?
 * The obviously correct answer is to raise an error!  That string value
 * does not represent any valid bytearray value. Full Stop.  The
 * setFromAnyProc signature has a completion code return value for just
 * this reason, to reject invalid inputs.
 *
 * Unfortunately this was not the path taken by the authors of the
 * original tclByteArrayType.  They chose to accept all Tcl string values
 * as acceptable string encodings of the bytearray values that result
 * from masking away the high bits of any codepoint value at all. This
 * meant that every bytearray value had multiple accepted string
 * representations.
 *
 * The implications of this choice are truly ugly.  When a Tcl value has
 * a string representation, we are required to accept that as the true
 * value.  Bytearray values that possess a string representation cannot
 * be processed as bytearrays because we cannot know which true value
 * that bytearray represents.  The consequence is that we drag around
 * an internal rep that we cannot make any use of.  This painful price
 * is extracted at any point after a string rep happens to be generated
 * for the value.  This happens even when the troublesome codepoints
 * outside the byte range never show up.  This happens rather routinely
 * in normal Tcl operations unless we burden the script writer with the
 * cognitive burden of avoiding it.  The price is also paid by callers
 * of the C interface.  The routine
 *
 *	unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
 *
 * has a guarantee to always return a non-NULL value, but that value
 * points to a byte sequence that cannot be used by the caller to
 * process the Tcl value absent some sideband testing that objPtr
 * is "pure".  Tcl offers no public interface to perform this test,
 * so callers either break encapsulation or are unavoidably buggy.  Tcl
 * has defined a public interface that cannot be used correctly. The
 * Tcl source code itself suffers the same problem, and has been buggy,
 * but progressively less so as more and more portions of the code have
 * been retrofitted with the required "purity testing".  The set of values
 * able to pass the purity test can be increased via the introduction of
 * a "canonical" flag marker, but the only way the broken interface itself
 * can be discarded is to start over and define the Tcl_ObjType properly.
 * Bytearrays should simply be usable as bytearrays without a kabuki
 * dance of testing.
 *
 * The "Pure" ByteArray type is (nearly) a correct

 * implementation of bytearrays.  Any Tcl value with the type
 * properByteArrayType can have its bytearray value fetched and
 * used with confidence that acting on that value is equivalent to
 * acting on the true Tcl string value.  This still implies a side
 * testing burden -- past mistakes will not let us avoid that
 * immediately, but it is at least a conventional test of type, and
 * can be implemented entirely by examining the objPtr fields, with
 * no need to query the intrep, as a canonical flag would require.
 *
 * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can
 * be revised to admit the possibility of returning NULL when the true
 * value is not a valid bytearray, we need a mechanism to retain
 * compatibility with the deployed callers of the broken interface.
 * That's what the retained "tclByteArrayType" provides.  In those
 * unusual circumstances where we convert an invalid bytearray value
 * to a bytearray type, it is to this legacy type.  Essentially any
 * time this legacy type gets used, it's a signal of a bug being ignored.
 * A TIP should be drafted to remove this connection to the broken past
 * so that Tcl 9 will no longer have any trace of it.  Prescribing a
 * migration path will be the key element of that work.  The internal
 * changes now in place are the limit of what can be done short of
 * interface repair.  They provide a great expansion of the histories
 * over which bytearray values can be useful in the meanwhile.
 */

static const Tcl_ObjType properByteArrayType = {
    "bytearray",
    FreeProperByteArrayInternalRep,
    DupProperByteArrayInternalRep,
    UpdateStringOfByteArray,
................................................................................
				 * minus 1 byte. */
    unsigned char bytes[1];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		((TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)
 
int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new
				   value. May be NULL even if length > 0. */
    size_t length)			/* Length of the array of bytes, which must
				   be >= 0. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
................................................................................
	if ((src[i] == 0) || (src[i] > 127)) {
	    size++;
	}
    }

    if (size == length) {
	char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);

	TclOOM(dst, size);
    } else {
	char *dst = Tcl_InitStringRep(objPtr, NULL, size);

	TclOOM(dst, size);
	for (i = 0; i < length; i++) {
	    dst += Tcl_UniCharToUtf(src[i], dst);
	}
	(void)Tcl_InitStringRep(objPtr, NULL, size);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclAppendBytesToByteArray --
................................................................................
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	size_t attempt;

	if (needed <= INT_MAX/2) {

	    /* Try to allocate double the total space that is needed. */


	    attempt = 2 * needed;
	    ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {

	    /* Try to allocate double the increment that is needed (plus). */


	    size_t limit = UINT_MAX - needed;
	    size_t extra = len + TCL_MIN_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;

	    attempt = needed + growth;
	    ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {

	    /* Last chance: Try to allocate exactly what is needed. */


	    attempt = needed;
	    ptr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }
................................................................................
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    size_t count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;	/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
................................................................................
     */

    resultPtr = Tcl_NewObj();
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, length);

    /*
     * Pack the data into the result object. Note that we can skip the
     * error checking during this pass, since we have already parsed the
     * string once.
     */

    arg = 2;
    format = TclGetString(objv[1]);
    cursor = buffer;
    maxPos = cursor;
    while (*format != 0) {
................................................................................
		TclListObjGetElements(interp, objv[arg], &listc, &listv);
		if (count == BINARY_ALL) {
		    count = listc;
		}
	    }
	    arg++;
	    for (i = 0; (size_t)i < count; i++) {
		if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case 'x':
................................................................................
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    size_t count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;	/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    int offset, size;
    size_t length = 0;
................................................................................

	    /*
	     * Trim trailing nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {
		while (size > 0) {
		    if (src[size-1] != '\0' && src[size-1] != ' ') {
			break;
		    }
		    size--;
		}
	    }

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

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

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

	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double)FLT_MAX) {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;
................................................................................

static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */
    int flags,			/* Format field flags */
    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned
				 * value objects, or NULL if too many
				 * different numbers have been scanned. */
{
    long value;
    float fvalue;
    double dvalue;
    Tcl_WideUInt uwvalue;

    /*
................................................................................
		    + (buffer[1] << 16)
		    + (((long) buffer[0]) << 24));
	}

	/*
	 * Check to see if the value was sign extended properly on systems
	 * where an int is more than 32-bits.

	 * We avoid caching unsigned integers as we cannot distinguish between
	 * 32bit signed and unsigned in the hash (short and char are ok).
	 */

	if (flags & BINARY_UNSIGNED) {
	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
	}
	if ((value & (((unsigned) 1)<<31)) && (value > 0)) {
	    value -= (((unsigned) 1)<<31);
	    value -= (((unsigned) 1)<<31);
	}

    returnNumericObject:
	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewWideIntObj(value);
	} else {
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
................................................................................
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(objv[1], &count);
    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
    for (offset = 0; offset < count; ++offset) {
	*cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
	*cursor++ = HexDigits[(data[offset] & 0x0f)];
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i=0 ; i<2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit(UCHAR(c))) {
................................................................................
	    c -= '0';
	    if (c > 9) {
		c += ('0' - 'A') + 10;
	    }
	    if (c > 16) {
		c += ('A' - 'a');
	    }
	    value |= (c & 0xf);
	}
	if (i < 2) {
	    cut++;
	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
................................................................................
    Tcl_Obj *resultObj;
    unsigned char *data, *cursor, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    size_t wrapcharlen = 1;
    int i, index, size, outindex = 0;
    size_t offset, count = 0;
    enum {OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc%2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = TclGetStringFromObj(objv[i+1], &wrapcharlen);
	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    data = TclGetByteArrayFromObj(objv[objc-1], &count);
    if (count > 0) {
	size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));

	    if (size % maxlen == 0) {
		adjusted -= wrapcharlen;
	    }
	    size = adjusted;
	}
	cursor = Tcl_SetByteArrayLength(resultObj, size);
	limit = cursor + size;
	for (offset = 0; offset < count; offset+=3) {
	    unsigned char d[3] = {0, 0, 0};

	    for (i = 0; i < 3 && offset+i < count; ++i) {
		d[i] = data[offset + i];
	    }
	    OUTPUT(B64Digits[d[0] >> 2]);
	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
	    if (offset+1 < count) {
		OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
	    } else {
		OUTPUT(B64Digits[64]);
	    }
	    if (offset+2 < count) {
		OUTPUT(B64Digits[d[2] & 0x3f]);
	    } else {
................................................................................
    int lineLength = 61;
    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
    const unsigned char *wrapchar = SingleNewline;
    size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc%2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) {

		return TCL_ERROR;
	    }
	    if (lineLength < 3 || lineLength > 85) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = TclGetByteArrayFromObj(objv[i+1], &wrapcharlen);
	    break;
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    resultObj = Tcl_NewObj();
    offset = 0;
    data = TclGetByteArrayFromObj(objv[objc-1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
................................................................................
    while (offset < count) {
	int lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i=0 ; i<lineLen ; i++) {
	    n <<= 8;
	    n |= data[offset++];
	    for (bits += 8; bits > 6 ; bits -= 6) {
		*cursor++ = UueDigits[(n >> (bits-6)) & 0x3f];
	    }
	}
	if (bits > 0) {
	    n <<= 8;
	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
	    bits = 0;
	}
	for (j=0 ; j<wrapcharlen ; ++j) {
	    *cursor++ = wrapchar[j];
	}
    }

    /*
     * Fix the length of the output bytearray.
     */

    Tcl_SetByteArrayLength(resultObj, cursor-start);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, size, strict = 0, lineLen;
    size_t count = 0;
    unsigned char c;
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

    /*
     * The decoding loop. First, we get the length of line (strictly, the
................................................................................
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i=0 ; i<4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
................................................................................
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

	/*
................................................................................

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {
		if (strict && i <= 1) {

		    /* single resp. unfulfilled char (each 4th next single char)
		     * is rather bad64 error case in strict mode */


		    goto bad64;
		}
		cut += 3;
		break;
	    }

	    /*
................................................................................
	     * because they're only valid as the last character or two of the
	     * final block of input. Unless strict mode is enabled, skip any
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		     value <<= 6;
		     cut++;
		} else if (!strict && TclIsSpaceProc(c)) {
		     i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=' && (

		!strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */
	    ) {


		value <<= 6;
		if (i) cut++;


	    } else if (strict || !TclIsSpaceProc(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
................................................................................
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

    { "hex",      BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryDecodeUu,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "base64",   BinaryDecode64,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};

/*
 * The following object types represent an array of bytes. The intent is to
 * allow arbitrary binary data to pass through Tcl as a Tcl value without loss
 * or damage. Such values are useful for things like encoded strings or Tk
 * images to name just two.
 *
 * It's strange to have two Tcl_ObjTypes in place for this task when one would
 * do, so a bit of detail and history how we got to this point and where we
 * might go from here.
 *
 * A bytearray is an ordered sequence of bytes. Each byte is an integer value
 * in the range [0-255].  To be a Tcl value type, we need a way to encode each
 * value in the value set as a Tcl string.  The simplest encoding is to
 * represent each byte value as the same codepoint value.  A bytearray of N
 * bytes is encoded into a Tcl string of N characters where the codepoint of
 * each character is the value of corresponding byte.  This approach creates a
 * one-to-one map between all bytearray values and a subset of Tcl string
 * values.
 *
 * When converting a Tcl string value to the bytearray internal rep, the
 * question arises what to do with strings outside that subset?  That is,
 * those Tcl strings containing at least one codepoint greater than 255?  The
 * obviously correct answer is to raise an error!  That string value does not
 * represent any valid bytearray value. Full Stop.  The setFromAnyProc
 * signature has a completion code return value for just this reason, to
 * reject invalid inputs.
 *
 * Unfortunately this was not the path taken by the authors of the original
 * tclByteArrayType.  They chose to accept all Tcl string values as acceptable
 * string encodings of the bytearray values that result from masking away the
 * high bits of any codepoint value at all. This meant that every bytearray
 * value had multiple accepted string representations.

 *
 * The implications of this choice are truly ugly.  When a Tcl value has a
 * string representation, we are required to accept that as the true value.
 * Bytearray values that possess a string representation cannot be processed
 * as bytearrays because we cannot know which true value that bytearray
 * represents.  The consequence is that we drag around an internal rep that we
 * cannot make any use of.  This painful price is extracted at any point after

 * a string rep happens to be generated for the value.  This happens even when
 * the troublesome codepoints outside the byte range never show up.  This
 * happens rather routinely in normal Tcl operations unless we burden the
 * script writer with the cognitive burden of avoiding it.  The price is also
 * paid by callers of the C interface.  The routine
 *
 *	unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
 *
 * has a guarantee to always return a non-NULL value, but that value points to
 * a byte sequence that cannot be used by the caller to process the Tcl value
 * absent some sideband testing that objPtr is "pure".  Tcl offers no public

 * interface to perform this test, so callers either break encapsulation or
 * are unavoidably buggy.  Tcl has defined a public interface that cannot be
 * used correctly. The Tcl source code itself suffers the same problem, and
 * has been buggy, but progressively less so as more and more portions of the
 * code have been retrofitted with the required "purity testing".  The set of
 * values able to pass the purity test can be increased via the introduction
 * of a "canonical" flag marker, but the only way the broken interface itself
 * can be discarded is to start over and define the Tcl_ObjType properly.
 * Bytearrays should simply be usable as bytearrays without a kabuki dance of
 * testing.
 *

 * The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation
 * of bytearrays.  Any Tcl value with the type properByteArrayType can have

 * its bytearray value fetched and used with confidence that acting on that
 * value is equivalent to acting on the true Tcl string value.  This still
 * implies a side testing burden -- past mistakes will not let us avoid that
 * immediately, but it is at least a conventional test of type, and can be
 * implemented entirely by examining the objPtr fields, with no need to query
 * the intrep, as a canonical flag would require.
 *
 * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can be revised
 * to admit the possibility of returning NULL when the true value is not a
 * valid bytearray, we need a mechanism to retain compatibility with the
 * deployed callers of the broken interface.  That's what the retained
 * "tclByteArrayType" provides.  In those unusual circumstances where we
 * convert an invalid bytearray value to a bytearray type, it is to this

 * legacy type.  Essentially any time this legacy type gets used, it's a
 * signal of a bug being ignored.  A TIP should be drafted to remove this
 * connection to the broken past so that Tcl 9 will no longer have any trace
 * of it.  Prescribing a migration path will be the key element of that work.
 * The internal changes now in place are the limit of what can be done short
 * of interface repair.  They provide a great expansion of the histories over
 * which bytearray values can be useful in the meanwhile.
 */

static const Tcl_ObjType properByteArrayType = {
    "bytearray",
    FreeProperByteArrayInternalRep,
    DupProperByteArrayInternalRep,
    UpdateStringOfByteArray,
................................................................................
				 * minus 1 byte. */
    unsigned char bytes[1];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		(offsetof(ByteArray, bytes) + (len))
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)
 
int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new value.
				 * May be NULL even if length > 0. */
    size_t length)			/* Length of the array of bytes, which must
				 * be >= 0. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
................................................................................
	if ((src[i] == 0) || (src[i] > 127)) {
	    size++;
	}
    }

    if (size == length) {
	char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);

	TclOOM(dst, size);
    } else {
	char *dst = Tcl_InitStringRep(objPtr, NULL, size);

	TclOOM(dst, size);
	for (i = 0; i < length; i++) {
	    dst += Tcl_UniCharToUtf(src[i], dst);
	}
	(void) Tcl_InitStringRep(objPtr, NULL, size);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclAppendBytesToByteArray --
................................................................................
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	size_t attempt;

	if (needed <= INT_MAX/2) {
	    /*
	     * Try to allocate double the total space that is needed.
	     */

	    attempt = 2 * needed;
	    ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Try to allocate double the increment that is needed (plus).
	     */

	    size_t limit = UINT_MAX - needed;
	    size_t extra = len + TCL_MIN_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;

	    attempt = needed + growth;
	    ptr = Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	     */

	    attempt = needed;
	    ptr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }
................................................................................
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    size_t count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
................................................................................
     */

    resultPtr = Tcl_NewObj();
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, length);

    /*
     * Pack the data into the result object. Note that we can skip the error
     * checking during this pass, since we have already parsed the string
     * once.
     */

    arg = 2;
    format = TclGetString(objv[1]);
    cursor = buffer;
    maxPos = cursor;
    while (*format != 0) {
................................................................................
		TclListObjGetElements(interp, objv[arg], &listc, &listv);
		if (count == BINARY_ALL) {
		    count = listc;
		}
	    }
	    arg++;
	    for (i = 0; (size_t)i < count; i++) {
		if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case 'x':
................................................................................
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    size_t count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    int offset, size;
    size_t length = 0;
................................................................................

	    /*
	     * Trim trailing nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {
		while (size > 0) {
		    if (src[size - 1] != '\0' && src[size - 1] != ' ') {
			break;
		    }
		    size--;
		}
	    }

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

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

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

	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double) FLT_MAX) {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;
................................................................................

static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */
    int flags,			/* Format field flags */
    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned value
				 * objects, or NULL if too many different
				 * numbers have been scanned. */
{
    long value;
    float fvalue;
    double dvalue;
    Tcl_WideUInt uwvalue;

    /*
................................................................................
		    + (buffer[1] << 16)
		    + (((long) buffer[0]) << 24));
	}

	/*
	 * Check to see if the value was sign extended properly on systems
	 * where an int is more than 32-bits.
	 *
	 * We avoid caching unsigned integers as we cannot distinguish between
	 * 32bit signed and unsigned in the hash (short and char are ok).
	 */

	if (flags & BINARY_UNSIGNED) {
	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
	}
	if ((value & (((unsigned) 1) << 31)) && (value > 0)) {
	    value -= (((unsigned) 1) << 31);
	    value -= (((unsigned) 1) << 31);
	}

    returnNumericObject:
	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewWideIntObj(value);
	} else {
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
................................................................................
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(objv[1], &count);
    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
    for (offset = 0; offset < count; ++offset) {
	*cursor++ = HexDigits[(data[offset] >> 4) & 0x0f];
	*cursor++ = HexDigits[data[offset] & 0x0f];
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i = 0 ; i < 2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit(UCHAR(c))) {
................................................................................
	    c -= '0';
	    if (c > 9) {
		c += ('0' - 'A') + 10;
	    }
	    if (c > 16) {
		c += ('A' - 'a');
	    }
	    value |= c & 0xf;
	}
	if (i < 2) {
	    cut++;
	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
................................................................................
    Tcl_Obj *resultObj;
    unsigned char *data, *cursor, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    size_t wrapcharlen = 1;
    int i, index, size, outindex = 0;
    size_t offset, count = 0;
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    data = TclGetByteArrayFromObj(objv[objc - 1], &count);
    if (count > 0) {
	size = (((count * 4) / 3) + 3) & ~3;	/* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));

	    if (size % maxlen == 0) {
		adjusted -= wrapcharlen;
	    }
	    size = adjusted;
	}
	cursor = Tcl_SetByteArrayLength(resultObj, size);
	limit = cursor + size;
	for (offset = 0; offset < count; offset += 3) {
	    unsigned char d[3] = {0, 0, 0};

	    for (i = 0; i < 3 && offset + i < count; ++i) {
		d[i] = data[offset + i];
	    }
	    OUTPUT(B64Digits[d[0] >> 2]);
	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
	    if (offset + 1 < count) {
		OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
	    } else {
		OUTPUT(B64Digits[64]);
	    }
	    if (offset+2 < count) {
		OUTPUT(B64Digits[d[2] & 0x3f]);
	    } else {
................................................................................
    int lineLength = 61;
    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
    const unsigned char *wrapchar = SingleNewline;
    size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1],
		    &lineLength) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (lineLength < 3 || lineLength > 85) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = TclGetByteArrayFromObj(objv[i + 1], &wrapcharlen);
	    break;
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    resultObj = Tcl_NewObj();
    offset = 0;
    data = TclGetByteArrayFromObj(objv[objc - 1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
................................................................................
    while (offset < count) {
	int lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i = 0 ; i < lineLen ; i++) {
	    n <<= 8;
	    n |= data[offset++];
	    for (bits += 8; bits > 6 ; bits -= 6) {
		*cursor++ = UueDigits[(n >> (bits - 6)) & 0x3f];
	    }
	}
	if (bits > 0) {
	    n <<= 8;
	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
	    bits = 0;
	}
	for (j = 0 ; j < wrapcharlen ; ++j) {
	    *cursor++ = wrapchar[j];
	}
    }

    /*
     * Fix the length of the output bytearray.
     */

    Tcl_SetByteArrayLength(resultObj, cursor - start);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, size, strict = 0, lineLen;
    size_t count = 0;
    unsigned char c;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

    /*
     * The decoding loop. First, we get the length of line (strictly, the
................................................................................
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i = 0 ; i < 4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
................................................................................
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

	/*
................................................................................

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {
		if (strict && i <= 1) {
		    /*
		     * Single resp. unfulfilled char (each 4th next single
		     * char) is rather bad64 error case in strict mode.
		     */

		    goto bad64;
		}
		cut += 3;
		break;
	    }

	    /*
................................................................................
	     * because they're only valid as the last character or two of the
	     * final block of input. Unless strict mode is enabled, skip any
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		    value <<= 6;
		    cut++;
		} else if (!strict && TclIsSpaceProc(c)) {
		    i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=' && (!strict || i > 1)) {
		/*
		 * "=" and "a=" is rather bad64 error case in strict mode.

		 */

		value <<= 6;
		if (i) {
		    cut++;
		}
	    } else if (strict || !TclIsSpaceProc(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
................................................................................
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

    size_t refCount;		/* Number of mem_headers referencing this
				 * tag. */
    char string[1];		/* Actual size of string will be as large as
				 * needed for actual tag. This must be the
				 * last field in the structure. */
} MemTag;

#define TAG_SIZE(bytesInString) ((TclOffset(MemTag, string) + 1) + bytesInString)

static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
				 * by "memory tag" command). */

/*
 * One of the following structures is allocated just before each dynamically
 * allocated chunk of memory, both to record information about the chunk and

    size_t refCount;		/* Number of mem_headers referencing this
				 * tag. */
    char string[1];		/* Actual size of string will be as large as
				 * needed for actual tag. This must be the
				 * last field in the structure. */
} MemTag;

#define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1) + bytesInString)

static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
				 * by "memory tag" command). */

/*
 * One of the following structures is allocated just before each dynamically
 * allocated chunk of memory, both to record information about the chunk and

	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},

	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    return TclMakeEnsemble(interp, "file", initMap);

	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"tempdir",	TclFileTempDirCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    return TclMakeEnsemble(interp, "file", initMap);

int
Tcl_RegexpObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t offset;
    int i, indices, match, about, all, doinline, numMatchesSaved;
    int cflags, eflags, stringLength, matchLength;
    Tcl_RegExp regExpr;
    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-all",		"-about",	"-indices",	"-inline",
	"-expanded",	"-line",	"-linestop",	"-lineanchor",
	"-nocase",	"-start",	"--",		NULL
................................................................................
	 * considered the start of the line. If for example the pattern {^} is
	 * passed and -start is positive, then the pattern will not match the
	 * start of the string unless the previous character is a newline.
	 */

	if (offset == TCL_INDEX_START) {
	    eflags = 0;
	} else if (offset + 1 > (size_t)stringLength + 1) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

................................................................................
		resultPtr = Tcl_NewObj();
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		int start, end;
		Tcl_Obj *objs[2];

		/*
		 * Only adjust the match area if there was a match for that
		 * area. (Scriptics Bug 4391/SF Bug #219232)
		 */

		if (i <= info.nsubs && info.matches[i].start >= 0) {
		    start = offset + info.matches[i].start;
		    end = offset + info.matches[i].end;

		    /*
		     * Adjust index so it refers to the last character in the
		     * match instead of the first character after the match.
		     */

		    if ((size_t)end + 1 >= offset + 1) {
			end--;
		    }
		} else {
		    start = -1;
		    end = -1;
		}

		objs[0] = Tcl_NewWideIntObj(start);
		objs[1] = Tcl_NewWideIntObj(end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if (i <= info.nsubs) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    newPtr = Tcl_NewObj();
		}
	    }
................................................................................
	 * these cases we always want to bump the index up one.
	 */

	if (matchLength == 0) {
	    offset++;
	}
	all++;
	if (offset + 1 >= (size_t)stringLength + 1) {
	    break;
	}
    }

    /*
     * Set the interpreter's object result to an integer object with value 1
     * if -all wasn't specified, otherwise it's all-1 (the number of times
................................................................................
int
Tcl_RegsubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int idx, result, cflags, all, numMatches;
    size_t wlen, wsublen = 0, offset;
    int start, end, subStart, subEnd, match, command, numParts;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
................................................................................

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = TCL_INDEX_START;
    command = 0;
    resultPtr = NULL;

    for (idx = 1; idx < objc; idx++) {
	const char *name;
	int index;

	name = TclGetString(objv[idx]);
	if (name[0] != '-') {
	    break;
	}
................................................................................
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGSUB_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGSUB_START: {
	    size_t temp;
	    if (++idx >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], TCL_INDEX_START, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
................................................................................
	case REGSUB_LAST:
	    idx++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if (objc-idx < 3 || objc-idx > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? exp string subSpec ?varName?");
    optionError:
	if (startIndex) {
	    Tcl_DecrRefCount(startIndex);
	}
	return TCL_ERROR;
................................................................................
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
	const char *element, *p, *splitEnd;
	int splitLen;
	Tcl_UniChar splitChar = 0;

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */

................................................................................
static int
StringMapCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    int mapElemc, index;
    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
................................................................................
	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
	 */

	Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
	if (mapElemc == 0) {
	    /*
	     * Empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
	}

	mapElemc *= 2;
	mapWithDict = 1;

	/*
	 * Copy the dictionary out into an array; that's the easiest way to
	 * adapt this code...
	 */

	mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (i=2 ; i<mapElemc ; i+=2) {
	    Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {

	if (TclListObjGetElements(interp, objv[objc-2], &mapElemc,
		&mapElemv) != TCL_OK) {
	    return TCL_ERROR;
	}

	if (mapElemc == 0) {
	    /*
	     * empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
................................................................................
int
TclNRSwitchObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i,j, index, mode, foundmode, splitObjs, numMatchesSaved;
    int noCase;
    size_t patternLength;
    const char *pattern;
    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
    Tcl_Obj *const *savedObjv = objv;
    Tcl_RegExp regExpr = NULL;
    Interp *iPtr = (Interp *) interp;
    int pc = 0;
    int bidx = 0;		/* Index of body argument. */
................................................................................
	    TclNewObj(indicesObj);
	}

	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end > 0) {
		    rangeObjAry[0] = Tcl_NewWideIntObj(info.matches[j].start);
		    rangeObjAry[1] = Tcl_NewWideIntObj(info.matches[j].end-1);
		} else {
		    rangeObjAry[0] = rangeObjAry[1] = Tcl_NewWideIntObj(-1);
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */
................................................................................
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

    for (j = i + 1; ; j += 2) {
	if (j >= objc) {
	    /*
	     * This shouldn't happen since we've checked that the last body is
	     * not a continuation...
	     */

	    Tcl_Panic("fall-out when searching for body to match pattern");
	}
................................................................................
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };
    NRE_callback *rootPtr;
    ByteCode *codePtr = NULL;


    for (i = 1; i < objc - 1; i++) {
	int index;

	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
................................................................................

    if (!direct) {
	if (TclInterpReady(interp) != TCL_OK) {
	    return TCL_ERROR;
	}
	codePtr = TclCompileObj(interp, objPtr, NULL, 0);
	TclPreserveByteCode(codePtr);









    }

    /*
     * Get start and stop time.
     */

#ifdef TCL_WIDE_CLICKS
................................................................................
	    if (!direct) {		/* precompiled */
		rootPtr = TOP_CB(interp);
		result = TclNRExecuteByteCode(interp, codePtr);
		result = TclNRRunCallbacks(interp, result, rootPtr);
	    } else {			/* eval */
		result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	    }
	    if (result != TCL_OK) {
		/*
		 * Allow break from measurement cycle (used for conditional
		 * stop).

		 */

		if (result != TCL_BREAK) {

		    goto done;
		}


		/*
		 * Force stop immediately.
		 */

		threshold = 1;
		maxcnt = 0;

		result = TCL_OK;



	    }

	    /*
	     * Don't check time up to threshold.
	     */

	    if (--threshold > 0) {
................................................................................
		threshold = maxcnt - count;
	    }
	}
    }

    {
	Tcl_Obj *objarr[8], **objs = objarr;
	Tcl_WideInt val;
	int digits;


	middle -= start;		/* execution time in microsecs */



#ifdef TCL_WIDE_CLICKS
	/*
	 * convert execution time in wide clicks to microsecs.
	 */

	middle *= TclpWideClickInMicrosec();
#endif /* TCL_WIDE_CLICKS */

	if (!count) {		/* no iterations - avoid divide by zero */
	    objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
	    goto retRes;
	}

................................................................................
	    if (overhead > 0) {
		/*
		 * Estimate the time of overhead (microsecs).
		 */

		Tcl_WideUInt curOverhead = overhead * count;

		if (middle > (Tcl_WideInt) curOverhead) {
		    middle -= curOverhead;
		} else {
		    middle = 0;
		}
	    }
	} else {
	    /*
	     * Calibration: obtaining new measurement overhead.
	     */

	    if (measureOverhead > ((double) middle) / count) {
		measureOverhead = ((double) middle) / count;
	    }
	    objs[0] = Tcl_NewDoubleObj(measureOverhead);
	    TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
	    objs += 2;
	}

	val = middle / count;		/* microsecs per iteration */
	if (val >= 1000000) {
	    objs[0] = Tcl_NewWideIntObj(val);
	} else {
	    if (val < 10) {
		digits = 6;
	    } else if (val < 100) {
		digits = 4;
................................................................................
	    } else if (val < 1000) {
		digits = 3;
	    } else if (val < 10000) {
		digits = 2;
	    } else {
		digits = 1;
	    }
	    objs[0] = Tcl_ObjPrintf("%.*f", digits, ((double) middle)/count);
	}

	objs[2] = Tcl_NewWideIntObj(count); /* iterations */

	/*
	 * Calculate speed as rate (count) per sec
	 */

	if (!middle) {
	    middle++;			/* Avoid divide by zero. */
	}
	if (count < (WIDE_MAX / 1000000)) {
	    val = (count * 1000000) / middle;
	    if (val < 100000) {
		if (val < 100) {
		    digits = 3;
		} else if (val < 1000) {
		    digits = 2;
		} else {
		    digits = 1;
		}
		objs[4] = Tcl_ObjPrintf("%.*f",
			digits, ((double) (count * 1000000)) / middle);
	    } else {
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
	}

    retRes:
	/*
	 * Estimated net execution time (in millisecs).
	 */

	if (!calibrate) {
	    if (middle >= 1) {
		objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
	    } else {
		objs[6] = Tcl_NewWideIntObj(0);
	    }
	    TclNewLiteralStringObj(objs[7], "nett-ms");
	}

	/*
	 * Construct the result as a list because many programs have always
	 * parsed as such (extracting the first element, typically).
	 */

................................................................................
	TclNewLiteralStringObj(objs[3], "#");
	TclNewLiteralStringObj(objs[5], "#/sec");
	Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
    }

  done:
    if (codePtr != NULL) {





	TclReleaseByteCode(codePtr);
    }
    return result;
}
 
/*
 *----------------------------------------------------------------------

int
Tcl_RegexpObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t offset, stringLength, matchLength, cflags, eflags;
    int i, indices, match, about, all, doinline, numMatchesSaved;

    Tcl_RegExp regExpr;
    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-all",		"-about",	"-indices",	"-inline",
	"-expanded",	"-line",	"-linestop",	"-lineanchor",
	"-nocase",	"-start",	"--",		NULL
................................................................................
	 * considered the start of the line. If for example the pattern {^} is
	 * passed and -start is positive, then the pattern will not match the
	 * start of the string unless the previous character is a newline.
	 */

	if (offset == TCL_INDEX_START) {
	    eflags = 0;
	} else if (offset + 1 > stringLength + 1) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

................................................................................
		resultPtr = Tcl_NewObj();
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		size_t start, end;
		Tcl_Obj *objs[2];

		/*
		 * Only adjust the match area if there was a match for that
		 * area. (Scriptics Bug 4391/SF Bug #219232)
		 */

		if (i <= (int)info.nsubs && info.matches[i].start != TCL_INDEX_NONE) {
		    start = offset + info.matches[i].start;
		    end = offset + info.matches[i].end;

		    /*
		     * Adjust index so it refers to the last character in the
		     * match instead of the first character after the match.
		     */

		    if (end + 1 >= offset + 1) {
			end--;
		    }
		} else {
		    start = TCL_INDEX_NONE;
		    end = TCL_INDEX_NONE;
		}

		objs[0] = TclNewWideIntObjFromSize(start);
		objs[1] = TclNewWideIntObjFromSize(end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if (i <= (int)info.nsubs) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    newPtr = Tcl_NewObj();
		}
	    }
................................................................................
	 * these cases we always want to bump the index up one.
	 */

	if (matchLength == 0) {
	    offset++;
	}
	all++;
	if (offset + 1 >= stringLength + 1) {
	    break;
	}
    }

    /*
     * Set the interpreter's object result to an integer object with value 1
     * if -all wasn't specified, otherwise it's all-1 (the number of times
................................................................................
int
Tcl_RegsubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result, cflags, all, match, command, numParts;
    size_t idx, wlen, wsublen = 0, offset, numMatches;
    size_t start, end, subStart, subEnd;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
................................................................................

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = TCL_INDEX_START;
    command = 0;
    resultPtr = NULL;

    for (idx = 1; idx < (size_t)objc; idx++) {
	const char *name;
	int index;

	name = TclGetString(objv[idx]);
	if (name[0] != '-') {
	    break;
	}
................................................................................
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGSUB_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGSUB_START: {
	    size_t temp;
	    if (++idx >= (size_t)objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], TCL_INDEX_START, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
................................................................................
	case REGSUB_LAST:
	    idx++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((size_t)objc < idx + 3 || (size_t)objc > idx + 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? exp string subSpec ?varName?");
    optionError:
	if (startIndex) {
	    Tcl_DecrRefCount(startIndex);
	}
	return TCL_ERROR;
................................................................................
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
	const char *element, *p, *splitEnd;
	size_t splitLen;
	Tcl_UniChar splitChar = 0;

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */

................................................................................
static int
StringMapCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2,  mapElemc, index;

    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
................................................................................
	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
	 */

	Tcl_DictObjSize(interp, objv[objc-2], &i);
	if (i == 0) {
	    /*
	     * Empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
	}

	mapElemc = 2 * i;
	mapWithDict = 1;

	/*
	 * Copy the dictionary out into an array; that's the easiest way to
	 * adapt this code...
	 */

	mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (index=2 ; index<mapElemc ; index+=2) {
	    Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {
	int i;
	if (TclListObjGetElements(interp, objv[objc-2], &i,
		&mapElemv) != TCL_OK) {
	    return TCL_ERROR;
	}
	mapElemc = i;
	if (mapElemc == 0) {
	    /*
	     * empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
................................................................................
int
TclNRSwitchObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, index, mode, foundmode, splitObjs, numMatchesSaved;
    int noCase;
    size_t patternLength, j;
    const char *pattern;
    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
    Tcl_Obj *const *savedObjv = objv;
    Tcl_RegExp regExpr = NULL;
    Interp *iPtr = (Interp *) interp;
    int pc = 0;
    int bidx = 0;		/* Index of body argument. */
................................................................................
	    TclNewObj(indicesObj);
	}

	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end + 1 > 1) {
		    rangeObjAry[0] = TclNewWideIntObjFromSize(info.matches[j].start);
		    rangeObjAry[1] = TclNewWideIntObjFromSize(info.matches[j].end-1);
		} else {
		    rangeObjAry[0] = rangeObjAry[1] = Tcl_NewWideIntObj(-1);
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */
................................................................................
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

    for (j = i + 1; ; j += 2) {
	if (j >= (size_t)objc) {
	    /*
	     * This shouldn't happen since we've checked that the last body is
	     * not a continuation...
	     */

	    Tcl_Panic("fall-out when searching for body to match pattern");
	}
................................................................................
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };
    NRE_callback *rootPtr;
    ByteCode *codePtr = NULL;
    int codeOptimized = 0;

    for (i = 1; i < objc - 1; i++) {
	int index;

	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
................................................................................

    if (!direct) {
	if (TclInterpReady(interp) != TCL_OK) {
	    return TCL_ERROR;
	}
	codePtr = TclCompileObj(interp, objPtr, NULL, 0);
	TclPreserveByteCode(codePtr);
	/*
	 * Replace last compiled done instruction with continue: it's a part of
	 * iteration, this way evaluation will be more similar to a cycle (also
	 * avoids extra overhead to set result to interp, etc.)
	 */
	if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) {
	    codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE;
	    codeOptimized = 1;
	}
    }

    /*
     * Get start and stop time.
     */

#ifdef TCL_WIDE_CLICKS
................................................................................
	    if (!direct) {		/* precompiled */
		rootPtr = TOP_CB(interp);
		result = TclNRExecuteByteCode(interp, codePtr);
		result = TclNRRunCallbacks(interp, result, rootPtr);
	    } else {			/* eval */
		result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	    }

	    /*
	     * Allow break and continue from measurement cycle (used for

	     * conditional stop and flow control of iterations).
	     */

	    switch (result) {
		case TCL_OK:
		    break;


		case TCL_BREAK:
		    /*
		     * Force stop immediately.
		     */

		    threshold = 1;
		    maxcnt = 0;
		case TCL_CONTINUE:
		    result = TCL_OK;
		    break;
		default:
		    goto done;
	    }

	    /*
	     * Don't check time up to threshold.
	     */

	    if (--threshold > 0) {
................................................................................
		threshold = maxcnt - count;
	    }
	}
    }

    {
	Tcl_Obj *objarr[8], **objs = objarr;
	Tcl_WideUInt usec, val;
	int digits;

	/*
	 * Absolute execution time in microseconds or in wide clicks.
	 */
	usec = (Tcl_WideUInt)(middle - start);

#ifdef TCL_WIDE_CLICKS
	/*
	 * convert execution time (in wide clicks) to microsecs.
	 */

	usec *= TclpWideClickInMicrosec();
#endif /* TCL_WIDE_CLICKS */

	if (!count) {		/* no iterations - avoid divide by zero */
	    objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
	    goto retRes;
	}

................................................................................
	    if (overhead > 0) {
		/*
		 * Estimate the time of overhead (microsecs).
		 */

		Tcl_WideUInt curOverhead = overhead * count;

		if (usec > curOverhead) {
		    usec -= curOverhead;
		} else {
		    usec = 0;
		}
	    }
	} else {
	    /*
	     * Calibration: obtaining new measurement overhead.
	     */

	    if (measureOverhead > ((double) usec) / count) {
		measureOverhead = ((double) usec) / count;
	    }
	    objs[0] = Tcl_NewDoubleObj(measureOverhead);
	    TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
	    objs += 2;
	}

	val = usec / count;		/* microsecs per iteration */
	if (val >= 1000000) {
	    objs[0] = Tcl_NewWideIntObj(val);
	} else {
	    if (val < 10) {
		digits = 6;
	    } else if (val < 100) {
		digits = 4;
................................................................................
	    } else if (val < 1000) {
		digits = 3;
	    } else if (val < 10000) {
		digits = 2;
	    } else {
		digits = 1;
	    }
	    objs[0] = Tcl_ObjPrintf("%.*f", digits, ((double) usec)/count);
	}

	objs[2] = Tcl_NewWideIntObj(count); /* iterations */

	/*
	 * Calculate speed as rate (count) per sec
	 */

	if (!usec) {
	    usec++;			/* Avoid divide by zero. */
	}
	if (count < (WIDE_MAX / 1000000)) {
	    val = (count * 1000000) / usec;
	    if (val < 100000) {
		if (val < 100) {
		    digits = 3;
		} else if (val < 1000) {
		    digits = 2;
		} else {
		    digits = 1;
		}
		objs[4] = Tcl_ObjPrintf("%.*f",
			digits, ((double) (count * 1000000)) / usec);
	    } else {
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / usec) * 1000000);
	}

    retRes:
	/*
	 * Estimated net execution time (in millisecs).
	 */

	if (!calibrate) {
	    if (usec >= 1) {
		objs[6] = Tcl_ObjPrintf("%.3f", (double)usec / 1000);
	    } else {
		objs[6] = Tcl_NewWideIntObj(0);
	    }
	    TclNewLiteralStringObj(objs[7], "net-ms");
	}

	/*
	 * Construct the result as a list because many programs have always
	 * parsed as such (extracting the first element, typically).
	 */

................................................................................
	TclNewLiteralStringObj(objs[3], "#");
	TclNewLiteralStringObj(objs[5], "#/sec");
	Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
    }

  done:
    if (codePtr != NULL) {
	if ( codeOptimized
	  && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE
	) {
	    codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE;
	}
	TclReleaseByteCode(codePtr);
    }
    return result;
}
 
/*
 *----------------------------------------------------------------------

    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = Tcl_Alloc(TclOffset(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;

    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;

/* 642 */
EXTERN void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
/* 643 */
EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);
/* 644 */
EXTERN int		Tcl_LinkArray(Tcl_Interp *interp,
				const char *varName, void *addr, int type,
				int size);





typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */
    Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */

} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclStubsPtr->tcl_IncrRefCount) /* 641 */
#define Tcl_DecrRefCount \
	(tclStubsPtr->tcl_DecrRefCount) /* 642 */
#define Tcl_IsShared \
	(tclStubsPtr->tcl_IsShared) /* 643 */
#define Tcl_LinkArray \
	(tclStubsPtr->tcl_LinkArray) /* 644 */



#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp

/* 642 */
EXTERN void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
/* 643 */
EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);
/* 644 */
EXTERN int		Tcl_LinkArray(Tcl_Interp *interp,
				const char *varName, void *addr, int type,
				size_t size);
/* 645 */
EXTERN int		Tcl_GetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, size_t endValue,
				size_t *indexPtr);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */
    Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, size_t size); /* 644 */
    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 645 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclStubsPtr->tcl_IncrRefCount) /* 641 */
#define Tcl_DecrRefCount \
	(tclStubsPtr->tcl_DecrRefCount) /* 642 */
#define Tcl_IsShared \
	(tclStubsPtr->tcl_IsShared) /* 643 */
#define Tcl_LinkArray \
	(tclStubsPtr->tcl_LinkArray) /* 644 */
#define Tcl_GetIntForIndex \
	(tclStubsPtr->tcl_GetIntForIndex) /* 645 */

#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp

     * exist, enlarge the array if necessary to make room. If the name exists,
     * free its old entry.
     */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    if (index == TCL_AUTO_LENGTH) {
#ifndef USE_PUTENV
	/*
	 * We need to handle the case where the environment may be changed
	 * outside our control. ourEnvironSize is only valid if the current
	 * environment is the one we allocated. [Bug 979640]
	 */

................................................................................

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if ((index != TCL_AUTO_LENGTH) && (environ[index] == p)) {
	ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

     * exist, enlarge the array if necessary to make room. If the name exists,
     * free its old entry.
     */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    if (index == TCL_INDEX_NONE) {
#ifndef USE_PUTENV
	/*
	 * We need to handle the case where the environment may be changed
	 * outside our control. ourEnvironSize is only valid if the current
	 * environment is the one we allocated. [Bug 979640]
	 */

................................................................................

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if ((index != TCL_INDEX_NONE) && (environ[index] == p)) {
	ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

#endif

/*
 * These are used by evalstats to monitor object usage in Tcl.
 */

#ifdef TCL_COMPILE_STATS
long		tclObjsAlloced = 0;
long		tclObjsFreed = 0;
long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
 
/*
 * NR_TEBC
 * Helpers for NR - non-recursive calls to TEBC
 * Minimal data required to fully reconstruct the execution state.
 */
................................................................................
    } while (0)
 
/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{
................................................................................
	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
		(match < 0 ? -1 : match > 0 ? 1 : 0)));
	JUMP_PEEPHOLE_F(match, 1, 2);

    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;
	slength = Tcl_GetCharLength(valuePtr);
	TclNewIntObj(objResultPtr, slength);
	TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "d\n", O2S(valuePtr), slength));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_UPPER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &slength);
................................................................................
	}
	Tcl_IncrRefCount(dictPtr);
	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
		&keyPtrPtr) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if ((unsigned int)length != duiPtr->length) {
	    Tcl_Panic("dictUpdateStart argument length mismatch");
	}
	for (i=0 ; i<length ; i++) {
	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
		    &valuePtr) != TCL_OK) {
		TRACE_ERROR(interp);
		Tcl_DecrRefCount(dictPtr);
................................................................................

	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);

	mp_init(&bigResult);
	if (opcode == INST_LSHIFT) {
	    mp_mul_2d(&big1, shift, &bigResult);
	} else {
	    mp_tc_div_2d(&big1, shift, &bigResult);
	}
	mp_clear(&big1);
	BIG_RESULT(&bigResult);
    }

    case INST_BITOR:
    case INST_BITXOR:
................................................................................
	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);

	    mp_init(&bigResult);

	    switch (opcode) {
	    case INST_BITAND:
		mp_tc_and(&big1, &big2, &bigResult);
		break;

	    case INST_BITOR:
		mp_tc_or(&big1, &big2, &bigResult);
		break;

	    case INST_BITXOR:
		mp_tc_xor(&big1, &big2, &bigResult);
		break;
	    }

	    mp_clear(&big1);
	    mp_clear(&big2);
	    BIG_RESULT(&bigResult);
	}
................................................................................
    size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert ((int)pcOffset < codePtr->numCodeBytes);

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */

................................................................................
				 * point or a catch range. */
    ByteCode *codePtr)		/* Points to the ByteCode in which to search
				 * for the enclosing ExceptionRange. */
{
    ExceptionRange *rangeArrayPtr;
    int numRanges = codePtr->numExceptRanges;
    ExceptionRange *rangePtr;
    unsigned int pcOffset = pc - codePtr->codeStart;
    unsigned int start;

    if (numRanges == 0) {
	return NULL;
    }

    /*
     * This exploits peculiarities of our compiler: nested ranges are always
................................................................................
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    ByteCodeStats *statsPtr = &iPtr->stats;
    double totalCodeBytes, currentCodeBytes;
    double totalLiteralBytes, currentLiteralBytes;
    double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
    double strBytesSharedMultX, strBytesSharedOnce;
    double numInstructions, currentHeaderBytes;
    long numCurrentByteCodes, numByteCodeLits;
    long refCountSum, literalMgmtBytes, sum;
    int numSharedMultX, numSharedOnce;
    size_t decadeHigh, minSizeDecade, maxSizeDecade, length, i;
    char *litTableStats;
    LiteralEntry *entryPtr;
    Tcl_Obj *objPtr;

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

    objPtr = Tcl_NewObj();
................................................................................
     */

    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
    Tcl_AppendPrintfToObj(objPtr,
	    "Compilation and execution statistics for interpreter %p\n",
	    iPtr);

    Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "d\n",
	    statsPtr->numExecutions);
    Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "d\n",
	    statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile\t%.1f\n",
	    statsPtr->numExecutions / (float)statsPtr->numCompilations);

    Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n",
	    numInstructions);
    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/compile\t\t%.0f\n",
	    numInstructions / statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/execution\t\t%.0f\n",
	    numInstructions / statsPtr->numExecutions);

    Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%" TCL_Z_MODIFIER "d\n",
	    statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
	    statsPtr->totalSrcBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
	    totalCodeBytes);
    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
	    statsPtr->totalByteCodeBytes);
................................................................................
	    statsPtr->numLiteralsCreated * sizeof(Tcl_Obj),
	    statsPtr->totalLitStringBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Mean code/compile\t\t%.1f\n",
	    totalCodeBytes / statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
	    totalCodeBytes / statsPtr->totalSrcBytes);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n",
	    numCurrentByteCodes);
    Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
	    statsPtr->currentSrcBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
	    currentCodeBytes);
    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
	    statsPtr->currentByteCodeBytes);
................................................................................
     *
     * This gives the refcount of each obj as Tcl_IsShared was called for it.
     * Shared objects must be duplicated before they can be modified.
     */

    numSharedMultX = 0;
    Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n");
    Tcl_AppendPrintfToObj(objPtr, "  Object had refcount <=1 (not shared)\t%ld\n",
	    tclObjsShared[1]);
    for (i = 2;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
	Tcl_AppendPrintfToObj(objPtr, "  refcount ==%" TCL_Z_MODIFIER "d\t\t%ld\n",
		i, tclObjsShared[i]);
	numSharedMultX += tclObjsShared[i];
    }
    Tcl_AppendPrintfToObj(objPtr, "  refcount >=%" TCL_Z_MODIFIER "d\t\t%ld\n",
	    i, tclObjsShared[0]);
    numSharedMultX += tclObjsShared[0];
    Tcl_AppendPrintfToObj(objPtr, "  Total shared objects\t\t\t%d\n",
	    numSharedMultX);

    /*
     * Literal table statistics.
     */

    numByteCodeLits = 0;
................................................................................
		strBytesSharedOnce += (length+1);
	    }
	}
    }
    sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
	    - currentLiteralBytes;

    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n",
	    tclObjsAlloced);
    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n",
	    (tclObjsAlloced - tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "d\n",
	    statsPtr->numLiteralsCreated);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "d (%0.1f%% of current objects)\n",
	    globalTablePtr->numEntries,
	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%ld (%0.1f%% of current literals)\n",
	    numByteCodeLits,
	    Percent(numByteCodeLits, globalTablePtr->numEntries));
    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%d\n",
	    numSharedMultX);
    Tcl_AppendPrintfToObj(objPtr, "  Mean reference count\t\t%.2f\n",
	    ((double) refCountSum) / globalTablePtr->numEntries);
    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str reused >1x \t%.2f\n",
	    (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str used 1x\t\t%.2f\n",
	    (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
................................................................................
	    statsPtr->currentLitStringBytes);
    Tcl_AppendPrintfToObj(objPtr, "    Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
	    (objBytesIfUnshared + strBytesIfUnshared),
	    objBytesIfUnshared, strBytesIfUnshared);
    Tcl_AppendPrintfToObj(objPtr, "  String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
	    (strBytesIfUnshared - statsPtr->currentLitStringBytes),
	    strBytesIfUnshared, statsPtr->currentLitStringBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n",
	    literalMgmtBytes,
	    Percent(literalMgmtBytes, currentLiteralBytes));
    Tcl_AppendPrintfToObj(objPtr, "    table %lu + buckets %lu + entries %lu\n",
	    (unsigned long) sizeof(LiteralTable),
	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)));

................................................................................
    /*
     * Detailed literal statistics.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n");
    maxSizeDecade = 0;
    for (i = 31;  i >= 0;  i--) {

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

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    Tcl_Free(litTableStats);
................................................................................
	    break;
	}
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->srcCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
................................................................................
	    break;
	}
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->byteCodeCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
    Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
................................................................................

    /*
     * Instruction counts.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
    for (i = 0;  i < LAST_INST_OPCODE;  i++) {
	Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "d ",
		tclInstructionTable[i].name, statsPtr->instructionCount[i]);
	if (statsPtr->instructionCount[i]) {
	    Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
		    Percent(statsPtr->instructionCount[i], numInstructions));
	} else {
	    Tcl_AppendPrintfToObj(objPtr, "0\n");
	}

#endif

/*
 * These are used by evalstats to monitor object usage in Tcl.
 */

#ifdef TCL_COMPILE_STATS
size_t		tclObjsAlloced = 0;
size_t		tclObjsFreed = 0;
size_t		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
 
/*
 * NR_TEBC
 * Helpers for NR - non-recursive calls to TEBC
 * Minimal data required to fully reconstruct the execution state.
 */
................................................................................
    } while (0)
 
/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{
................................................................................
	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
		(match < 0 ? -1 : match > 0 ? 1 : 0)));
	JUMP_PEEPHOLE_F(match, 1, 2);

    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;
	slength = Tcl_GetCharLength(valuePtr);
	objResultPtr = TclNewWideIntObjFromSize(slength);
	TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_UPPER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &slength);
................................................................................
	}
	Tcl_IncrRefCount(dictPtr);
	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
		&keyPtrPtr) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if ((size_t)length != duiPtr->length) {
	    Tcl_Panic("dictUpdateStart argument length mismatch");
	}
	for (i=0 ; i<length ; i++) {
	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
		    &valuePtr) != TCL_OK) {
		TRACE_ERROR(interp);
		Tcl_DecrRefCount(dictPtr);
................................................................................

	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);

	mp_init(&bigResult);
	if (opcode == INST_LSHIFT) {
	    mp_mul_2d(&big1, shift, &bigResult);
	} else {
	    mp_signed_rsh(&big1, shift, &bigResult);
	}
	mp_clear(&big1);
	BIG_RESULT(&bigResult);
    }

    case INST_BITOR:
    case INST_BITXOR:
................................................................................
	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);

	    mp_init(&bigResult);

	    switch (opcode) {
	    case INST_BITAND:
		mp_and(&big1, &big2, &bigResult);
		break;

	    case INST_BITOR:
		mp_or(&big1, &big2, &bigResult);
		break;

	    case INST_BITXOR:
		mp_xor(&big1, &big2, &bigResult);
		break;
	    }

	    mp_clear(&big1);
	    mp_clear(&big2);
	    BIG_RESULT(&bigResult);
	}
................................................................................
    size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert (pcOffset < (size_t)codePtr->numCodeBytes);

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */

................................................................................
				 * point or a catch range. */
    ByteCode *codePtr)		/* Points to the ByteCode in which to search
				 * for the enclosing ExceptionRange. */
{
    ExceptionRange *rangeArrayPtr;
    int numRanges = codePtr->numExceptRanges;
    ExceptionRange *rangePtr;
    size_t pcOffset = pc - codePtr->codeStart;
    size_t start;

    if (numRanges == 0) {
	return NULL;
    }

    /*
     * This exploits peculiarities of our compiler: nested ranges are always
................................................................................
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    ByteCodeStats *statsPtr = &iPtr->stats;
    double totalCodeBytes, currentCodeBytes;
    double totalLiteralBytes, currentLiteralBytes;
    double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
    double strBytesSharedMultX, strBytesSharedOnce;
    double numInstructions, currentHeaderBytes;
    size_t numCurrentByteCodes, numByteCodeLits;
    size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
    size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;

    char *litTableStats;
    LiteralEntry *entryPtr;
    Tcl_Obj *objPtr;

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

    objPtr = Tcl_NewObj();
................................................................................
     */

    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
    Tcl_AppendPrintfToObj(objPtr,
	    "Compilation and execution statistics for interpreter %p\n",
	    iPtr);

    Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numExecutions);
    Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile\t%.1f\n",
	    statsPtr->numExecutions / (float)statsPtr->numCompilations);

    Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n",
	    numInstructions);
    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/compile\t\t%.0f\n",
	    numInstructions / statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/execution\t\t%.0f\n",
	    numInstructions / statsPtr->numExecutions);

    Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
	    statsPtr->totalSrcBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
	    totalCodeBytes);
    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
	    statsPtr->totalByteCodeBytes);
................................................................................
	    statsPtr->numLiteralsCreated * sizeof(Tcl_Obj),
	    statsPtr->totalLitStringBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Mean code/compile\t\t%.1f\n",
	    totalCodeBytes / statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
	    totalCodeBytes / statsPtr->totalSrcBytes);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%" TCL_Z_MODIFIER "u\n",
	    numCurrentByteCodes);
    Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
	    statsPtr->currentSrcBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
	    currentCodeBytes);
    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
	    statsPtr->currentByteCodeBytes);
................................................................................
     *
     * This gives the refcount of each obj as Tcl_IsShared was called for it.
     * Shared objects must be duplicated before they can be modified.
     */

    numSharedMultX = 0;
    Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n");
    Tcl_AppendPrintfToObj(objPtr, "  Object had refcount <=1 (not shared)\t%" TCL_Z_MODIFIER "u\n",
	    tclObjsShared[1]);
    for (i = 2;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
	Tcl_AppendPrintfToObj(objPtr, "  refcount ==%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n",
		i, tclObjsShared[i]);
	numSharedMultX += tclObjsShared[i];
    }
    Tcl_AppendPrintfToObj(objPtr, "  refcount >=%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n",
	    i, tclObjsShared[0]);
    numSharedMultX += tclObjsShared[0];
    Tcl_AppendPrintfToObj(objPtr, "  Total shared objects\t\t\t%" TCL_Z_MODIFIER "u\n",
	    numSharedMultX);

    /*
     * Literal table statistics.
     */

    numByteCodeLits = 0;
................................................................................
		strBytesSharedOnce += (length+1);
	    }
	}
    }
    sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
	    - currentLiteralBytes;

    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n",
	    tclObjsAlloced);
    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n",
	    (tclObjsAlloced - tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numLiteralsCreated);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current objects)\n",
	    globalTablePtr->numEntries,
	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n",
	    numByteCodeLits,
	    Percent(numByteCodeLits, globalTablePtr->numEntries));
    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n",
	    numSharedMultX);
    Tcl_AppendPrintfToObj(objPtr, "  Mean reference count\t\t%.2f\n",
	    ((double) refCountSum) / globalTablePtr->numEntries);
    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str reused >1x \t%.2f\n",
	    (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str used 1x\t\t%.2f\n",
	    (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
................................................................................
	    statsPtr->currentLitStringBytes);
    Tcl_AppendPrintfToObj(objPtr, "    Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
	    (objBytesIfUnshared + strBytesIfUnshared),
	    objBytesIfUnshared, strBytesIfUnshared);
    Tcl_AppendPrintfToObj(objPtr, "  String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
	    (strBytesIfUnshared - statsPtr->currentLitStringBytes),
	    strBytesIfUnshared, statsPtr->currentLitStringBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Literal mgmt overhead\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of bytes with sharing)\n",
	    literalMgmtBytes,
	    Percent(literalMgmtBytes, currentLiteralBytes));
    Tcl_AppendPrintfToObj(objPtr, "    table %lu + buckets %lu + entries %lu\n",
	    (unsigned long) sizeof(LiteralTable),
	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)));

................................................................................
    /*
     * Detailed literal statistics.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n");
    maxSizeDecade = 0;
    i = 32;
    while (i-- > 0) {
	if (statsPtr->literalCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	}
    }
    sum = 0;
    for (i = 0;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->literalCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    Tcl_Free(litTableStats);
................................................................................
	    break;
	}
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->srcCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
................................................................................
	    break;
	}
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->byteCodeCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
    Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
................................................................................

    /*
     * Instruction counts.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
    for (i = 0;  i < LAST_INST_OPCODE;  i++) {
	Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ",
		tclInstructionTable[i].name, statsPtr->instructionCount[i]);
	if (statsPtr->instructionCount[i]) {
	    Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
		    Percent(statsPtr->instructionCount[i], numInstructions));
	} else {
	    Tcl_AppendPrintfToObj(objPtr, "0\n");
	}

    Tcl_DecrRefCount(contents);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclFileTemporaryCmd
 *
 *	This function implements the "tempfile" subcommand of the "file"
 *	command.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
................................................................................
	    Tcl_UnregisterChannel(interp, chan);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return TCL_OK;
}
 
/*

















































































































































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

    Tcl_DecrRefCount(contents);
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclFileTemporaryCmd --
 *
 *	This function implements the "tempfile" subcommand of the "file"
 *	command.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
................................................................................
	    Tcl_UnregisterChannel(interp, chan);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclFileTempDirCmd --
 *
 *	This function implements the "tempdir" subcommand of the "file"
 *	command.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Creates a temporary directory.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileTempDirCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirNameObj;	/* Object that will contain the directory
				 * name. */
    Tcl_Obj *baseDirObj = NULL, *nameBaseObj = NULL;
				/* Pieces of template. Each piece is NULL if
				 * it is omitted. The platform temporary file
				 * engine might ignore some pieces. */

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

    if (objc > 1) {
	int length;
	Tcl_Obj *templateObj = objv[1];
	const char *string = TclGetStringFromObj(templateObj, &length);
	const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {
	    goto makeTemporary;
	}

	/*
	 * The template only gives a directory if there is a directory
	 * separator in it, and only gives a base name if there's at least one
	 * character after the last directory separator.
	 */

	if (strchr(string, '/') == NULL
		&& (!onWindows || strchr(string, '\\') == NULL)) {
	    /*
	     * No directory separator, so just assume we have a file name.
	     * This is a bit wrong on Windows where we could have problems
	     * with disk name prefixes... but those are much less common in
	     * naked form so we just pass through and let the OS figure it out
	     * instead.
	     */

	    nameBaseObj = templateObj;
	    Tcl_IncrRefCount(nameBaseObj);
	} else if (string[length-1] != '/'
		&& (!onWindows || string[length-1] != '\\')) {
	    /*
	     * If the template has a non-terminal directory separator, split
	     * into dirname and tail.
	     */

	    baseDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
	    nameBaseObj = TclPathPart(interp, templateObj, TCL_PATH_TAIL);
	} else {
	    /*
	     * Otherwise, there must be a terminal directory separator, so
	     * just the directory is given.
	     */

	    baseDirObj = templateObj;
	    Tcl_IncrRefCount(baseDirObj);
	}

	/*
	 * Only allow creation of temporary directories in the native
	 * filesystem since they are frequently used for integration with
	 * external tools or system libraries.
	 */

	if (baseDirObj != NULL && Tcl_FSGetFileSystemForPath(baseDirObj)
		!= &tclNativeFilesystem) {
	    TclDecrRefCount(baseDirObj);
	    baseDirObj = NULL;
	}
    }

    /*
     * Convert empty parts of the template into unspecified parts.
     */

    if (baseDirObj && !TclGetString(baseDirObj)[0]) {
	TclDecrRefCount(baseDirObj);
	baseDirObj = NULL;
    }
    if (nameBaseObj && !TclGetString(nameBaseObj)[0]) {
	TclDecrRefCount(nameBaseObj);
	nameBaseObj = NULL;
    }

    /*
     * Create and open the temporary file.
     */

  makeTemporary:
    dirNameObj = TclpCreateTemporaryDirectory(baseDirObj, nameBaseObj);

    /*
     * If we created pieces of template, get rid of them now.
     */

    if (baseDirObj) {
	TclDecrRefCount(baseDirObj);
    }
    if (nameBaseObj) {
	TclDecrRefCount(nameBaseObj);
    }

    /*
     * Deal with results.
     */

    if (dirNameObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create temporary directory: %s",
		Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirNameObj);
    return TCL_OK;
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != hPtr->hash) {
		continue;
	    }


	    if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {

		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
    } else {
................................................................................
    Tcl_HashEntry *hPtr;
    size_t size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = Tcl_Alloc(TclOffset(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}
 
/*
 *----------------------------------------------------------------------

	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != hPtr->hash) {
		continue;
	    }
	    /* if keys pointers or values are equal */
	    if ((key == hPtr->key.oneWordValue)
		|| compareKeysProc((void *) key, hPtr)
	    ) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
    } else {
................................................................................
    Tcl_HashEntry *hPtr;
    size_t size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}
 
/*
 *----------------------------------------------------------------------

    				/* Next buffer in chain. */
    char buf[1];		/* Placeholder for real buffer. The real
				 * buffer occuppies this space + bufSize-1
				 * bytes. This must be the last field in the
				 * structure. */
} ChannelBuffer;

#define CHANNELBUFFER_HEADER_SIZE	TclOffset(ChannelBuffer, buf)

/*
 * How much extra space to allocate in buffer to hold bytes from previous
 * buffer (when converting to UTF-8) or to hold bytes that will go to next
 * buffer (when converting from UTF-8).
 */

    				/* Next buffer in chain. */
    char buf[1];		/* Placeholder for real buffer. The real
				 * buffer occuppies this space + bufSize-1
				 * bytes. This must be the last field in the
				 * structure. */
} ChannelBuffer;

#define CHANNELBUFFER_HEADER_SIZE	offsetof(ChannelBuffer, buf)

/*
 * How much extra space to allocate in buffer to hold bytes from previous
 * buffer (when converting to UTF-8) or to hold bytes that will go to next
 * buffer (when converting from UTF-8).
 */

    int TclGetFrame(Tcl_Interp *interp, const char *str,
	    CallFrame **framePtrPtr)
}
# Removed in 8.5:
#declare 33 {
#    TclCmdProcType TclGetInterpProc(void)
#}
declare 34 {
    int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    size_t endValue, size_t *indexPtr)
}

# Removed in 8.4b2:
#declare 35 {
#    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    int flags)
#}
# Removed in 8.6a2:
#declare 36 {
................................................................................

# Added for Tcl 8.2

declare 150 {
    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 {
    void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, int *startPtr,
	    int *endPtr)
}
declare 152 {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 {
    Tcl_Obj *TclGetLibraryPath(void)
}
................................................................................
    int	TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
	    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
declare 257 {
    void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}


declare 258 {




    int	TclMSB(size_t n)
}
 
##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

    int TclGetFrame(Tcl_Interp *interp, const char *str,
	    CallFrame **framePtrPtr)
}
# Removed in 8.5:
#declare 33 {
#    TclCmdProcType TclGetInterpProc(void)
#}
# Removed in 9.0:
#declare 34 {deprecated {Use Tcl_GetIntForIndex}} {
#    int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
#	    int endValue, int *indexPtr)
#}
# Removed in 8.4b2:
#declare 35 {
#    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    int flags)
#}
# Removed in 8.6a2:
#declare 36 {
................................................................................

# Added for Tcl 8.2

declare 150 {
    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 {
    void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, size_t *startPtr,
	    size_t *endPtr)
}
declare 152 {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 {
    Tcl_Obj *TclGetLibraryPath(void)
}
................................................................................
    int	TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
	    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
declare 257 {
    void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}

# TIP 431: temporary directory creation function
declare 258 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
	    Tcl_Obj *basenameObj)
}
declare 259 {
    int	TclMSB(size_t n)
}
 
##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
#include <string.h>
#endif
#if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \
     || defined(__cplusplus) || defined(_MSC_VER)
#include <stddef.h>
#else
typedef int ptrdiff_t;
#endif

/*
 * Ensure WORDS_BIGENDIAN is defined correctly:
................................................................................
    void *clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
    struct CommandTrace *nextPtr;
				/* Next in list of traces associated with a
				 * particular command. */
    size_t refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
} CommandTrace;

/*
 * When a command trace is active (i.e. its associated procedure is executing)
................................................................................
				 * NULL if end of chain. */
    Tcl_Obj *objPtr;		/* Points to Tcl object that holds the
				 * literal's bytes and length. */
    size_t refCount;		/* If in an interpreter's global literal
				 * table, the number of ByteCode structures
				 * that share the literal object; the literal
				 * entry can be freed when refCount drops to
				 * 0. If in a local literal table, -1. */
    Namespace *nsPtr;		/* Namespace in which this literal is used. We
				 * try to avoid sharing literal non-FQ command
				 * names among different namespaces to reduce
				 * shimmering. */
} LiteralEntry;

typedef struct LiteralTable {
................................................................................

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

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

#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    || (objPtr)->typePtr == &tclBooleanType) \
................................................................................
	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
	    ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \
	    ? (size_t)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \
	    : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			Tcl_WideInt *wideIntPtr);
................................................................................
 * The head of the list of free Tcl objects, and the total number of Tcl
 * objects ever allocated and freed.
 */

MODULE_SCOPE Tcl_Obj *	tclFreeObjList;

#ifdef TCL_COMPILE_STATS
MODULE_SCOPE long	tclObjsAlloced;
MODULE_SCOPE long	tclObjsFreed;
#define TCL_MAX_SHARED_OBJ_STATS 5
MODULE_SCOPE long	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
#endif /* TCL_COMPILE_STATS */

/*
 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */
................................................................................
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;

MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
................................................................................
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclDivOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileDivOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLessOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLessOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLeqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclGreaterOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileGreaterOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclGeqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileGeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclEqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileEqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclStreqOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
................................................................................

MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE size_t	TclIndexDecode(int encoded, size_t endValue);

/* Constants used in index value encoding routines. */
#define TCL_INDEX_END           ((size_t)-2)
#define TCL_INDEX_NONE          ((size_t)-1) /* Index out of range or END+1 */
#define TCL_INDEX_START         ((size_t)0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and release Tcl objects.
 * TclNewObj(objPtr) creates a new object denoting an empty string.
 * TclDecrRefCount(objPtr) decrements the object's reference count, and frees
................................................................................
#    ifdef NO_ISNAN
#	 define TclIsNaN(d)	((d) != (d))
#    else
#	 define TclIsNaN(d)	(isnan(d))
#    endif
#endif

/*
 * ----------------------------------------------------------------------
 * Macro to use to find the offset of a field in a structure. Computes number
 * of bytes from beginning of structure to a given field.
 */

#ifdef offsetof
#define TclOffset(type, field) (offsetof(type, field))
#else
#define TclOffset(type, field) (((char *) &((type *) 0)->field))
#endif

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */

................................................................................
 */

#if (!defined(TCL_WIDE_INT_IS_LONG) || (LONG_MAX > UINT_MAX)) && (SIZE_MAX <= UINT_MAX)
#   define TclWideIntFromSize(value)	(((Tcl_WideInt)(((size_t)(value))+1))-1)
#   define TclNewWideIntObjFromSize(value) \
	Tcl_NewWideIntObj(TclWideIntFromSize(value))
#else
#   define TclWideIntFromSize(value)	(value)
#   define TclNewWideIntObjFromSize Tcl_NewWideIntObj
#endif

/*
 * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
 */

#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
#include <string.h>
#endif
#if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \
     || defined(__cplusplus) || defined(_MSC_VER) || defined(__ICC)
#include <stddef.h>
#else
typedef int ptrdiff_t;
#endif

/*
 * Ensure WORDS_BIGENDIAN is defined correctly:
................................................................................
    void *clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
    struct CommandTrace *nextPtr;
				/* Next in list of traces associated with a
				 * particular command. */
    size_t refCount;	/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
} CommandTrace;

/*
 * When a command trace is active (i.e. its associated procedure is executing)
................................................................................
				 * NULL if end of chain. */
    Tcl_Obj *objPtr;		/* Points to Tcl object that holds the
				 * literal's bytes and length. */
    size_t refCount;		/* If in an interpreter's global literal
				 * table, the number of ByteCode structures
				 * that share the literal object; the literal
				 * entry can be freed when refCount drops to
				 * 0. If in a local literal table, TCL_AUTO_LENGTH. */
    Namespace *nsPtr;		/* Namespace in which this literal is used. We
				 * try to avoid sharing literal non-FQ command
				 * names among different namespaces to reduce
				 * shimmering. */
} LiteralEntry;

typedef struct LiteralTable {
................................................................................

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

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

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

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			Tcl_WideInt *wideIntPtr);
................................................................................
 * The head of the list of free Tcl objects, and the total number of Tcl
 * objects ever allocated and freed.
 */

MODULE_SCOPE Tcl_Obj *	tclFreeObjList;

#ifdef TCL_COMPILE_STATS
MODULE_SCOPE size_t	tclObjsAlloced;
MODULE_SCOPE size_t	tclObjsFreed;
#define TCL_MAX_SHARED_OBJ_STATS 5
MODULE_SCOPE size_t	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
#endif /* TCL_COMPILE_STATS */

/*
 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */
................................................................................
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTempDirCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
................................................................................
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclDivOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileDivOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);



MODULE_SCOPE int	TclCompileLessOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);



MODULE_SCOPE int	TclCompileLeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);



MODULE_SCOPE int	TclCompileGreaterOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);



MODULE_SCOPE int	TclCompileGeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);



MODULE_SCOPE int	TclCompileEqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);



MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
................................................................................

MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE size_t	TclIndexDecode(int encoded, size_t endValue);

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

#define TCL_INDEX_START         ((size_t)0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and release Tcl objects.
 * TclNewObj(objPtr) creates a new object denoting an empty string.
 * TclDecrRefCount(objPtr) decrements the object's reference count, and frees
................................................................................
#    ifdef NO_ISNAN
#	 define TclIsNaN(d)	((d) != (d))
#    else
#	 define TclIsNaN(d)	(isnan(d))
#    endif
#endif

/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */





#ifndef offsetof


#   define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field))
#endif

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */

................................................................................
 */

#if (!defined(TCL_WIDE_INT_IS_LONG) || (LONG_MAX > UINT_MAX)) && (SIZE_MAX <= UINT_MAX)
#   define TclWideIntFromSize(value)	(((Tcl_WideInt)(((size_t)(value))+1))-1)
#   define TclNewWideIntObjFromSize(value) \
	Tcl_NewWideIntObj(TclWideIntFromSize(value))
#else
#   define TclWideIntFromSize(value)	((Tcl_WideInt)(value))
#   define TclNewWideIntObjFromSize Tcl_NewWideIntObj
#endif

/*
 * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
 */

/* Slot 30 is reserved */
/* 31 */
EXTERN const char *	TclGetExtension(const char *name);
/* 32 */
EXTERN int		TclGetFrame(Tcl_Interp *interp, const char *str,
				CallFrame **framePtrPtr);
/* Slot 33 is reserved */
/* 34 */
EXTERN int		TclGetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, size_t endValue,
				size_t *indexPtr);
/* Slot 35 is reserved */
/* Slot 36 is reserved */
/* 37 */
EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
				const char *targetName);
/* 38 */
EXTERN int		TclGetNamespaceForQualName(Tcl_Interp *interp,
................................................................................
EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
/* 149 */
EXTERN void		TclHandleRelease(TclHandle handle);
/* 150 */
EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, size_t index,
				int *startPtr, int *endPtr);
/* 152 */
EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
EXTERN Tcl_Obj *	TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
/* 156 */
................................................................................
				Tcl_Obj *part2Ptr, const int flags);
/* 257 */
EXTERN void		TclStaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 258 */



EXTERN int		TclMSB(size_t n);

typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
................................................................................
    void (*reserved27)(void);
    Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
    void (*reserved29)(void);
    void (*reserved30)(void);
    const char * (*tclGetExtension) (const char *name); /* 31 */
    int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
    void (*reserved33)(void);
    int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 34 */
    void (*reserved35)(void);
    void (*reserved36)(void);
    int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
    int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
    int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
    Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
................................................................................
    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, int *startPtr, int *endPtr); /* 151 */
    void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
    Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
    void (*reserved154)(void);
    void (*reserved155)(void);
    void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
    Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
    void (*reserved158)(void);
................................................................................
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
    int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
    int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
    void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */

    int (*tclMSB) (size_t n); /* 258 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
/* Slot 29 is reserved */
/* Slot 30 is reserved */
#define TclGetExtension \
	(tclIntStubsPtr->tclGetExtension) /* 31 */
#define TclGetFrame \
	(tclIntStubsPtr->tclGetFrame) /* 32 */
/* Slot 33 is reserved */
#define TclGetIntForIndex \
	(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
/* Slot 35 is reserved */
/* Slot 36 is reserved */
#define TclGetLoadedPackages \
	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#define TclGetNamespaceForQualName \
	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
#define TclGetObjInterpProc \
................................................................................
	(tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */
#define TclPtrObjMakeUpvar \
	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticPackage \
	(tclIntStubsPtr->tclStaticPackage) /* 257 */


#define TclMSB \
	(tclIntStubsPtr->tclMSB) /* 258 */

#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#undef Tcl_StaticPackage

/* Slot 30 is reserved */
/* 31 */
EXTERN const char *	TclGetExtension(const char *name);
/* 32 */
EXTERN int		TclGetFrame(Tcl_Interp *interp, const char *str,
				CallFrame **framePtrPtr);
/* Slot 33 is reserved */
/* Slot 34 is reserved */



/* Slot 35 is reserved */
/* Slot 36 is reserved */
/* 37 */
EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
				const char *targetName);
/* 38 */
EXTERN int		TclGetNamespaceForQualName(Tcl_Interp *interp,
................................................................................
EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
/* 149 */
EXTERN void		TclHandleRelease(TclHandle handle);
/* 150 */
EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, size_t index,
				size_t *startPtr, size_t *endPtr);
/* 152 */
EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
EXTERN Tcl_Obj *	TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
/* 156 */
................................................................................
				Tcl_Obj *part2Ptr, const int flags);
/* 257 */
EXTERN void		TclStaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* 259 */
EXTERN int		TclMSB(size_t n);

typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
................................................................................
    void (*reserved27)(void);
    Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
    void (*reserved29)(void);
    void (*reserved30)(void);
    const char * (*tclGetExtension) (const char *name); /* 31 */
    int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
    void (*reserved33)(void);
    void (*reserved34)(void);
    void (*reserved35)(void);
    void (*reserved36)(void);
    int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
    int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
    int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
    Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
................................................................................
    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, size_t *startPtr, size_t *endPtr); /* 151 */
    void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
    Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
    void (*reserved154)(void);
    void (*reserved155)(void);
    void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
    Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
    void (*reserved158)(void);
................................................................................
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
    int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
    int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
    void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
    Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
    int (*tclMSB) (size_t n); /* 259 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
/* Slot 29 is reserved */
/* Slot 30 is reserved */
#define TclGetExtension \
	(tclIntStubsPtr->tclGetExtension) /* 31 */
#define TclGetFrame \
	(tclIntStubsPtr->tclGetFrame) /* 32 */
/* Slot 33 is reserved */
/* Slot 34 is reserved */

/* Slot 35 is reserved */
/* Slot 36 is reserved */
#define TclGetLoadedPackages \
	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#define TclGetNamespaceForQualName \
	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
#define TclGetObjInterpProc \
................................................................................
	(tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */
#define TclPtrObjMakeUpvar \
	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticPackage \
	(tclIntStubsPtr->tclStaticPackage) /* 257 */
#define TclpCreateTemporaryDirectory \
	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
#define TclMSB \
	(tclIntStubsPtr->tclMSB) /* 259 */

#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#undef Tcl_StaticPackage

    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
    Namespace *nsPtr;		/* Namespace containing Tcl variable */
    Tcl_Obj *varName;		/* Name of variable (must be global). This is
				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    void *addr;			/* Location of C variable. */
    int bytes;			/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    int numElems;		/* Number of elements in C variable array.
				 * Zero for single variables. */
    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;
................................................................................
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. If NULL then the necessary space
				 * will be allocated and returned as the
				 * interpreter result. */
    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
    int size)			/* Size of C variable array, >1 if array */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

................................................................................
    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
    const char *name1,		/* First part of variable name. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = clientData;
    int changed;
    int valueLength;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
................................................................................
	pp = (char **) linkPtr->addr;

	*pp = Tcl_Realloc(*pp, ++valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength);
	valueLength++;		/* include end of string char */
	if (valueLength > linkPtr->bytes) {
	    return (char *) "wrong size of char* value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
	    memcpy(linkPtr->addr, value, (size_t) valueLength);
................................................................................
	} else {
	    linkPtr->lastValue.c = '\0';
	    LinkedVar(char) = linkPtr->lastValue.c;
	}
	return NULL;

    case TCL_LINK_BINARY:
	value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength);
	if (valueLength != linkPtr->bytes) {
	    return (char *) "wrong size of binary value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
	    memcpy(linkPtr->addr, value, (size_t) valueLength);
	} else {
................................................................................

    /*
     * If we're working with an array of numbers, extract the Tcl list.
     */

    if (linkPtr->flags & LINK_ALLOC_LAST) {
	if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
		|| objc != linkPtr->numElems) {
	    return (char *) "wrong dimension";
	}
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
................................................................................

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    int i;

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {

    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
    Namespace *nsPtr;		/* Namespace containing Tcl variable */
    Tcl_Obj *varName;		/* Name of variable (must be global). This is
				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    void *addr;			/* Location of C variable. */
    size_t bytes;		/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    size_t numElems;	/* Number of elements in C variable array.
				 * Zero for single variables. */
    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;
................................................................................
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. If NULL then the necessary space
				 * will be allocated and returned as the
				 * interpreter result. */
    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
    size_t size)			/* Size of C variable array, >1 if array */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

................................................................................
    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
    const char *name1,		/* First part of variable name. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = clientData;
    int changed;
    size_t valueLength = 0;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
................................................................................
	pp = (char **) linkPtr->addr;

	*pp = Tcl_Realloc(*pp, ++valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) TclGetStringFromObj(valueObj, &valueLength);
	valueLength++;		/* include end of string char */
	if (valueLength > linkPtr->bytes) {
	    return (char *) "wrong size of char* value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
	    memcpy(linkPtr->addr, value, (size_t) valueLength);
................................................................................
	} else {
	    linkPtr->lastValue.c = '\0';
	    LinkedVar(char) = linkPtr->lastValue.c;
	}
	return NULL;

    case TCL_LINK_BINARY:
	value = (char *) TclGetByteArrayFromObj(valueObj, &valueLength);
	if (valueLength != linkPtr->bytes) {
	    return (char *) "wrong size of binary value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
	    memcpy(linkPtr->addr, value, (size_t) valueLength);
	} else {
................................................................................

    /*
     * If we're working with an array of numbers, extract the Tcl list.
     */

    if (linkPtr->flags & LINK_ALLOC_LAST) {
	if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
		|| (size_t)objc != linkPtr->numElems) {
	    return (char *) "wrong dimension";
	}
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
................................................................................

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    size_t i;

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {

		}
		if ((flags & LITERAL_ON_HEAP)) {
		    Tcl_Free((void *)bytes);
		}
		if (globalPtrPtr) {
		    *globalPtrPtr = globalPtr;
		} else {

		    globalPtr->refCount++;

#ifdef TCL_COMPILE_DEBUG
    if (globalPtr->refCount + 1 < 2) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : length), bytes,
		globalPtr->refCount);
    }
#endif
		}
		return objPtr;
	    }
	}
    }
................................................................................
	if (entryPtr->objPtr == objPtr) {
	    /*
	     * If the literal is no longer being used by any ByteCode, delete
	     * the entry then remove the reference corresponding to the global
	     * literal table entry (decrement the ref count of the object).
	     */

	    if (entryPtr->refCount-- <= 1) {
		if (prevPtr == NULL) {
		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
		} else {
		    prevPtr->nextPtr = entryPtr->nextPtr;
		}
		Tcl_Free(entryPtr);
		globalTablePtr->numEntries--;
................................................................................
     */

    result = Tcl_Alloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "d entries: %" TCL_Z_MODIFIER "d\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "d\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}
#endif /*TCL_COMPILE_STATS*/
 
................................................................................

    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount + 1 < 2) {
		bytes = TclGetStringFromObj(globalPtr->objPtr, &length);
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "d",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : (int)length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");
	    }
	}
    }
    if (count != globalTablePtr->numEntries) {
	Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "d entries, should be %" TCL_Z_MODIFIER "d",
		"TclVerifyGlobalLiteralTable", count,
		globalTablePtr->numEntries);
    }
}
#endif /*TCL_COMPILE_DEBUG*/
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

		}
		if ((flags & LITERAL_ON_HEAP)) {
		    Tcl_Free((void *)bytes);
		}
		if (globalPtrPtr) {
		    *globalPtrPtr = globalPtr;
		} else {
		    if (globalPtr->refCount != TCL_AUTO_LENGTH) {
			globalPtr->refCount++;
		    }
#ifdef TCL_COMPILE_DEBUG
    if (globalPtr->refCount + 1 < 2) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %"
		TCL_Z_MODIFIER "u", "TclRegisterLiteral",
		(length>60? 60 : length), bytes, globalPtr->refCount);
    }
#endif
		}
		return objPtr;
	    }
	}
    }
................................................................................
	if (entryPtr->objPtr == objPtr) {
	    /*
	     * If the literal is no longer being used by any ByteCode, delete
	     * the entry then remove the reference corresponding to the global
	     * literal table entry (decrement the ref count of the object).
	     */

	    if ((entryPtr->refCount != TCL_AUTO_LENGTH) && (entryPtr->refCount-- <= 1)) {
		if (prevPtr == NULL) {
		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
		} else {
		    prevPtr->nextPtr = entryPtr->nextPtr;
		}
		Tcl_Free(entryPtr);
		globalTablePtr->numEntries--;
................................................................................
     */

    result = Tcl_Alloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}
#endif /*TCL_COMPILE_STATS*/
 
................................................................................

    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount + 1 < 2) {
		bytes = TclGetStringFromObj(globalPtr->objPtr, &length);
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : (int)length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");
	    }
	}
    }
    if (count != globalTablePtr->numEntries) {
	Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %" TCL_Z_MODIFIER "u",
		"TclVerifyGlobalLiteralTable", count,
		globalTablePtr->numEntries);
    }
}
#endif /*TCL_COMPILE_DEBUG*/
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * Helper macros (derived from things private to tclVar.c)
 */

#define TclVarTable(contextNs) \
    ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
#define TclVarHashGetValue(hPtr) \
    ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry)))
 
/*
 * ----------------------------------------------------------------------
 *
 * Tcl_NewInstanceMethod --
 *
 *	Attach a method to an object instance.

/*
 * Helper macros (derived from things private to tclVar.c)
 */

#define TclVarTable(contextNs) \
    ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
#define TclVarHashGetValue(hPtr) \
    ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry)))
 
/*
 * ----------------------------------------------------------------------
 *
 * Tcl_NewInstanceMethod --
 *
 *	Attach a method to an object instance.

	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = Tcl_Alloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;

	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = Tcl_Alloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;

				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    const char *string;

    if (index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so == -1) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
	    string = regexpPtr->string;
	}
................................................................................

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange, -1 means the range of the
				 * rm_extend field. */
    int *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    int *endPtr)		/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;

    if ((regexpPtr->flags&REG_EXPECT) && index == TCL_AUTO_LENGTH) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if (index > regexpPtr->re.re_nsub) {
	*startPtr = -1;
	*endPtr = -1;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}
 
/*
................................................................................
     * Assume that there will never be more than INT_MAX subexpressions. This
     * is a pretty reasonable assumption; the RE engine doesn't scale _that_
     * well and Tcl has other limits that constrain things as well...
     */

    resultObj = Tcl_NewObj();
    Tcl_ListObjAppendElement(NULL, resultObj,
	    Tcl_NewWideIntObj((Tcl_WideInt) regexpPtr->re.re_nsub));

    /*
     * Now append a list of all the bit-flags set for the RE.
     */

    TclNewObj(infoObj);
    for (inf=infonames ; inf->bit != 0 ; inf++) {

				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    const char *string;

    if (index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
	    string = regexpPtr->string;
	}
................................................................................

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange, TCL_INDEX_NONE means the range of the
				 * rm_extend field. */
    size_t *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    size_t *endPtr)		/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;

    if ((regexpPtr->flags&REG_EXPECT) && (index == TCL_INDEX_NONE)) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if (index + 1 > regexpPtr->re.re_nsub + 1) {
	*startPtr = TCL_INDEX_NONE;
	*endPtr = TCL_INDEX_NONE;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}
 
/*
................................................................................
     * Assume that there will never be more than INT_MAX subexpressions. This
     * is a pretty reasonable assumption; the RE engine doesn't scale _that_
     * well and Tcl has other limits that constrain things as well...
     */

    resultObj = Tcl_NewObj();
    Tcl_ListObjAppendElement(NULL, resultObj,
	    TclNewWideIntObjFromSize(regexpPtr->re.re_nsub));

    /*
     * Now append a list of all the bit-flags set for the RE.
     */

    TclNewObj(infoObj);
    for (inf=infonames ; inf->bit != 0 ; inf++) {

	if (lsb == -1-shift) {

	    /*
	     * Round to even
	     */

	    mp_div_2d(a, -shift, &b, NULL);
	    if (mp_get_bit(&b, 0)) {
		if (b.sign == MP_ZPOS) {
		    mp_add_d(&b, 1, &b);
		} else {
		    mp_sub_d(&b, 1, &b);
		}
	    }
	} else {

	if (lsb == -1-shift) {

	    /*
	     * Round to even
	     */

	    mp_div_2d(a, -shift, &b, NULL);
	    if (mp_isodd(&b)) {
		if (b.sign == MP_ZPOS) {
		    mp_add_d(&b, 1, &b);
		} else {
		    mp_sub_d(&b, 1, &b);
		}
	    }
	} else {

     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;

    if (numChars > stringPtr->maxChars) {
	size_t offset = TCL_AUTO_LENGTH;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    offset = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (offset != TCL_AUTO_LENGTH) {
	    unicode = stringPtr->unicode + offset;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;

    if (numChars > stringPtr->maxChars) {
	size_t index = TCL_INDEX_NONE;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    index = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (index != TCL_INDEX_NONE) {
	    unicode = stringPtr->unicode + index;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    0, /* 27 */
    TclpGetDefaultStdChannel, /* 28 */
    0, /* 29 */
    0, /* 30 */
    TclGetExtension, /* 31 */
    TclGetFrame, /* 32 */
    0, /* 33 */
    TclGetIntForIndex, /* 34 */
    0, /* 35 */
    0, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
................................................................................
    TclRegisterLiteral, /* 251 */
    TclPtrGetVar, /* 252 */
    TclPtrSetVar, /* 253 */
    TclPtrIncrObjVar, /* 254 */
    TclPtrObjMakeUpvar, /* 255 */
    TclPtrUnsetVar, /* 256 */
    TclStaticPackage, /* 257 */

    TclMSB, /* 258 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */
................................................................................
    0, /* 66 */
    TclBN_mp_expt_d_ex, /* 67 */
    TclBN_mp_set_long_long, /* 68 */
    TclBN_mp_get_long_long, /* 69 */
    TclBN_mp_set_long, /* 70 */
    TclBN_mp_get_long, /* 71 */
    TclBN_mp_get_int, /* 72 */
    TclBN_mp_tc_and, /* 73 */
    TclBN_mp_tc_or, /* 74 */
    TclBN_mp_tc_xor, /* 75 */
    TclBN_mp_tc_div_2d, /* 76 */
    TclBN_mp_get_bit, /* 77 */
};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs
................................................................................
    Tcl_FetchIntRep, /* 638 */
    Tcl_StoreIntRep, /* 639 */
    Tcl_HasStringRep, /* 640 */
    Tcl_IncrRefCount, /* 641 */
    Tcl_DecrRefCount, /* 642 */
    Tcl_IsShared, /* 643 */
    Tcl_LinkArray, /* 644 */

};

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

    0, /* 27 */
    TclpGetDefaultStdChannel, /* 28 */
    0, /* 29 */
    0, /* 30 */
    TclGetExtension, /* 31 */
    TclGetFrame, /* 32 */
    0, /* 33 */
    0, /* 34 */
    0, /* 35 */
    0, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
................................................................................
    TclRegisterLiteral, /* 251 */
    TclPtrGetVar, /* 252 */
    TclPtrSetVar, /* 253 */
    TclPtrIncrObjVar, /* 254 */
    TclPtrObjMakeUpvar, /* 255 */
    TclPtrUnsetVar, /* 256 */
    TclStaticPackage, /* 257 */
    TclpCreateTemporaryDirectory, /* 258 */
    TclMSB, /* 259 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */
................................................................................
    0, /* 66 */
    TclBN_mp_expt_d_ex, /* 67 */
    TclBN_mp_set_long_long, /* 68 */
    TclBN_mp_get_long_long, /* 69 */
    TclBN_mp_set_long, /* 70 */
    TclBN_mp_get_long, /* 71 */
    TclBN_mp_get_int, /* 72 */
    0, /* 73 */
    0, /* 74 */
    0, /* 75 */
    TclBN_mp_signed_rsh, /* 76 */
    TclBN_mp_get_bit, /* 77 */
};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs
................................................................................
    Tcl_FetchIntRep, /* 638 */
    Tcl_StoreIntRep, /* 639 */
    Tcl_HasStringRep, /* 640 */
    Tcl_IncrRefCount, /* 641 */
    Tcl_DecrRefCount, /* 642 */
    Tcl_IsShared, /* 643 */
    Tcl_LinkArray, /* 644 */
    Tcl_GetIntForIndex, /* 645 */
};

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

static int		TestregexpObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestreturnObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestregexpXflags(const char *string,
			    int length, int *cflagsPtr, int *eflagsPtr);
static int		TestsaveresultCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestsaveresultFree(void *blockPtr);
static int		TestsetassocdataCmd(void *dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetCmd(void *dummy,
................................................................................
	 * value 0.
	 */

	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    int start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, -1, &start, &end);
	    sprintf(resinfo, "%d %d", start, end-1);
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	} else if (cflags & TCL_REG_CANMATCH) {
	    const char *varName;
	    const char *value;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    Tcl_RegExpGetInfo(regExpr, &info);
	    varName = Tcl_GetString(objv[2]);
	    sprintf(resinfo, "%ld", info.extendStart);
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	}
................................................................................
     */

    objc -= 2;
    objv += 2;

    Tcl_RegExpGetInfo(regExpr, &info);
    for (i = 0; i < objc; i++) {
	int start, end;
	Tcl_Obj *newPtr, *varPtr, *valuePtr;

	varPtr = objv[i];
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i;
	if (indices) {
	    Tcl_Obj *objs[2];

	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
	    } else if (ii > (size_t)info.nsubs) {
		start = -1;
		end = -1;
	    } else {
		start = info.matches[ii].start;
		end = info.matches[ii].end;
	    }

	    /*
	     * Adjust index so it refers to the last character in the match
	     * instead of the first character after the match.
	     */

	    if (end >= 0) {
		end--;
	    }

	    objs[0] = Tcl_NewWideIntObj(start);
	    objs[1] = Tcl_NewWideIntObj(end);

	    newPtr = Tcl_NewListObj(2, objs);
	} else {
	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
		newPtr = Tcl_GetRange(objPtr, start, end);
	    } else if (ii > (size_t)info.nsubs) {
		newPtr = Tcl_NewObj();
	    } else {
		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
			info.matches[ii].end - 1);
	    }
	}
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
................................................................................
 *
 *----------------------------------------------------------------------
 */

static void
TestregexpXflags(
    const char *string,	/* The string of flags. */
    int length,			/* The length of the string in bytes. */
    int *cflagsPtr,		/* compile flags word */
    int *eflagsPtr)		/* exec flags word */
{

    int i, cflags, eflags;

    cflags = *cflagsPtr;
    eflags = *eflagsPtr;
    for (i = 0; i < length; i++) {
	switch (string[i]) {
	case 'a':
	    cflags |= REG_ADVF;
................................................................................
}
 
/*
 *----------------------------------------------------------------------
 *
 * TestupvarCmd --
 *
 *	This procedure implements the "testupvar2" command.  It is used
 *	to test Tcl_UpVar and Tcl_UpVar2.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates or modifies an "upvar" reference.
................................................................................
    if (resVarInfo->var) {
        HashVarFree(resVarInfo->var);
    }
    Tcl_Free(vInfoPtr);
}

#define TclVarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

static Tcl_Var
MyCompiledVarFetch(
    Tcl_Interp *interp,
    Tcl_ResolvedVarInfo *vinfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr;

static int		TestregexpObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestreturnObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestregexpXflags(const char *string,
			    size_t length, int *cflagsPtr, int *eflagsPtr);
static int		TestsaveresultCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		TestsaveresultFree(void *blockPtr);
static int		TestsetassocdataCmd(void *dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetCmd(void *dummy,
................................................................................
	 * value 0.
	 */

	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    size_t start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, -1, &start, &end);
	    sprintf(resinfo, "%" TCL_LL_MODIFIER "d %" TCL_LL_MODIFIER "d", TclWideIntFromSize(start), TclWideIntFromSize(end-1));
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	} else if (cflags & TCL_REG_CANMATCH) {
	    const char *varName;
	    const char *value;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    Tcl_RegExpGetInfo(regExpr, &info);
	    varName = Tcl_GetString(objv[2]);
	    sprintf(resinfo, "%" TCL_LL_MODIFIER "d", TclWideIntFromSize(info.extendStart));
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	}
................................................................................
     */

    objc -= 2;
    objv += 2;

    Tcl_RegExpGetInfo(regExpr, &info);
    for (i = 0; i < objc; i++) {
	size_t start, end;
	Tcl_Obj *newPtr, *varPtr, *valuePtr;

	varPtr = objv[i];
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i;
	if (indices) {
	    Tcl_Obj *objs[2];

	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
	    } else if (ii > info.nsubs) {
		start = TCL_INDEX_NONE;
		end = TCL_INDEX_NONE;
	    } else {
		start = info.matches[ii].start;
		end = info.matches[ii].end;
	    }

	    /*
	     * Adjust index so it refers to the last character in the match
	     * instead of the first character after the match.
	     */

	    if (end != TCL_INDEX_NONE) {
		end--;
	    }

	    objs[0] = TclNewWideIntObjFromSize(start);
	    objs[1] = TclNewWideIntObjFromSize(end);

	    newPtr = Tcl_NewListObj(2, objs);
	} else {
	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
		newPtr = Tcl_GetRange(objPtr, start, end);
	    } else if (ii > info.nsubs) {
		newPtr = Tcl_NewObj();
	    } else {
		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
			info.matches[ii].end - 1);
	    }
	}
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
................................................................................
 *
 *----------------------------------------------------------------------
 */

static void
TestregexpXflags(
    const char *string,	/* The string of flags. */
    size_t length,			/* The length of the string in bytes. */
    int *cflagsPtr,		/* compile flags word */
    int *eflagsPtr)		/* exec flags word */
{
    size_t i;
    int cflags, eflags;

    cflags = *cflagsPtr;
    eflags = *eflagsPtr;
    for (i = 0; i < length; i++) {
	switch (string[i]) {
	case 'a':
	    cflags |= REG_ADVF;
................................................................................
}
 
/*
 *----------------------------------------------------------------------
 *
 * TestupvarCmd --
 *
 *	This procedure implements the "testupvar" command.  It is used
 *	to test Tcl_UpVar and Tcl_UpVar2.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates or modifies an "upvar" reference.
................................................................................
    if (resVarInfo->var) {
        HashVarFree(resVarInfo->var);
    }
    Tcl_Free(vInfoPtr);
}

#define TclVarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))

static Tcl_Var
MyCompiledVarFetch(
    Tcl_Interp *interp,
    Tcl_ResolvedVarInfo *vinfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr;

	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], !mp_get_bit(&bignumValue, 0));
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(!mp_get_bit(&bignumValue, 0)));
	}
	mp_clear(&bignumValue);
	break;

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

	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], !mp_isodd(&bignumValue));
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(!mp_isodd(&bignumValue)));
	}
	mp_clear(&bignumValue);
	break;

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

	if (cachePtr == sharedPtr) {
	    Tcl_DStringAppendElement(dsPtr, "shared");
	} else {
	    sprintf(buf, "thread%p", cachePtr->owner);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	for (n = 0; n < NBUCKETS; ++n) {
	    sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d",
		    bucketInfo[n].blockSize,
		    cachePtr->buckets[n].numFree,
		    cachePtr->buckets[n].numRemoves,
		    cachePtr->buckets[n].numInserts,
		    cachePtr->buckets[n].totalAssigned,
		    cachePtr->buckets[n].numLocks,
		    cachePtr->buckets[n].numWaits);

	if (cachePtr == sharedPtr) {
	    Tcl_DStringAppendElement(dsPtr, "shared");
	} else {
	    sprintf(buf, "thread%p", cachePtr->owner);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	for (n = 0; n < NBUCKETS; ++n) {
	    sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u",
		    bucketInfo[n].blockSize,
		    cachePtr->buckets[n].numFree,
		    cachePtr->buckets[n].numRemoves,
		    cachePtr->buckets[n].numInserts,
		    cachePtr->buckets[n].totalAssigned,
		    cachePtr->buckets[n].numLocks,
		    cachePtr->buckets[n].numWaits);

    unsigned long TclBN_mp_get_long(const mp_int *a)
}
declare 72 {
    unsigned long TclBN_mp_get_int(const mp_int *a)
}

# Added in libtommath 1.1.0

declare 73 {
    int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)
}


declare 74 {
    int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
}


declare 75 {
    int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
}

declare 76 {
    int TclBN_mp_tc_div_2d(const mp_int *a, int b, mp_int *c)
}
declare 77 {
    int TclBN_mp_get_bit(const mp_int *a, int b)
}


# Local Variables:
# mode: tcl
# End:

    unsigned long TclBN_mp_get_long(const mp_int *a)
}
declare 72 {
    unsigned long TclBN_mp_get_int(const mp_int *a)
}

# Added in libtommath 1.1.0
# No longer in use: replaced by mp_and()
#declare 73 {
#    int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)

#}
# No longer in use: replaced by mp_or()
#declare 74 {
#    int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)

#}
# No longer in use: replaced by mp_xor()
#declare 75 {
#    int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)

#}
declare 76 {
    int TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c)
}
declare 77 {
    int TclBN_mp_get_bit(const mp_int *a, int b)
}


# Local Variables:
# mode: tcl
# End:

};

/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);


/* error code to char* string */

const char *mp_error_to_string(int code);


/* ---> init and deinit bignum functions <--- */
/* init a bignum */
/*
int mp_init(mp_int *a);
*/

/* free a bignum */
/*
void mp_clear(mp_int *a);
*/

/* init a null terminated series of arguments */
/*
int mp_init_multi(mp_int *mp, ...);
*/

/* clear a null terminated series of arguments */
/*
void mp_clear_multi(mp_int *mp, ...);
*/

................................................................................
/* exchange two ints */
/*
void mp_exch(mp_int *a, mp_int *b);
*/

/* shrink ram required for a bignum */
/*
int mp_shrink(mp_int *a);
*/

/* grow an int to a given size */
/*
int mp_grow(mp_int *a, int size);
*/

/* init to a given number of digits */
/*
int mp_init_size(mp_int *a, int size);
*/

/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) (!mp_get_bit((a),0))
#define mp_isodd(a)  mp_get_bit((a),0)
#define mp_isneg(a)  (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)

/* set to zero */
/*
void mp_zero(mp_int *a);
*/

................................................................................
*/

/* c = a AND b */
/*
int mp_and(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* c = a XOR b (two complement) */
/*
int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* c = a OR b (two complement) */
/*
int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* c = a AND b (two complement) */
/*
int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c);
*/

/* right shift (two complement) */
/*
int mp_tc_div_2d(const mp_int *a, int b, mp_int *c);
*/

/* ---> Basic arithmetic <--- */

/* b = ~a */
/*
int mp_complement(const mp_int *a, mp_int *b);

};

/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);


/* error code to char* string */
/*
const char *mp_error_to_string(mp_err code);
*/

/* ---> init and deinit bignum functions <--- */
/* init a bignum */
/*
mp_err mp_init(mp_int *a);
*/

/* free a bignum */
/*
void mp_clear(mp_int *a);
*/

/* init a null terminated series of arguments */
/*
mp_err mp_init_multi(mp_int *mp, ...);
*/

/* clear a null terminated series of arguments */
/*
void mp_clear_multi(mp_int *mp, ...);
*/

................................................................................
/* exchange two ints */
/*
void mp_exch(mp_int *a, mp_int *b);
*/

/* shrink ram required for a bignum */
/*
mp_err mp_shrink(mp_int *a);
*/

/* grow an int to a given size */
/*
mp_err mp_grow(mp_int *a, int size);
*/

/* init to a given number of digits */
/*
mp_err mp_init_size(mp_int *a, int size);
*/

/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
#define mp_isodd(a)  (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
#define mp_isneg(a)  (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)

/* set to zero */
/*
void mp_zero(mp_int *a);
*/

................................................................................
*/

/* c = a AND b */
/*
int mp_and(const mp_int *a, const mp_int *b, mp_int *c);
*/
















/* right shift (two complement) */
/*
int mp_signed_rsh(const mp_int *a, int b, mp_int *c);
*/

/* ---> Basic arithmetic <--- */

/* b = ~a */
/*
int mp_complement(const mp_int *a, mp_int *b);

#define mp_div_2 TclBN_mp_div_2
#define mp_div_2d TclBN_mp_div_2d
#define mp_div_3 TclBN_mp_div_3
#define mp_div_d TclBN_mp_div_d
#define mp_exch TclBN_mp_exch
#define mp_expt_d TclBN_mp_expt_d
#define mp_expt_d_ex TclBN_mp_expt_d_ex
#define mp_get_bit TclBN_mp_get_bit
#define mp_get_int TclBN_mp_get_int
#define mp_get_long TclBN_mp_get_long
#define mp_get_long_long TclBN_mp_get_long_long


#define mp_grow TclBN_mp_grow
#define mp_init TclBN_mp_init
#define mp_init_copy TclBN_mp_init_copy
#define mp_init_multi TclBN_mp_init_multi
#define mp_init_set TclBN_mp_init_set
#define mp_init_set_int TclBN_mp_init_set_int
#define mp_init_size TclBN_mp_init_size
................................................................................
#define mp_set_long TclBN_mp_set_long
#define mp_set_long_long TclBN_mp_set_long_long
#define mp_shrink TclBN_mp_shrink
#define mp_sqr TclBN_mp_sqr
#define mp_sqrt TclBN_mp_sqrt
#define mp_sub TclBN_mp_sub
#define mp_sub_d TclBN_mp_sub_d
#define mp_tc_and TclBN_mp_tc_and
#define mp_tc_div_2d TclBN_mp_tc_div_2d
#define mp_tc_or TclBN_mp_tc_or
#define mp_tc_xor TclBN_mp_tc_xor
#define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin
#define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n
#define mp_toom_mul TclBN_mp_toom_mul
#define s_mp_toom_mul TclBN_mp_toom_mul
#define mp_toom_sqr TclBN_mp_toom_sqr
#define s_mp_toom_sqr TclBN_mp_toom_sqr
#define mp_toradix_n TclBN_mp_toradix_n
................................................................................
EXTERN Tcl_WideUInt	TclBN_mp_get_long_long(const mp_int *a);
/* 70 */
EXTERN int		TclBN_mp_set_long(mp_int *a, unsigned long i);
/* 71 */
EXTERN unsigned long	TclBN_mp_get_long(const mp_int *a);
/* 72 */
EXTERN unsigned long	TclBN_mp_get_int(const mp_int *a);
/* 73 */
EXTERN int		TclBN_mp_tc_and(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 74 */
EXTERN int		TclBN_mp_tc_or(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 75 */
EXTERN int		TclBN_mp_tc_xor(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 76 */
EXTERN int		TclBN_mp_tc_div_2d(const mp_int *a, int b, mp_int *c);
/* 77 */
EXTERN int		TclBN_mp_get_bit(const mp_int *a, int b);

typedef struct TclTomMathStubs {
    int magic;
    void *hooks;

................................................................................
    void (*reserved66)(void);
    int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */
    int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */
    Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */
    int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */
    unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */
    unsigned long (*tclBN_mp_get_int) (const mp_int *a); /* 72 */
    int (*tclBN_mp_tc_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 73 */
    int (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 74 */
    int (*tclBN_mp_tc_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 75 */
    int (*tclBN_mp_tc_div_2d) (const mp_int *a, int b, mp_int *c); /* 76 */
    int (*tclBN_mp_get_bit) (const mp_int *a, int b); /* 77 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;

#ifdef __cplusplus
}
................................................................................
	(tclTomMathStubsPtr->tclBN_mp_get_long_long) /* 69 */
#define TclBN_mp_set_long \
	(tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */
#define TclBN_mp_get_long \
	(tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */
#define TclBN_mp_get_int \
	(tclTomMathStubsPtr->tclBN_mp_get_int) /* 72 */
#define TclBN_mp_tc_and \
	(tclTomMathStubsPtr->tclBN_mp_tc_and) /* 73 */
#define TclBN_mp_tc_or \
	(tclTomMathStubsPtr->tclBN_mp_tc_or) /* 74 */
#define TclBN_mp_tc_xor \
	(tclTomMathStubsPtr->tclBN_mp_tc_xor) /* 75 */
#define TclBN_mp_tc_div_2d \
	(tclTomMathStubsPtr->tclBN_mp_tc_div_2d) /* 76 */
#define TclBN_mp_get_bit \
	(tclTomMathStubsPtr->tclBN_mp_get_bit) /* 77 */

#endif /* defined(USE_TCL_STUBS) */

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

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLINTDECLS */

#define mp_div_2 TclBN_mp_div_2
#define mp_div_2d TclBN_mp_div_2d
#define mp_div_3 TclBN_mp_div_3
#define mp_div_d TclBN_mp_div_d
#define mp_exch TclBN_mp_exch
#define mp_expt_d TclBN_mp_expt_d
#define mp_expt_d_ex TclBN_mp_expt_d_ex

#define mp_get_int TclBN_mp_get_int
#define mp_get_long TclBN_mp_get_long
#define mp_get_long_long TclBN_mp_get_long_long
#define mp_grow TclBN_mp_grow
#define s_mp_get_bit TclBN_mp_get_bit
#define mp_grow TclBN_mp_grow
#define mp_init TclBN_mp_init
#define mp_init_copy TclBN_mp_init_copy
#define mp_init_multi TclBN_mp_init_multi
#define mp_init_set TclBN_mp_init_set
#define mp_init_set_int TclBN_mp_init_set_int
#define mp_init_size TclBN_mp_init_size
................................................................................
#define mp_set_long TclBN_mp_set_long
#define mp_set_long_long TclBN_mp_set_long_long
#define mp_shrink TclBN_mp_shrink
#define mp_sqr TclBN_mp_sqr
#define mp_sqrt TclBN_mp_sqrt
#define mp_sub TclBN_mp_sub
#define mp_sub_d TclBN_mp_sub_d
#define mp_signed_rsh TclBN_mp_signed_rsh



#define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin
#define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n
#define mp_toom_mul TclBN_mp_toom_mul
#define s_mp_toom_mul TclBN_mp_toom_mul
#define mp_toom_sqr TclBN_mp_toom_sqr
#define s_mp_toom_sqr TclBN_mp_toom_sqr
#define mp_toradix_n TclBN_mp_toradix_n
................................................................................
EXTERN Tcl_WideUInt	TclBN_mp_get_long_long(const mp_int *a);
/* 70 */
EXTERN int		TclBN_mp_set_long(mp_int *a, unsigned long i);
/* 71 */
EXTERN unsigned long	TclBN_mp_get_long(const mp_int *a);
/* 72 */
EXTERN unsigned long	TclBN_mp_get_int(const mp_int *a);
/* Slot 73 is reserved */
/* Slot 74 is reserved */
/* Slot 75 is reserved */
/* 76 */
EXTERN int		TclBN_mp_signed_rsh(const mp_int *a, int b,
				mp_int *c);





/* 77 */
EXTERN int		TclBN_mp_get_bit(const mp_int *a, int b);

typedef struct TclTomMathStubs {
    int magic;
    void *hooks;

................................................................................
    void (*reserved66)(void);
    int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */
    int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */
    Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */
    int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */
    unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */
    unsigned long (*tclBN_mp_get_int) (const mp_int *a); /* 72 */
    void (*reserved73)(void);
    void (*reserved74)(void);
    void (*reserved75)(void);
    int (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c); /* 76 */
    int (*tclBN_mp_get_bit) (const mp_int *a, int b); /* 77 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;

#ifdef __cplusplus
}
................................................................................
	(tclTomMathStubsPtr->tclBN_mp_get_long_long) /* 69 */
#define TclBN_mp_set_long \
	(tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */
#define TclBN_mp_get_long \
	(tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */
#define TclBN_mp_get_int \
	(tclTomMathStubsPtr->tclBN_mp_get_int) /* 72 */
/* Slot 73 is reserved */
/* Slot 74 is reserved */
/* Slot 75 is reserved */

#define TclBN_mp_signed_rsh \
	(tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */


#define TclBN_mp_get_bit \
	(tclTomMathStubsPtr->tclBN_mp_get_bit) /* 77 */

#endif /* defined(USE_TCL_STUBS) */

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

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLINTDECLS */

		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
................................................................................
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
................................................................................
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc(
		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }

		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
................................................................................
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
................................................................................
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = Tcl_Alloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }

    register size_t index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
#if TCL_UTF_MAX <= 4
    size_t len = 0;
#endif

    if (index != TCL_AUTO_LENGTH) {
	while (index--) {
#if TCL_UTF_MAX <= 4
	    src += (len = TclUtfToUniChar(src, &ch));
#else
	    src += TclUtfToUniChar(src, &ch);
#endif
	}

    register size_t index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
#if TCL_UTF_MAX <= 4
    size_t len = 0;
#endif

    if (index != TCL_INDEX_NONE) {
	while (index--) {
#if TCL_UTF_MAX <= 4
	    src += (len = TclUtfToUniChar(src, &ch));
#else
	    src += TclUtfToUniChar(src, &ch);
#endif
	}

			    int stringLength, const char *typeStr,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, size_t *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in TclGetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching intrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

................................................................................
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *bytes,		/* String to append. If length is -1 then this
				 * must be null-terminated. */
    size_t length)			/* Number of bytes from "bytes" to append. If
				 * -1, then append all of bytes, up to null
				 * at end. */
{
    size_t newSize;

    if (length == TCL_AUTO_LENGTH) {
	length = strlen(bytes);
    }
................................................................................
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = Tcl_Alloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    size_t offset = TCL_AUTO_LENGTH;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		offset = bytes - dsPtr->string;
	    }

	    dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset != TCL_AUTO_LENGTH) {
		bytes = dsPtr->string + offset;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */
................................................................................
    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclGetIntForIndex --
 *
 *	Provides an integer corresponding to the list index held in a Tcl
 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *
 * Value
 * 	TCL_OK
................................................................................
 * 	The object referenced by 'objPtr' is converted, as needed, to an
 * 	integer, wide integer, or end-based-index object.
 *
 *----------------------------------------------------------------------
 */

int
TclGetIntForIndex(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    size_t endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */

			    int stringLength, const char *typeStr,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, size_t *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in Tcl_GetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching intrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

................................................................................
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *bytes,		/* String to append. If length is
				 * TCL_AUTO_LENGTH then this must be null-terminated. */
    size_t length)			/* Number of bytes from "bytes" to append. If
				 * TCL_AUTO_LENGTH, then append all of bytes, up to null
				 * at end. */
{
    size_t newSize;

    if (length == TCL_AUTO_LENGTH) {
	length = strlen(bytes);
    }
................................................................................
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = Tcl_Alloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    size_t index = TCL_INDEX_NONE;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		index = bytes - dsPtr->string;
	    }

	    dsPtr->string = Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);

	    if (index != TCL_INDEX_NONE) {
		bytes = dsPtr->string + index;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */
................................................................................
    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntForIndex --
 *
 *	Provides an integer corresponding to the list index held in a Tcl
 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *
 * Value
 * 	TCL_OK
................................................................................
 * 	The object referenced by 'objPtr' is converted, as needed, to an
 * 	integer, wide integer, or end-based-index object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntForIndex(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    size_t endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */

			    Tcl_Obj *key, int *newPtr);
static inline Var *	VarHashFirstVar(TclVarHashTable *tablePtr,
			    Tcl_HashSearch *searchPtr);
static inline Var *	VarHashNextVar(Tcl_HashSearch *searchPtr);
static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

/*
 * NOTE: VarHashCreateVar increments the recount of its key argument.
 * All callers that will call Tcl_DecrRefCount on that argument must
 * call Tcl_IncrRefCount on it before passing it in.  This requirement
 * can bubble up to callers of callers .... etc.
 */

			    Tcl_Obj *key, int *newPtr);
static inline Var *	VarHashFirstVar(TclVarHashTable *tablePtr,
			    Tcl_HashSearch *searchPtr);
static inline Var *	VarHashNextVar(Tcl_HashSearch *searchPtr);
static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))

/*
 * NOTE: VarHashCreateVar increments the recount of its key argument.
 * All callers that will call Tcl_DecrRefCount on that argument must
 * call Tcl_IncrRefCount on it before passing it in.  This requirement
 * can bubble up to callers of callers .... etc.
 */

#include "tommath_private.h"
#ifdef BN_MP_AND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* AND two ints together */

int mp_and(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res, ix, px;
   mp_int  t;
   const mp_int *x;





   if (a->used > b->used) {

      if ((res = mp_init_copy(&t, a)) != MP_OKAY) {
         return res;
      }








      px = b->used;
      x = b;
   } else {
      if ((res = mp_init_copy(&t, b)) != MP_OKAY) {
         return res;
      }

      px = a->used;
      x = a;





   }

   for (ix = 0; ix < px; ix++) {
      t.dp[ix] &= x->dp[ix];

   }






   /* zero digits above the last from the smallest mp_int */
   for (; ix < t.used; ix++) {
      t.dp[ix] = 0;
   }



   mp_clamp(&t);
   mp_exch(c, &t);
   mp_clear(&t);
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_AND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */








/* SPDX-License-Identifier: Unlicense */



/* two complement and */
mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c)
{



   int used = MAX(a->used, b->used) + 1, i;
   mp_err err;
   mp_digit ac = 1, bc = 1, cc = 1;
   mp_sign csign = ((a->sign == MP_NEG) && (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS;


   if (c->alloc < used) {
      if ((err = mp_grow(c, used)) != MP_OKAY) {
         return err;
      }
   }

   for (i = 0; i < used; i++) {
      mp_digit x, y;

      /* convert to two complement if negative */
      if (a->sign == MP_NEG) {
         ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK);
         x = ac & MP_MASK;
         ac >>= MP_DIGIT_BIT;
      } else {
         x = (i >= a->used) ? 0uL : a->dp[i];

      }

      /* convert to two complement if negative */
      if (b->sign == MP_NEG) {
         bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK);
         y = bc & MP_MASK;
         bc >>= MP_DIGIT_BIT;
      } else {
         y = (i >= b->used) ? 0uL : b->dp[i];
      }



      c->dp[i] = x & y;

      /* convert to to sign-magnitude if negative */
      if (csign == MP_NEG) {
         cc += ~c->dp[i] & MP_MASK;
         c->dp[i] = cc & MP_MASK;
         cc >>= MP_DIGIT_BIT;
      }



   }

   c->used = used;
   c->sign = csign;
   mp_clamp(c);


   return MP_OKAY;
}
#endif

#include "tommath_private.h"
#ifdef BN_MP_CMP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* compare two ints (signed)*/
int mp_cmp(const mp_int *a, const mp_int *b)
{
   /* compare based on sign */
   if (a->sign != b->sign) {
      if (a->sign == MP_NEG) {
         return MP_LT;
      } else {
         return MP_GT;
................................................................................
      /* if negative compare opposite direction */
      return mp_cmp_mag(b, a);
   } else {
      return mp_cmp_mag(a, b);
   }
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_CMP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */








/* SPDX-License-Identifier: Unlicense */


/* compare two ints (signed)*/
mp_ord mp_cmp(const mp_int *a, const mp_int *b)
{
   /* compare based on sign */
   if (a->sign != b->sign) {
      if (a->sign == MP_NEG) {
         return MP_LT;
      } else {
         return MP_GT;
................................................................................
      /* if negative compare opposite direction */
      return mp_cmp_mag(b, a);
   } else {
      return mp_cmp_mag(a, b);
   }
}
#endif

#include "tommath_private.h"
#ifdef BN_MP_CMP_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* compare a digit */
int mp_cmp_d(const mp_int *a, mp_digit b)
{
   /* compare based on sign */
   if (a->sign == MP_NEG) {
      return MP_LT;
   }

   /* compare based on magnitude */
................................................................................
   } else if (a->dp[0] < b) {
      return MP_LT;
   } else {
      return MP_EQ;
   }
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_CMP_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */








/* SPDX-License-Identifier: Unlicense */


/* compare a digit */
mp_ord mp_cmp_d(const mp_int *a, mp_digit b)
{
   /* compare based on sign */
   if (a->sign == MP_NEG) {
      return MP_LT;
   }

   /* compare based on magnitude */
................................................................................
   } else if (a->dp[0] < b) {
      return MP_LT;
   } else {
      return MP_EQ;
   }
}
#endif

#include "tommath_private.h"
#ifdef BN_MP_CMP_MAG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* compare maginitude of two ints (unsigned) */
int mp_cmp_mag(const mp_int *a, const mp_int *b)
{
   int     n;
   mp_digit *tmpa, *tmpb;

   /* compare based on # of non-zero digits */
   if (a->used > b->used) {
      return MP_GT;
   }

   if (a->used < b->used) {
................................................................................
      if (*tmpa < *tmpb) {
         return MP_LT;
      }
   }
   return MP_EQ;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_CMP_MAG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */








/* SPDX-License-Identifier: Unlicense */


/* compare maginitude of two ints (unsigned) */
mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b)
{
   int     n;
   const mp_digit *tmpa, *tmpb;

   /* compare based on # of non-zero digits */
   if (a->used > b->used) {
      return MP_GT;
   }

   if (a->used < b->used) {
................................................................................
      if (*tmpa < *tmpb) {
         return MP_LT;
      }
   }
   return MP_EQ;
}
#endif

#include "tommath_private.h"
#ifdef BN_MP_OR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* OR two ints together */

int mp_or(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res, ix, px;
   mp_int  t;
   const mp_int *x;





   if (a->used > b->used) {

      if ((res = mp_init_copy(&t, a)) != MP_OKAY) {
         return res;
      }








      px = b->used;
      x = b;
   } else {
      if ((res = mp_init_copy(&t, b)) != MP_OKAY) {
         return res;
      }

      px = a->used;
      x = a;





   }

   for (ix = 0; ix < px; ix++) {
      t.dp[ix] |= x->dp[ix];

   }










   mp_clamp(&t);
   mp_exch(c, &t);
   mp_clear(&t);
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_OR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */








/* SPDX-License-Identifier: Unlicense */



/* two complement or */
mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c)
{



   int used = MAX(a->used, b->used) + 1, i;
   mp_err err;
   mp_digit ac = 1, bc = 1, cc = 1;
   mp_sign csign = ((a->sign == MP_NEG) || (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS;


   if (c->alloc < used) {
      if ((err = mp_grow(c, used)) != MP_OKAY) {
         return err;
      }
   }

   for (i = 0; i < used; i++) {
      mp_digit x, y;

      /* convert to two complement if negative */
      if (a->sign == MP_NEG) {
         ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK);
         x = ac & MP_MASK;
         ac >>= MP_DIGIT_BIT;
      } else {
         x = (i >= a->used) ? 0uL : a->dp[i];

      }

      /* convert to two complement if negative */
      if (b->sign == MP_NEG) {
         bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK);
         y = bc & MP_MASK;
         bc >>= MP_DIGIT_BIT;
      } else {
         y = (i >= b->used) ? 0uL : b->dp[i];
      }



      c->dp[i] = x | y;

      /* convert to to sign-magnitude if negative */
      if (csign == MP_NEG) {
         cc += ~c->dp[i] & MP_MASK;
         c->dp[i] = cc & MP_MASK;
         cc >>= MP_DIGIT_BIT;
      }
   }

   c->used = used;
   c->sign = csign;
   mp_clamp(c);


   return MP_OKAY;
}
#endif

#include "tommath_private.h"
#ifdef BN_MP_TC_DIV_2D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* two complement right shift */

int mp_tc_div_2d(const mp_int *a, int b, mp_int *c)
{
   int res;
   if (mp_isneg(a) == MP_NO) {

      return mp_div_2d(a, b, c, NULL);
   }

   res = mp_add_d(a, 1uL, c);
   if (res != MP_OKAY) {
      return res;
   }

   res = mp_div_2d(c, b, c, NULL);
   return (res == MP_OKAY) ? mp_sub_d(c, 1uL, c) : res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_SIGNED_RSH_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */








/* SPDX-License-Identifier: Unlicense */



/* shift right by a certain bit count with sign extension */
mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c)
{
   mp_err res;

   if (a->sign == MP_ZPOS) {
      return mp_div_2d(a, b, c, NULL);
   }

   res = mp_add_d(a, 1uL, c);
   if (res != MP_OKAY) {
      return res;
   }

   res = mp_div_2d(c, b, c, NULL);
   return (res == MP_OKAY) ? mp_sub_d(c, 1uL, c) : res;
}
#endif

#include "tommath_private.h"
#ifdef BN_MP_TC_AND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* two complement and */
int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)
{
   int res = MP_OKAY, bits, abits, bbits;
   int as = mp_isneg(a), bs = mp_isneg(b);
   mp_int *mx = NULL, _mx, acpy, bcpy;

   if ((as != MP_NO) || (bs != MP_NO)) {
      abits = mp_count_bits(a);
      bbits = mp_count_bits(b);
      bits = MAX(abits, bbits);
      res = mp_init_set_int(&_mx, 1uL);
      if (res != MP_OKAY) {
         goto end;
      }

      mx = &_mx;
      res = mp_mul_2d(mx, bits + 1, mx);
      if (res != MP_OKAY) {
         goto end;
      }

      if (as != MP_NO) {
         res = mp_init(&acpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, a, &acpy);
         if (res != MP_OKAY) {
            mp_clear(&acpy);
            goto end;
         }
         a = &acpy;
      }
      if (bs != MP_NO) {
         res = mp_init(&bcpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, b, &bcpy);
         if (res != MP_OKAY) {
            mp_clear(&bcpy);
            goto end;
         }
         b = &bcpy;
      }
   }

   res = mp_and(a, b, c);

   if ((as != MP_NO) && (bs != MP_NO) && (res == MP_OKAY)) {
      res = mp_sub(c, mx, c);
   }

end:
   if (a == &acpy) {
      mp_clear(&acpy);
   }

   if (b == &bcpy) {
      mp_clear(&bcpy);
   }

   if (mx == &_mx) {
      mp_clear(mx);
   }

   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_TC_OR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* two complement or */
int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
{
   int res = MP_OKAY, bits, abits, bbits;
   int as = mp_isneg(a), bs = mp_isneg(b);
   mp_int *mx = NULL, _mx, acpy, bcpy;

   if ((as != MP_NO) || (bs != MP_NO)) {
      abits = mp_count_bits(a);
      bbits = mp_count_bits(b);
      bits = MAX(abits, bbits);
      res = mp_init_set_int(&_mx, 1uL);
      if (res != MP_OKAY) {
         goto end;
      }

      mx = &_mx;
      res = mp_mul_2d(mx, bits + 1, mx);
      if (res != MP_OKAY) {
         goto end;
      }

      if (as != MP_NO) {
         res = mp_init(&acpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, a, &acpy);
         if (res != MP_OKAY) {
            mp_clear(&acpy);
            goto end;
         }
         a = &acpy;
      }
      if (bs != MP_NO) {
         res = mp_init(&bcpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, b, &bcpy);
         if (res != MP_OKAY) {
            mp_clear(&bcpy);
            goto end;
         }
         b = &bcpy;
      }
   }

   res = mp_or(a, b, c);

   if (((as != MP_NO) || (bs != MP_NO)) && (res == MP_OKAY)) {
      res = mp_sub(c, mx, c);
   }

end:
   if (a == &acpy) {
      mp_clear(&acpy);
   }

   if (b == &bcpy) {
      mp_clear(&bcpy);
   }

   if (mx == &_mx) {
      mp_clear(mx);
   }

   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_TC_XOR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* two complement xor */
int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
{
   int res = MP_OKAY, bits, abits, bbits;
   int as = mp_isneg(a), bs = mp_isneg(b);
   mp_int *mx = NULL, _mx, acpy, bcpy;

   if ((as != MP_NO) || (bs != MP_NO)) {
      abits = mp_count_bits(a);
      bbits = mp_count_bits(b);
      bits = MAX(abits, bbits);
      res = mp_init_set_int(&_mx, 1uL);
      if (res != MP_OKAY) {
         goto end;
      }

      mx = &_mx;
      res = mp_mul_2d(mx, bits + 1, mx);
      if (res != MP_OKAY) {
         goto end;
      }

      if (as != MP_NO) {
         res = mp_init(&acpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, a, &acpy);
         if (res != MP_OKAY) {
            mp_clear(&acpy);
            goto end;
         }
         a = &acpy;
      }
      if (bs != MP_NO) {
         res = mp_init(&bcpy);
         if (res != MP_OKAY) {
            goto end;
         }

         res = mp_add(mx, b, &bcpy);
         if (res != MP_OKAY) {
            mp_clear(&bcpy);
            goto end;
         }
         b = &bcpy;
      }
   }

   res = mp_xor(a, b, c);

   if ((as != bs) && (res == MP_OKAY)) {
      res = mp_sub(c, mx, c);
   }

end:
   if (a == &acpy) {
      mp_clear(&acpy);
   }

   if (b == &bcpy) {
      mp_clear(&bcpy);
   }

   if (mx == &_mx) {
      mp_clear(mx);
   }

   return res;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_XOR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* XOR two ints together */

int mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
{
   int     res, ix, px;
   mp_int  t;
   const mp_int *x;





   if (a->used > b->used) {

      if ((res = mp_init_copy(&t, a)) != MP_OKAY) {
         return res;
      }








      px = b->used;
      x = b;
   } else {
      if ((res = mp_init_copy(&t, b)) != MP_OKAY) {
         return res;
      }

      px = a->used;
      x = a;





   }

   for (ix = 0; ix < px; ix++) {
      t.dp[ix] ^= x->dp[ix];

   }










   mp_clamp(&t);
   mp_exch(c, &t);
   mp_clear(&t);
   return MP_OKAY;
}
#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_MP_XOR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */








/* SPDX-License-Identifier: Unlicense */



/* two complement xor */
mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
{



   int used = MAX(a->used, b->used) + 1, i;
   mp_err err;
   mp_digit ac = 1, bc = 1, cc = 1;
   mp_sign csign = (a->sign != b->sign) ? MP_NEG : MP_ZPOS;


   if (c->alloc < used) {
      if ((err = mp_grow(c, used)) != MP_OKAY) {
         return err;
      }
   }

   for (i = 0; i < used; i++) {
      mp_digit x, y;

      /* convert to two complement if negative */
      if (a->sign == MP_NEG) {
         ac += (i >= a->used) ? MP_MASK : (~a->dp[i] & MP_MASK);
         x = ac & MP_MASK;
         ac >>= MP_DIGIT_BIT;
      } else {
         x = (i >= a->used) ? 0uL : a->dp[i];

      }

      /* convert to two complement if negative */
      if (b->sign == MP_NEG) {
         bc += (i >= b->used) ? MP_MASK : (~b->dp[i] & MP_MASK);
         y = bc & MP_MASK;
         bc >>= MP_DIGIT_BIT;
      } else {
         y = (i >= b->used) ? 0uL : b->dp[i];
      }



      c->dp[i] = x ^ y;

      /* convert to to sign-magnitude if negative */
      if (csign == MP_NEG) {
         cc += ~c->dp[i] & MP_MASK;
         c->dp[i] = cc & MP_MASK;
         cc >>= MP_DIGIT_BIT;
      }
   }

   c->used = used;
   c->sign = csign;
   mp_clamp(c);


   return MP_OKAY;
}
#endif

#include "tommath_private.h"
#ifdef BN_MP_GET_BIT_C

/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */

/* Checks the bit at position b and returns MP_YES
   if the bit is 1, MP_NO if it is 0 and MP_VAL
   in case of error */
int mp_get_bit(const mp_int *a, int b)
{
   int limb;
   mp_digit bit, isset;

   if (b < 0) {
      return MP_VAL;
   }

   limb = b / DIGIT_BIT;


   if (limb >= a->used) {
      return MP_NO;
   }

   bit = (mp_digit)(1) << (b % DIGIT_BIT);

   isset = a->dp[limb] & bit;
   return (isset != 0u) ? MP_YES : MP_NO;
}

#endif

/* ref:         $Format:%D$ */
/* git commit:  $Format:%H$ */
/* commit time: $Format:%ai$ */

#include "tommath_private.h"
#ifdef BN_S_MP_GET_BIT_C

/* LibTomMath, multiple-precision integer library -- Tom St Denis */








/* SPDX-License-Identifier: Unlicense */



/* Get bit at position b and return MP_YES if the bit is 1, MP_NO if it is 0 */

mp_bool s_mp_get_bit(const mp_int *a, int b)
{

   mp_digit bit;






   int limb = (int)((unsigned)b / MP_DIGIT_BIT);

   if (limb >= a->used) {
      return MP_NO;
   }

   bit = (mp_digit)1 << ((unsigned)b % MP_DIGIT_BIT);


   return ((a->dp[limb] & bit) != 0u) ? MP_YES : MP_NO;
}

#endif

/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * SPDX-License-Identifier: Unlicense
 */
#ifndef BN_H_
#define BN_H_

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

................................................................................
/* clear a null terminated series of arguments */
void mp_clear_multi(mp_int *mp, ...);

/* exchange two ints */
void mp_exch(mp_int *a, mp_int *b);

/* shrink ram required for a bignum */
int mp_shrink(mp_int *a);

/* grow an int to a given size */
int mp_grow(mp_int *a, int size);

/* init to a given number of digits */
int mp_init_size(mp_int *a, int size);

/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) (!mp_get_bit((a),0))
#define mp_isodd(a)  mp_get_bit((a),0)
#define mp_isneg(a)  (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)

/* set to zero */
void mp_zero(mp_int *a);

/* set to a digit */
void mp_set(mp_int *a, mp_digit b);
................................................................................
/* c = a OR b (two complement) */
int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a AND b (two complement) */
int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c);

/* right shift (two complement) */
int mp_tc_div_2d(const mp_int *a, int b, mp_int *c);

/* ---> Basic arithmetic <--- */

/* b = ~a */
int mp_complement(const mp_int *a, mp_int *b);

/* b = -a */

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









#ifndef BN_H_
#define BN_H_

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

................................................................................
/* clear a null terminated series of arguments */
void mp_clear_multi(mp_int *mp, ...);

/* exchange two ints */
void mp_exch(mp_int *a, mp_int *b);

/* shrink ram required for a bignum */
mp_err mp_shrink(mp_int *a);

/* grow an int to a given size */
mp_err mp_grow(mp_int *a, int size);

/* init to a given number of digits */
mp_err mp_init_size(mp_int *a, int size);

/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
#define mp_isodd(a)  (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
#define mp_isneg(a)  (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)

/* set to zero */
void mp_zero(mp_int *a);

/* set to a digit */
void mp_set(mp_int *a, mp_digit b);
................................................................................
/* c = a OR b (two complement) */
int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a AND b (two complement) */
int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c);

/* right shift (two complement) */
int mp_signed_rsh(const mp_int *a, int b, mp_int *c);

/* ---> Basic arithmetic <--- */

/* b = ~a */
int mp_complement(const mp_int *a, mp_int *b);

/* b = -a */

#   define BN_MP_EXPT_D_EX_C
#   define BN_MP_EXPTMOD_C
#   define BN_MP_EXPTMOD_FAST_C
#   define BN_MP_EXTEUCLID_C
#   define BN_MP_FREAD_C
#   define BN_MP_FWRITE_C
#   define BN_MP_GCD_C
#   define BN_MP_GET_BIT_C
#   define BN_MP_GET_DOUBLE_C
#   define BN_MP_GET_INT_C
#   define BN_MP_GET_LONG_C
#   define BN_MP_GET_LONG_LONG_C
#   define BN_MP_GROW_C
#   define BN_MP_IMPORT_C
#   define BN_MP_INIT_C
................................................................................
#   define BN_MP_SQRMOD_C
#   define BN_MP_SQRT_C
#   define BN_MP_SQRTMOD_PRIME_C
#   define BN_MP_SUB_C
#   define BN_MP_SUB_D_C
#   define BN_MP_SUBMOD_C
#   define BN_MP_TC_AND_C
#   define BN_MP_TC_DIV_2D_C
#   define BN_MP_TC_OR_C
#   define BN_MP_TC_XOR_C
#   define BN_MP_TO_SIGNED_BIN_C
#   define BN_MP_TO_SIGNED_BIN_N_C
#   define BN_MP_TO_UNSIGNED_BIN_C
#   define BN_MP_TO_UNSIGNED_BIN_N_C
#   define BN_MP_TOOM_MUL_C
................................................................................
#   define BN_MP_CMP_MAG_C
#   define BN_MP_EXCH_C
#   define BN_S_MP_SUB_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_GET_BIT_C)
#   define BN_MP_ISZERO_C
#endif

#if defined(BN_MP_GET_DOUBLE_C)
#   define BN_MP_ISNEG_C
#endif

................................................................................
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_MUL_2_C
#   define BN_MP_MUL_D_C
#   define BN_MP_ADD_C
#   define BN_MP_MUL_C
#   define BN_MP_SUB_C
#   define BN_MP_MOD_C
#   define BN_MP_GET_BIT_C
#   define BN_MP_EXCH_C
#   define BN_MP_ISZERO_C
#   define BN_MP_CMP_C
#   define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_MP_PRIME_IS_DIVISIBLE_C)
................................................................................
#   define BN_MP_DIV_2D_C
#   define BN_MP_SET_C
#   define BN_MP_MUL_2_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_MOD_C
#   define BN_MP_SQR_C
#   define BN_MP_SUB_C
#   define BN_MP_GET_BIT_C
#   define BN_MP_ADD_C
#   define BN_MP_ISODD_C
#   define BN_MP_DIV_2_C
#   define BN_MP_SUB_D_C
#   define BN_MP_ISZERO_C
#   define BN_MP_CLEAR_MULTI_C
#endif
................................................................................
#   define BN_MP_INIT_C
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_C
#   define BN_MP_AND_C
#   define BN_MP_SUB_C
#endif

#if defined(BN_MP_TC_DIV_2D_C)
#   define BN_MP_ISNEG_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_ADD_D_C
#   define BN_MP_SUB_D_C
#endif

#if defined(BN_MP_TC_OR_C)

#   define BN_MP_EXPT_D_EX_C
#   define BN_MP_EXPTMOD_C
#   define BN_MP_EXPTMOD_FAST_C
#   define BN_MP_EXTEUCLID_C
#   define BN_MP_FREAD_C
#   define BN_MP_FWRITE_C
#   define BN_MP_GCD_C
#   define BN_S_MP_GET_BIT_C
#   define BN_MP_GET_DOUBLE_C
#   define BN_MP_GET_INT_C
#   define BN_MP_GET_LONG_C
#   define BN_MP_GET_LONG_LONG_C
#   define BN_MP_GROW_C
#   define BN_MP_IMPORT_C
#   define BN_MP_INIT_C
................................................................................
#   define BN_MP_SQRMOD_C
#   define BN_MP_SQRT_C
#   define BN_MP_SQRTMOD_PRIME_C
#   define BN_MP_SUB_C
#   define BN_MP_SUB_D_C
#   define BN_MP_SUBMOD_C
#   define BN_MP_TC_AND_C
#   define BN_MP_SIGNED_RSH_C
#   define BN_MP_TC_OR_C
#   define BN_MP_TC_XOR_C
#   define BN_MP_TO_SIGNED_BIN_C
#   define BN_MP_TO_SIGNED_BIN_N_C
#   define BN_MP_TO_UNSIGNED_BIN_C
#   define BN_MP_TO_UNSIGNED_BIN_N_C
#   define BN_MP_TOOM_MUL_C
................................................................................
#   define BN_MP_CMP_MAG_C
#   define BN_MP_EXCH_C
#   define BN_S_MP_SUB_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_CLEAR_C
#endif

#if defined(BN_S_MP_GET_BIT_C)
#   define BN_MP_ISZERO_C
#endif

#if defined(BN_MP_GET_DOUBLE_C)
#   define BN_MP_ISNEG_C
#endif

................................................................................
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_MUL_2_C
#   define BN_MP_MUL_D_C
#   define BN_MP_ADD_C
#   define BN_MP_MUL_C
#   define BN_MP_SUB_C
#   define BN_MP_MOD_C
#   define BN_S_MP_GET_BIT_C
#   define BN_MP_EXCH_C
#   define BN_MP_ISZERO_C
#   define BN_MP_CMP_C
#   define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_MP_PRIME_IS_DIVISIBLE_C)
................................................................................
#   define BN_MP_DIV_2D_C
#   define BN_MP_SET_C
#   define BN_MP_MUL_2_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_MOD_C
#   define BN_MP_SQR_C
#   define BN_MP_SUB_C
#   define BN_S_MP_GET_BIT_C
#   define BN_MP_ADD_C
#   define BN_MP_ISODD_C
#   define BN_MP_DIV_2_C
#   define BN_MP_SUB_D_C
#   define BN_MP_ISZERO_C
#   define BN_MP_CLEAR_MULTI_C
#endif
................................................................................
#   define BN_MP_INIT_C
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_C
#   define BN_MP_AND_C
#   define BN_MP_SUB_C
#endif

#if defined(BN_MP_SIGNED_RSH_C)
#   define BN_MP_ISNEG_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_ADD_D_C
#   define BN_MP_SUB_D_C
#endif

#if defined(BN_MP_TC_OR_C)

  if {!$tcnt} {
    puts ""
    return
  }

  set mintm 0x7fffffff
  set maxtm 0
  set nett 0
  set wtm 0
  set wcnt 0
  set i 0
  foreach tm $_(itm) {
    if {[llength $tm] > 6} {
      set nett [expr {$nett + [lindex $tm 6]}]
    }
    set wtm [expr {$wtm + [lindex $tm 0]}]
    set wcnt [expr {$wcnt + [lindex $tm 2]}]
    set tm [lindex $tm 0]
    if {$tm > $maxtm} {set maxtm $tm; set maxi $i}
    if {$tm < $mintm} {set mintm $tm; set mini $i}
    incr i
  }

  puts [string repeat ** 40]
  set s [format "%d cases in %.2f sec." $tcnt [expr {([clock milliseconds] - $_(starttime)) / 1000.0}]]
  if {$nett > 0} {
    append s [format " (%.2f nett-sec.)" [expr {$nett / 1000.0}]]
  }
  puts "Total $s:"
  lset _(m) 0 [format %.6f $wtm]
  lset _(m) 2 $wcnt
  lset _(m) 4 [format %.3f [expr {$wcnt / (($nett ? $nett : ($tcnt * [lindex $_(reptime) 0])) / 1000.0)}]]
  if {[llength $_(m)] > 6} {
    lset _(m) 6 [format %.3f $nett]
  }
  puts $_(m)
  puts "Average:"
  lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]]
  lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}]
  if {[llength $_(m)] > 6} {
    lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]]

  if {!$tcnt} {
    puts ""
    return
  }

  set mintm 0x7fffffff
  set maxtm 0
  set nettm 0
  set wtm 0
  set wcnt 0
  set i 0
  foreach tm $_(itm) {
    if {[llength $tm] > 6} {
      set nettm [expr {$nettm + [lindex $tm 6]}]
    }
    set wtm [expr {$wtm + [lindex $tm 0]}]
    set wcnt [expr {$wcnt + [lindex $tm 2]}]
    set tm [lindex $tm 0]
    if {$tm > $maxtm} {set maxtm $tm; set maxi $i}
    if {$tm < $mintm} {set mintm $tm; set mini $i}
    incr i
  }

  puts [string repeat ** 40]
  set s [format "%d cases in %.2f sec." $tcnt [expr {([clock milliseconds] - $_(starttime)) / 1000.0}]]
  if {$nettm > 0} {
    append s [format " (%.2f net-sec.)" [expr {$nettm / 1000.0}]]
  }
  puts "Total $s:"
  lset _(m) 0 [format %.6f $wtm]
  lset _(m) 2 $wcnt
  lset _(m) 4 [format %.3f [expr {$wcnt / (($nettm ? $nettm : ($tcnt * [lindex $_(reptime) 0])) / 1000.0)}]]
  if {[llength $_(m)] > 6} {
    lset _(m) 6 [format %.3f $nettm]
  }
  puts $_(m)
  puts "Average:"
  lset _(m) 0 [format %.6f [expr {[lindex $_(m) 0] / $tcnt}]]
  lset _(m) 2 [expr {[lindex $_(m) 2] / $tcnt}]
  if {[llength $_(m)] > 6} {
    lset _(m) 6 [format %.3f [expr {[lindex $_(m) 6] / $tcnt}]]

} -result iso8859-1

test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
    file exists
} -result {wrong # args: should be "file exists name"}
test cmdAH-5.4 {Tcl_FileObjCmd} {
    file exists ""
} 0

................................................................................
    }
    set res
} -result "characterSpecial"

# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file gorp x
} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file ex x
} -match glob -result {unknown or ambiguous subcommand "ex": must be *}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file is x
} -match glob -result {unknown or ambiguous subcommand "is": must be *}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
................................................................................
    set template [file join $dirfile foo]
    close [file tempfile name $template.bar]
    expr {[string match $template*.bar $name] ? "ok" :
	  "$template.bar produced $name"}
} -constraints {unix nonPortable} -cleanup {
    catch {file delete $name}
} -result ok
























































 
# This shouldn't work, but just in case a test above failed...
catch {close $newFileId}

interp delete safeInterp
interp delete simpleInterp

} -result iso8859-1

test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable}
test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
    file exists
} -result {wrong # args: should be "file exists name"}
test cmdAH-5.4 {Tcl_FileObjCmd} {
    file exists ""
} 0

................................................................................
    }
    set res
} -result "characterSpecial"

# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file gorp x
} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file ex x
} -match glob -result {unknown or ambiguous subcommand "ex": must be *}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file is x
} -match glob -result {unknown or ambiguous subcommand "is": must be *}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
................................................................................
    set template [file join $dirfile foo]
    close [file tempfile name $template.bar]
    expr {[string match $template*.bar $name] ? "ok" :
	  "$template.bar produced $name"}
} -constraints {unix nonPortable} -cleanup {
    catch {file delete $name}
} -result ok

test cmdAH-33.1 {file tempdir} -body {
    file tempdir a b
} -returnCodes error -result {wrong # args: should be "file tempdir ?template?"}
test cmdAH-33.2 {file tempdir} -body {
    set d [file tempdir]
    list [file tail $d] [file exists $d] [file type $d] \
	[glob -nocomplain -directory $d *]
} -match glob -result {tcl_* 1 directory {}} -cleanup {
    catch {file delete $d}
}
test cmdAH-33.3 {file tempdir} -body {
    set d [file tempdir gorp]
    list [file tail $d] [file exists $d] [file type $d] \
	[glob -nocomplain -directory $d *]
} -match glob -result {gorp_* 1 directory {}} -cleanup {
    catch {file delete $d}
}
test cmdAH-33.4 {file tempdir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -body {
    set pre [glob -nocomplain -directory $base *]
    set d [file normalize [file tempdir $base/]]
    list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \
	$pre [glob -nocomplain -directory $d *]
} -match glob -result {GORP:/tcl_* 1 directory {} {}} -cleanup {
    catch {file delete -force $base}
}
test cmdAH-33.5 {file tempdir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -body {
    set pre [glob -nocomplain -directory $base *]
    set d [file normalize [file tempdir $base/gorp]]
    list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \
	$pre [glob -nocomplain -directory $d *]
} -match glob -result {GORP:/gorp_* 1 directory {} {}} -cleanup {
    catch {file delete -force $base}
}
test cmdAH-33.6 {file tempdir: missing parent dir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -returnCodes error -body {
    file tempdir $base/quux/
} -cleanup {
    catch {file delete -force $base}
} -result {can't create temporary directory: no such file or directory}
test cmdAH-33.7 {file tempdir: missing parent dir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -returnCodes error -body {
    file tempdir $base/quux/foobar
} -cleanup {
    catch {file delete -force $base}
} -result {can't create temporary directory: no such file or directory}
 
# This shouldn't work, but just in case a test above failed...
catch {close $newFileId}

interp delete safeInterp
interp delete simpleInterp

test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
    list [catch {timerate -overhead b {} a b} msg] $msg
} {1 {expected floating-point number but got "b"}}
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
    list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
    regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? nett-ms$} [timerate {} 0]
} 1
test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
    regexp {^0 \ws/# 0 # 0 #/sec 0 nett-ms$} [timerate {} 0 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
    set m1 [timerate {_nrt_sleep 0} 20]
    set m2 [timerate {_nrt_sleep 0.2} 20]
    list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
	[expr {[lindex $m1 0] < 100}] \
................................................................................
test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
    set m1 [timerate {break}]
    list \
	[expr {[lindex $m1 0] < 1000}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] > 1000}] \
	[expr {[lindex $m1 6] < 10}]








} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
    set m1 [timerate {} 1000 5];	# max-count wins
    set m2 [timerate {_nrt_sleep 20} 1 5];	# max-time wins
    list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
................................................................................
    set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1]
    list \
	[expr {[lindex $m1 0] == 0.0}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] == 1000000}] \
	[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}







test cmdMZ-try-1.0 {

    fix for issue 45b9faf103f2

    [try] interaction with local variable names produces segmentation violation

test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} {
    list [catch {timerate -overhead b {} a b} msg] $msg
} {1 {expected floating-point number but got "b"}}
test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} {
    list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg
} {1 {missing close-brace}}
test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
    regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? net-ms$} [timerate {} 0]
} 1
test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
    regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0]
} 1
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} {
    set m1 [timerate {_nrt_sleep 0} 20]
    set m2 [timerate {_nrt_sleep 0.2} 20]
    list \
	[expr {[lindex $m1 0] < [lindex $m2 0]}] \
	[expr {[lindex $m1 0] < 100}] \
................................................................................
test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
    set m1 [timerate {break}]
    list \
	[expr {[lindex $m1 0] < 1000}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] > 1000}] \
	[expr {[lindex $m1 6] < 10}]
} {1 1 1 1}
test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} {
    set m1 [timerate {continue; return -code error "unexpected"} 1000 10]
    list \
    [expr {[lindex $m1 0] < 1000}] \
    [expr {[lindex $m1 2] == 10}] \
    [expr {[lindex $m1 4] > 1000}] \
    [expr {[lindex $m1 6] < 100}]
} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
    set m1 [timerate {} 1000 5];	# max-count wins
    set m2 [timerate {_nrt_sleep 20} 1 5];	# max-time wins
    list [lindex $m1 2] [lindex $m2 2]
} {5 1}
test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
................................................................................
    set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1]
    list \
	[expr {[lindex $m1 0] == 0.0}] \
	[expr {[lindex $m1 2] == 1}] \
	[expr {[lindex $m1 4] == 1000000}] \
	[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}
test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} {
    set m1 {set m2 ok}
    if 1 $m1
    timerate $m1 1000 10
    if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop
} ok

test cmdMZ-try-1.0 {

    fix for issue 45b9faf103f2

    [try] interaction with local variable names produces segmentation violation

    slave eval demo
    set result [slave eval {set ::result}]

    interp delete slave
    set result
} -result {inject-executed}

test coroutine-9.1 {coro type} {

















































































































































    coroutine demo eval {
	yield
	yield "PHASE 1"
	yieldto string cat "PHASE 2"
	::tcl::unsupported::corotype [info coroutine]
    }
    list [demo] [::tcl::unsupported::corotype demo] \
	[demo] [::tcl::unsupported::corotype demo] [demo]
} {{PHASE 1} yield {PHASE 2} yieldto active}
test coroutine-9.2 {coro type} -setup {
    catch {rename nosuchcommand ""}
} -returnCodes error -body {
    ::tcl::unsupported::corotype nosuchcommand
} -result {can only get coroutine type of a coroutine}
test coroutine-9.3 {coro type} -returnCodes error -body {
    proc notacoroutine {} {}
    ::tcl::unsupported::corotype notacoroutine
} -returnCodes error -cleanup {
    rename notacoroutine {}
} -result {can only get coroutine type of a coroutine}

test coroutine-10.1 {coroutine general introspection} -setup {
    set i [interp create]
} -body {
    $i eval {
	# Make the introspection code
	namespace path tcl::unsupported
	proc probe {type var} {
	    upvar 1 $var v

    slave eval demo
    set result [slave eval {set ::result}]

    interp delete slave
    set result
} -result {inject-executed}

test coroutine-9.1 {coroprobe with yield} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    list [coroprobe demo set i] [demo] [coroprobe demo set i] [demo]
} -cleanup {
    catch {rename demo {}}
} -result {1 {} 2 {}}
test coroutine-9.2 {coroprobe with yieldto} -body {
    coroutine demo apply {{} { lmap i {1 2} {yieldto string cat} }}
    list [coroprobe demo set i] [demo a b] [coroprobe demo set i] [demo c d]
} -cleanup {
    catch {rename demo {}}
} -result {1 {} 2 {{a b} {c d}}}
test coroutine-9.3 {coroprobe errors} -setup {
    catch {rename demo {}}
} -body {
    coroprobe demo set i
} -returnCodes error -result {can only inject a probe command into a coroutine}
test coroutine-9.4 {coroprobe errors} -body {
    proc demo {} { foreach i {1 2} yield }
    coroprobe demo set i
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {can only inject a probe command into a coroutine}
test coroutine-9.5 {coroprobe errors} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroprobe
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "coroprobe coroName cmd ?arg1 arg2 ...?"}
test coroutine-9.6 {coroprobe errors} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroprobe demo
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "coroprobe coroName cmd ?arg1 arg2 ...?"}
test coroutine-9.7 {coroprobe errors in probe command} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroprobe demo set
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "set varName ?newValue?"}
test coroutine-9.8 {coroprobe errors in probe command} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    list [catch {coroprobe demo set}] [demo] [coroprobe demo set i]
} -cleanup {
    catch {rename demo {}}
} -result {1 {} 2}
test coroutine-9.9 {coroprobe: advanced features} -setup {
    set i [interp create]
} -body {
    $i eval {
	coroutine demo apply {{} {
	    set f [info level],[info frame]
	    foreach i {1 2} yield
	}}
	coroprobe demo apply {{} {
	    upvar 1 f f
	    list [info coroutine] [info level] [info frame] $f
	}}
    }
} -cleanup {
    interp delete $i
} -result {::demo 2 3 1,2}

test coroutine-10.1 {coroinject with yield} -setup {
    set result {}
} -body {
    coroutine demo apply {{} { lmap i {1 2} yield }}
    coroinject demo apply {{op val} {lappend ::result $op $val}}
    list $result [demo x] [demo y] $result
} -cleanup {
    catch {rename demo {}}
} -result {{} {} {{yield x} y} {yield x}}
test coroutine-10.2 {coroinject stacking} -setup {
    set result {}
} -body {
    coroutine demo apply {{} { lmap i {1 2} yield }}
    coroinject demo apply {{op val} {lappend ::result $op $val A;return $val}}
    coroinject demo apply {{op val} {lappend ::result $op $val B;return $val}}
    list $result [demo x] [demo y] $result
} -cleanup {
    catch {rename demo {}}
} -result {{} {} {x y} {yield x B yield x A}}
test coroutine-10.3 {coroinject with yieldto} -setup {
    set result {}
} -body {
    coroutine demo apply {{} { lmap i {1 2} {yieldto string cat} }}
    coroinject demo apply {{op val} {lappend ::result $op $val;return $val}}
    list $result [demo x mp] [demo y le] $result
} -cleanup {
    catch {rename demo {}}
} -result {{} {} {{x mp} {y le}} {yieldto {x mp}}}
test coroutine-10.4 {coroinject errors} -setup {
    catch {rename demo {}}
} -body {
    coroinject demo set i
} -returnCodes error -result {can only inject a command into a coroutine}
test coroutine-10.5 {coroinject errors} -body {
    proc demo {} { foreach i {1 2} yield }
    coroinject demo set i
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {can only inject a command into a coroutine}
test coroutine-10.6 {coroinject errors} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroinject
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "coroinject coroName cmd ?arg1 arg2 ...?"}
test coroutine-10.7 {coroinject errors} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroinject demo
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "coroinject coroName cmd ?arg1 arg2 ...?"}
test coroutine-10.8 {coroinject errors in injected command} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroinject demo apply {args {error "ERR: $args"}}
    list [catch demo msg] $msg [catch demo msg] $msg
} -cleanup {
    catch {rename demo {}}
} -result {1 {ERR: yield {}} 1 {invalid command name "demo"}}
test coroutine-10.9 {coroinject: advanced features} -setup {
    set i [interp create]
} -body {
    $i eval {
	coroutine demo apply {{} {
	    set l [info level]
	    set f [info frame]
	    lmap i {1 2} yield
	}}
	coroinject demo apply {{arg op val} {
	    global result
	    upvar 1 f f l l
	    lappend result [info coroutine] $arg $op $val
	    lappend result [info level] $l [info frame] $f
	    lappend result [yield $arg]
	    return [string toupper $val]
	}} grill
	list [demo ABC] [demo pqr] [demo def] $result
    }
} -cleanup {
    interp delete $i
} -result {grill {} {ABC def} {::demo grill yield ABC 2 1 3 2 pqr}}

test coroutine-11.1 {coro type} {
    coroutine demo eval {
	yield
	yield "PHASE 1"
	yieldto string cat "PHASE 2"
	::tcl::unsupported::corotype [info coroutine]
    }
    list [demo] [::tcl::unsupported::corotype demo] \
	[demo] [::tcl::unsupported::corotype demo] [demo]
} {{PHASE 1} yield {PHASE 2} yieldto active}
test coroutine-11.2 {coro type} -setup {
    catch {rename nosuchcommand ""}
} -returnCodes error -body {
    ::tcl::unsupported::corotype nosuchcommand
} -result {can only get coroutine type of a coroutine}
test coroutine-11.3 {coro type} -returnCodes error -body {
    proc notacoroutine {} {}
    ::tcl::unsupported::corotype notacoroutine
} -returnCodes error -cleanup {
    rename notacoroutine {}
} -result {can only get coroutine type of a coroutine}

test coroutine-12.1 {coroutine general introspection} -setup {
    set i [interp create]
} -body {
    $i eval {
	# Make the introspection code
	namespace path tcl::unsupported
	proc probe {type var} {
	    upvar 1 $var v

}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}

foreach i [interp slaves] {
  interp delete $i
}
 
# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} -returnCodes error -body {

}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}

foreach i [interp slaves] {
  interp delete $i
}
 
# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} -returnCodes error -body {

		    set pad 28
		}
		append line $next
		set sep ", "
	    }
	    append line ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append line " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append line $sep
		set next {}
................................................................................
		    append text " "
		}
		append text [lindex $arg 1] [lindex $arg 2]
		set sep ", "
	    }
	    append text ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append text " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append text $sep [lindex $arg 0]
		if {[string index $text end] ne "*"} {

		    set pad 28
		}
		append line $next
		set sep ", "
	    }
	    append line ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append line " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append line $sep
		set next {}
................................................................................
		    append text " "
		}
		append text [lindex $arg 1] [lindex $arg 2]
		set sep ", "
	    }
	    append text ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append text " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append text $sep [lindex $arg 0]
		if {[string index $text end] ne "*"} {

    } elseif {$length == 1} {
	set indent 5
    }
    if {$text == {\(bu}} {
	set text "\u00b7"
    }

    set tab [expr $indent * 0.1]i
    newPara $tab -$tab
    set state(sb) 80
    setTabs $tab
    formattedText $text
    tab
}

    } elseif {$length == 1} {
	set indent 5
    }
    if {$text == {\(bu}} {
	set text "\u00b7"
    }

    set tab [expr {$indent * 0.1}]i
    newPara $tab -$tab
    set state(sb) 80
    setTabs $tab
    formattedText $text
    tab
}

# string -		Text to output in the paragraph.

proc text string {
    global file textState inDT charCnt inTable

    set pos [string first "\t" $string]
    if {$pos >= 0} {
    	text [string range $string 0 [expr $pos-1]]
    	tab
    	text [string range $string [expr $pos+1] end]
	return
    }
    if {$inTable} {
	if {$inTable == 1} {
	    puts -nonewline $file <TR>
	    set inTable 2
	}
................................................................................
#	puts "formattedText: $text"
    while {$text ne ""} {
	set index [string first \\ $text]
	if {$index < 0} {
	    text $text
	    return
	}
	text [string range $text 0 [expr $index-1]]
	set c [string index $text [expr $index+1]]
	switch -- $c {
	    f {
		font [string index $text [expr $index+2]]
		set text [string range $text [expr $index+3] end]
	    }
	    e {
		text \\
		set text [string range $text [expr $index+2] end]
	    }
	    - {
		dash
		set text [string range $text [expr $index+2] end]
	    }
	    | {
		set text [string range $text [expr $index+2] end]
	    }
	    default {
		puts stderr "Unknown sequence: \\$c"
		set text [string range $text [expr $index+2] end]
	    }
	}
    }
}
 
##############################################################################
# dash --
................................................................................
# Arguments:
# None.

proc tab {} {
    global inPRE charCnt tabString file
#	? charCnt
    if {$inPRE == 1} {
	set pos [expr $charCnt % [string length $tabString] ]
	set spaces [string first "1" [string range $tabString $pos end] ]
	text [format "%*s" [incr spaces] " "]
    } else {
#	puts "tab: found tab outside of <PRE> block"
    }
}

# string -		Text to output in the paragraph.

proc text string {
    global file textState inDT charCnt inTable

    set pos [string first "\t" $string]
    if {$pos >= 0} {
    	text [string range $string 0 [expr {$pos-1}]]
    	tab
    	text [string range $string [expr {$pos+1}] end]
	return
    }
    if {$inTable} {
	if {$inTable == 1} {
	    puts -nonewline $file <TR>
	    set inTable 2
	}
................................................................................
#	puts "formattedText: $text"
    while {$text ne ""} {
	set index [string first \\ $text]
	if {$index < 0} {
	    text $text
	    return
	}
	text [string range $text 0 [expr {$index-1}]]
	set c [string index $text [expr {$index+1}]]
	switch -- $c {
	    f {
		font [string index $text [expr {$index+2}]]
		set text [string range $text [expr {$index+3}] end]
	    }
	    e {
		text \\
		set text [string range $text [expr {$index+2}] end]
	    }
	    - {
		dash
		set text [string range $text [expr {$index+2}] end]
	    }
	    | {
		set text [string range $text [expr {$index+2}] end]
	    }
	    default {
		puts stderr "Unknown sequence: \\$c"
		set text [string range $text [expr {$index+2}] end]
	    }
	}
    }
}
 
##############################################################################
# dash --
................................................................................
# Arguments:
# None.

proc tab {} {
    global inPRE charCnt tabString file
#	? charCnt
    if {$inPRE == 1} {
	set pos [expr {$charCnt % [string length $tabString]}]
	set spaces [string first "1" [string range $tabString $pos end] ]
	text [format "%*s" [incr spaces] " "]
    } else {
#	puts "tab: found tab outside of <PRE> block"
    }
}

    set fileId [open $inFileName r]

    set i 0
    while {[gets $fileId line] >= 0} {

	set len [string length $line]

	if {($len > 0) && ([string index $line [expr $len - 1]] == "\\")} {
	    if {[info exists lineArray(c$i)] == 0} {
		set lineArray(c$i) 1
	    } else {
		incr lineArray(c$i)
	    }
	    set line [string range $line 0 [expr $len - 2]]
	    append lineArray($i) $line
	    continue
	}
	if {[info exists lineArray(c$i)] == 0} {
	    set lineArray(c$i) 1
	} else {
	    incr lineArray(c$i)
................................................................................
	}
	set str [lindex $currentLine 2]
    }
    set flags [removeFlags $flags]

    # find the test result

    set numVars [expr $len - 3]
    set vars {}
    set vals {}
    set result 0
    set v 0

    if {[regsub {\*} "$flags" "" newFlags] == 1} {
	# an error is expected

    set fileId [open $inFileName r]

    set i 0
    while {[gets $fileId line] >= 0} {

	set len [string length $line]

	if {($len > 0) && ([string index $line [expr {$len - 1}]] == "\\")} {
	    if {[info exists lineArray(c$i)] == 0} {
		set lineArray(c$i) 1
	    } else {
		incr lineArray(c$i)
	    }
	    set line [string range $line 0 [expr {$len - 2}]]
	    append lineArray($i) $line
	    continue
	}
	if {[info exists lineArray(c$i)] == 0} {
	    set lineArray(c$i) 1
	} else {
	    incr lineArray(c$i)
................................................................................
	}
	set str [lindex $currentLine 2]
    }
    set flags [removeFlags $flags]

    # find the test result

    set numVars [expr {$len - 3}]
    set vars {}
    set vals {}
    set result 0
    set v 0

    if {[regsub {\*} "$flags" "" newFlags] == 1} {
	# an error is expected

} else {
    puts "/*
 * Multi parts read only string generated by str2c
 */
static const char * const data\[\]= {"
    set n 1
    for {set i 0} {$i<$lg} {incr i $MAX} {
	set part [string range $r $i [expr $i+$MAX-1]]
	set len  [string length $part];
	puts "\t/* Start of part $n ($len characters) */"
	puts "\t\"[translate $part]\","
	puts "\t/* End of part $n */\n"
	incr n
    }
    puts "\tNULL\t/* End of data marker */\n};"

} else {
    puts "/*
 * Multi parts read only string generated by str2c
 */
static const char * const data\[\]= {"
    set n 1
    for {set i 0} {$i<$lg} {incr i $MAX} {
	set part [string range $r $i [expr {$i+$MAX-1}]]
	set len  [string length $part];
	puts "\t/* Start of part $n ($len characters) */"
	puts "\t\"[translate $part]\","
	puts "\t/* End of part $n */\n"
	incr n
    }
    puts "\tNULL\t/* End of data marker */\n};"

	#
	set manual(toc-$manual(wing-file)-$manual(name)) \
	    [concat <DL> $manual(section-toc) </DL>]
    }
    if {!$verbose} {
	puts stderr ""
    }





    #
    # make the wing table of contents for the section
    #
    set width 0
    foreach name $manual(wing-toc) {
	if {[string length $name] > $width} {

	#
	set manual(toc-$manual(wing-file)-$manual(name)) \
	    [concat <DL> $manual(section-toc) </DL>]
    }
    if {!$verbose} {
	puts stderr ""
    }

    if {![llength $manual(wing-toc)]} {
	fatal "not table of contents."
    }

    #
    # make the wing table of contents for the section
    #
    set width 0
    foreach name $manual(wing-toc) {
	if {[string length $name] > $width} {

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]
 


















proc findversion {top name useversion} {





    set upper [string toupper $name]
    foreach top1 [list $top $top/..] sub {{} generic} {
	foreach dirname [
	    glob -nocomplain -tails -type d -directory $top1 *] {

	    set tclh [join [list $top1 $dirname {*}$sub $name.h] /]
	    if {[file exists $tclh]} {
		set chan [open $tclh]
		set data [read $chan]
		close $chan
		# backslash isn't required in front of quote, but it keeps syntax
		# highlighting straight in some editors
		if {[regexp -lineanchor \
		    [string map [list @[email protected] $upper] \
			{^#define\[email protected]@_VERSION\s+\"([^.])+\.([^.\"]+)}] \
		    $data -> major minor]} {
			# to do
			#     use glob matching instead of string matching or add
			#     brace handling to [string matcch]
			if {$useversion eq {} || [string match $useversion $major.$minor]} {
			    set top [file dirname [file dirname $tclh]]
			    set prefix [file dirname $top]
			    return [list $prefix [file tail $top] $major $minor]
			}
		}
	    }
	}
    }
    return
}

proc parse_command_line {} {
    global argv Version

    # These variables determine where the man pages come from and where
    # the converted pages go to.
................................................................................
	}
    }

    if {!$build_tcl && !$build_tk} {
	set build_tcl 1;
	set build_tk 1
    }




    if {$build_tcl} {
	# Find Tcl.







	lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor

	if {$tcldir eq {} && $opt_build_tcl} {
	    puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
	    exit 1
	}
	puts "using Tcl source directory $tcltkdir $tcldir"
    }


    if {$build_tk} {
	# Find Tk.








	lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor

	if {$tkdir eq {} && $opt_build_tk} {
	    puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
	    exit 1
	}
	puts "using Tk source directory $tkdir"
    }

    puts "verbose messages are [expr {$verbose ? {on} : {off}}]"

    # the title for the man pages overall
    global overall_title
    set overall_title ""
    if {$build_tcl} {

	append overall_title "Tcl $major.$minor"



    }
    if {$build_tcl && $build_tk} {
	append overall_title "/"
    }
    if {$build_tk} {
	append overall_title "[capitalize $tkdir]"
    }

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]
 
proc getversion {tclh {name {}}} {
    if {[file exists $tclh]} {
	set chan [open $tclh]
	set data [read $chan]
	close $chan
	if {$name eq ""} {
	    set name [string toupper [file root [file tail $tclh]]]
	}
	# backslash isn't required in front of quote, but it keeps syntax
	# highlighting straight in some editors
	if {[regexp -lineanchor \
	    [string map [list @[email protected] $name] \
		{^#define\[email protected]@_VERSION\s+\"([^.])+\.([^.\"]+)}] \
	    $data -> major minor]} {
		return [list $major $minor]
	}
    }
}
proc findversion {top name useversion} {
    # Default search version is a glob pattern, switch it for string match:
    if {$useversion eq {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}} {
	set useversion {[8-9].[0-9]}
    }
    # Search:
    set upper [string toupper $name]
    foreach top1 [list $top $top/..] sub {{} generic} {
	foreach dirname [
	    glob -nocomplain -tails -type d -directory $top1 *] {

	    set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /]
	    set v [getversion $tclh $upper]
	    if {[llength $v]} {







		lassign $v major minor
		# to do
		#     use glob matching instead of string matching or add
		#     brace handling to [string matcch]
		if {$useversion eq {} || [string match $useversion $major.$minor]} {
		    set top [file dirname [file dirname $tclh]]
		    set prefix [file dirname $top]
		    return [list $prefix [file tail $top] $major $minor]

		}
	    }
	}
    }

}

proc parse_command_line {} {
    global argv Version

    # These variables determine where the man pages come from and where
    # the converted pages go to.
................................................................................
	}
    }

    if {!$build_tcl && !$build_tk} {
	set build_tcl 1;
	set build_tk 1
    }

    set major ""
    set minor ""

    if {$build_tcl} {

	# Find Tcl (firstly using glob pattern / backwards compatible way)
	set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
		-directory $tcltkdir tcl$useversion]] end]
	if {$tcldir ne {}} {
	    # obtain version from generic header if we can:
	    lassign [getversion [file join $tcltkdir $tcldir generic tcl.h]] major minor
	} else {
	    lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor
	}
	if {$tcldir eq {} && $opt_build_tcl} {
	    puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
	    exit 1
	}
	puts "using Tcl source directory $tcltkdir $tcldir"
    }


    if {$build_tk} {
	# Find Tk (firstly using glob pattern / backwards compatible way)
	set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
		-directory $tcltkdir tk$useversion]] end]
	if {$tkdir ne {}} {
	    if {$major eq ""} {
		# obtain version from generic header if we can:
		lassign [getversion [file join $tcltkdir $tcldir generic tk.h]] major minor
	    }
	} else {
	    lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor
	}
	if {$tkdir eq {} && $opt_build_tk} {
	    puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
	    exit 1
	}
	puts "using Tk source directory $tkdir"
    }

    puts "verbose messages are [expr {$verbose ? {on} : {off}}]"

    # the title for the man pages overall
    global overall_title
    set overall_title ""
    if {$build_tcl} {
	if {$major ne ""} {
	    append overall_title "Tcl $major.$minor"
	} else {
	    append overall_title "Tcl [capitalize $tcldir]"
	}
    }
    if {$build_tcl && $build_tk} {
	append overall_title "/"
    }
    if {$build_tk} {
	append overall_title "[capitalize $tkdir]"
    }

TOMMATH_OBJS = bn_reverse.o bn_fast_s_mp_mul_digs.o \
	bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
	bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
	bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
	bn_mp_cnt_lsb.o bn_mp_copy.o \
	bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
	bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o \
	bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_get_bit.o bn_mp_get_int.o \
	bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \
	bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
	bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \
	bn_mp_karatsuba_sqr.o \
	bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
	bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_radix_size.o bn_mp_radix_smap.o \
	bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
	bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
	bn_mp_tc_and.o bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o \
	bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
	bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o \
	tclTomMathStubLib.o \
................................................................................
	$(TOMMATH_DIR)/bn_mp_set_long.c \
	$(TOMMATH_DIR)/bn_mp_set_long_long.c \
	$(TOMMATH_DIR)/bn_mp_shrink.c \
	$(TOMMATH_DIR)/bn_mp_sqr.c \
	$(TOMMATH_DIR)/bn_mp_sqrt.c \
	$(TOMMATH_DIR)/bn_mp_sub.c \
	$(TOMMATH_DIR)/bn_mp_sub_d.c \
	$(TOMMATH_DIR)/bn_mp_tc_and.c \
	$(TOMMATH_DIR)/bn_mp_tc_div_2d.c \
	$(TOMMATH_DIR)/bn_mp_tc_or.c \
	$(TOMMATH_DIR)/bn_mp_tc_xor.c \
	$(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c \
	$(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c \
	$(TOMMATH_DIR)/bn_mp_toom_mul.c \
	$(TOMMATH_DIR)/bn_mp_toom_sqr.c \
	$(TOMMATH_DIR)/bn_mp_toradix_n.c \
	$(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c \
	$(TOMMATH_DIR)/bn_mp_xor.c \
................................................................................

bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d.c

bn_mp_expt_d_ex.o: $(TOMMATH_DIR)/bn_mp_expt_d_ex.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d_ex.c

bn_mp_get_bit.o: $(TOMMATH_DIR)/bn_mp_get_bit.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_bit.c

bn_mp_get_int.o: $(TOMMATH_DIR)/bn_mp_get_int.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_int.c

bn_mp_get_long.o: $(TOMMATH_DIR)/bn_mp_get_long.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_long.c

................................................................................

bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub.c

bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c

bn_mp_tc_and.o: $(TOMMATH_DIR)/bn_mp_tc_and.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_tc_and.c

bn_mp_tc_div_2d.o: $(TOMMATH_DIR)/bn_mp_tc_div_2d.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_tc_div_2d.c

bn_mp_tc_or.o: $(TOMMATH_DIR)/bn_mp_tc_or.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_tc_or.c

bn_mp_tc_xor.o: $(TOMMATH_DIR)/bn_mp_tc_xor.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_tc_xor.c

bn_mp_to_unsigned_bin.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c

bn_mp_to_unsigned_bin_n.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c

................................................................................
		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
	$(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix
	$(INSTALL_DATA_DIR) $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README \
		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
		$(DISTDIR)
	$(INSTALL_DATA_DIR) $(DISTDIR)/library
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	@for i in $(BUILTIN_PACKAGE_LIST) ; do \
	    $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\

TOMMATH_OBJS = bn_reverse.o bn_fast_s_mp_mul_digs.o \
	bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
	bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
	bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
	bn_mp_cnt_lsb.o bn_mp_copy.o \
	bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
	bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o \
	bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_s_mp_get_bit.o bn_mp_get_int.o \
	bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \
	bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
	bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \
	bn_mp_karatsuba_sqr.o \
	bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
	bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_radix_size.o bn_mp_radix_smap.o \
	bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
	bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
	bn_mp_signed_rsh.o \
	bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
	bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o \
	tclTomMathStubLib.o \
................................................................................
	$(TOMMATH_DIR)/bn_mp_set_long.c \
	$(TOMMATH_DIR)/bn_mp_set_long_long.c \
	$(TOMMATH_DIR)/bn_mp_shrink.c \
	$(TOMMATH_DIR)/bn_mp_sqr.c \
	$(TOMMATH_DIR)/bn_mp_sqrt.c \
	$(TOMMATH_DIR)/bn_mp_sub.c \
	$(TOMMATH_DIR)/bn_mp_sub_d.c \


	$(TOMMATH_DIR)/bn_mp_signed_rsh.c \

	$(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c \
	$(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c \
	$(TOMMATH_DIR)/bn_mp_toom_mul.c \
	$(TOMMATH_DIR)/bn_mp_toom_sqr.c \
	$(TOMMATH_DIR)/bn_mp_toradix_n.c \
	$(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c \
	$(TOMMATH_DIR)/bn_mp_xor.c \
................................................................................

bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d.c

bn_mp_expt_d_ex.o: $(TOMMATH_DIR)/bn_mp_expt_d_ex.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d_ex.c

bn_s_mp_get_bit.o: $(TOMMATH_DIR)/bn_s_mp_get_bit.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_get_bit.c

bn_mp_get_int.o: $(TOMMATH_DIR)/bn_mp_get_int.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_int.c

bn_mp_get_long.o: $(TOMMATH_DIR)/bn_mp_get_long.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_long.c

................................................................................

bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub.c

bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c







bn_mp_signed_rsh.o: $(TOMMATH_DIR)/bn_mp_signed_rsh.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_signed_rsh.c




bn_mp_to_unsigned_bin.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c

bn_mp_to_unsigned_bin_n.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c

................................................................................
		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
	$(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix
	$(INSTALL_DATA_DIR) $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \
		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
		$(DISTDIR)
	$(INSTALL_DATA_DIR) $(DISTDIR)/library
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	@for i in $(BUILTIN_PACKAGE_LIST) ; do \
	    $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\

     * Assume that the default location ("/tmp" if not overridden) is always
     * an existing writable directory; we've no recovery mechanism if it
     * isn't.
     */

    return TCL_TEMPORARY_FILE_DIRECTORY;
}















































































 
#if defined(__CYGWIN__)

static void
StatError(
    Tcl_Interp *interp,		/* The interp that has the error */
    Tcl_Obj *fileName)		/* The name of the file which caused the

     * Assume that the default location ("/tmp" if not overridden) is always
     * an existing writable directory; we've no recovery mechanism if it
     * isn't.
     */

    return TCL_TEMPORARY_FILE_DIRECTORY;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpCreateTemporaryDirectory --
 *
 *	Creates a temporary directory, possibly based on the supplied bits and
 *	pieces of template supplied in the arguments.
 *
 * Results:
 *	An object (refcount 0) containing the name of the newly-created
 *	directory, or NULL on failure.
 *
 * Side effects:
 *	Accesses the native filesystem. Makes a directory.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpCreateTemporaryDirectory(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj)
{
    Tcl_DString template, tmp;
    const char *string;

#define DEFAULT_TEMP_DIR_PREFIX	"tcl"

    /*
     * Build the template in writable memory from the user-supplied pieces and
     * some defaults.
     */

    if (dirObj) {
	string = TclGetString(dirObj);
	Tcl_UtfToExternalDString(NULL, string, dirObj->length, &template);
    } else {
	Tcl_DStringInit(&template);
	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
    }

    if (Tcl_DStringValue(&template)[Tcl_DStringLength(&template) - 1] != '/') {
	TclDStringAppendLiteral(&template, "/");
    }

    if (basenameObj) {
	string = TclGetString(basenameObj);
	if (basenameObj->length) {
	    Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp);
	    TclDStringAppendDString(&template, &tmp);
	    Tcl_DStringFree(&tmp);
	} else {
	    TclDStringAppendLiteral(&template, DEFAULT_TEMP_DIR_PREFIX);
	}
    } else {
	TclDStringAppendLiteral(&template, DEFAULT_TEMP_DIR_PREFIX);
    }

    TclDStringAppendLiteral(&template, "_XXXXXX");

    /*
     * Make the temporary directory.
     */

    if (mkdtemp(Tcl_DStringValue(&template)) == NULL) {
	Tcl_DStringFree(&template);
	return NULL;
    }

    /*
     * The template has been updated. Tell the caller what it was.
     */

    Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template),
	    Tcl_DStringLength(&template), &tmp);
    Tcl_DStringFree(&template);
    return TclDStringToObj(&tmp);
}
 
#if defined(__CYGWIN__)

static void
StatError(
    Tcl_Interp *interp,		/* The interp that has the error */
    Tcl_Obj *fileName)		/* The name of the file which caused the

	bn_mp_div_d.${OBJEXT} \
	bn_mp_div_2.${OBJEXT} \
	bn_mp_div_2d.${OBJEXT} \
	bn_mp_div_3.${OBJEXT} \
	bn_mp_exch.${OBJEXT} \
	bn_mp_expt_d.${OBJEXT} \
	bn_mp_expt_d_ex.${OBJEXT} \
	bn_mp_get_bit.${OBJEXT} \
	bn_mp_get_int.${OBJEXT} \
	bn_mp_get_long.${OBJEXT} \
	bn_mp_get_long_long.${OBJEXT} \
	bn_mp_grow.${OBJEXT} \
	bn_mp_init.${OBJEXT} \
	bn_mp_init_copy.${OBJEXT} \
	bn_mp_init_multi.${OBJEXT} \
................................................................................
	bn_mp_set_long.${OBJEXT} \
	bn_mp_set_long_long.${OBJEXT} \
	bn_mp_shrink.${OBJEXT} \
	bn_mp_sqr.${OBJEXT} \
	bn_mp_sqrt.${OBJEXT} \
	bn_mp_sub.${OBJEXT} \
	bn_mp_sub_d.${OBJEXT} \
	bn_mp_tc_and.${OBJEXT} \
	bn_mp_tc_div_2d.${OBJEXT} \
	bn_mp_tc_or.${OBJEXT} \
	bn_mp_tc_xor.${OBJEXT} \
	bn_mp_to_unsigned_bin.${OBJEXT} \
	bn_mp_to_unsigned_bin_n.${OBJEXT} \
	bn_mp_toom_mul.${OBJEXT} \
	bn_mp_toom_sqr.${OBJEXT} \
	bn_mp_toradix_n.${OBJEXT} \
	bn_mp_unsigned_bin_size.${OBJEXT} \
	bn_mp_xor.${OBJEXT} \

	bn_mp_div_d.${OBJEXT} \
	bn_mp_div_2.${OBJEXT} \
	bn_mp_div_2d.${OBJEXT} \
	bn_mp_div_3.${OBJEXT} \
	bn_mp_exch.${OBJEXT} \
	bn_mp_expt_d.${OBJEXT} \
	bn_mp_expt_d_ex.${OBJEXT} \
	bn_s_mp_get_bit.${OBJEXT} \
	bn_mp_get_int.${OBJEXT} \
	bn_mp_get_long.${OBJEXT} \
	bn_mp_get_long_long.${OBJEXT} \
	bn_mp_grow.${OBJEXT} \
	bn_mp_init.${OBJEXT} \
	bn_mp_init_copy.${OBJEXT} \
	bn_mp_init_multi.${OBJEXT} \
................................................................................
	bn_mp_set_long.${OBJEXT} \
	bn_mp_set_long_long.${OBJEXT} \
	bn_mp_shrink.${OBJEXT} \
	bn_mp_sqr.${OBJEXT} \
	bn_mp_sqrt.${OBJEXT} \
	bn_mp_sub.${OBJEXT} \
	bn_mp_sub_d.${OBJEXT} \


	bn_mp_signed_rsh.${OBJEXT} \

	bn_mp_to_unsigned_bin.${OBJEXT} \
	bn_mp_to_unsigned_bin_n.${OBJEXT} \
	bn_mp_toom_mul.${OBJEXT} \
	bn_mp_toom_sqr.${OBJEXT} \
	bn_mp_toradix_n.${OBJEXT} \
	bn_mp_unsigned_bin_size.${OBJEXT} \
	bn_mp_xor.${OBJEXT} \

	$(TMP_DIR)\bn_mp_div_d.obj \
	$(TMP_DIR)\bn_mp_div_2.obj \
	$(TMP_DIR)\bn_mp_div_2d.obj \
	$(TMP_DIR)\bn_mp_div_3.obj \
	$(TMP_DIR)\bn_mp_exch.obj \
	$(TMP_DIR)\bn_mp_expt_d.obj \
	$(TMP_DIR)\bn_mp_expt_d_ex.obj \
	$(TMP_DIR)\bn_mp_get_bit.obj \
	$(TMP_DIR)\bn_mp_get_int.obj \
	$(TMP_DIR)\bn_mp_get_long.obj \
	$(TMP_DIR)\bn_mp_get_long_long.obj \
	$(TMP_DIR)\bn_mp_grow.obj \
	$(TMP_DIR)\bn_mp_init.obj \
	$(TMP_DIR)\bn_mp_init_copy.obj \
	$(TMP_DIR)\bn_mp_init_multi.obj \
................................................................................
	$(TMP_DIR)\bn_mp_set_long.obj \
	$(TMP_DIR)\bn_mp_set_long_long.obj \
	$(TMP_DIR)\bn_mp_shrink.obj \
	$(TMP_DIR)\bn_mp_sqr.obj \
	$(TMP_DIR)\bn_mp_sqrt.obj \
	$(TMP_DIR)\bn_mp_sub.obj \
	$(TMP_DIR)\bn_mp_sub_d.obj \
	$(TMP_DIR)\bn_mp_tc_and.obj \
	$(TMP_DIR)\bn_mp_tc_div_2d.obj \
	$(TMP_DIR)\bn_mp_tc_or.obj \
	$(TMP_DIR)\bn_mp_tc_xor.obj \
	$(TMP_DIR)\bn_mp_to_unsigned_bin.obj \
	$(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \
	$(TMP_DIR)\bn_mp_toom_mul.obj \
	$(TMP_DIR)\bn_mp_toom_sqr.obj \
	$(TMP_DIR)\bn_mp_toradix_n.obj \
	$(TMP_DIR)\bn_mp_unsigned_bin_size.obj \
	$(TMP_DIR)\bn_mp_xor.obj \

	$(TMP_DIR)\bn_mp_div_d.obj \
	$(TMP_DIR)\bn_mp_div_2.obj \
	$(TMP_DIR)\bn_mp_div_2d.obj \
	$(TMP_DIR)\bn_mp_div_3.obj \
	$(TMP_DIR)\bn_mp_exch.obj \
	$(TMP_DIR)\bn_mp_expt_d.obj \
	$(TMP_DIR)\bn_mp_expt_d_ex.obj \
	$(TMP_DIR)\bn_s_mp_get_bit.obj \
	$(TMP_DIR)\bn_mp_get_int.obj \
	$(TMP_DIR)\bn_mp_get_long.obj \
	$(TMP_DIR)\bn_mp_get_long_long.obj \
	$(TMP_DIR)\bn_mp_grow.obj \
	$(TMP_DIR)\bn_mp_init.obj \
	$(TMP_DIR)\bn_mp_init_copy.obj \
	$(TMP_DIR)\bn_mp_init_multi.obj \
................................................................................
	$(TMP_DIR)\bn_mp_set_long.obj \
	$(TMP_DIR)\bn_mp_set_long_long.obj \
	$(TMP_DIR)\bn_mp_shrink.obj \
	$(TMP_DIR)\bn_mp_sqr.obj \
	$(TMP_DIR)\bn_mp_sqrt.obj \
	$(TMP_DIR)\bn_mp_sub.obj \
	$(TMP_DIR)\bn_mp_sub_d.obj \


	$(TMP_DIR)\bn_mp_signed_rsh.obj \

	$(TMP_DIR)\bn_mp_to_unsigned_bin.obj \
	$(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \
	$(TMP_DIR)\bn_mp_toom_mul.obj \
	$(TMP_DIR)\bn_mp_toom_sqr.obj \
	$(TMP_DIR)\bn_mp_toradix_n.obj \
	$(TMP_DIR)\bn_mp_unsigned_bin_size.obj \
	$(TMP_DIR)\bn_mp_xor.obj \

	    Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
	}
    }

    Tcl_IncrRefCount(resultPtr);
    return resultPtr;
}
 
/*



















































































































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

	    Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
	}
    }

    Tcl_IncrRefCount(resultPtr);
    return resultPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpCreateTemporaryDirectory --
 *
 *	Creates a temporary directory, possibly based on the supplied bits and
 *	pieces of template supplied in the arguments.
 *
 * Results:
 *	An object (refcount 0) containing the name of the newly-created
 *	directory, or NULL on failure.
 *
 * Side effects:
 *	Accesses the native filesystem. Makes a directory.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpCreateTemporaryDirectory(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj)
{
    Tcl_DString base, name;	/* Contains WCHARs */
    int baseLen;
    DWORD error;
    WCHAR tempBuf[MAX_PATH + 1];
    DWORD len = GetTempPathW(MAX_PATH, tempBuf);

    /*
     * Build the path in writable memory from the user-supplied pieces and
     * some defaults. First, the parent temporary directory.
     */

    if (dirObj) {
	Tcl_GetString(dirObj);
	if (dirObj->length < 1) {
	    goto useSystemTemp;
	}
	Tcl_WinUtfToTChar(Tcl_GetString(dirObj), -1, &base);
	if (dirObj->bytes[dirObj->length - 1] != '\\') {
	    TclUtfToWCharDString("\\", -1, &base);
	}
    } else {
    useSystemTemp:
	Tcl_DStringInit(&base);
	Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR));
    }

    /*
     * Next, the base of the directory name.
     */

#define DEFAULT_TEMP_DIR_PREFIX	"tcl"
#define SUFFIX_LENGTH	8

    if (basenameObj) {
	Tcl_WinUtfToTChar(Tcl_GetString(basenameObj), -1, &name);
	TclDStringAppendDString(&base, &name);
	Tcl_DStringFree(&name);
    } else {
	TclUtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, -1, &base);
    }
    TclUtfToWCharDString("_", -1, &base);

    /*
     * Now we keep on trying random suffixes until we get one that works
     * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that
     * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a
     * case-sensitive filesystem.
     */

    baseLen = Tcl_DStringLength(&base);
    do {
	char tempbuf[SUFFIX_LENGTH + 1];
	int i;
	static const char randChars[] =
	    "QWERTYUIOPASDFGHJKLZXCVBNM1234567890";
	static const int numRandChars = sizeof(randChars) - 1;

	/*
	 * Put a random suffix on the end.
	 */

	error = ERROR_SUCCESS;
	tempbuf[SUFFIX_LENGTH] = '\0';
	for (i = 0 ; i < SUFFIX_LENGTH; i++) {
	    tempbuf[i] = randChars[(int) (rand() % numRandChars)];
	}
	Tcl_DStringSetLength(&base, baseLen);
	TclUtfToWCharDString(tempbuf, -1, &base);
    } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL)
	    && (error = GetLastError()) == ERROR_ALREADY_EXISTS);

    /*
     * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and
     * ERROR_ACCESS_DENIED.
     */

    if (error != ERROR_SUCCESS) {
	TclWinConvertError(error);
	Tcl_DStringFree(&base);
	return NULL;
    }

    /*
     * We actually made the directory, so we're done! Report what we made back
     * as a (clean) Tcl_Obj.
     */

    Tcl_WinTCharToUtf((LPCWSTR) Tcl_DStringValue(&base), -1, &name);
    Tcl_DStringFree(&base);
    return TclDStringToObj(&name);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */