compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
compat/zlib/zlib.map
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.wse.in
win/*.bat
win/*.vc
win/coffbase.txt




win/tcl.dsp
win/tcl.dsw

*.ts text
*.tcl text
*.test text

# Declare files that will always have CRLF line endings on checkout.
*.bat eol=crlf
*.cs eol=crlf
*.dsp eol=crlf
*.dsw eol=crlf
*.sln eol=crlf
*.vc eol=crlf

# Denote all files that are truly binary and should not be modified.
*.a binary
*.bmp binary
*.dll binary

          ulimit -a || echo 'get limit failed'
          echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
      - name: Upload
        uses: actions/upload-artifact@v4
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot)
          path: 1dist/*.tar
        id: upload
    outputs:
      url: ${{ steps.upload.outputs.artifact-url }}
  macos:
    name: macOS
    runs-on: macos-13
    defaults:
      run:
        shell: bash
    timeout-minutes: 10

          ulimit -a || echo 'get limit failed'
          echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
      - name: Upload
        uses: actions/upload-artifact@v4
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot)
          path: 1dist/*.dmg
        id: upload
    outputs:
      url: ${{ steps.upload.outputs.artifact-url }}
  win:
    name: Windows
    runs-on: windows-2019
    defaults:
      run:
        shell: msys2 {0}
    timeout-minutes: 10

          ulimit -a || echo 'get limit failed'
          echo 'puts exe:\t[info nameofexecutable]\nver:\t[info patchlevel]\t[if {![catch tcl::build-info ret]} {set ret}]\nlib:\t[info library]\nplat:\t[lsort -dictionary -stride 2 [array get tcl_platform]]' | make runtest || echo 'get info failed'
      - name: Upload
        uses: actions/upload-artifact@v4
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot)
          path: '1dist/*_snapshot.exe'
        id: upload
    outputs:
      url: ${{ steps.upload.outputs.artifact-url }}
  combine:
    needs:
      - linux
      - macos
      - win
    name: Combine Artifacts (prototype)
    runs-on: ubuntu-latest
    defaults:
      run:
        shell: bash
    timeout-minutes: 10
    env:
      # See also
      # https://docs.github.com/en/actions/writing-workflows/choosing-what-your-workflow-does/store-information-in-variables
      REMOTE_PATH: ${{ vars.PUBLISH_DROP_PATH }}/data-${{ github.sha }}
    steps:
      - name: Make directory
        run: |
          mkdir data
      - name: Get Linux build
        uses: actions/download-artifact@v4
        with:
          path: data
          # Can't download by artifact ID; stupid missing feature!
          merge-multiple: true
      - name: Check data downloaded
        run: |
          ls -AlR
        working-directory: data
      - name: Transfer built files
        # https://github.com/marketplace/actions/rsync-deployments-action
        uses: burnett01/rsync-deployments@7.0.1
        id: rsync
        if: false  # Disabled... for now
        with:
          # I don't know what the right switches are here, BTW
          switches: -avzr
          path: data/
          remote_path: ${{ env.REMOTE_PATH }}
          remote_host: ${{ vars.PUBLISH_HOST }}
          remote_user: ${{ vars.PUBLISH_USER }}
          remote_key: ${{ secrets.DEPLOY_HOST_KEY }}
          # MUST be a literal passwordless key
      - name: Publish files
        # https://github.com/marketplace/actions/ssh-remote-commands
        uses: appleboy/ssh-action@v1.2.0
        id: ssh
        if: steps.rsync.outcome == 'success'
        with:
          host: ${{ vars.PUBLISH_HOST }}
          username: ${{ vars.PUBLISH_USER }}
          key: ${{ secrets.DEPLOY_HOST_KEY }}
          script: |
            ${{ vars.PUBLISHER_SCRIPT }} ${{ env.REMOTE_PATH }} ${{ github.ref_type }} ${{ github.ref_name }}
      - name: Report what would be done
        if: steps.rsync.outcome == 'skipped'
        env:
          SWITCHES: -av
          LOCAL_PATH: data/
          REMOTE_HOST: ${{ vars.PUBLISH_HOST }}
          REMOTE_USER: ${{ vars.PUBLISH_USER }}
          REMOTE_SCRIPT: |
            ${{ vars.PUBLISHER_SCRIPT }} ${{ env.REMOTE_PATH }} ${{ github.ref_type }} ${{ github.ref_name }}
        run: |
          echo "would run: rsync $SWITCHES $LOCAL_PATH $REMOTE_USER@$REMOTE_HOST:$REMOTE_PATH"
          echo "would run: ssh $REMOTE_USER@$REMOTE_HOST $REMOTE_SCRIPT"
      # Consider https://github.com/marketplace/actions/slack-notify maybe?

# README:  Tcl

This is the **Tcl 9.0.2** source distribution.

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

9.0 (production release, daily build)
[![Build Status](https://github.com/tcltk/tcl/actions/workflows/linux-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions/workflows/linux-build.yml?query=branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/actions/workflows/win-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions/workflows/win-build.yml?query=branch%3Amain)

The source code for Tcl is managed by fossil.  Tcl developers coordinate all
changes to the Tcl source code at

> [Tcl Source Code](https://core.tcl-lang.org/tcl/timeline)

Release Tcl 9.0.2 arises from the check-in with tag `core-9-0-2`.

Tcl patch releases have the primary purpose of delivering bug fixes
to the userbase.

# Bug fixes
 - Better error-message than "interpreter uses an incompatible stubs mechanism"](https://core.tcl-lang.org/tcl/tktview/fc3509)

# Incompatibilities
 - No known incompatibilities with the Tcl 9.0.0 public interface.

# Updated bundled packages, libraries, standards, data
 - sqlite3 3.48.0

Release Tcl 9.0.1 arises from the check-in with tag `core-9-0-1`.

Tcl patch releases have the primary purpose of delivering bug fixes
to the userbase.  As the first patch release in the Tcl 9.0.\* series,
Tcl 9.0.1 also includes a small number of interface changes that complete
some incomplete features first delivered in Tcl 9.0.0.

# Completed 9.0 Features and Interfaces
 - [TIP 701 - Tcl_FSTildeExpand C API](https://core.tcl-lang.org/tips/doc/trunk/tip/701.md)
 - [TIP 707 - ptrAndSize internal rep in Tcl_Obj](https://core.tcl-lang.org/tips/doc/trunk/tip/707.md)
 - [Size modifiers j, q, z, t not implemented]( https://core.tcl-lang.org/tcl/info/c4f365)

# Bug fixes
 - [regression in tzdata, %z instead of offset TZ-name](https://core.tcl-lang.org/tcl/tktview/2c237b)
 - [Tcl will not start properly if there is an init.tcl file in the current dir](https://core.tcl-lang.org/tcl/tktview/43c94f)
 - [clock scan "24:00", ISO-8601 compatibility](https://core.tcl-lang.org/tcl/tktview/aee9f2)
 - [Temporary folder with file "tcl9registry13.dll" remains after "exit"](https://core.tcl-lang.org/tcl/tktview/6ce3c0)
 - [Wrong result by "lsearch -stride -subindices -inline -all"](https://core.tcl-lang.org/tcl/info/5a1aaa)
 - [TIP 609 - required Tcl_ThreadAlert() skipped with nested event loop](https://core.tcl-lang.org/tcl/info/c7e4c4)
 - [buffer overwrite for non-BMP characters in utf-16](https://core.tcl-lang.org/tcl/tktview/66da4d)
 - [zipfs info on mountpoint of executable returns zero offset in field 4"](https://core.tcl-lang.org/tcl/info/aaa84f)
 - [zlib-8.8, zlib-8.16 fail on Fedora 40, gcc 14.1.1](https://core.tcl-lang.org/tcl/tktview/73d5cb)
 - [install registry and dde in $INSTALL_DIR\lib always](https://core.tcl-lang.org/tcl/tktview/364bd9)
 - [cannot build .chm help file (Windows)](https://core.tcl-lang.org/tcl/tktview/bb110c)

# Incompatibilities
 - No known incompatibilities with the Tcl 9.0.0 public interface.

# Updated bundled packages, libraries, standards, data
 - Itcl 4.3.2
 - sqlite3 3.47.2
 - Thread 3.0.1
 - TDBC\* 1.1.10
 - tcltest 2.5.9
 - tzdata 2024b, corrected

Release Tcl 9.0.0 arises from the check-in with tag `core-9-0-0`.

Highlighted differences between Tcl 9.0 and Tcl 8.6 are summarized below,
with focus on changes important to programmers using the Tcl library and
writing Tcl scripts.

 - configurable properties
 - `method -export`, `method -unexport`

# Known bugs
 - [changed behaviour wrt command names, namespaces and resolution](https://core.tcl-lang.org/tcl/tktview/f14b33)
 - [windows dos device paths inconsistencies and missing functionality](https://core.tcl-lang.org/tcl/tktview/d8f121)
 - [load library (dll) from zipfs-library causes a leak in temporary folder](https://core.tcl-lang.org/tcl/tktview/a8e4f7)

 - [lsearch -sorted -inline -subindices incorrect result](https://core.tcl-lang.org/tcl/tktview/bc4ac0)
 - ["No error" when load fails due to a missing secondary DLL](https://core.tcl-lang.org/tcl/tktview/bc4ac0)

\fBTcl_InitStubs\fR(\fIinterp, version, exact\fR)
.fi
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Tcl interpreter handle.
.AP "const char" *version in
A version string, indicating which minimal version of Tcl is accepted.
Normally just \fB"9.0"\fR. Or \fB"8.6-"\fR if both 8.6 and 9.0 are accepted.
.AP int exact in
1 means that only the particular version specified by
\fIversion\fR is accepted.
0 means that versions newer than \fIversion\fR are also
accepted. If the\fIversion\fR ends with \fB-\fR,
higher major versions are accepted as well, otherwise
the major version must be the same as in \fIversion\fR.
Other bits have no effect.
.BE
.SH INTRODUCTION
.PP
The Tcl stubs mechanism defines a way to dynamically bind
extensions to a particular Tcl implementation at run time.
This provides two significant benefits to Tcl users:
.IP 1) 5
Extensions that use the stubs mechanism can be loaded into
multiple versions of Tcl without being recompiled or
relinked, as long as the major Tcl version is the same.
.IP 2) 5
Extensions that use the stubs mechanism can be dynamically
loaded into statically-linked Tcl applications.
.PP
The stubs mechanism accomplishes this by exporting function tables
that define an interface to the Tcl API.  The extension then accesses
the Tcl API through offsets into the function table, so there are no

with the Tk stubs libraries.  See the \fBTk_InitStubs\fR page for
more information.
.SH DESCRIPTION
\fBTcl_InitStubs\fR attempts to initialize the stub table pointers
and ensure that the correct version of Tcl is loaded.  In addition
to an interpreter handle, it accepts as arguments a version number
and a Boolean flag indicating whether the extension requires
an exact version match or not.  If \fIexact\fR is 0, then versions
newer than \fIversion\fR are also accepted. If the\fIversion\fR
ends with \fB-\fR, higher major versions are accepted as well,
otherwise the major version must be the same as in \fIversion\fR.
1 means that only the specified \fIversion\fR is accepted.
\fIversion\fR can be any construct as described for \fBpackage require\fR
(\fBPACKAGE\fR manual page in the section \fBREQUIREMENT\fR).
Multiple requirement strings like with \fBpackage require\fR are not supported.

\fBTcl_InitStubs\fR returns a string containing the actual version
of Tcl satisfying the request, or NULL if the Tcl version is not
accepted, does not support stubs, or any other error condition occurred.
.SH "SEE ALSO"
Tk_InitStubs
package
.SH KEYWORDS
stubs

'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_SetWideUIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetSizeIntFromObj, Tcl_GetWideIntFromObj, Tcl_GetWideUIntFromObj, 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

provides value exchange routines are \fBint\fR, \fBlong int\fR,
\fBTcl_WideInt\fR, and \fBmp_int\fR.  The \fBint\fR and \fBlong int\fR types
are provided by the C language standard.  The \fBTcl_WideInt\fR type is a
typedef defined to be whatever signed integral type covers at least the
64-bit integer range (-9223372036854775808 to 9223372036854775807).  Depending
on the platform and the C compiler, the actual type might be
\fBlong long int\fR, or something else.
The \fBTcl_Size\fR typedef is a signed integer type
capable of holding the maximum permitted lengths of Tcl values like
strings and lists. Correspondingly, the preprocessor constant
\fBTCL_SIZE_MAX\fR defines the maximum value that can be stored
in a variable of this type.
The \fBmp_int\fR type is a multiple-precision integer type defined
by the LibTomMath multiple-precision integer library.
.PP
The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR,
\fBTcl_NewWideUIntObj\fR, and \fBTcl_NewBignumObj\fR
routines each create and return a new Tcl value initialized to the
integral value of the argument.  The returned Tcl value is unshared.

\fBTcl_NewObj\fR.
.PP
\fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, and
\fBTcl_SetBignumObj\fR do not modify the reference count of their \fIobjPtr\fR
arguments, but do require that the object be unshared.
.PP
\fBTcl_GetIntFromObj\fR, \fBTcl_GetIntForIndex\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetSizeIntFromObj\fR,
\fBTcl_GetBignumFromObj\fR, and
\fBTcl_TakeBignumFromObj\fR do not modify the reference count of their
\fIobjPtr\fR arguments; they only read. Note however that this function may
set the interpreter result; if that is the only place that is holding a
reference to the object, it will be deleted. Also note that if
\fBTcl_TakeBignumFromObj\fR is given an unshared value, the value of that
object may be modified; it is intended to be used when the value is
.QW consumed

'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsPrivate, Tcl_MethodIsType, Tcl_MethodIsType2, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewInstanceMethod2, Tcl_NewMethod, Tcl_NewMethod2, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
.sp
Tcl_Method
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, flags, methodTypePtr,
              clientData\fR)
.sp
Tcl_Method
\fBTcl_NewMethod2\fR(\fIinterp, class, nameObj, flags, methodType2Ptr,
              clientData\fR)
.sp
Tcl_Method
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, flags, methodTypePtr,
                      clientData\fR)
.sp
Tcl_Method
\fBTcl_NewInstanceMethod2\fR(\fIinterp, object, nameObj, flags, methodType2Ptr,
                      clientData\fR)
.sp
\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
.sp
\fBTcl_ClassSetDestructor\fR(\fIinterp, class, method\fR)
.sp
Tcl_Class
\fBTcl_MethodDeclarerClass\fR(\fImethod\fR)
.sp

.sp
int
\fBTcl_MethodIsPrivate\fR(\fImethod\fR)
.sp
int
\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
.sp
int
\fBTcl_MethodIsType2\fR(\fImethod, methodType2Ptr, clientDataPtr\fR)
.sp
int
\fBTcl_ObjectContextInvokeNext\fR(\fIinterp, context, objc, objv, skip\fR)
.sp
int
\fBTcl_ObjectContextIsFiltering\fR(\fIcontext\fR)
.sp
Tcl_Method

compatibility) for a non-exported method,
.VS TIP500
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
.VE TIP500
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
.AP Tcl_MethodType2 *methodType2Ptr in
A description of the type of the method to create, or the type of method to
compare against.
.AP void *clientData in
A piece of data that is passed to the implementation of the method without
interpretation.
.AP void **clientDataPtr out
A pointer to a variable in which to write the \fIclientData\fR value supplied
when the method was created. If NULL, the \fIclientData\fR value will not be
retrieved.

and whether the method is private is retrieved with \fBTcl_MethodIsPrivate\fR.
.VE TIP500
The type of the method
can also be introspected upon to a limited degree; the function
\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
assigning the per-method \fIclientData\fR to the variable pointed to by
\fIclientDataPtr\fR if (that is non-NULL) if the type is matched.
\fBTcl_MethodIsType2\fR does the same for TCL_OO_METHOD_VERSION_2.
.SS "METHOD CREATION"
.PP
Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
or by \fBTcl_NewMethod2\fR and \fBTcl_NewInstanceMethod2\fR which
create a method attached to a class or an object respectively. In both cases,
the \fInameObj\fR argument gives the name of the method to create, the
\fIflags\fR argument states whether the method should be exported
initially
.VS TIP500
or be marked as a private method,
.VE TIP500
the \fImethodTypePtr\fR or \fImethodType2Ptr\fR (for TCL_OO_METHOD_VERSION_2)
argument describes the implementation of
the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
argument gives some implementation-specific data that is passed on to the
implementation of the method when it is called.
.PP
When the \fInameObj\fR argument to \fBTcl_NewMethod\fR or \fBTcl_NewMethod2\fR is NULL, an
unnamed method is created, which is used for constructors and destructors.
Constructors should be installed into their class using the
\fBTcl_ClassSetConstructor\fR function, and destructors (which must not
require any arguments) should be installed into their class using the
\fBTcl_ClassSetDestructor\fR function. Unnamed methods should not be used for
any other purpose, and named methods should not be used as either constructors
or destructors. Also note that a NULL \fImethodTypePtr\fR or \fImethodType2Ptr\fR is used to provide
internal signaling, and should not be used in client code.
.SS "METHOD CALL CONTEXTS"
.PP
When a method is called, a method-call context reference is passed in as one
of the arguments to the implementation function. This context can be inspected
to provide information about the caller, but should not be retained beyond the
moment when the method call terminates.

implementation has pushed one or more extra frames on the stack as part of its
implementation, it is also responsible for temporarily popping those frames
from the stack while the \fBTcl_ObjectContextInvokeNext\fR function is
executing. Note also that the method-call context is \fInever\fR deleted
during the execution of this function.
.SH "METHOD TYPES"
.PP
The types of methods are described by a pointer to a Tcl_MethodType or
Tcl_MethodType2 (for TCL_OO_METHOD_VERSION_2) structure, which are defined as:
.PP
.CS
typedef struct {
    int \fIversion\fR;
    const char *\fIname\fR;
    Tcl_MethodCallProc *\fIcallProc\fR;
    Tcl_MethodDeleteProc *\fIdeleteProc\fR;
    Tcl_CloneProc *\fIcloneProc\fR;
} \fBTcl_MethodType\fR;

typedef struct {
    int \fIversion\fR;
    const char *\fIname\fR;
    Tcl_MethodCallProc2 *\fIcallProc\fR;
    Tcl_MethodDeleteProc *\fIdeleteProc\fR;
    Tcl_CloneProc *\fIcloneProc\fR;
} \fBTcl_MethodType2\fR;
.CE
.PP

The \fIversion\fR field should always be declared equal to TCL_OO_METHOD_VERSION_CURRENT,
TCL_OO_METHOD_VERSION_1 or TCL_OO_METHOD_VERSION_2. The
\fIname\fR field provides a human-readable name for the type, and is the value
that is exposed via the \fBinfo class methodtype\fR and
\fBinfo object methodtype\fR Tcl commands.
.PP
The \fIcallProc\fR field gives a function that is called when the method is
invoked; it must never be NULL.
.PP

.CS
typedef int \fBTcl_MethodCallProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        Tcl_ObjectContext \fIobjectContext\fR,
        int \fIobjc\fR,
        Tcl_Obj *const *\fIobjv\fR);

typedef int \fBTcl_MethodCallProc2\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        Tcl_ObjectContext \fIobjectContext\fR,
        Tcl_Size \fIobjc\fR,
        Tcl_Obj *const *\fIobjv\fR);
.CE
.PP
The \fIclientData\fR argument to a Tcl_MethodCallProc is the value that was
given when the method was created, the \fIinterp\fR is a place in which to
execute scripts and access variables as well as being where to put the result
of the method, and the \fIobjc\fR and \fIobjv\fR fields give the parameter
objects to the method. The calling context of the method can be discovered

            void *\fIptr1\fR;
            void *\fIptr2\fR;
        } \fItwoPtrValue\fR;
        struct {
            void *\fIptr\fR;
            unsigned long \fIvalue\fR;
        } \fIptrAndLongRep\fR;
        struct {
            void *\fIptr\fR;
            Tcl_Size \fIsize\fR;
        } \fIptrAndSize\fR;
    } \fIinternalRep\fR;
} \fBTcl_Obj\fR;
.CE
.PP
The \fIbytes\fR and the \fIlength\fR members together hold
a value's UTF-8 string representation,
which is a \fIcounted string\fR not containing null bytes (UTF-8 null

If \fItypePtr\fR is NULL,
the internal representation is invalid.
.PP
The \fIinternalRep\fR union member holds
a value's internal representation.
This is either a (long) integer, a double-precision floating-point number,
a pointer to a value containing additional information
needed by the value's type to represent the value, a \fBTcl_WideInt\fR
integer, two arbitrary pointers, a pair made up of a pointer and an unsigned long
integer, or a pair made up of a pointer and \fBTcl_Size\fR which is a signed integer
type capable of holding the maximum lengths permitted in Tcl.
.PP
The \fIrefCount\fR member is used to tell when it is safe to free
a value's storage.
It holds the count of active references to the value.
Maintaining the correct reference count is a key responsibility
of extension writers.
Reference counting is discussed below

it returns -1;
.PP
\fBTcl_GetRange\fR returns a newly created value comprised of the
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the value's
Unicode representation.  If the value's Unicode representation
is invalid, the Unicode representation is regenerated from the value's
string representation.  If \fIfirst\fR is negative, then the returned
string starts at the beginning of the value. If \fIlast\fR is negative,
then the returned string ends at the end of the value.
.PP
\fBTcl_GetCharLength\fR returns the number of characters (as opposed
to bytes) in the string value.
.PP
\fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and
\fIlength\fR to the string representation of the value specified by

Tcl_Obj *newPtr = \fBTcl_ObjPrintf\fR(format, ...);
\fBTcl_AppendObjToObj\fR(objPtr, newPtr);
\fBTcl_DecrRefCount\fR(newPtr);
.CE
.PP
but with greater convenience and efficiency when the appending
functionality is needed.
.PP
When printing integer types defined by Tcl, such as \fBTcl_Size\fR
or \fBTcl_WideInt\fR, a format size specifier is needed as the
integer width of those types is dependent on the Tcl version,
platform and compiler. To accomodate these differences, Tcl defines
C preprocessor symbols \fBTCL_LL_MODIFER\fR and
\fBTCL_SIZE_MODIFER\fR for use when formatting values of type
\fBTcl_WideInt\fR and \fBTcl_Size\fR respectively. Their usage
is illustrated by
.PP
.CS
Tcl_WideInt wide;
Tcl_Size len;
Tcl_Obj *wideObj = Tcl_ObjPrintf("wide = %" \fBTCL_LL_MODIFIER\fR "d", wide);
Tcl_Obj *lenObj = Tcl_ObjPrintf("len = %" \fBTCL_SIZE_MODIFIER\fR "d", len);
.CE
.PP
The \fBTcl_SetObjLength\fR procedure changes the length of the
string value of its \fIobjPtr\fR argument.  If the \fInewLength\fR
argument is greater than the space allocated for the value's
string, then the string space is reallocated and the old value
is copied to the new space; the bytes between the old length of
the string and the new length may have arbitrary values.

the start of the application.
.PP
.CS
package require http
\fBpackage require cookiejar\fR

set cookiedb [file join [file home] cookiejar]
http::config -cookiejar [\fBhttp::cookiejar new\fR $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl-lang.org/]
.CE
.PP
To only allow a particular domain to use cookies, perhaps because you only
want to enable a particular host to create and manipulate sessions, create a

indicate which package is wanted, and the command ensures that
a suitable version of the package is loaded into the interpreter.
If the command succeeds, it returns the version number that is
loaded;  otherwise it generates an error.
.RS
.PP
A suitable version of the package is any version which satisfies at
least one of the requirements as defined in the section \fBREQUIREMENT\fR below.
If multiple versions are suitable the implementation
with the highest version is chosen. This last part is additionally
influenced by the selection mode set with \fBpackage prefer\fR.
.PP
In the
.QW stable
selection mode the command will select the highest
stable version satisfying the requirements, if any. If no stable

for which information has been provided by \fBpackage ifneeded\fR
commands.
.\" METHOD: vsatisfies
.TP
\fBpackage vsatisfies \fIversion requirement...\fR
.
Returns 1 if the \fIversion\fR satisfies at least one of the given
requirements, and 0 otherwise. \fIrequirements\fR are defined in the \fBREQUIREMENT\fR section below.























































.\" METHOD: prefer
.TP
\fBpackage prefer \fR?\fBlatest\fR|\fBstable\fR?
.
With no arguments, the commands returns either
.QW latest
or

.PP
The recommended way to use packages in Tcl is to invoke \fBpackage require\fR
and \fBpackage provide\fR commands in scripts, and use the procedure
\fBpkg_mkIndex\fR to create package index files.
Once you have done this, packages will be loaded automatically
in response to \fBpackage require\fR commands.
See the documentation for \fBpkg_mkIndex\fR for details.
.SH "REQUIREMENT"
.PP
A \fIrequirement\fR string checks, if a compatible version number of a package is present.
Most commands accept a list of requirement strings where the highest suitable version is matched.
.PP
Each \fIrequirement\fR is allowed to have any of the forms:
.RS
.IP \fImin\fR
This form is called
.QW min-bounded .
.IP \fImin\fB\-\fR
This form is called
.QW min-unbound .
.IP \fImin\fB\-\fImax\fR
This form is called
.QW bounded .
.PP
where
.QW \fImin\fR
and
.QW \fImax\fR
are valid version numbers. The legacy syntax is
a special case of the extended syntax, keeping backward
compatibility. Regarding satisfaction the rules are:
.IP [1]
The \fIversion\fR has to pass at least one of the listed
\fIrequirement\fRs to be satisfactory.
.IP [2]
A version satisfies a
.QW bounded
requirement when
.RS
.IP [a]
For \fImin\fR equal to the \fImax\fR if, and only if the \fIversion\fR
is equal to the \fImin\fR.
.IP [b]
Otherwise if, and only if the \fIversion\fR is greater than or equal
to the \fImin\fR, and less than the \fImax\fR, where both \fImin\fR
and \fImax\fR have been padded internally with
.QW a0 .
Note that while the comparison to \fImin\fR is inclusive, the
comparison to \fImax\fR is exclusive.
.RE
.IP [3]
A
.QW min-bounded
requirement is a
.QW bounded
requirement in disguise,
with the \fImax\fR part implicitly specified as the next higher major
version number of the \fImin\fR part. A version satisfies it per the
rules above.
.IP [4]
A \fIversion\fR satisfies a
.QW min-unbound
requirement if, and only if it is greater than or equal to the
\fImin\fR, where the \fImin\fR has been padded internally with
.QW a0 .
There is no constraint to a maximum.
.RE
.SH EXAMPLES
.PP
To state that a Tcl script requires the Tk and http packages, put this
at the top of the script:
.PP
.CS
\fBpackage require\fR Tk

#if !defined(TCL_MAJOR_VERSION)
#   define TCL_MAJOR_VERSION	9
#endif
#if TCL_MAJOR_VERSION == 9
#   define TCL_MINOR_VERSION	0
#   define TCL_RELEASE_LEVEL	TCL_FINAL_RELEASE
#   define TCL_RELEASE_SERIAL	2

#   define TCL_VERSION		"9.0"
#   define TCL_PATCH_LEVEL	"9.0.2"
#endif /* TCL_MAJOR_VERSION */

#if defined(RC_INVOKED)
/*
 * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
 * quotation marks), JOIN joins two arguments.
 */

#define Tcl_WideAsLong(val)	((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val)	((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))

#if TCL_MAJOR_VERSION < 9
# ifndef Tcl_Size
    typedef int Tcl_Size;
# endif
# ifndef TCL_SIZE_MAX
#   define TCL_SIZE_MAX ((int)(((unsigned int)-1)>>1))
# endif
# ifndef TCL_SIZE_MODIFIER
#   define TCL_SIZE_MODIFIER ""
#endif
#else
    typedef ptrdiff_t Tcl_Size;
#   define TCL_SIZE_MAX ((Tcl_Size)(((size_t)-1)>>1))
#   define TCL_SIZE_MODIFIER TCL_T_MODIFIER
#endif /* TCL_MAJOR_VERSION */

#ifdef _WIN32

	void *ptr1;
	void *ptr2;
    } twoPtrValue;
    struct {			/*   - internal rep as a pointer and a long, */
	void *ptr;		/*     not used internally any more. */
	unsigned long value;
    } ptrAndLongRep;
    struct {			/*   - use for pointer and length reps */
	void *ptr;
	Tcl_Size size;
    } ptrAndSize;
} Tcl_ObjInternalRep;

/*
 * One of the following structures exists for each object in the Tcl system.
 * An object stores a value as either a string, some internal representation,
 * or both.
 */

 * Unicode character in UTF-8. The valid values are 3 and 4. If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
 * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
 * mode is the default and recommended mode.
 */

#ifndef TCL_UTF_MAX
#   if defined(BUILD_tcl) || TCL_MAJOR_VERSION > 8
#	define TCL_UTF_MAX		4
#   else
#	define TCL_UTF_MAX		3
#   endif
#endif

/*

const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
			    int exact, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);
const char *		TclInitStubTable(const char *version);
void *			TclStubCall(void *arg);
#if defined(_WIN32)
    TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic ((Tcl_PanicProc *)NULL)
#endif

#ifdef USE_TCL_STUBS
#if TCL_MAJOR_VERSION < 9
# if TCL_UTF_MAX < 4

#endif

/*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \

	    ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp())))
EXTERN TCL_NORETURN void Tcl_MainEx(Tcl_Size argc, char **argv,
			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
			    const char *version, int exact);
EXTERN const char *	Tcl_InitSubsystems(void);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
EXTERN const char *	Tcl_FindExecutable(const char *argv0);
EXTERN const char *	Tcl_SetPreInitScript(const char *string);
EXTERN const char *	Tcl_SetPanicProc(
			    Tcl_PanicProc *panicProc);
EXTERN void		Tcl_StaticLibrary(Tcl_Interp *interp,
			    const char *prefix,
			    Tcl_LibraryInitProc *initProc,
			    Tcl_LibraryInitProc *safeInitProc);
#ifndef TCL_NO_DEPRECATED
#   define Tcl_StaticPackage Tcl_StaticLibrary
#endif
EXTERN Tcl_ExitProc *	Tcl_SetExitProc(Tcl_ExitProc *proc);
#ifdef _WIN32
EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
#if defined(_WIN32) && defined(UNICODE)
#ifndef USE_TCL_STUBS
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#endif

 * but it's faster to cache it inside the internal representation.
 */

typedef struct {
    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
    Tcl_Size refCount;
} ArithSeries;

typedef struct {
    ArithSeries base;
    Tcl_WideInt start;

    Tcl_WideInt step;
} ArithSeriesInt;

typedef struct {
    ArithSeries base;
    double start;

    double step;
    unsigned precision;		/* Number of decimal places to render. */
} ArithSeriesDbl;

/* Forward declarations. */

static int		TclArithSeriesObjIndex(TCL_UNUSED(Tcl_Interp *),

static void		FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr);
static void		UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr);
static int		SetArithSeriesFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		ArithSeriesInOperation(Tcl_Interp *interp,
			    Tcl_Obj *valueObj, Tcl_Obj *arithSeriesObj,
			    int *boolResult);



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

static const Tcl_ObjType arithSeriesType = {
    "arithseries",			/* name */
    FreeArithSeriesInternalRep,		/* freeIntRepProc */
    DupArithSeriesInternalRep,		/* dupIntRepProc */

 *   in the arithSeries
 */

static inline double
power10(
    unsigned n)
{
    /* few "precomputed" powers (note, max double is mostly 1.7e+308) */
    static const double powers[] = {
	1, 10, 100, 1000, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, 1e10,
	1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20,
	1e21, 1e22, 1e23, 1e24, 1e25, 1e26, 1e27, 1e28, 1e29, 1e30,
	1e31, 1e32, 1e33, 1e34, 1e35, 1e36, 1e37, 1e38, 1e39, 1e40,
	1e41, 1e42, 1e43, 1e44, 1e45, 1e46, 1e47, 1e48, 1e49, 1e50
    };

    if (n < sizeof(powers) / sizeof(*powers)) {
	return powers[n];
    } else {
	// Not an expected case. Doesn't need to be so fast
	return pow(10, n);
    }
}

static inline double
ArithRound(
    double d,
    unsigned n)
{
    double scaleFactor;

    if (!n) {
	return d;
    }
    scaleFactor = power10(n);
    return round(d * scaleFactor) / scaleFactor;
}

static inline double
ArithSeriesEndDbl(
    ArithSeriesDbl *dblRepPtr)
{
    double d;
    if (!dblRepPtr->base.len) {
	return dblRepPtr->start;
    }
    d = dblRepPtr->start + ((dblRepPtr->base.len-1) * dblRepPtr->step);
    return ArithRound(d, dblRepPtr->precision);
}

static inline Tcl_WideInt
ArithSeriesEndInt(
    ArithSeriesInt *intRepPtr)
{
    if (!intRepPtr->base.len) {
	return intRepPtr->start;
    }
    return intRepPtr->start + ((intRepPtr->base.len-1) * intRepPtr->step);
}

static inline double
ArithSeriesIndexDbl(
    ArithSeries *arithSeriesRepPtr,
    Tcl_WideInt index)
{

    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl *)arithSeriesRepPtr;
    assert(arithSeriesRepPtr->isDouble);
    double d = dblRepPtr->start;
    if (index) {
	d += (index * dblRepPtr->step);
    }





    return ArithRound(d, dblRepPtr->precision);
}

static inline Tcl_WideInt
ArithSeriesIndexInt(
    ArithSeries *arithSeriesRepPtr,
    Tcl_WideInt index)
{




    ArithSeriesInt *intRepPtr = (ArithSeriesInt *)arithSeriesRepPtr;
    assert(!arithSeriesRepPtr->isDouble);
    return intRepPtr->start + (index * intRepPtr->step);

}

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

/*
 * Compute number of significant fractional digits
 */
static inline unsigned
ObjPrecision(
    Tcl_Obj *numObj)
{
    void *ptr;
    int type;

    if (TclHasInternalRep(numObj, &tclDoubleType) || (
	  Tcl_GetNumberFromObj(NULL, numObj, &ptr, &type) == TCL_OK &&
	  type == TCL_NUMBER_DOUBLE
	)
    ) { /* TCL_NUMBER_DOUBLE */
	const char *str = TclGetString(numObj);

	if (strchr(str, 'e') == NULL && strchr(str, 'E') == NULL) {
	    str = strchr(str, '.');
	    return (str ? strlen(str + 1) : 0);
	}
	/* don't calculate precision for e-notation */
    }
    /* no fraction for TCL_NUMBER_NAN, TCL_NUMBER_INT, TCL_NUMBER_BIG */
    return 0;
}

/*
 * Find longest number of digits after the decimal point.
 */
static inline unsigned
maxObjPrecision(
    Tcl_Obj *start,
    Tcl_Obj *end,
    Tcl_Obj *step)
{
    unsigned i, dp = 0;
    if (step) {
	dp = ObjPrecision(step);
    }
    if (start) {
	i = ObjPrecision(start);
	if (i > dp) {
	    dp = i;
	}
    }
    if (end) {
	i = ObjPrecision(end);
	if (i > dp) {
	    dp = i;
	}
    }
    return dp;
}

/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesLen --

    Tcl_WideInt step)
{
    Tcl_WideInt len;

    if (step == 0) {
	return 0;
    }
    len = (end - start) / step + 1;
    if (len < 0) {
	return 0;
    }
    return len;
}

static Tcl_WideInt
ArithSeriesLenDbl(
    double start,
    double end,
    double step,
    unsigned precision)
{
    double scaleFactor;
    volatile double len; /* use volatile for more deterministic cross-platform
			  * FP arithmetics, (e. g. to avoid wrong optimization
			  * and divergent results by different compilers/platforms
			  * with and w/o FPU_INLINE_ASM, _CONTROLFP, etc) */

    if (step == 0) {
	return 0;
    }
    if (precision) {
	scaleFactor = power10(precision);
	start *= scaleFactor;
	end *= scaleFactor;
	step *= scaleFactor;
    }
    /* distance */
    end -= start;
    /*
     * To improve numerical stability use wide arithmetic instead of IEEE-754
     * when distance and step do not exceed wide-integers.
     */
    if (
	((double)WIDE_MIN <= end && end <= (double)WIDE_MAX) &&
	((double)WIDE_MIN <= step && step <= (double)WIDE_MAX)
    ) {
	Tcl_WideInt iend = end < 0 ? end - 0.5 : end + 0.5;
	Tcl_WideInt istep = step < 0 ? step - 0.5 : step + 0.5;
	if (istep) { /* avoid div by zero, steps like 0.1, precision 0 */
	    return (iend / istep) + 1;
	}
    }
    /*
     * Too large, so use double (note the result may be instable due
     * to IEEE-754, so to be as precise as possible we'll use volatile len)
     */
    len = (end / step) + 1;
    if (len >= (double)TCL_SIZE_MAX) {
	return TCL_SIZE_MAX;
    }
    if (len < 0) {
	return 0;
    }
    return (Tcl_WideInt)len;
}

/*
 *----------------------------------------------------------------------
 *
 * DupArithSeriesInternalRep --
 *

DupArithSeriesInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    ArithSeries *srcRepPtr = (ArithSeries *)
	    srcPtr->internalRep.twoPtrValue.ptr1;

    srcRepPtr->refCount++;






    copyPtr->internalRep.twoPtrValue.ptr1 = srcRepPtr;









    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &arithSeriesType;
}

/*
 *----------------------------------------------------------------------
 *

{
    if (arithSeriesRepPtr->elements) {
	Tcl_WideInt i, len = arithSeriesRepPtr->len;

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

static void
FreeArithSeriesInternalRep(
    Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)
	    arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;

    if (arithSeriesRepPtr && arithSeriesRepPtr->refCount-- <= 1) {
	FreeElements(arithSeriesRepPtr);
	Tcl_Free((void *)arithSeriesRepPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NewArithSeriesInt --

 *	None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj *
NewArithSeriesInt(
    Tcl_WideInt start,

    Tcl_WideInt step,
    Tcl_WideInt len)
{
    Tcl_WideInt length;
    Tcl_Obj *arithSeriesObj;
    ArithSeriesInt *arithSeriesRepPtr;

	return arithSeriesObj;
    }

    arithSeriesRepPtr = (ArithSeriesInt *) Tcl_Alloc(sizeof(ArithSeriesInt));
    arithSeriesRepPtr->base.len = length;
    arithSeriesRepPtr->base.elements = NULL;
    arithSeriesRepPtr->base.isDouble = 0;
    arithSeriesRepPtr->base.refCount = 1;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->step = step;
    arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    arithSeriesObj->typePtr = &arithSeriesType;
    if (length > 0) {
	Tcl_InvalidateStringRep(arithSeriesObj);
    }

 * Side Effects:
 *	None.
 *----------------------------------------------------------------------
 */
static Tcl_Obj *
NewArithSeriesDbl(
    double start,

    double step,
    Tcl_WideInt len,
    unsigned precision)
{
    Tcl_WideInt length;
    Tcl_Obj *arithSeriesObj;
    ArithSeriesDbl *arithSeriesRepPtr;

    length = len>=0 ? len : -1;
    if (length < 0) {
	length = -1;
    }

    TclNewObj(arithSeriesObj);

    if (length <= 0) {
	return arithSeriesObj;
    }

    arithSeriesRepPtr = (ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl));
    arithSeriesRepPtr->base.len = length;
    arithSeriesRepPtr->base.elements = NULL;
    arithSeriesRepPtr->base.isDouble = 1;
    arithSeriesRepPtr->base.refCount = 1;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->precision = precision;
    arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    arithSeriesObj->typePtr = &arithSeriesType;

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

assignNumber(
    Tcl_Interp *interp,
    int useDoubles,
    Tcl_WideInt *intNumberPtr,
    double *dblNumberPtr,
    Tcl_Obj *numberObj)
{
    void *ptr;
    int type;

    if (Tcl_GetNumberFromObj(interp, numberObj, &ptr, &type) != TCL_OK) {

	return TCL_ERROR;
    }
    if (type == TCL_NUMBER_BIG) {
	/* bignum is not supported yet. */
	Tcl_WideInt w;
	(void)Tcl_GetWideIntFromObj(interp, numberObj, &w);
	return TCL_ERROR;
    }
    if (useDoubles) {
	if (type != TCL_NUMBER_INT) {
	    double value = *(double *)ptr;
	    *intNumberPtr = (Tcl_WideInt)value;
	    *dblNumberPtr = value;
	} else {
	    Tcl_WideInt value = *(Tcl_WideInt *)ptr;
	    *intNumberPtr = value;
	    *dblNumberPtr = (double)value;
	}
    } else {
	if (type == TCL_NUMBER_INT) {
	    Tcl_WideInt value = *(Tcl_WideInt *)ptr;
	    *intNumberPtr = value;
	    *dblNumberPtr = (double)value;
	} else {
	    double value = *(double *)ptr;
	    *intNumberPtr = (Tcl_WideInt)value;
	    *dblNumberPtr = value;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

    int useDoubles,           /* Flag indicates values start,
			      ** end, step, are treated as doubles */
    Tcl_Obj *startObj,        /* Starting value */
    Tcl_Obj *endObj,          /* Ending limit */
    Tcl_Obj *stepObj,         /* increment value */
    Tcl_Obj *lenObj)          /* Number of elements */
{
    double dstart, dend, dstep = 1.0;
    Tcl_WideInt start, end, step = 1;
    Tcl_WideInt len = -1;
    Tcl_Obj *objPtr;
    unsigned precision = (unsigned)-1; /* unknown precision */

    if (startObj) {
	if (assignNumber(interp, useDoubles, &start, &dstart, startObj) != TCL_OK) {
	    return NULL;
	}
    } else {
	start = 0;
	dstart = 0.0;
    }
    if (stepObj) {
	if (assignNumber(interp, useDoubles, &step, &dstep, stepObj) != TCL_OK) {
	    return NULL;
	}
	if (!useDoubles ? !step : !dstep) {





	    TclNewObj(objPtr);
	    return objPtr;
	}
    }
    if (endObj) {
	if (assignNumber(interp, useDoubles, &end, &dend, endObj) != TCL_OK) {
	    return NULL;
	}
    }
    if (lenObj) {
	if (Tcl_GetWideIntFromObj(interp, lenObj, &len) != TCL_OK) {
	    return NULL;
	}
    }

    if (endObj) {
	if (!stepObj) {
	    if (useDoubles) {
		if (dstart > dend) {
		    dstep = -1.0;
		    step = -1;
		}
	    } else {
		if (start > end) {
		    step = -1;
		    dstep = -1.0;
		}
	    }
	}
	assert(dstep!=0);
	if (!lenObj) {
	    if (useDoubles) {
		if (isinf(dstart) || isinf(dend)) {
		    goto exceeded;
		}
		if (isnan(dstart) || isnan(dend)) {
		    const char *description = "non-numeric floating-point value";
		    char tmp[TCL_DOUBLE_SPACE + 2];

		    tmp[0] = '\0';
		    Tcl_PrintDouble(NULL, isnan(dstart)?dstart:dend, tmp);
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot use %s \"%s\" to estimate length of arith-series",
			description, tmp));
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description,
			(char *)NULL);
		    return NULL;
		}
		precision = maxObjPrecision(startObj, endObj, stepObj);
		len = ArithSeriesLenDbl(dstart, dend, dstep, precision);
	    } else {
		len = ArithSeriesLenInt(start, end, step);
	    }
	}

    } else {

	if (useDoubles) {
	    // Compute precision based on given command argument values
	    precision = maxObjPrecision(startObj, NULL, stepObj);

	    dend = dstart + (dstep * (len-1));
	    // Make computed end value match argument(s) precision
	    dend = ArithRound(dend, precision);
	    end = dend;
	} else {
	    end = start + (step * (len - 1));
	    dend = end;
	}
    }

    /*
     * todo: check whether the boundary must be rather LIST_MAX, to be more
     * similar to plain lists, otherwise it'd generare an error or panic later
     * (0x0ffffffffffffffa instead of 0x7fffffffffffffff by 64bit)
     */
    if (len > TCL_SIZE_MAX) {
      exceeded:
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"max length of a Tcl list exceeded", TCL_AUTO_LENGTH));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
	return NULL;
    }

    if (useDoubles) {
	/* ensure we'll not get NaN somewhere in the arith-series,
	 * so simply check the end of it and behave like [expr {Inf - Inf}] */
	double d = dstart + (len - 1) * dstep;
	if (isnan(d)) {
	    const char *s = "domain error: argument not in valid range";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *)NULL);
	    return NULL;
	}

	if (precision == (unsigned)-1) {
	    precision = maxObjPrecision(startObj, endObj, stepObj);
	}

	objPtr = NewArithSeriesDbl(dstart, dstep, len, precision);
    } else {
	objPtr = NewArithSeriesInt(start, step, len);
    }

    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjIndex --

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


































 * SetArithSeriesFromAny --
 *
 *	The Arithmetic Series object is just an way to optimize
 *	Lists space complexity, so no one should try to convert
 *	a string to an Arithmetic Series object.
 *
 *	This function is here just to populate the Type structure.

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

    (void)interp; /* silence compiler */

    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

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

    if (fromIdx < 0) {
	fromIdx = 0;
    }
    if (toIdx < 0) {
	toIdx = 0;
    }



    len = toIdx - fromIdx + 1;

    if (arithSeriesRepPtr->isDouble) {

	ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl *)arithSeriesRepPtr;

	double dstart = ArithSeriesIndexDbl(arithSeriesRepPtr, fromIdx);


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


	    /* as new object */
	    *newObjPtr = NewArithSeriesDbl(dstart, dblRepPtr->step, len,



		dblRepPtr->precision);

	} else {

	    /* in-place is possible */

	    *newObjPtr = arithSeriesObj;
	    /*
	     * Even if nothing below causes any changes, we still want the
	     * string-canonizing effect of [lrange 0 end].
	     */

	    TclInvalidateStringRep(arithSeriesObj);








	    dblRepPtr->start = dstart;
	    /* step and precision remain the same */
	    dblRepPtr->base.len = len;


	    FreeElements(arithSeriesRepPtr);


	}
    } else {
	ArithSeriesInt *intRepPtr = (ArithSeriesInt *) arithSeriesRepPtr;
	Tcl_WideInt start = ArithSeriesIndexInt(arithSeriesRepPtr, fromIdx);

	if (Tcl_IsShared(arithSeriesObj) || ((arithSeriesRepPtr->refCount > 1))) {
	    /* as new object */
	    *newObjPtr = NewArithSeriesInt(start, intRepPtr->step, len);
	} else {
	    /* in-place is possible. */
	    *newObjPtr = arithSeriesObj;
	    /*
	     * Even if nothing below causes any changes, we still want the
	     * string-canonizing effect of [lrange 0 end].
	     */
	    TclInvalidateStringRep(arithSeriesObj);

	    intRepPtr->start = start;
	    /* step remains the same */
	    intRepPtr->base.len = len;

	    FreeElements(arithSeriesRepPtr);

	}
    }





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

int
TclArithSeriesObjReverse(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to reverse. */
    Tcl_Obj **newObjPtr)
{
    ArithSeries *arithSeriesRepPtr;

    Tcl_Obj *resultObj;




    (void)interp;

    assert(newObjPtr != NULL);



    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    if (Tcl_IsShared(arithSeriesObj) || (arithSeriesRepPtr->refCount > 1)) {
	if (arithSeriesRepPtr->isDouble) {
	    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl *)arithSeriesRepPtr;




	    resultObj = NewArithSeriesDbl(ArithSeriesEndDbl(dblRepPtr),

		-dblRepPtr->step, arithSeriesRepPtr->len, dblRepPtr->precision);






	} else {






	    ArithSeriesInt *intRepPtr = (ArithSeriesInt *)arithSeriesRepPtr;
	    resultObj = NewArithSeriesInt(ArithSeriesEndInt(intRepPtr),
		-intRepPtr->step, arithSeriesRepPtr->len);
	}




    } else {
	/*
	 * In-place is possible.
	 */

	TclInvalidateStringRep(arithSeriesObj);

	if (arithSeriesRepPtr->isDouble) {
	    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl *)arithSeriesRepPtr;

	    dblRepPtr->start = ArithSeriesEndDbl(dblRepPtr);

	    dblRepPtr->step = -dblRepPtr->step;
	    /* precision remains the same */
	} else {
	    ArithSeriesInt *intRepPtr = (ArithSeriesInt *)arithSeriesRepPtr;

	    intRepPtr->start = ArithSeriesEndInt(intRepPtr);
	    intRepPtr->step = -intRepPtr->step;
	}
	FreeElements(arithSeriesRepPtr);
	resultObj = arithSeriesObj;
    }





    *newObjPtr = resultObj;

    return resultObj ? TCL_OK : TCL_ERROR;
}

/*
 *----------------------------------------------------------------------

static void
UpdateStringOfArithSeries(
    Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)
	    arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
    char *p;

    Tcl_Size i, bytlen = 0;

    if (!arithSeriesRepPtr->len) {
	TclInitEmptyStringRep(arithSeriesObjPtr);
	return;
    }

    /*
     * Pass 1: estimate space.
     */
    if (!arithSeriesRepPtr->isDouble) {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = (double)ArithSeriesIndexInt(arithSeriesRepPtr, i);
	    Tcl_Size slen = d>0 ? log10(d)+1 : d<0 ? log10(-d)+2 : 1;

	    bytlen += slen;
	}
    } else {
	char tmp[TCL_DOUBLE_SPACE + 2];
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);


	    tmp[0] = '\0';
	    Tcl_PrintDouble(NULL,d,tmp);
	    bytlen += strlen(tmp);
	    if (bytlen > TCL_SIZE_MAX) {
		/* overflow, todo: check we could use some representation instead of the panic
		 * to signal it is too large for string representation, because too heavy */
		Tcl_Panic("UpdateStringOfArithSeries: too large to represent");
	    }

	}
    }
    bytlen += arithSeriesRepPtr->len; // Space for each separator

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

    p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, bytlen);
    if (!arithSeriesRepPtr->isDouble) {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    Tcl_WideInt d = ArithSeriesIndexInt(arithSeriesRepPtr, i);
	    p += TclFormatInt(p, d);
	    assert(p - arithSeriesObjPtr->bytes <= bytlen);
	    *p++ = ' ';
	}
    } else {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);

	    *p = '\0';
	    Tcl_PrintDouble(NULL,d,p);
	    p += strlen(p);


	    assert(p - arithSeriesObjPtr->bytes <= bytlen);
	    *p++ = ' ';
	}


    }
    *(--p) = '\0';
    arithSeriesObjPtr->length = p - arithSeriesObjPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesInOperator --
 *

#endif /* !TCL_FPCLASSIFY_MODE */

/*
 * Bug 7371b6270b: to check C call stack depth, prefer an approach which is
 * compatible with AddressSanitizer (ASan) use-after-return detection.
 */

#if defined(_MSC_VER)
#include <intrin.h> /* for _AddressOfReturnAddress() */
#endif

/*
 * As suggested by
 * https://clang.llvm.org/docs/LanguageExtensions.html#has-builtin
 */
#ifndef __has_builtin
#define __has_builtin(x) 0 /* for non-clang compilers */
#endif

void *
TclGetCStackPtr(void)
{
#if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address)
    return __builtin_frame_address(0);
#elif defined(_MSC_VER)
    return _AddressOfReturnAddress();
#else
    ptrdiff_t unused = 0;
    /*
     * LLVM recommends using volatile:
     * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31
     */

	return FP_NAN;
    }
#else /* TCL_FPCLASSIFY_MODE not in (0..3) */
#error "unknown or unexpected TCL_FPCLASSIFY_MODE"
#endif /* TCL_FPCLASSIFY_MODE */
#endif /* !fpclassify */
}

static inline int
DoubleObjClass(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,		/* Object with double to get its class. */
    int *fpClsPtr)		/* FP class retrieved for double in object. */
{
    double d;
    void *ptr;
    int type;

    if (Tcl_GetNumberFromObj(interp, objPtr, &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }
    switch (type) {
      case TCL_NUMBER_NAN:
	*fpClsPtr = FP_NAN;
	return TCL_OK;
      case TCL_NUMBER_DOUBLE:
	d = *((const double *) ptr);
	break;
      case TCL_NUMBER_INT:
	d = (double)*((const Tcl_WideInt *) ptr);
	break;
      default:
	if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
	    return TCL_ERROR;
	}
	break;
    }
    *fpClsPtr = ClassifyDouble(d);
    return TCL_OK;
}
static inline int
DoubleObjIsClass(
    Tcl_Interp *interp,
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv,	/* Actual parameter list */
    int cmpCls,			/* FP class to compare. */
    int positive)		/* 1 if compare positive, 0 - otherwise  */
{
    int dCls;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (DoubleObjClass(interp, objv[1], &dCls) != TCL_OK) {
	return TCL_ERROR;
    }
    dCls = (
	positive
	    ? (dCls == cmpCls)
	    : (dCls != cmpCls && dCls != FP_NAN)
    ) ? 1 : 0;
    Tcl_SetObjResult(interp, ((Interp *)interp)->execEnvPtr->constants[dCls]);
    return TCL_OK;
}

static int
ExprIsFiniteFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{



    return DoubleObjIsClass(interp, objc, objv, FP_INFINITE, 0);

















}

static int
ExprIsInfinityFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{



    return DoubleObjIsClass(interp, objc, objv, FP_INFINITE, 1);
















}

static int
ExprIsNaNFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{



    return DoubleObjIsClass(interp, objc, objv, FP_NAN, 1);
















}

static int
ExprIsNormalFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{



    return DoubleObjIsClass(interp, objc, objv, FP_NORMAL, 1);
















}

static int
ExprIsSubnormalFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{



    return DoubleObjIsClass(interp, objc, objv, FP_SUBNORMAL, 1);
















}

static int
ExprIsUnorderedFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{


    int dCls, dCls2;

    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }




    if (





	DoubleObjClass(interp, objv[1], &dCls) != TCL_OK ||
	DoubleObjClass(interp, objv[2], &dCls2) != TCL_OK
    ) {
	return TCL_ERROR;
    }






    dCls = ((dCls == FP_NAN) || (dCls2 == FP_NAN)) ? 1 : 0;
    Tcl_SetObjResult(interp, ((Interp *)interp)->execEnvPtr->constants[dCls]);
    return TCL_OK;
}

static int
FloatClassifyObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the

		if (returnSubindices && (sortInfo.indexc != 0)) {
		    Tcl_BounceRefCount(itemPtr);
		    itemPtr = SelectObjFromSublist(listv[i+groupOffset],
			    &sortInfo);
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		} else if (returnSubindices && (sortInfo.indexc == 0) && (groupSize > 1)) {
		    Tcl_BounceRefCount(itemPtr);
		    itemPtr = listv[i + groupOffset];
			Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		} else if (groupSize > 1) {
		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
			    groupSize, &listv[i]);
		} else {
		    Tcl_BounceRefCount(itemPtr);

	    allowedArgs = RangeKeywordArg;
	    /* if last number but 2 arguments remain, next is not numeric */
	    if ((remNums != 1) || ((objc-1-i) != 2)) {
		allowedArgs |= NumericArg;
	    }
	    numValues[value_i] = numberObj;
	    values[value_i] = keyword;  /* TCL_NUMBER_* */
	    if ((keyword == TCL_NUMBER_DOUBLE || keyword == TCL_NUMBER_NAN)) {
		useDoubles++;
	    }
	    value_i++;
	    break;

	  case RangeKeywordArg:
	    arg_key += RangeKeywordArg;
	    allowedArgs = NumericArg;   /* after keyword always numeric only */
	    values[value_i] = keyword;  /* SequenceOperators */

/*    lseq n */
    case 1:
	start = zero;
	elementCount = numValues[0];
	end = NULL;
	step = one;
	useDoubles = 0; /* Can only have Integer value. If a fractional value
			 * is given, this will fail later. In other words,
			 * "3.0" is allowed and used as Integer, but "3.1"
			 * will be flagged as an error. (bug f4a4bd7f1070) */
	break;

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

	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    step = one;
	    break;
	default:
	    goto syntax;
	}
	break;

/*    lseq n 'to' n n    */
/*    lseq n 'count' n n */
    case 1211:
	opmode = (SequenceOperators)values[1];

	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    step = numValues[3];
	    break;
	case LSEQ_BY:
	    /* Error case */
	    goto syntax;
	    break;
	default:
	    goto syntax;
	    break;
	}
	break;

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

/*    lseq n 'to' n 'by' n    */
/*    lseq n 'count' n 'by' n */
    case 12121:
	start = numValues[0];
	opmode = (SequenceOperators)values[3];
	switch (opmode) {
	case LSEQ_BY:
	    step = numValues[4];
	    break;
	default:
	    goto syntax;
	    break;
	}
	opmode = (SequenceOperators)values[1];
	switch (opmode) {
	case LSEQ_DOTS:
	case LSEQ_TO:
	    start = numValues[0];
	    end = numValues[2];
	    break;
	case LSEQ_COUNT:
	    start = numValues[0];
	    elementCount = numValues[2];
	    break;
	default:
	    goto syntax;
	    break;
	}
	break;

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

    /* Count needs to be integer, so try to convert if possible */
    if (elementCount && TclHasInternalRep(elementCount, &tclDoubleType)) {
	double d = elementCount->internalRep.doubleValue;
	/* Don't consider Count type to indicate using double values in seqence */
	useDoubles -= (useDoubles > 0) ? 1 : 0;

	if (!isinf(d) && !isnan(d) && floor(d) == d) {
	    if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) {
		mp_int big;

		if (Tcl_InitBignumFromDouble(NULL, d, &big) == TCL_OK) {
		    elementCount = Tcl_NewBignumObj(&big);
		    keyword = TCL_NUMBER_INT;
		}

	    void *ptr1;
	    void *ptr2;
	} twoPtrValue;
	struct {
	    void *ptr;
	    unsigned long value;
	} ptrAndLongRep;
	struct {
	    void *ptr;
	    Tcl_Size size;
	} ptrAndSize;
    } internalRep;
};

enum return_codes {
    TCL_OK = 0,
    TCL_ERROR,
    TCL_RETURN,

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

/*
 * Bison generates several labels that happen to be unused. Several compilers
 * don't like that, and complain. Simply disable the warning to silence them.
 */

#ifdef _MSC_VER
#pragma warning( disable : 4102 )
#elif defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic ignored "-Wunused-but-set-variable"
#endif

#if 0
#define YYDEBUG 1
#endif

/*
 * yyparse will accept a 'struct DateInfo' as its parameter; that's where the

#define Tcl_SetResult(interp, result, freeProc) \
	do { \
	    const char *__result = result; \
	    Tcl_FreeProc *__freeProc = freeProc; \
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
		if (__freeProc == TCL_DYNAMIC) { \
		    Tcl_Free((void *)__result); \
		} else { \
		    (*__freeProc)((void *)__result); \
		} \
	    } \
	} while(0)

#if defined(USE_TCL_STUBS)
#   if defined(_WIN32) && defined(_WIN64) && TCL_MAJOR_VERSION < 9
#	undef Tcl_GetTime

				/* Information about each EscapeSubTable used
				 * by this encoding type. The actual size is
				 * as large as necessary to hold all
				 * EscapeSubTables. */
} EscapeEncodingData;

/*
 * Values used when loading an encoding file to identify the type of the
 * file.
 */
enum EncodingTypes {
    ENCODING_SINGLEBYTE = 0,	/* Encoding is single byte per character. */
    ENCODING_DOUBLEBYTE = 1,	/* Encoding is two bytes per character. */
    ENCODING_MULTIBYTE = 2,	/* Encoding is variable bytes per character. */
    ENCODING_ESCAPE = 3		/* Encoding has modes with escapes to move
				 * between them. */
};

/*
 * A list of directories in which Tcl should look for *.enc files. This list
 * is shared by all threads. Access is governed by a mutex lock.
 */

static TclInitProcessGlobalValueProc InitializeEncodingSearchPath;

	if (framePtr == NULL ||
		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	    TRACE(("=> ERROR: no TclOO call context\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "self may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    OO_ERROR(interp, CONTEXT_REQUIRED);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = (CallContext *)framePtr->clientData;

	/*
	 * Call out to get the name; it's expensive to compute but cached.

	if (framePtr == NULL ||
		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	    TRACE_APPEND(("ERROR: no TclOO call context\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "nextto may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    OO_ERROR(interp, CONTEXT_REQUIRED);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = (CallContext *)framePtr->clientData;

	oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
	if (oPtr == NULL) {
	    TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
	    goto gotError;
	} else {
	    Class *classPtr = oPtr->classPtr;
	    struct MInvoke *miPtr;
	    Tcl_Size i;
	    const char *methodType;

	    if (classPtr == NULL) {
		TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not a class", TclGetString(valuePtr)));
		DECACHE_STACK_INFO();
		OO_ERROR(interp, CLASS_REQUIRED);
		CACHE_STACK_INFO();
		goto gotError;
	    }

	    for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
		miPtr = contextPtr->callPtr->chain + i;
		if (!miPtr->isFilter &&

			|| miPtr->mPtr->declaringClassPtr != classPtr) {
		    continue;
		}
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s implementation by \"%s\" not reachable from here",
			methodType, TclGetString(valuePtr)));
		DECACHE_STACK_INFO();
		OO_ERROR(interp, CLASS_NOT_REACHABLE);

		CACHE_STACK_INFO();
		goto gotError;
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s has no non-filter implementation by \"%s\"",
		    methodType, TclGetString(valuePtr)));
	    DECACHE_STACK_INFO();
	    OO_ERROR(interp, CLASS_NOT_THERE);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

    case INST_TCLOO_NEXT:
	opnd = TclGetUInt1AtPtr(pc+1);
	objv = &OBJ_AT_DEPTH(opnd - 1);
	framePtr = iPtr->varFramePtr;
	skip = 1;
	TRACE(("%d => ", opnd));
	if (framePtr == NULL ||
		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	    TRACE_APPEND(("ERROR: no TclOO call context\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "next may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    OO_ERROR(interp, CONTEXT_REQUIRED);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = (CallContext *)framePtr->clientData;

	newDepth = contextPtr->index + 1;
	if (newDepth >= contextPtr->callPtr->numChain) {

		methodType = "method";
	    }

	    TRACE_APPEND(("ERROR: no TclOO next impl\n"));
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "no next %s implementation", methodType));
	    DECACHE_STACK_INFO();
	    OO_ERROR(interp, NOTHING_NEXT);
	    CACHE_STACK_INFO();
	    goto gotError;
#ifdef TCL_COMPILE_DEBUG
	} else if (tclTraceExec >= 2) {
	    int i;

	    if (traceInstructions) {

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

/*
 * Bison generates several labels that happen to be unused. Several compilers
 * don't like that, and complain. Simply disable the warning to silence them.
 */

#ifdef _MSC_VER
#pragma warning( disable : 4102 )
#elif defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic ignored "-Wunused-but-set-variable"
#endif

#if 0
#define YYDEBUG 1
#endif

/*
 * yyparse will accept a 'struct DateInfo' as its parameter; that's where the

int
TclFSCwdIsNative(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    /* if not yet initialized - ensure we'll once obtain cwd */
    if (!tsdPtr->cwdPathEpoch) {
	Tcl_Obj *temp = Tcl_FSGetCwd(NULL);
	if (temp) { Tcl_DecrRefCount(temp); }
    }

    if (tsdPtr->cwdClientData != NULL) {
	return 1;
    } else {
	return 0;
    }

	buffer = TclpLoadMemoryGetBuffer(size);
	if (!buffer) {
	    Tcl_CloseEx(interp, data, 0);
	    goto mustCopyToTempAnyway;
	}
	ret = Tcl_Read(data, (char *)buffer, size);
	Tcl_CloseEx(interp, data, 0);
	ret = TclpLoadMemory(buffer, size, ret, TclGetString(pathPtr), handlePtr,
		&unloadProcPtr, flags);
	if (ret == TCL_OK && *handlePtr != NULL) {
	    goto resolveSymbols;
	}
    }

  mustCopyToTempAnyway:

MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void *	TclpLoadMemoryGetBuffer(size_t size);
MODULE_SCOPE int	TclpLoadMemory(void *buffer, size_t size,
			    Tcl_Size codeSize,  const char *path, Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);

#ifdef TCL_WIDE_CLICKS

 */

#define TclInvalidateStringRep(objPtr) \
    do {								\
	Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr);			\
	if (_isobjPtr->bytes != NULL) {					\
	    if (_isobjPtr->bytes != &tclEmptyString) {			\
		Tcl_Free((void *)_isobjPtr->bytes);			\
	    }								\
	    _isobjPtr->bytes = NULL;					\
	}								\
    } while (0)

/*
 * These form part of the native filesystem support. They are needed here

     * from the target interpreter to the originating one.
     */

    if (code != TCL_OK) {
	Interp *iPtr = (Interp *) target;
	if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) {
	    /*
	     * A call to Tcl_InitStubs() determined the caller extension
	     * Stubs were introduced in Tcl 8.1, so there's only one possible reason.

	     */
	    Tcl_SetObjResult(target, Tcl_NewStringObj("this extension is compiled for Tcl 8.x", -1));
	    iPtr->legacyResult = NULL;
	    iPtr->legacyFreeProc = (void (*) (void))-1;
	}
	Tcl_TransferResult(target, code, interp);
	goto done;
    }

}

MODULE_SCOPE int
TclpLoadMemory(
    TCL_UNUSED(void *),
    TCL_UNUSED(size_t),
    TCL_UNUSED(Tcl_Size),
    TCL_UNUSED(const char *),
    TCL_UNUSED(Tcl_LoadHandle *),
    TCL_UNUSED(Tcl_FSUnloadFileProc **),
    TCL_UNUSED(int))
{
    return TCL_ERROR;
}

    listPtr = Tcl_NewListObj(0, NULL);
    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	size_t length = strlen(nsPtr->fullName);

	if (strncmp(pattern, nsPtr->fullName, length) != 0) {
	    goto searchDone;
	}
	/*
	 * Global namespace members are prefixed with "::", others not. Ticket [63449c0514]
	 */
	if (FindChildEntry(nsPtr, (nsPtr != globalNsPtr ? 2 : 0) + pattern+length) != NULL) {
	    Tcl_ListObjAppendElement(NULL, listPtr,
		    Tcl_NewStringObj(pattern, -1));
	}
	goto searchDone;
    }
    entryPtr = FirstChildEntry(nsPtr, &search);
    while (entryPtr != NULL) {

 */

typedef struct ThreadSpecificData {
    Tcl_Event *firstEventPtr;	/* First pending event, or NULL if none. */
    Tcl_Event *lastEventPtr;	/* Last pending event, or NULL if none. */
    Tcl_Event *markerEventPtr;	/* Last high-priority event in queue, or NULL
				 * if none. */
    Tcl_Size eventCount;	/* Number of entries, but refer to comments in
				 * Tcl_ServiceEvent(). */
    Tcl_Mutex queueMutex;	/* Mutex to protect access to the previous
				 * four fields. */
    int serviceMode;		/* One of TCL_SERVICE_NONE or
				 * TCL_SERVICE_ALL. */
    int blockTimeSet;		/* 0 means there is no maximum block time:
				 * block forever. */
    Tcl_Time blockTime;		/* If blockTimeSet is 1, gives the maximum
				 * elapsed time for the next block. */
    int inTraversal;		/* 1 if Tcl_SetMaxBlockTime is being called
				 * during an event source traversal. */
    int initialized;		/* 1 if notifier has been initialized. */
    EventSource *firstEventSourcePtr;
				/* Pointer to first event source in list of
				 * event sources for this thread. */
    Tcl_ThreadId threadId;	/* Thread that owns this notifier instance. */
    void *clientData;	/* Opaque handle for platform specific
				 * notifier. */

    struct ThreadSpecificData *nextPtr;
				/* Next notifier in global list of notifiers.
				 * Access is controlled by the listLock global
				 * mutex. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

    for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
	hold = evPtr;
	evPtr = evPtr->nextPtr;
	Tcl_Free(hold);
    }
    tsdPtr->firstEventPtr = NULL;
    tsdPtr->lastEventPtr = NULL;
    tsdPtr->eventCount = 0;
    Tcl_MutexUnlock(&(tsdPtr->queueMutex));

    Tcl_MutexLock(&listLock);

    Tcl_FinalizeNotifier(tsdPtr->clientData);
    Tcl_MutexFinalize(&(tsdPtr->queueMutex));
    for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;

				 * must have been allocated the caller with
				 * malloc (Tcl_Alloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    int position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK,
				 * possibly combined with TCL_QUEUE_ALERT_IF_EMPTY */
{
    int wasEmpty = 0;



    Tcl_MutexLock(&(tsdPtr->queueMutex));
    if ((position & 3) == TCL_QUEUE_TAIL) {
	/*
	 * Append the event on the end of the queue.
	 */

	evPtr->nextPtr = NULL;
	if (tsdPtr->firstEventPtr == NULL) {

	    tsdPtr->markerEventPtr->nextPtr = evPtr;
	}
	tsdPtr->markerEventPtr = evPtr;
	if (evPtr->nextPtr == NULL) {
	    tsdPtr->lastEventPtr = evPtr;
	}
    }
    if (position & TCL_QUEUE_ALERT_IF_EMPTY) {
	wasEmpty = (tsdPtr->eventCount <= 0);
    }
    tsdPtr->eventCount++;
    Tcl_MutexUnlock(&(tsdPtr->queueMutex));
    return wasEmpty;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteEvents --
 *

	    /*
	     * Delete the event data structure.
	     */

	    hold = evPtr;
	    evPtr = evPtr->nextPtr;
	    Tcl_Free(hold);
	    tsdPtr->eventCount--;
	} else {
	    /*
	     * Event is to be retained.
	     */

	    prevPtr = evPtr;
	    evPtr = evPtr->nextPtr;

				 * TCL_FILE_EVENTS, TCL_TIMER_EVENTS, or other
				 * flags defined elsewhere. Events not
				 * matching this will be skipped for
				 * processing later. */
{
    Tcl_Event *evPtr, *prevPtr;
    Tcl_EventProc *proc;
    Tcl_Size eventCount;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int result;

    /*
     * Asynchronous event handlers are considered to be the highest priority
     * events, and so must be invoked before we process events on the event
     * queue.
     */

	evPtr->proc = NULL;

	/*
	 * Release the lock before calling the event function. This allows
	 * other threads to post events if we enter a recursive event loop in
	 * this thread. Note that we are making the assumption that if the
	 * proc returns 0, the event is still in the list.
	 *
	 * The eventCount is remembered and set to zero that the next
	 * level of Tcl_ServiceEvent() gets an empty condition for the
	 * Tcl_ThreadQueueEvent() to perform optional wakeups.
	 * On exit of the next level, the eventCount is readjusted.
	 */

	eventCount = tsdPtr->eventCount;
	tsdPtr->eventCount = 0;
	Tcl_MutexUnlock(&(tsdPtr->queueMutex));
	result = proc(evPtr, flags);
	Tcl_MutexLock(&(tsdPtr->queueMutex));
	tsdPtr->eventCount += eventCount;

	if (result) {
	    /*
	     * The event was processed, so remove it from the queue.
	     */

	    if (tsdPtr->firstEventPtr == evPtr) {

		    }
		} else {
		    evPtr = NULL;
		}
	    }
	    if (evPtr) {
		Tcl_Free(evPtr);
		tsdPtr->eventCount--;
	    }
	    Tcl_MutexUnlock(&(tsdPtr->queueMutex));
	    return 1;
	} else {
	    /*
	     * The event wasn't actually handled, so we have to restore the
	     * proc field to allow the event to be attempted again.

	}
	Tcl_Free(clsPtr->superclasses.list);
	clsPtr->superclasses.num = 0;
	clsPtr->superclasses.list = NULL;
    }

    FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
	/* instance gets deleted, so if method remains, reset it there */
	if (mPtr->refCount > 1 && mPtr->declaringClassPtr == clsPtr) {
	    mPtr->declaringClassPtr = NULL;
	}
	TclOODelMethodRef(mPtr);
    }
    Tcl_DeleteHashTable(&clsPtr->classMethods);
    TclOODelMethodRef(clsPtr->constructorPtr);
    TclOODelMethodRef(clsPtr->destructorPtr);

    FOREACH(variableObj, clsPtr->variables) {

    }
    if (i) {
	Tcl_Free(oPtr->filters.list);
    }

    if (oPtr->methodsPtr) {
	FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
	    /* instance gets deleted, so if method remains, reset it there */
	    if (mPtr->refCount > 1 && mPtr->declaringObjectPtr == oPtr) {
		mPtr->declaringObjectPtr = NULL;
	    }
	    TclOODelMethodRef(mPtr);
	}
	Tcl_DeleteHashTable(oPtr->methodsPtr);
	Tcl_Free(oPtr->methodsPtr);
    }

    FOREACH(variableObj, oPtr->variables) {

	 */

	hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName);
	if (hPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't create object \"%s\": command already exists with"
		    " that name", nameStr));
	    OO_ERROR(interp, OVERWRITE_OBJECT);
	    return NULL;
	}
    }

    /*
     * Create the object.
     */

     * Ensure an error if the object was deleted in the constructor. Don't
     * want to lose errors by accident. [Bug 2903011]
     */

    if (result != TCL_ERROR && Destructing(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object deleted in constructor", TCL_AUTO_LENGTH));
	OO_ERROR(interp, STILLBORN);
	result = TCL_ERROR;
    }
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);

	/*
	 * Take care to not delete a deleted object; that would be bad. [Bug

    /*
     * Sanity check.
     */

    if (IsRootClass(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not clone the class of classes", TCL_AUTO_LENGTH));
	OO_ERROR(interp, CLONING_CLASS);
	return NULL;
    }

    /*
     * Build the instance. Note that this does not run any constructors.
     */

	    methodType = "destructor";
	} else {
	    methodType = "method";
	}

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no next %s implementation", methodType));
	OO_ERROR(interp, NOTHING_NEXT);
	return TCL_ERROR;
    }

    /*
     * Advance to the next method implementation in the chain in the method
     * call context while we process the body. However, need to adjust the
     * argument-skip control because we're guaranteed to have a single prefix

	    methodType = "destructor";
	} else {
	    methodType = "method";
	}

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no next %s implementation", methodType));
	OO_ERROR(interp, NOTHING_NEXT);
	return TCL_ERROR;
    }

    /*
     * Advance to the next method implementation in the chain in the method
     * call context while we process the body. However, need to adjust the
     * argument-skip control because we're guaranteed to have a single prefix

    void TclOOObjectSetMixins(Object *oPtr, Tcl_Size numMixins,
	    Class *const *mixins)
}
declare 15 {
    void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
	    Tcl_Size numMixins, Class *const *mixins)
}
declare 16 {
    Tcl_Method TclOOMakeProcInstanceMethod2(Tcl_Interp *interp, Object *oPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    const Tcl_MethodType2 *typePtr, void *clientData,
	    Proc **procPtrPtr)
}
declare 17 {
    Tcl_Method TclOOMakeProcMethod2(Tcl_Interp *interp, Class *clsPtr,
	    int flags, Tcl_Obj *nameObj, const char *namePtr,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType2 *typePtr,
	    void *clientData, Proc **procPtrPtr)
}

return

# Local Variables:
# mode: tcl
# End:

     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	OO_ERROR(interp, INSTANTIATE_NONCLASS);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

    if (objc < 1 + Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", TCL_AUTO_LENGTH));
	OO_ERROR(interp, EMPTY_NAME);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	OO_ERROR(interp, INSTANTIATE_NONCLASS);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

    if (objc + 1 < Tcl_ObjectContextSkippedArgs(context) + 3) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName namespaceName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", TCL_AUTO_LENGTH));
	OO_ERROR(interp, EMPTY_NAME);
	return TCL_ERROR;
    }
    nsName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context) + 1], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"namespace name must not be empty", TCL_AUTO_LENGTH));
	OO_ERROR(interp, EMPTY_NAME);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	OO_ERROR(interp, INSTANTIATE_NONCLASS);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

	}
	Tcl_AppendToObj(errorMsg, methodNames[i], TCL_AUTO_LENGTH);
    }
    if (i) {
	Tcl_AppendToObj(errorMsg, " or ", TCL_AUTO_LENGTH);
    }
    Tcl_AppendToObj(errorMsg, methodNames[i], TCL_AUTO_LENGTH);
    Tcl_Free((void *)methodNames);
    Tcl_SetObjResult(interp, errorMsg);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
	    TclGetString(objv[skip]), (char *)NULL);
    return TCL_ERROR;
}

/*

     * retrieve the handle to the object call context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	OO_ERROR(interp, CONTEXT_REQUIRED);
	return TCL_ERROR;
    }
    context = (Tcl_ObjectContext) framePtr->clientData;

    /*
     * Invoke the (advanced) method call context in the caller context. Note
     * that this is like [uplevel 1] and not [eval].

     * retrieve the handle to the object call context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	OO_ERROR(interp, CONTEXT_REQUIRED);
	return TCL_ERROR;
    }
    contextPtr = (CallContext *) framePtr->clientData;

    /*
     * Sanity check the arguments; we need the first one to refer to a class.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "class ?arg...?");
	return TCL_ERROR;
    }
    object = Tcl_GetObjectFromObj(interp, objv[1]);
    if (object == NULL) {
	return TCL_ERROR;
    }
    classPtr = ((Object *) object)->classPtr;
    if (classPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" is not a class", TclGetString(objv[1])));
	OO_ERROR(interp, CLASS_REQUIRED);
	return TCL_ERROR;
    }

    /*
     * Search for an implementation of a method associated with the current
     * call on the call chain past the point where we currently are. Do not
     * allow jumping backwards!

    for (i=contextPtr->index ; i != TCL_INDEX_NONE ; i--) {
	MInvoke *miPtr = &contextPtr->callPtr->chain[i];

	if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s implementation by \"%s\" not reachable from here",
		    methodType, TclGetString(objv[1])));
	    OO_ERROR(interp, CLASS_NOT_REACHABLE);

	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "%s has no non-filter implementation by \"%s\"",
	    methodType, TclGetString(objv[1])));
    OO_ERROR(interp, CLASS_NOT_THERE);
    return TCL_ERROR;
}

static int
NextRestoreFrame(
    void *data[],
    Tcl_Interp *interp,

     * Start with sanity checks on the calling context and the method context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	OO_ERROR(interp, CONTEXT_REQUIRED);
	return TCL_ERROR;
    }

    contextPtr = (CallContext *) framePtr->clientData;

    /*
     * Now we do "conventional" argument parsing for a while. Note that no

	return TCL_OK;
    case SELF_CLASS: {
	Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;

	if (clsPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "method not defined by a class", TCL_AUTO_LENGTH));
	    OO_ERROR(interp, UNMATCHED_CONTEXT);
	    return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
	return TCL_OK;
    }
    case SELF_METHOD:
	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
	    Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName);
	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
	    Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName);
	} else {
	    Tcl_SetObjResult(interp,
		    CurrentlyInvoked(contextPtr).mPtr->namePtr);
	}
	return TCL_OK;
    case SELF_FILTER:
	if (!CurrentlyInvoked(contextPtr).isFilter) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "not inside a filtering context", TCL_AUTO_LENGTH));
	    OO_ERROR(interp, UNMATCHED_CONTEXT);
	    return TCL_ERROR;
	} else {
	    MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
	    Object *oPtr;
	    const char *type;

	    if (miPtr->filterDeclarer != NULL) {

	    return TCL_OK;
	}
    case SELF_CALLER:
	if ((framePtr->callerVarPtr == NULL) ||
		!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "caller is not an object", TCL_AUTO_LENGTH));
	    OO_ERROR(interp, CONTEXT_REQUIRED);
	    return TCL_ERROR;
	} else {
	    CallContext *callerPtr = (CallContext *)
		    framePtr->callerVarPtr->clientData;
	    Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
	    Object *declarerPtr;

	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	}
	return TCL_OK;
    case SELF_TARGET:
	if (!CurrentlyInvoked(contextPtr).isFilter) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "not inside a filtering context", TCL_AUTO_LENGTH));
	    OO_ERROR(interp, UNMATCHED_CONTEXT);
	    return TCL_ERROR;
	} else {
	    Method *mPtr;
	    Object *declarerPtr;
	    Tcl_Size i;

	    for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++) {

    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	Tcl_Free((void *)strings);
	*stringsPtr = NULL;
    }
    return i;
}

/*
 * Comparator for SortMethodNames

	if (toPtr) {
	    newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, toPtr,
		    &isNew);
	    if (hPtr == newHPtr) {
	    renameToSelf:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot rename method to itself", TCL_AUTO_LENGTH));
		OO_ERROR(interp, RENAME_TO_SELF);
		return TCL_ERROR;
	    } else if (!isNew) {
	    renameToExisting:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"method called %s already exists",
			TclGetString(toPtr)));
		OO_ERROR(interp, RENAME_OVER);
		return TCL_ERROR;
	    }
	}
    } else {
	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods, fromPtr);
	if (hPtr == NULL) {
	    goto noSuchMethod;

    FOREACH_HASH_DECLS;
    Tcl_Size soughtLen;
    const char *soughtStr, *nameStr, *matchedStr = NULL;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad call of unknown handler", TCL_AUTO_LENGTH));
	OO_ERROR(interp, BAD_UNKNOWN);
	return TCL_ERROR;
    }
    if (TclOOGetDefineCmdContext(interp) == NULL) {
	return TCL_ERROR;
    }

    soughtStr = TclGetStringFromObj(objv[1], &soughtLen);

    Tcl_Obj *const objv[])
{
    CallFrame *framePtr, **framePtrPtr = &framePtr;

    if (namespacePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"no definition namespace available", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    /*
     * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
     */

    if ((iPtr->varFramePtr == NULL)
	    || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE
	    && iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"this command may only be called from within the context of"
		" an ::oo::define or ::oo::objdefine command",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return NULL;
    }
    object = (Tcl_Object) iPtr->varFramePtr->clientData;
    if (Tcl_ObjectDeleted(object)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"this command cannot be called when the object has been"
		" deleted", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return NULL;
    }
    return object;
}

Class *
TclOOGetClassDefineCmdContext(
    Tcl_Interp *interp)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return NULL;
    }
    if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return NULL;
    }
    return oPtr->classPtr;
}

/*
 * ----------------------------------------------------------------------

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr->flags & ROOT_OBJECT) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not modify the class of the root object class",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }
    if (oPtr->flags & ROOT_CLASS) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not modify the class of the class of classes",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    /*
     * Parse the argument to get the class to set the object's class to.
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassInOuterContext(interp, objv[1],
	    "the class of an object must be a class");
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr == clsPtr->thisPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not change classes into an instance of themselves",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    /*
     * Set the object's class.
     */

    if (clsPtr == NULL) {
	return TCL_ERROR;
    } else if (clsPtr->thisPtr->flags & (ROOT_OBJECT | ROOT_CLASS)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not modify the definition namespace of the root classes",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    /*
     * Parse the arguments and work out what the user wants to do.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceDeleteMethod && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Delete the method structure from the appropriate hash table.
	 */

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;
    if (!isInstanceExport && !clsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Exporting is done by adding the PUBLIC_METHOD flag to the method
	 * record. If there is no such method in this object or class (i.e.

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceForward && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN)
	    ? PUBLIC_METHOD : 0;
    if (IsPrivateDefine(interp)) {
	isPublic = TRUE_PRIVATE_METHOD;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceMethod && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }
    if (objc == 5) {
	if (Tcl_GetIndexFromObj(interp, objv[2], exportModes, "export flag",
		0, &exportMode) != TCL_OK) {
	    return TCL_ERROR;
	}

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceRenameMethod && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    /*
     * Delete the method entry from the appropriate hash table, and transfer
     * the thing it points to to its new entry. To do this, we first need to
     * get the entries from the appropriate hash tables (this can generate a

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;
    if (!isInstanceUnexport && !clsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Unexporting is done by removing the PUBLIC_METHOD flag from the
	 * method record. If there is no such method in this object or class

	    goto freeAndError;
	}
	(void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew);
	if (!isNew) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "class should only be a direct mixin once",
		    TCL_AUTO_LENGTH));
	    OO_ERROR(interp, REPETITIOUS);
	    goto freeAndError;
	}
	if (TclOOIsReachable(clsPtr, mixins[i])) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "may not mix a class into itself", TCL_AUTO_LENGTH));
	    OO_ERROR(interp, SELF_MIXIN);
	    goto freeAndError;
	}
    }

    TclOOClassSetMixins(interp, clsPtr, mixinc, mixins);
    Tcl_DeleteHashTable(&uniqueCheck);
    TclStackFree(interp, mixins);

    objv += Tcl_ObjectContextSkippedArgs(context);

    Foundation *fPtr = clsPtr->thisPtr->fPtr;
    if (clsPtr == fPtr->objectCls) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not modify the superclass of the root object",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    } else if (TclListObjGetElements(interp, objv[0], &superc,
	    &superv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*

		goto failedAfterAlloc;
	    }
	    for (j = 0; j < i; j++) {
		if (superclasses[j] == superclasses[i]) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "class should only be a direct superclass once",
			    TCL_AUTO_LENGTH));
		    OO_ERROR(interp, REPETITIOUS);
		    goto failedAfterAlloc;
		}
	    }
	    if (TclOOIsReachable(clsPtr, superclasses[i])) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph",
			TCL_AUTO_LENGTH));
		OO_ERROR(interp, CIRCULARITY);
	    failedAfterAlloc:
		for (; i-- > 0 ;) {
		    TclOODecrRefCount(superclasses[i]->thisPtr);
		}
		Tcl_Free(superclasses);
		return TCL_ERROR;
	    }

    for (i = 0; i < varc; i++) {
	const char *varName = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    OO_ERROR(interp, BAD_DECLVAR);
	    return TCL_ERROR;
	}
	if (Tcl_StringMatch(varName, "*(*)")) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "refer to an array element"));
	    OO_ERROR(interp, BAD_DECLVAR);
	    return TCL_ERROR;
	}
    }

    if (IsPrivateDefine(interp)) {
	InstallPrivateVariableMapping(&clsPtr->privateVariables,
		varc, varv, clsPtr->thisPtr->creationEpoch);

	    goto freeAndError;
	}
	(void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew);
	if (!isNew) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "class should only be a direct mixin once",
		    TCL_AUTO_LENGTH));
	    OO_ERROR(interp, REPETITIOUS);
	    goto freeAndError;
	}
    }

    TclOOObjectSetMixins(oPtr, mixinc, mixins);
    TclStackFree(interp, mixins);
    Tcl_DeleteHashTable(&uniqueCheck);

    for (i = 0; i < varc; i++) {
	const char *varName = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    OO_ERROR(interp, BAD_DECLVAR);
	    return TCL_ERROR;
	}
	if (Tcl_StringMatch(varName, "*(*)")) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "refer to an array element"));
	    OO_ERROR(interp, BAD_DECLVAR);
	    return TCL_ERROR;
	}
    }

    if (IsPrivateDefine(interp)) {
	InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
		oPtr->creationEpoch);

		&names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], TCL_AUTO_LENGTH));
	}
	if (numNames > 0) {
	    Tcl_Free((void *)names);
	}
    } else if (oPtr->methodsPtr) {
	if (scope == SCOPE_DEFAULT) {
	    /*
	     * Handle legacy-mode matching. [Bug 36e5517a6850]
	     */
	    int scopeFilter = flag | TRUE_PRIVATE_METHOD;

	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", TclGetString(objv[2])) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "option \"%s\" is not exactly \"-private\"",
		    TclGetString(objv[2])));
	    OO_ERROR(interp, BAD_ARG);
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;

	return TCL_OK;
    }
    procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, METHOD_TYPE);
	return TCL_ERROR;
    }

    TclNewObj(resultObjs[0]);
    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)) {

	return TCL_OK;
    }
    procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, METHOD_TYPE);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr));
    return TCL_OK;
}


	Tcl_Size i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], TCL_AUTO_LENGTH));
	}
	if (numNames > 0) {
	    Tcl_Free((void *)names);
	}
    } else {
	FOREACH_HASH_DECLS;

	if (scope == SCOPE_DEFAULT) {
	    /*
	     * Handle legacy-mode matching. [Bug 36e5517a6850]

	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", TclGetString(objv[2])) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "option \"%s\" is not exactly \"-private\"",
		    TclGetString(objv[2])));
	    OO_ERROR(interp, BAD_ARG);
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;

     */

    contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
	    NULL);
    if (contextPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot construct any call chain", TCL_AUTO_LENGTH));
	OO_ERROR(interp, BAD_CALL_CHAIN);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
	    TclOORenderCallChain(interp, contextPtr->callPtr));
    TclOODeleteContext(contextPtr);
    return TCL_OK;
}

     * Get an render the stereotypical call chain.
     */

    callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD);
    if (callPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot construct any call chain", TCL_AUTO_LENGTH));
	OO_ERROR(interp, BAD_CALL_CHAIN);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
    TclOODeleteChain(callPtr);
    return TCL_OK;
}


	if (len != 0) { \
	    memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \
	} else { \
	    (target).list = NULL; \
	} \
    } while(0)

/*
 * Convenience macro for generating error codes.
 */
#define OO_ERROR(interp, code) \
    Tcl_SetErrorCode((interp), "TCL", "OO", #code, (char *)NULL)

#endif /* TCL_OO_INTERNAL_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78

/* 14 */
TCLAPI void		TclOOObjectSetMixins(Object *oPtr,
				Tcl_Size numMixins, Class *const *mixins);
/* 15 */
TCLAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
				Class *classPtr, Tcl_Size numMixins,
				Class *const *mixins);
/* 16 */
TCLAPI Tcl_Method	TclOOMakeProcInstanceMethod2(Tcl_Interp *interp,
				Object *oPtr, int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				const Tcl_MethodType2 *typePtr,
				void *clientData, Proc **procPtrPtr);
/* 17 */
TCLAPI Tcl_Method	TclOOMakeProcMethod2(Tcl_Interp *interp,
				Class *clsPtr, int flags, Tcl_Obj *nameObj,
				const char *namePtr, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj,
				const Tcl_MethodType2 *typePtr,
				void *clientData, Proc **procPtrPtr);

typedef struct TclOOIntStubs {
    int magic;
    void *hooks;

    Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */
    Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */

    Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
    Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
    int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 11 */
    void (*tclOOObjectSetFilters) (Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 12 */
    void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 13 */
    void (*tclOOObjectSetMixins) (Object *oPtr, Tcl_Size numMixins, Class *const *mixins); /* 14 */
    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numMixins, Class *const *mixins); /* 15 */
    Tcl_Method (*tclOOMakeProcInstanceMethod2) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType2 *typePtr, void *clientData, Proc **procPtrPtr); /* 16 */
    Tcl_Method (*tclOOMakeProcMethod2) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType2 *typePtr, void *clientData, Proc **procPtrPtr); /* 17 */
} TclOOIntStubs;

extern const TclOOIntStubs *tclOOIntStubsPtr;

#ifdef __cplusplus
}
#endif

	(tclOOIntStubsPtr->tclOOObjectSetFilters) /* 12 */
#define TclOOClassSetFilters \
	(tclOOIntStubsPtr->tclOOClassSetFilters) /* 13 */
#define TclOOObjectSetMixins \
	(tclOOIntStubsPtr->tclOOObjectSetMixins) /* 14 */
#define TclOOClassSetMixins \
	(tclOOIntStubsPtr->tclOOClassSetMixins) /* 15 */
#define TclOOMakeProcInstanceMethod2 \
	(tclOOIntStubsPtr->tclOOMakeProcInstanceMethod2) /* 16 */
#define TclOOMakeProcMethod2 \
	(tclOOIntStubsPtr->tclOOMakeProcMethod2) /* 17 */

#endif /* defined(USE_TCLOO_STUBS) */

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

#endif /* _TCLOOINTDECLS */

				 * the procedure record reference. Presumably
				 * inside the structure indicated by the
				 * pointer in clientData. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;

    if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
	Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
		"TclOOMakeProcInstanceMethod", "TCL_OO_METHOD_VERSION_1");
    }
    if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj,
	    procPtrPtr) != TCL_OK) {
	return NULL;
    }
    procPtr = *procPtrPtr;
    procPtr->cmdPtr = NULL;

    InitCmdFrame(iPtr, procPtr);

    return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
	    typePtr, clientData);
}

Tcl_Method
TclOOMakeProcInstanceMethod2(
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Object *oPtr,		/* The object to modify. */
    int flags,			/* Whether this is a public method. */
    Tcl_Obj *nameObj,		/* The name of the method, which _must not_ be
				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which _must not_ be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
				 * NULL. */
    const Tcl_MethodType2 *typePtr,
				/* The type of the method to create. */
    void *clientData,		/* The per-method type-specific data. */
    Proc **procPtrPtr)		/* A pointer to the variable in which to write
				 * the procedure record reference. Presumably
				 * inside the structure indicated by the
				 * pointer in clientData. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;

    if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
	Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
		"TclOOMakeProcInstanceMethod2", "TCL_OO_METHOD_VERSION_2");
    }
    if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj,
	    procPtrPtr) != TCL_OK) {
	return NULL;
    }
    procPtr = *procPtrPtr;
    procPtr->cmdPtr = NULL;

    InitCmdFrame(iPtr, procPtr);

    return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
	    (const Tcl_MethodType *)typePtr, clientData);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOMakeProcMethod --
 *
 *	The guts of the code to make a procedure-like method for a class.

				 * the procedure record reference. Presumably
				 * inside the structure indicated by the
				 * pointer in clientData. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;

    if (typePtr->version > TCL_OO_METHOD_VERSION_1) {
	Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
		"TclOOMakeProcMethod", "TCL_OO_METHOD_VERSION_1");
    }
    if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj,
	    procPtrPtr) != TCL_OK) {
	return NULL;
    }
    procPtr = *procPtrPtr;
    procPtr->cmdPtr = NULL;

    InitCmdFrame(iPtr, procPtr);

    return TclNewMethod(
	    (Tcl_Class) clsPtr, nameObj, flags, typePtr, clientData);
}

Tcl_Method
TclOOMakeProcMethod2(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Class *clsPtr,		/* The class to modify. */
    int flags,			/* Whether this is a public method. */
    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
				 * if so, up to caller to manage storage
				 * (e.g., because it is a constructor or
				 * destructor). */
    const char *namePtr,	/* The name of the method as a string, which
				 * _must not_ be NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which _must not_ be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
				 * NULL. */
    const Tcl_MethodType2 *typePtr,
				/* The type of the method to create. */
    void *clientData,		/* The per-method type-specific data. */
    Proc **procPtrPtr)		/* A pointer to the variable in which to write
				 * the procedure record reference. Presumably
				 * inside the structure indicated by the
				 * pointer in clientData. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;

    if (typePtr->version < TCL_OO_METHOD_VERSION_2) {
	Tcl_Panic("%s: Wrong version in typePtr->version, should be %s",
		"TclOOMakeProcMethod2", "TCL_OO_METHOD_VERSION_2");
    }
    if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj,
	    procPtrPtr) != TCL_OK) {
	return NULL;
    }
    procPtr = *procPtrPtr;
    procPtr->cmdPtr = NULL;

    InitCmdFrame(iPtr, procPtr);

    return TclNewMethod(
	    (Tcl_Class) clsPtr, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData);
}

/*
 * ----------------------------------------------------------------------
 *
 * InvokeProcedureMethod, PushMethodCallFrame --
 *
 *	How to invoke a procedure-like method.

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

// TODO: Check whether Tcl_AppendLimitedToObj() can work here.

#define LIMIT 60
#define ELLIPSIFY(str,len) \
    ((len) > LIMIT ? LIMIT : (int)(len)), (str), ((len) > LIMIT ? "..." : "")

static void
CommonMethErrorHandler(
    Tcl_Interp *interp,
    const char *special)
{
    Tcl_Size objectNameLen;
    CallContext *contextPtr = (CallContext *)((Interp *)
	    interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName = "instance";
    Object *declarerPtr = NULL;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else if (mPtr->declaringClassPtr != NULL) {
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    if (declarerPtr) {
	objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
		&objectNameLen);
    } else {
	objectName = "unknown or deleted";
	objectNameLen = 18;
    }
    if (!special) {
	Tcl_Size nameLen;
	const char *methodName = TclGetStringFromObj(mPtr->namePtr, &nameLen);
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (%s \"%.*s%s\" method \"%.*s%s\" line %d)",
		kindName, ELLIPSIFY(objectName, objectNameLen),
		ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp)));
    } else {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (%s \"%.*s%s\" %s line %d)",
		kindName, ELLIPSIFY(objectName, objectNameLen), special,
		Tcl_GetErrorLine(interp)));
    }
}

static void
MethodErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)

{







    /* We pull the method name out of context instead of from argument. */










    CommonMethErrorHandler(interp, NULL);






}

static void
ConstructorErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)

{






    /* We know this is for the constructor. */










    CommonMethErrorHandler(interp, "constructor");





}

static void
DestructorErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)

{






    /* We know this is for the destructor. */










    CommonMethErrorHandler(interp, "destructor");





}

/*
 * ----------------------------------------------------------------------
 *
 * DeleteProcedureMethod, CloneProcedureMethod --
 *

    if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", TCL_AUTO_LENGTH));
	OO_ERROR(interp, BAD_FORWARD);
	return NULL;
    }

    fmPtr = (ForwardMethod *) Tcl_Alloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) TclNewInstanceMethod(interp, (Tcl_Object) oPtr,

    if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", TCL_AUTO_LENGTH));
	OO_ERROR(interp, BAD_FORWARD);
	return NULL;
    }

    fmPtr = (ForwardMethod *) Tcl_Alloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) TclNewMethod((Tcl_Class) clsPtr, nameObj,

	ImplementClassProperty(cls, propName, readable, writable);
    }
    return TCL_OK;

  badProp:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad property name \"%s\": %s", name, reason));
    OO_ERROR(interp, PROPERTY_FORMAT);
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefinePropertyCmd --

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!useInstance && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", TCL_AUTO_LENGTH));
	OO_ERROR(interp, MONKEY_BUSINESS);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	Tcl_Obj *propObj = objv[i], *nextObj, *argObj, *hyphenated;
	Tcl_Obj *getterScript = NULL, *setterScript = NULL;

    TclOONewProcInstanceMethodEx, /* 9 */
    TclOONewProcMethodEx, /* 10 */
    TclOOInvokeObject, /* 11 */
    TclOOObjectSetFilters, /* 12 */
    TclOOClassSetFilters, /* 13 */
    TclOOObjectSetMixins, /* 14 */
    TclOOClassSetMixins, /* 15 */
    TclOOMakeProcInstanceMethod2, /* 16 */
    TclOOMakeProcMethod2, /* 17 */
};

static const TclOOStubHooks tclOOStubHooks = {
    &tclOOIntStubs
};

const TclOOStubs tclOOStubs = {

    Tcl_Obj **nsObjPtrPtr)
{
    Proc *procPtr;
    Tcl_Obj *nsObjPtr;

    LambdaGetInternalRep(objPtr, procPtr, nsObjPtr);

    if (!procPtr || (procPtr->iPtr != (Interp *)interp)) {
	if (SetLambdaFromAny(interp, objPtr) != TCL_OK) {
	    return NULL;
	}
	LambdaGetInternalRep(objPtr, procPtr, nsObjPtr);
    }

    assert(procPtr != NULL);

	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    char *formatEnd;
	    /* Note currently XPG3 range limited to INT_MAX to match type of objc */
	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
	    if (*formatEnd == '$') {
		format = formatEnd+1;
		format += TclUtfToUniChar(format, &ch);
		objIndex = (int)value - 1;
	    }
	}

	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    unsigned long long ull;
	    ull  = strtoull(format-1, (char **)&format, 10); /* INTL: "C" locale. */
	    assert(ull <= TCL_SIZE_MAX); /* Else ValidateFormat should've error'ed */
	    width = (Tcl_Size)ull;
	    format += TclUtfToUniChar(format, &ch);
	} else {
	    width = 0;
	}

	/*
	 * Handle any size specifier.
	 */

	switch (ch) {
	case 'z':
	case 't':
	    if (sizeof(void *) > sizeof(int)) {
		flags |= SCAN_LONGER;
	    }
	    format += TclUtfToUniChar(format, &ch);
	    break;
	case 'L':
	    flags |= SCAN_BIG;
	    format += TclUtfToUniChar(format, &ch);
	    break;
	case 'l':
	    if (*format == 'l') {
		flags |= SCAN_BIG;
		format += 1;
		format += TclUtfToUniChar(format, &ch);
		break;
	    }
	    /* FALLTHRU */
	case 'j':
	case 'q':
	    flags |= SCAN_LONGER;
	    /* FALLTHRU */
	case 'h':
	    format += TclUtfToUniChar(format, &ch);
	}

	/*

    int exact,
    int magic)
{
    Interp *iPtr = (Interp *)interp;
    const char *actualVersion = NULL;
    void *pkgData = NULL;
    const TclStubs *stubsPtr = iPtr->stubTable;
    const char *tclName = "tcl";

    if ((exact&0xFF00) < 0x900) {
	magic = (int)0xFCA3BACF; /* TCL_STUB_MAGIC from Tcl 8.x */

	tclName = "Tcl";
    }
    /*
     * We can't optimize this check by caching tclStubsPtr because that
     * prevents apps from being able to load/unload Tcl dynamically multiple
     * times. [Bug 615304]
     */

    if (!stubsPtr || (stubsPtr->magic != magic)) {
	exact &= 0xFFFF00; /* Filter out minor/major Tcl version */
	if (!exact) {
	    exact = 0x060800;
	}
	if (stubsPtr && (stubsPtr->magic == TCL_STUB_MAGIC)
		&& ((exact|0x010000) == 0x070800)) {
	    /* We are running in Tcl 9.x, but extension is compiled with 8.6 or 8.7 */
	    stubsPtr->tcl_SetObjResult(interp, stubsPtr->tcl_ObjPrintf(
		    "this extension is compiled for Tcl %d.%d",
		    (exact & 0x0FF00)>>8, (exact & 0x0FF0000)>>16));
	} else if (stubsPtr && (stubsPtr->magic == (int)0xFCA3BACF)
		&& ((exact & 0x0FF00) >= 0x0900)) {
	    /* We are running in Tcl 8.x, but extension is compiled with 9.0+ */
	    char major[4], minor[4];
	    snprintf(major, sizeof(major), "%d", (exact & 0xFF00)>>8);
	    snprintf(minor, sizeof(minor), "%d", (exact & 0xFF0000)>>16);
	    stubsPtr->tcl_AppendResult(interp,
		    "this extension is compiled for Tcl ", major, ".", minor, (char *)NULL);
	} else {
	    iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
	    iPtr->legacyFreeProc = 0; /* TCL_STATIC */
	}
	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, tclName, version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }

/*
 * Include the static character classification tables and macros.
 */

#include "tclUniData.c"

/*
 * The following masks are used for fast character category tests. The x_BITS
 * values are shifted right by the category value to determine whether the
 * given category is included in the set.
 */
enum UnicodeCharacterCategoryMasks {
    ALPHA_BITS = (1 << UPPERCASE_LETTER) | (1 << LOWERCASE_LETTER) |
	(1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) |
	(1 << OTHER_LETTER),

    CONTROL_BITS = (1 << CONTROL) | (1 << FORMAT),

    DIGIT_BITS = (1 << DECIMAL_DIGIT_NUMBER),

    SPACE_BITS = (1 << SPACE_SEPARATOR) | (1 << LINE_SEPARATOR) |
	(1 << PARAGRAPH_SEPARATOR),

    WORD_BITS = ALPHA_BITS | DIGIT_BITS | (1 << CONNECTOR_PUNCTUATION),

    PUNCT_BITS = (1 << CONNECTOR_PUNCTUATION) |
	(1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) |
	(1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) |
	(1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION),

    GRAPH_BITS = WORD_BITS | PUNCT_BITS |
	(1 << NON_SPACING_MARK) | (1 << ENCLOSING_MARK) |
	(1 << COMBINING_SPACING_MARK) | (1 << LETTER_NUMBER) |
	(1 << OTHER_NUMBER) |
	(1 << MATH_SYMBOL) | (1 << CURRENCY_SYMBOL) |
	(1 << MODIFIER_SYMBOL) | (1 << OTHER_SYMBOL)
};

/*
 * Unicode characters less than this value are represented by themselves in
 * UTF-8 strings.
 */

#define UNICODE_SELF	0x80

 * are for internal use only.  Make sure they do not overlap with the public
 * values above.
 *
 * The Tcl*Scan*Element() routines make a determination which of 4 modes of
 * conversion is most appropriate for Tcl*Convert*Element() to perform, and
 * sets two bits of the flags value to indicate the mode selected.
 *



























 * For more details, see the comments on the Tcl*Scan*Element and
 * Tcl*Convert*Element routines.
 */

enum ConvertFlags {
    CONVERT_NONE = 0,		/* The element needs no quoting. Its literal
				 * string is suitable as is. */
    DONT_USE_BRACES = TCL_DONT_USE_BRACES,
				/* The caller is insisting that brace quoting
				 * not be used when converting the list
				 * element. */
    CONVERT_BRACE = 2,		/* The conversion should be enclosing the
				 * literal string in braces. */
    CONVERT_ESCAPE = 4,		/* The conversion should be using backslashes
				 * to escape any characters in the string that
				 * require it. */
    DONT_QUOTE_HASH = TCL_DONT_QUOTE_HASH,
				/* The caller insists that a leading hash
				 * character ('#') should *not* be quoted. This
				 * is appropriate when the caller can guarantee
				 * the element is not the first element of a
				 * list, so [eval] cannot mis-parse the element
				 * as a comment.*/
    CONVERT_MASK = CONVERT_BRACE | CONVERT_ESCAPE,
				/* A mask value used to extract the conversion
				 * mode from the flags argument.
				 *
				 * Also indicates a strange conversion mode
				 * where all special characters are escaped
				 * with backslashes *except for braces*. This
				 * is a strange and unnecessary case, but it's
				 * part of the historical way in which lists
				 * have been formatted in Tcl. To experiment
				 * with removing this case, define the value of
				 * COMPAT to be 0. */
    CONVERT_ANY = 16		/* The caller of TclScanElement() declares it
				 * can make no promise about what public flags
				 * will be passed to the matching call of
				 * TclConvertElement(). As such,
				 * TclScanElement() has to determine the worst
				 * case destination buffer length over all
				 * possibilities, and in other cases this means
				 * an overestimate of the required size.
				 *
				 * Used only by callers of TclScanElement().
				 * The flag value produced by a call to
				 * Tcl*Scan*Element() will never leave this
				 * bit set. */
};
#ifndef COMPAT
#define COMPAT 1
#endif

/*
 * Prototypes for functions defined later in this file.
 */

static void		ClearHash(Tcl_HashTable *tablePtr);
static void		FreeProcessGlobalValue(void *clientData);

     * the element #{a"b} like this:
     *			{#{a"b}}
     * and not like this:
     *			\#{a\"b}
     * This is inconsistent with [list x{a"b}], but we will not change that now.
     * Set that preference here so that we compute a tight size requirement.
     */
    if ((*src == '#') && !(*flagPtr & DONT_QUOTE_HASH)) {
	preferBrace = 1;
    }
#endif

    if ((*p == '{') || (*p == '"')) {
	/*
	 * Must escape or protect so leading character of value is not

	bytesNeeded += extra;

	/*
	 * Make room to escape leading #, if needed.
	 */

	if ((*src == '#') && !(*flagPtr & DONT_QUOTE_HASH)) {
	    bytesNeeded++;
	}
	*flagPtr = CONVERT_ESCAPE;
	return bytesNeeded;
    }
    if (*flagPtr & CONVERT_ANY) {
	/*
	 * The caller has not let us know what flags it will pass to
	 * TclConvertElement() so compute the max size we might need for any
	 * possible choice.  Normally the formatting using escape sequences is
	 * the longer one, and a minimum "extra" value of 2 makes sure we
	 * don't request too small a buffer in those edge cases where that's
	 * not true.
	 */

	if (extra < 2) {
	    extra = 2;
	}
	*flagPtr &= ~CONVERT_ANY;
	*flagPtr |= DONT_USE_BRACES;
    }
    if (forbidNone) {
	/*
	 * We must request some form of quoting of escaping...
	 */

#if COMPAT
	if (preferEscape && !preferBrace) {
	    /*
	     * If we are quoting solely due to ] or internal " characters use
	     * the CONVERT_MASK mode where we escape all special characters
	     * except for braces. "extra" counted space needed to escape
	     * braces too, so subtract "braceCount" to get our actual needs.
	     */

	    bytesNeeded += (extra - braceCount);
	    /* Make room to escape leading #, if needed. */
	    if ((*src == '#') && !(*flagPtr & DONT_QUOTE_HASH)) {
		bytesNeeded++;
	    }

	    /*
	     * If the caller reports it will direct TclConvertElement() to
	     * use full escapes on the element, add back the bytes needed to
	     * escape the braces.
	     */

	    if (*flagPtr & DONT_USE_BRACES) {
		bytesNeeded += braceCount;
	    }
	    *flagPtr = CONVERT_MASK;
	    return bytesNeeded;
	}
#endif /* COMPAT */
	if (*flagPtr & DONT_USE_BRACES) {
	    /*
	     * If the caller reports it will direct TclConvertElement() to
	     * use escapes, add the extra bytes needed to have room for them.
	     */

	    bytesNeeded += extra;

	    /*
	     * Make room to escape leading #, if needed.
	     */

	    if ((*src == '#') && !(*flagPtr & DONT_QUOTE_HASH)) {
		bytesNeeded++;
	    }
	} else {
	    /*
	     * Add 2 bytes for room for the enclosing braces.
	     */

	    bytesNeeded += 2;
	}
	*flagPtr = CONVERT_BRACE;
	return bytesNeeded;
    }

    /*
     * So far, no need to quote or escape anything.
     */

    if ((*src == '#') && !(*flagPtr & DONT_QUOTE_HASH)) {
	/*
	 * If we need to quote a leading #, make room to enclose in braces.
	 */

	bytesNeeded += 2;
    }
    *flagPtr = CONVERT_NONE;

    int conversion = flags & CONVERT_MASK;
    char *p = dst;

    /*
     * Let the caller demand we use escape sequences rather than braces.
     */

    if ((flags & DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
	conversion = CONVERT_ESCAPE;
    }

    /*
     * No matter what the caller demands, empty string must be braced!
     */

    if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_INDEX_NONE)) {
	p[0] = '{';
	p[1] = '}';
	return 2;
    }

    /*
     * Escape leading hash as needed and requested.
     */

    if ((*src == '#') && !(flags & DONT_QUOTE_HASH)) {
	if (conversion == CONVERT_ESCAPE) {
	    p[0] = '\\';
	    p[1] = '#';
	    p += 2;
	    src++;
	    length -= (length > 0);
	} else {

    if (argc <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = (char *)Tcl_Alloc(argc);
    }
    for (i = 0; i < argc; i++) {
	flagPtr[i] = ( i ? DONT_QUOTE_HASH : 0 );
	bytesNeeded += TclScanElement(argv[i], TCL_INDEX_NONE, &flagPtr[i]);
    }
    bytesNeeded += argc;

    /*
     * Pass two: copy into the result area.
     */

    result = (char *)Tcl_Alloc(bytesNeeded);
    dst = result;
    for (i = 0; i < argc; i++) {
	flagPtr[i] |= ( i ? DONT_QUOTE_HASH : 0 );
	dst += TclConvertElement(argv[i], TCL_INDEX_NONE, dst, flagPtr[i]);
	*dst = ' ';
	dst++;
    }
    dst[-1] = 0;

    if (flagPtr != localFlags) {

	while ((--dst >= dsPtr->string) && TclIsSpaceProcM(*dst)) {
	}

	/* Call again without whitespace to confound things. */
	quoteHash = !TclNeedSpace(dsPtr->string, dst+1);
    }
    if (!quoteHash) {
	flags |= DONT_QUOTE_HASH;
    }
    newSize = dsPtr->length + needSpace + TclScanElement(element, TCL_INDEX_NONE, &flags);
    if (!quoteHash) {
	flags |= DONT_QUOTE_HASH;
    }

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again. SPECIAL NOTE: must use
     * memcpy, not strcpy, to copy the string to a larger buffer, since there

	}								\
    } while (0)
#define ZIPFS_MEM_ERROR(interp) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(			\
		    "out of memory", -1));				\
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", (char *)NULL);	\
	}								\
    } while (0)
#define ZIPFS_POSIX_ERROR(interp,errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(			\
		    "%s: %s", errstr, Tcl_PosixError(interp)));		\
	}								\
    } while (0)
#define ZIPFS_ERROR_CODE(interp,errcode) \
    do {								\
	if (interp) {							\
	    Tcl_SetErrorCode(interp,					\
		    "TCL", "ZIPFS", errcode, (char *)NULL);		\
	}								\
    } while (0)

#include "zlib.h"
#include "crypt.h"
#include "zutil.h"
#include "crc32.h"

 * Various constants and offsets found in ZIP archive files
 */

#define ZIP_SIG_LEN			4

/*
 * Local header of ZIP archive member (at very beginning of each member).
 * C can't express this structure type even close to portably (thanks for
 * nothing, Clang and MSVC).
 */
enum ZipLocalEntryOffsets {
    ZIP_LOCAL_SIG_OFFS = 0,		/* sig field offset */
    ZIP_LOCAL_VERSION_OFFS = 4,		/* version field offset */
    ZIP_LOCAL_FLAGS_OFFS = 6,		/* flags field offset */
    ZIP_LOCAL_COMPMETH_OFFS = 8,	/* compMethod field offset */
    ZIP_LOCAL_MTIME_OFFS = 10,		/* modTime field offset */
    ZIP_LOCAL_MDATE_OFFS = 12,		/* modDate field offset */
    ZIP_LOCAL_CRC32_OFFS = 14,		/* crc32 field offset */
    ZIP_LOCAL_COMPLEN_OFFS = 18,	/* compLen field offset */
    ZIP_LOCAL_UNCOMPLEN_OFFS = 22,	/* uncompLen field offset */
    ZIP_LOCAL_PATHLEN_OFFS = 26,	/* pathLen field offset */
    ZIP_LOCAL_EXTRALEN_OFFS = 28,	/* extraLen field offset */
    ZIP_LOCAL_HEADER_LEN = 30		/* header part length */
};
#if 0
/* Recent enough GCC can do this. */
#define PACKED_LITTLE_ENDIAN \
    __attribute__((packed, scalar_storage_order("little-endian")))
#else
#undef PACKED_LITTLE_ENDIAN	/* Really don't support this yet! */
#endif
#ifdef PACKED_LITTLE_ENDIAN
/*
 * Local header of ZIP archive member (at very beginning of each member).
 */
struct PACKED_LITTLE_ENDIAN ZipLocalEntry {
    uint32_t sig;		// == ZIP_LOCAL_HEADER_SIG
    uint16_t version;
    uint16_t flags;
    uint16_t compMethod;
    uint16_t modTime;
    uint16_t modDate;
    uint32_t crc32;
    uint32_t compLen;
    uint32_t uncompLen;
    uint16_t pathLen;
    uint16_t extraLen;
};
#endif
#define ZIP_LOCAL_HEADER_SIG		0x04034b50

enum ZipLocalFlags {
    ZIP_LOCAL_FLAGS_UTF8 = 0x0800
};

/*
 * Central header of ZIP archive member at end of ZIP file.
 * C can't express this structure type even close to portably (thanks for
 * nothing, Clang and MSVC).
 */
enum ZipCentralEntryOffsets {
    ZIP_CENTRAL_SIG_OFFS = 0,		/* sig field offset */
    ZIP_CENTRAL_VERSIONMADE_OFFS = 4,	/* versionMade field offset */
    ZIP_CENTRAL_VERSION_OFFS = 6,	/* version field offset */
    ZIP_CENTRAL_FLAGS_OFFS = 8,		/* flags field offset */
    ZIP_CENTRAL_COMPMETH_OFFS = 10,	/* compMethod field offset */
    ZIP_CENTRAL_MTIME_OFFS = 12,	/* modTime field offset */
    ZIP_CENTRAL_MDATE_OFFS = 14,	/* modDate field offset */
    ZIP_CENTRAL_CRC32_OFFS = 16,	/* crc32 field offset */
    ZIP_CENTRAL_COMPLEN_OFFS = 20,	/* compLen field offset */
    ZIP_CENTRAL_UNCOMPLEN_OFFS = 24,	/* uncompLen field offset */
    ZIP_CENTRAL_PATHLEN_OFFS = 28,	/* pathLen field offset */
    ZIP_CENTRAL_EXTRALEN_OFFS = 30,	/* extraLen field offset */
    ZIP_CENTRAL_FCOMMENTLEN_OFFS = 32,	/* commentLen field offset */

    ZIP_CENTRAL_DISKFILE_OFFS = 34,	/* diskFile field offset */
    ZIP_CENTRAL_IATTR_OFFS = 36,	/* intAttr field offset */
    ZIP_CENTRAL_EATTR_OFFS = 38,	/* extAttr field offset */
    ZIP_CENTRAL_LOCALHDR_OFFS = 42,	/* localHeaderOffset field offset */
    ZIP_CENTRAL_HEADER_LEN = 46		/* header part length */
};
#ifdef PACKED_LITTLE_ENDIAN
/*
 * Central header of ZIP archive member at end of ZIP file.
 */
struct PACKED_LITTLE_ENDIAN ZipCentralEntry {
    uint32_t sig;		// == ZIP_CENTRAL_HEADER_SIG
    uint16_t versionMade;
    uint16_t version;
    uint16_t flags;
    uint16_t compMethod;
    uint16_t modTime;
    uint16_t modDate;
    uint32_t crc32;
    uint32_t compLen;
    uint32_t uncompLen;
    uint16_t pathLen;
    uint16_t extraLen;
    uint16_t commentLen;
    uint16_t diskFile;
    uint16_t intAttr;
    uint32_t extAttr;
    uint32_t localHeaderOffset;
};
#endif
#define ZIP_CENTRAL_HEADER_SIG		0x02014b50



















/*
 * Central end signature at very end of ZIP file.
 * C can't express this structure type even close to portably (thanks for
 * nothing, Clang and MSVC).
 */
enum ZipCentralMainOffsets {


    ZIP_CENTRAL_END_SIG_OFFS = 0,	/* sig field offset */
    ZIP_CENTRAL_DISKNO_OFFS = 4,	/* diskNum field offset */
    ZIP_CENTRAL_DISKDIR_OFFS = 6,	/* diskDir field offset */
    ZIP_CENTRAL_ENTS_OFFS = 8,		/* entriesOffset field offset */
    ZIP_CENTRAL_TOTALENTS_OFFS = 10,	/* totalEntries field offset */
    ZIP_CENTRAL_DIRSIZE_OFFS = 12,	/* dirSize field offset */
    ZIP_CENTRAL_DIRSTART_OFFS = 16,	/* dirStart field offset */
    ZIP_CENTRAL_COMMENTLEN_OFFS = 20,	/* commentLen field offset */
    ZIP_CENTRAL_END_LEN = 22		/* header part length */
};
#ifdef PACKED_LITTLE_ENDIAN
/*
 * Central end signature at very end of ZIP file.
 */
struct PACKED_LITTLE_ENDIAN ZipCentralMain {
    uint32_t sig;		// == ZIP_CENTRAL_END_SIG
    uint16_t diskNum;
    uint16_t diskDir;
    uint16_t entriesOffset;
    uint16_t totalEntries;
    uint32_t dirSize;
    uint32_t dirStart;
    uint16_t commentLen;
}
#endif
#define ZIP_CENTRAL_END_SIG		0x06054b50

#define ZIP_MIN_VERSION			20
enum ZipCompressionMethods {
    ZIP_COMPMETH_STORED = 0,
    ZIP_COMPMETH_DEFLATED = 8
};

#define ZIP_PASSWORD_END_SIG		0x5a5a4b50
#define ZIP_CRYPT_HDR_LEN		12

#define ZIP_MAX_FILE_SIZE		INT_MAX
#define DEFAULT_WRITE_MAX_SIZE		ZIP_MAX_FILE_SIZE

    unsigned char *data;	/* Memory mapped or malloc'ed file */
    size_t length;		/* Length of memory mapped file */
    void *ptrToFree;		/* Non-NULL if malloc'ed file */
    size_t numFiles;		/* Number of files in archive */
    size_t baseOffset;		/* Archive start */
    size_t passOffset;		/* Password start */
    size_t directoryOffset;	/* Archive directory start */
    size_t directorySize;	/* Size of archive directory */
    unsigned char passBuf[264];	/* Password buffer */
    size_t numOpen;		/* Number of open files on archive */
    struct ZipEntry *entries;	/* List of files in archive */
    struct ZipEntry *topEnts;	/* List of top-level dirs in archive */
    char *mountPoint;		/* Mount point name */
    Tcl_Size mountPointLen;	/* Length of mount point name */
#ifdef _WIN32
    HANDLE mountHandle;		/* Handle used for direct file access. */

				 * -1 for zip64 */
    int compressMethod;		/* Compress method */
    int isDirectory;		/* 0 if file, 1 if directory, -1 if root */
    int depth;			/* Number of slashes in path. */
    int crc32;			/* CRC-32 as stored in ZIP */
    int timestamp;		/* Modification time */
    int isEncrypted;		/* True if data is encrypted */
    int flags;			/* See ZipEntryFlags for bit definitions. */



    unsigned char *data;	/* File data if written */
    struct ZipEntry *next;	/* Next file in the same archive */
    struct ZipEntry *tnext;	/* Next top-level dir in archive */
} ZipEntry;

enum ZipEntryFlags {
    ZE_F_CRC_COMPARED = 1,	/* If 1, the CRC has been compared. */
    ZE_F_CRC_CORRECT = 2,	/* Only meaningful if ZE_F_CRC_COMPARED is 1 */
    ZE_F_VOLUME = 4		/* Entry corresponds to //zipfs:/ */
};

/*
 * File channel for file contained in mounted ZIP archive.
 *
 * Regarding data buffers:
 * For READ-ONLY files that are not encrypted and not compressed (zip STORE
 * method), ubuf points directly to the mapped zip file data in memory. No

typedef struct ZipChannel {
    ZipFile *zipFilePtr;	/* The ZIP file holding this channel */
    ZipEntry *zipEntryPtr;	/* Pointer back to virtual file */
    Tcl_Size maxWrite;		/* Maximum size for write */
    Tcl_Size numBytes;		/* Number of bytes of uncompressed data */
    Tcl_Size cursor;		/* Seek position for next read or write*/
    unsigned char *ubuf;	/* Pointer to the uncompressed data */
    unsigned char *ubufToFree;	/* NULL if ubuf points to memory that does not
				 * need freeing. Else memory to free (ubuf
				 * may point *inside* the block) */
    Tcl_Size ubufSize;		/* Size of allocated ubufToFree */
    int iscompr;		/* True if data is compressed */
    int isDirectory;		/* Set to 1 if directory, or -1 if root */
    int isEncrypted;		/* True if data is encrypted */
    int mode;			/* O_WRITE, O_APPEND, O_TRUNC etc.*/
    unsigned long keys[3];	/* Key for decryption */
} ZipChannel;

static inline int

static int		ListMountPoints(Tcl_Interp *interp);
static int		ContainsMountPoint(const char *path, int pathLen);
static void		CleanupMount(ZipFile *zf);
static Tcl_Obj *	ScriptLibrarySetup(const char *dirName);
static void		SerializeCentralDirectoryEntry(
			    const unsigned char *start,
			    const unsigned char *end, unsigned char *buf,
			    ZipEntry *z, size_t nameLength,
			    long long dataStartOffset);
static void		SerializeCentralDirectorySuffix(
			    const unsigned char *start,
			    const unsigned char *end, unsigned char *buf,
			    int entryCount, long long dataStartOffset,
			    long long directoryStartOffset,
			    long long suffixStartOffset);
static void		SerializeLocalEntryHeader(
			    const unsigned char *start,
			    const unsigned char *end, unsigned char *buf,
			    ZipEntry *z, int nameLength, int align);
static int		IsCryptHeaderValid(ZipEntry *z,
			    unsigned char cryptHdr[ZIP_CRYPT_HDR_LEN]);

		int lenz = (int) strlen(z->name);
		if ((lenz >= pathLen) &&
			(z->name[pathLen] == '/' || z->name[pathLen] == '\0') &&
			(strncmp(z->name, path, pathLen) == 0)) {
		    return 1;
		}
	    }
	} else if ((zf->mountPointLen >= pathLen)
		&& (zf->mountPoint[pathLen] == '/'
			|| zf->mountPoint[pathLen] == '\0'
			|| pathLen == ZIPFS_VOLUME_LEN)
		&& (strncmp(zf->mountPoint, path, pathLen) == 0)) {
	    /* Matched standard mount */
	    return 1;
	}
    }
    return 0;
}

		    ret = TCL_ERROR;
		} else {
		    ret = ZipFSOpenArchive(interp, normPath, 1, zf);
		    if (ret != TCL_OK) {
			Tcl_Free(zf);
		    } else {
			ret = ZipFSCatalogFilesystem(
				interp, zf, mountPoint, passwd, normPath);
			/* Note zf is already freed on error! */
		    }
		}
	    }
	    Tcl_DecrRefCount(normZipPathObj);
	    if (ret == TCL_OK && interp) {
		Tcl_DStringResult(interp, &ds);

    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *mountPoint = NULL, *zipFile = NULL, *password = NULL;
    int result;

    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?zipfile? ?mountpoint? ?password?");

	return TCL_ERROR;
    }
    /*
     * A single argument is treated as the mountpoint. Two arguments
     * are treated as zipfile and mountpoint.
     */
    if (objc > 1) {

    }

    /*
     * Convert to encoded form. Note that we use strlen() here; if someone's
     * crazy enough to embed NULs in filenames, they deserve what they get!
     */

    if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, zpathTcl,
	    TCL_INDEX_NONE, 0, &zpathDs, NULL) != TCL_OK) {
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
    }
    zpathExt = Tcl_DStringValue(&zpathDs);
    zpathlen = strlen(zpathExt);
    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(

		return TCL_ERROR;
	    }
	    kvbuf[i + ZIP_CRYPT_HDR_LEN] = UCHAR(zencode(keys, crc32tab, ch, tmp));
	}
	Tcl_ResetResult(interp);
	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < ZIP_CRYPT_HDR_LEN - 2; i++) {
	    kvbuf[i] = UCHAR(zencode(keys, crc32tab,
		    kvbuf[i + ZIP_CRYPT_HDR_LEN], tmp));
	}
	kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 16, tmp));
	kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 24, tmp));
	len = Tcl_Write(out, (char *) kvbuf, ZIP_CRYPT_HDR_LEN);
	memset(kvbuf, 0, sizeof(kvbuf));
	if (len != ZIP_CRYPT_HDR_LEN) {
	    goto writeErrorWithChannelOpen;

static inline const char *
ComputeNameInArchive(
    Tcl_Obj *pathObj,		/* The path to the origin file */
    Tcl_Obj *directNameObj,	/* User-specified name for use in the ZIP
				 * archive */
    const char *strip,		/* A prefix to strip; may be NULL if no
				 * stripping need be done. */
    Tcl_Size slen)		/* The length of the prefix; must be 0 if no
				 * stripping need be done. */
{
    const char *name;
    Tcl_Size len;

    if (directNameObj) {
	name = TclGetString(directNameObj);

    Tcl_Obj *passwordObj)	/* The password for encoding things. NULL if
				 * there's no password protection. */
{
    Tcl_Channel out;
    int count, ret = TCL_ERROR;
    Tcl_Size pwlen = 0, slen = 0, len, i = 0;
    Tcl_Size lobjc;
    long long dataStartOffset;	/* The overall file offset of the start of the
				 * data section of the file. */
    long long directoryStartOffset;
				/* The overall file offset of the start of the
				 * central directory. */
    long long suffixStartOffset;/* The overall file offset of the start of the
				 * suffix of the central directory (i.e.,
				 * where this data will be written). */
    Tcl_Obj **lobjv, *list = mappingList;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

			"write error: %s", Tcl_PosixError(interp)));
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	}
	memset(passBuf, 0, sizeof(passBuf));
	Tcl_Flush(out);
	dataStartOffset = Tcl_Tell(out);
    } else {
	dataStartOffset = 0;
    }

    /*
     * Prepare the contents of the ZIP archive.
     */

    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);

	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, z->name,
		TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) {
	    ret = TCL_ERROR;
	    goto done;
	}
	name = Tcl_DStringValue(&ds);
	len = Tcl_DStringLength(&ds);
	SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
		z, len, dataStartOffset);
	if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN)
		!= ZIP_CENTRAL_HEADER_LEN)
		|| (Tcl_Write(out, name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error: %s", Tcl_PosixError(interp)));
	    Tcl_DStringFree(&ds);
	    goto done;
	}
	Tcl_DStringFree(&ds);
	count++;
    }

    /*
     * Finalize the central directory.
     */

    Tcl_Flush(out);
    suffixStartOffset = Tcl_Tell(out);
    SerializeCentralDirectorySuffix(start, end, (unsigned char *) buf,
	    count, dataStartOffset, directoryStartOffset, suffixStartOffset);
    if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	goto done;
    }
    Tcl_Flush(out);
    ret = TCL_OK;

    unsigned char *buf,		/* Where to serialize to */
    ZipEntry *z,		/* The description of what to serialize. */
    int nameLength,		/* The length of the name. */
    int align)			/* The number of alignment bytes. */
{
    ZipWriteInt(start, end, buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_FLAGS_OFFS,
	    z->isEncrypted + ZIP_LOCAL_FLAGS_UTF8);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_COMPMETH_OFFS,
	    z->compressMethod);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_MTIME_OFFS,
	    ToDosTime(z->timestamp));
    ZipWriteShort(start, end, buf + ZIP_LOCAL_MDATE_OFFS,
	    ToDosDate(z->timestamp));
    ZipWriteInt(start, end, buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
    ZipWriteInt(start, end, buf + ZIP_LOCAL_COMPLEN_OFFS,
	    z->numCompressedBytes);
    ZipWriteInt(start, end, buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_PATHLEN_OFFS, nameLength);
    ZipWriteShort(start, end, buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
}

static void
SerializeCentralDirectoryEntry(
    const unsigned char *start,	/* The start of writable memory. */
    const unsigned char *end,	/* The end of writable memory. */
    unsigned char *buf,		/* Where to serialize to */
    ZipEntry *z,		/* The description of what to serialize. */
    size_t nameLength,		/* The length of the name. */
    long long dataStartOffset)	/* The overall file offset of the start of the
				 * data section of the file. */
{
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_SIG_OFFS,
	    ZIP_CENTRAL_HEADER_SIG);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_VERSIONMADE_OFFS,
	    ZIP_MIN_VERSION);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_FLAGS_OFFS,
	    z->isEncrypted + ZIP_LOCAL_FLAGS_UTF8);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_COMPMETH_OFFS,
	    z->compressMethod);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_MTIME_OFFS,
	    ToDosTime(z->timestamp));
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_MDATE_OFFS,
	    ToDosDate(z->timestamp));
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_COMPLEN_OFFS,
	    z->numCompressedBytes);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->numBytes);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_PATHLEN_OFFS, nameLength);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_IATTR_OFFS, 0);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_EATTR_OFFS, 0);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_LOCALHDR_OFFS,
	    z->offset - dataStartOffset);
}

static void
SerializeCentralDirectorySuffix(
    const unsigned char *start,	/* The start of writable memory. */
    const unsigned char *end,	/* The end of writable memory. */
    unsigned char *buf,		/* Where to serialize to */
    int entryCount,		/* The number of entries in the directory */
    long long dataStartOffset,
				/* The overall file offset of the start of the
				 * data file. */
    long long directoryStartOffset,
				/* The overall file offset of the start of the
				 * central directory. */
    long long suffixStartOffset)/* The overall file offset of the start of the
				 * suffix of the central directory (i.e.,
				 * where this data will be written). */
{
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_END_SIG_OFFS,
	    ZIP_CENTRAL_END_SIG);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_ENTS_OFFS, entryCount);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_TOTALENTS_OFFS, entryCount);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_DIRSIZE_OFFS,
	    suffixStartOffset - directoryStartOffset);
    ZipWriteInt(start, end, buf + ZIP_CENTRAL_DIRSTART_OFFS,
	    directoryStartOffset - dataStartOffset);
    ZipWriteShort(start, end, buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd --

	mntPoint = ZIPFS_VOLUME;
    } else {
	if (NormalizeMountPoint(interp, Tcl_GetString(objv[1]), &dsMount) != TCL_OK) {
	    return TCL_ERROR;
	}
	mntPoint = Tcl_DStringValue(&dsMount);
    }
    (void)MapPathToZipfs(interp, mntPoint, Tcl_GetString(objv[objc - 1]),


	    &dsPath);
    Tcl_SetObjResult(interp, Tcl_DStringToObj(&dsPath));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *

    if (ZipChannelWritable(info)) {
	/*
	 * Copy channel data back into original file in archive.
	 */
	ZipEntry *z = info->zipEntryPtr;
	assert(info->ubufToFree && info->ubuf);
	unsigned char *newdata;
	newdata = (unsigned char *) Tcl_AttemptRealloc(
		info->ubufToFree,
		info->numBytes ? info->numBytes : 1); /* Bug [23dd83ce7c] */
	if (newdata == NULL) {
	    /* Could not reallocate, keep existing buffer */
	    newdata = info->ubufToFree;
	}
	info->ubufToFree = NULL; /* Now newdata! */
	info->ubuf = NULL;
	info->ubufSize = 0;

	Tcl_Size needed = info->cursor + toWrite;
	/* Tack on a bit for future growth. */
	if (needed < (info->maxWrite - needed/2)) {
	    needed += needed / 2;
	} else {
	    needed = info->maxWrite;
	}
	unsigned char *newBuf = (unsigned char *)
		Tcl_AttemptRealloc(info->ubufToFree, needed);
	if (newBuf == NULL) {
	    *errloc = ENOMEM;
	    return -1;
	}
	info->ubufToFree = newBuf;
	info->ubuf = info->ubufToFree;
	info->ubufSize = needed;

	return -1;
    }
    if (types) {
	wanted = types->type;
	if ((wanted & TCL_GLOB_TYPE_MOUNT) && (wanted != TCL_GLOB_TYPE_MOUNT)) {
	    if (interp) {
		ZIPFS_ERROR(interp,
			"Internal error: TCL_GLOB_TYPE_MOUNT should not "
			"be set in conjunction with other glob types.");
	    }
	    return TCL_ERROR;
	}
	if ((wanted & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE |
		TCL_GLOB_TYPE_MOUNT)) == 0) {
	    /* Not looking for files,dirs,mounts. zipfs cannot have others */
	    return TCL_OK;

	break;
    case ZIP_ATTR_OFFSET:
	TclNewIntObj(*objPtrRef, z ? z->offset : 0);
	break;
    case ZIP_ATTR_MOUNT:
	if (z) {
	    *objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
		    z->zipFilePtr->mountPointLen);
	} else {
	    *objPtrRef = Tcl_NewStringObj("", 0);
	}
	break;
    case ZIP_ATTR_ARCHIVE:
	*objPtrRef = Tcl_NewStringObj(z ? z->zipFilePtr->name : "", -1);
	break;

#
# All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require -exact tcl 9.0.2

# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.

#include "tclPort.h"
#include "tclInt.h"

#ifdef HAVE_COREFOUNDATION
#include <CoreFoundation/CoreFoundation.h>
























#include <dlfcn.h>



















#ifdef TCL_DEBUG_LOAD
#define TclLoadDbgMsg(m, ...) \
    do {								\
	fprintf(stderr, "%s:%d: %s(): " m ".\n",			\
		strrchr(__FILE__, '/')+1, __LINE__, __func__,		\
		##__VA_ARGS__);						\

OpenResourceMap(
    CFBundleRef bundleRef)
{
    static int initialized = FALSE;
    static short (*openresourcemap)(CFBundleRef) = NULL;

    if (!initialized) {




	{
	    openresourcemap = (short (*)(CFBundleRef))dlsym(RTLD_NEXT,
		    "CFBundleOpenBundleResourceMap");
#ifdef TCL_DEBUG_LOAD
	    if (!openresourcemap) {
		const char *errMsg = dlerror();

		TclLoadDbgMsg("dlsym() failed: %s", errMsg);
	    }
#endif /* TCL_DEBUG_LOAD */
	}















	initialized = TRUE;
    }

    if (openresourcemap) {
	return openresourcemap(bundleRef);
    }
    return -1;

	     */

	    CFURLGetFileSystemRepresentation(libURL, TRUE,
		    (unsigned char *) libraryPath, maxPathLen);
	    CFRelease(libURL);
	}
	if (versionedBundleRef) {







	    {
		CFRelease(versionedBundleRef);
	    }
	}
    }

    if (libraryPath[0]) {

#include <libkern/OSByteOrder.h>
#endif

/* Darwin 8 copyfile API. */
#ifdef HAVE_COPYFILE
#ifdef HAVE_COPYFILE_H
#include <copyfile.h>







#else /* HAVE_COPYFILE_H */
int			copyfile(const char *from, const char *to,
			    void *state, uint32_t flags);
#define COPYFILE_ACL		(1<<0)
#define COPYFILE_XATTR		(1<<2)
#define COPYFILE_NOFOLLOW_SRC	(1<<18)







#endif /* HAVE_COPYFILE_H */
#endif /* HAVE_COPYFILE */

#ifdef WEAK_IMPORT_COPYFILE
#define MayUseCopyFile()	(copyfile != NULL)
#elif defined(HAVE_COPYFILE)
#define MayUseCopyFile()	(1)

 * In macOS 10.12 the os_unfair_lock was introduced as a replacement for the
 * OSSpinLock, and the OSSpinLock was deprecated.
 */

#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200
#define USE_OS_UNFAIR_LOCK
#include <os/lock.h>

#endif

#ifdef HAVE_COREFOUNDATION	/* Traditional unix select-based notifier is
				 * in tclUnixNotfy.c */
#include <CoreFoundation/CoreFoundation.h>
#include <pthread.h>



#if  !defined(USE_OS_UNFAIR_LOCK)

/*
 * We use the Darwin-native spinlock API rather than pthread mutexes for
 * notifier locking: this radically simplifies the implementation and lowers
 * overhead. Note that these are not pure spinlocks, they employ various
 * strategies to back off and relinquish the processor, making them immune to

#pragma GCC diagnostic ignored "-Wunused-function"
/*
 * Use OSSpinLock API where available (Tiger or later).
 */

#include <libkern/OSAtomic.h>






































































/*
 * Wrappers so that we get warnings in just one small part of this file.
 */

static inline void
SpinLockLock(
    OSSpinLock *lock)

}
static inline bool
SpinLockTry(
    OSSpinLock *lock)
{
    return OSSpinLockTry(lock);
}

#define SPINLOCK_INIT		OS_SPINLOCK_INIT

#else
/*
 * Otherwise, use commpage spinlock SPI directly.
 */

#define UNLOCK_NOTIFIER_INIT	SpinLockUnlock(&notifierInitLock)
#define LOCK_NOTIFIER		SpinLockLock(&notifierLock)
#define UNLOCK_NOTIFIER		SpinLockUnlock(&notifierLock)
#define LOCK_NOTIFIER_TSD	SpinLockLock(&tsdPtr->tsdLock)
#define UNLOCK_NOTIFIER_TSD	SpinLockUnlock(&tsdPtr->tsdLock)
#endif














































































/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
 */

typedef struct FileHandler {
    int fd;