Itcl - the [incr Tcl] extension

#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for itcl 4.2.0.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.

subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME='itcl'
PACKAGE_TARNAME='itcl'
PACKAGE_VERSION='4.2.0'
PACKAGE_STRING='itcl 4.2.0'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H

#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures itcl 4.2.0 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of itcl 4.2.0:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]

    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
itcl configure 4.2.0
generated by GNU Autoconf 2.69

Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit

  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_type
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by itcl $as_me 4.2.0, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{

test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by itcl $as_me 4.2.0, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@

Report bugs to the package provider."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
itcl config.status 4.2.0
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
# set as provided.  These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
# This will also define a special symbol for Windows (BUILD_<PACKAGE_NAME>
# so that we create the export library with the dll.
#-----------------------------------------------------------------------

AC_INIT([itcl], [4.2.0])

#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------

'\"
'\" Copyright (c) 1993-1998  Lucent Technologies, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Itcl_PreserveData 3 3.0 itcl "[incr\ Tcl] Library Procedures"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Itcl_Alloc, Itcl_Free, Itcl_PreserveData, Itcl_ReleaseData, Itcl_EventuallyFree \- Manipulate an Itcl list object.
.SH SYNOPSIS
.nf
\fB#include <itcl.h>\fR

void *
\fBItcl_Alloc\fR(\fIsize\fR)

void
\fBItcl_PreserveData\fR(\fIptr\fR)

void
\fBItcl_ReleaseData\fR(\fIptr\fR)

void
\fBItcl_EventuallyFree\fR(\fIptr, fproc\fR)

void
\fBItcl_Free\fR(\fIptr\fR)
.fi
.SH ARGUMENTS
.AP size_t size in
Number of bytes to allocate.
.AP void *ptr in
Pointer value allocated by \fBItcl_Alloc\fR.
.AP Tcl_FreeProc *fproc in
Address of function to call when the block is to be freed.


.BE

.SH DESCRIPTION
.PP
These procedures are used to allocate and release memory, especially blocks
of memory that will be used by multiple independent modules. They are similar
in function to the routines in the public Tcl interface, \fBTcl_Alloc\fR,
\fBTcl_Free\fR, \fBTcl_Preserve\fR, \fBTcl_Release\fR, and
\fBTcl_EventuallyFree\fR. The Tcl routines suffer from issues with
performance scaling as the number of blocks managed grows large. The facilities
of Itcl encounter these performance scaling issues and require an
alternative that does not suffer from them.
.PP
\fBItcl_Alloc\fR returns an untyped pointer to an allocated block
of memory of at least \fIsize\fR bytes.
.PP
A module calls \fBItcl_PreserveData\fR on a pointer \fIptr\fR 
allocated by \fBItcl_Alloc\fR to prevent deallocation of that memory while
the module remains interested in it.
.PP
A module calls \fBItcl_ReleaseData\fR on a pointer \fIptr\fR previously
preserved by \fBItcl_PreserveData\fR to indicate the module no longer has
an interest in the block of memory, and will not be disturbed by its
deallocation.
.PP
\fBItcl_EventuallyFree\fR is called on a pointer \fIptr\fR allocated by
\fBItcl_Alloc\fR to register a deallocation routine \fIfproc\fR to be
called when the number of calls to \fBItcl_ReleaseData\fR on \fIptr\fR
matches the number of calls to \fBItcl_PreserveData\fR on \fIptr\fR. This
condition indicates all modules have ended their interest in the block
of memory and a call to \fIfproc\ with argument \fIptr\fR will deallocate
the memory that no module needs anymore.
.PP
\fBItcl_Free\fR is a deallocation routine for a \fIptr\fR value allocated
by \fBItcl_Alloc\fR. It may be called on any \fIptr\fR with no history of
an \fBItcl_PreserveData\fR call unmatched by an \fBItcl_ReleaseData\fR
call. It is best used as an \fIfproc\fR argument to \fBItcl_EventuallyFree\fR
or as a routine called from within such an \fIfproc\fR routine. It can also
be used to deallocate a \fIptr\fR value when it can be assured that value
has never been passed to \fBItcl_PreserveData\fR or \fBItcl_EventuallyFree\fR.

.SH KEYWORDS
free, memory

}
declare 24 {
    int Itcl_RestoreInterpState(Tcl_Interp *interp, Itcl_InterpState state)
}
declare 25 {
    void Itcl_DiscardInterpState(Itcl_InterpState state)
}
declare 26 {
    void * Itcl_Alloc(size_t size)
}
declare 27 {
    void Itcl_Free(void *ptr)
}


# private API
interface itclInt
#
# Functions used within the package, but not considered "public"
#

#   define TCL_BETA_RELEASE     1
#endif
#ifndef TCL_FINAL_RELEASE
#   define TCL_FINAL_RELEASE    2
#endif

#define ITCL_MAJOR_VERSION	4
#define ITCL_MINOR_VERSION	2
#define ITCL_RELEASE_LEVEL      TCL_FINAL_RELEASE
#define ITCL_RELEASE_SERIAL     0

#define ITCL_VERSION            "4.2"
#define ITCL_PATCH_LEVEL        "4.2.0"


/*
 * A special definition used to allow this header file to be included from
 * windows resource files so that they can obtain version information.
 * RC_INVOKED is defined by default by the windows RC tool.
 *

    clazzObjectPtr = Tcl_GetObjectFromObj(interp, objPtr);
    if (!clazzObjectPtr || !(tclCls = Tcl_GetObjectAsClass(clazzObjectPtr))) {
	Tcl_DecrRefCount(objPtr);
        return TCL_ERROR;
    }
    Tcl_DecrRefCount(objPtr);

    infoPtr = (ItclObjectInfo*)Itcl_Alloc(sizeof(ItclObjectInfo));

    nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE, infoPtr, FreeItclObjectInfo);
    if (nsPtr == NULL) {
	Itcl_Free(infoPtr);
        Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", ITCL_NAMESPACE);
    }

    nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE"::internal::dicts",
            NULL, NULL);
    if (nsPtr == NULL) {
	Itcl_Free(infoPtr);
        Tcl_Panic("Itcl: cannot create namespace: \"%s::internal::dicts\" \n",
	        ITCL_NAMESPACE);
    }

    /*
     *  Create the top-level data structure for tracking objects.
     *  Store this as "associated data" for easy access, but link
     *  it to the itcl namespace for ownership.
     */

    infoPtr->interp = interp;
    infoPtr->class_meta_type = (Tcl_ObjectMetadataType *)ckalloc(
            sizeof(Tcl_ObjectMetadataType));
    infoPtr->class_meta_type->version = TCL_OO_METADATA_VERSION_CURRENT;
    infoPtr->class_meta_type->name = "ItclClass";
    infoPtr->class_meta_type->deleteProc = ItclDeleteClassMetadata;
    infoPtr->class_meta_type->cloneProc = NULL;

    Tcl_InitHashTable(&iclsPtr->resolveVars, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iclsPtr->contextCache, TCL_ONE_WORD_KEYS);

    Itcl_InitList(&iclsPtr->bases);
    Itcl_InitList(&iclsPtr->derived);

    resolveInfoPtr = (ItclResolveInfo *) ckalloc(sizeof(ItclResolveInfo));
    memset(resolveInfoPtr, 0, sizeof(ItclResolveInfo));
    resolveInfoPtr->flags = ITCL_RESOLVE_CLASS;
    resolveInfoPtr->iclsPtr = iclsPtr;
    iclsPtr->resolvePtr = (Tcl_Resolve *)ckalloc(sizeof(Tcl_Resolve));
    iclsPtr->resolvePtr->cmdProcPtr = Itcl_CmdAliasProc;
    iclsPtr->resolvePtr->varProcPtr = Itcl_VarAliasProc;
    iclsPtr->resolvePtr->clientData = resolveInfoPtr;
    iclsPtr->flags    = infoPtr->currClassFlags;

     */
    hPtr = Tcl_FirstHashEntry(&iclsPtr->infoPtr->objects, &place);
    while (hPtr) {
        ioPtr = (ItclObject*)Tcl_GetHashValue(hPtr);
        if (ioPtr->iclsPtr == iclsPtr) {
	    if ((ioPtr->accessCmd != NULL) && (!(ioPtr->flags &
	            (ITCL_OBJECT_IS_DESTRUCTED)))) {
		Itcl_PreserveData(ioPtr);
                Tcl_DeleteCommandFromToken(iclsPtr->interp, ioPtr->accessCmd);
	        ioPtr->accessCmd = NULL;
		Itcl_ReleaseData(ioPtr);
	        /*
	         * Fix 227804: Whenever an object to delete was found we
	         * have to reset the search to the beginning as the
	         * current entry in the search was deleted and accessing it
	         * is therefore not allowed anymore.
	         */

    Tcl_DeleteHashTable(&iclsPtr->options);

    /*
     *  Delete all function definitions.
     */
    FOREACH_HASH_VALUE(imPtr, &iclsPtr->functions) {
	imPtr->iclsPtr = NULL;
        Itcl_ReleaseData(imPtr);
    }
    Tcl_DeleteHashTable(&iclsPtr->functions);

    /*
     *  Delete all delegated options.
     */
    FOREACH_HASH_VALUE(idoPtr, &iclsPtr->delegatedOptions) {

    Tcl_DecrRefCount(iclsPtr->namePtr);
    Tcl_DecrRefCount(iclsPtr->fullNamePtr);

    if (iclsPtr->resolvePtr != NULL) {
        ckfree((char *)iclsPtr->resolvePtr->clientData);
        ckfree((char *)iclsPtr->resolvePtr);
    }
    ckfree(iclsPtr);
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_IsClassNamespace()
 *

     */
    if (config) {
        if (Itcl_CreateMemberCode(interp, iclsPtr, NULL, config,
                &mCodePtr) != TCL_OK) {
            Tcl_DeleteHashEntry(hPtr);
            return TCL_ERROR;
        }
	Itcl_PreserveData(mCodePtr);
    } else {
        mCodePtr = NULL;
    }


    /*
     *  If everything looks good, create the variable definition.
     */

    ivPtr = (ItclVariable*)Itcl_Alloc(sizeof(ItclVariable));
    ivPtr->iclsPtr      = iclsPtr;
    ivPtr->infoPtr      = iclsPtr->infoPtr;
    ivPtr->protection   = Itcl_Protection(interp, 0);
    ivPtr->codePtr      = mCodePtr;
    ivPtr->namePtr      = namePtr;
    Tcl_IncrRefCount(ivPtr->namePtr);
    ivPtr->fullNamePtr = Tcl_NewStringObj(

        hPtr = Tcl_FindHashEntry(&ivPtr->iclsPtr->variables,
                (char *)ivPtr->namePtr);
        if (hPtr != NULL) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    if (ivPtr->codePtr != NULL) {
	Itcl_ReleaseData(ivPtr->codePtr);
    }
    Tcl_DecrRefCount(ivPtr->namePtr);
    Tcl_DecrRefCount(ivPtr->fullNamePtr);
    if (ivPtr->init) {
        Tcl_DecrRefCount(ivPtr->init);
    }
    if (ivPtr->arrayInitPtr) {
        Tcl_DecrRefCount(ivPtr->arrayInitPtr);
    }
    Itcl_Free(ivPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteOption()
 *
 *  Destroys a option definition created by Itcl_CreateOption(),

        Tcl_DecrRefCount(ioptPtr->resourceNamePtr);
    }
    if (ioptPtr->resourceNamePtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->classNamePtr);
    }

    if (ioptPtr->codePtr) {
	Itcl_ReleaseData(ioptPtr->codePtr);
    }
    if (ioptPtr->defaultValuePtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->defaultValuePtr);
    }
    if (ioptPtr->cgetMethodPtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->cgetMethodPtr);
    }

    if (ioptPtr->validateMethodPtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->validateMethodPtr);
    }
    if (ioptPtr->validateMethodVarPtr != NULL) {
        Tcl_DecrRefCount(ioptPtr->validateMethodVarPtr);
    }
    Itcl_ReleaseData(ioptPtr->idoPtr);
    Itcl_Free(ioptPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteFunction()
 *
 *  fre data associated with a function

        hPtr = Tcl_FindHashEntry(&imPtr->iclsPtr->functions,
                (char *)imPtr->namePtr);
        if (hPtr != NULL) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    if (imPtr->codePtr != NULL) {
        Itcl_ReleaseData(imPtr->codePtr);
    }
    Tcl_DecrRefCount(imPtr->namePtr);
    Tcl_DecrRefCount(imPtr->fullNamePtr);
    if (imPtr->usagePtr != NULL) {
        Tcl_DecrRefCount(imPtr->usagePtr);
    }
    if (imPtr->argumentPtr != NULL) {

    }
    if (imPtr->bodyPtr != NULL) {
        Tcl_DecrRefCount(imPtr->bodyPtr);
    }
    if (imPtr->argListPtr != NULL) {
        ItclDeleteArgList(imPtr->argListPtr);
    }
    Itcl_Free(imPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteComponent()
 *
 *  free data associated with a component

    }
    FOREACH_HASH_VALUE(objPtr, &idoPtr->exceptions) {
	if (objPtr != NULL) {
            Tcl_DecrRefCount(objPtr);
        }
    }
    Tcl_DeleteHashTable(&idoPtr->exceptions);
    Itcl_Free(idoPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteDelegatedFunction()
 *
 *  free data associated with a delegated function

#endif


/* !BEGIN!: Do not edit below this line. */

#define ITCL_STUBS_EPOCH 0
#define ITCL_STUBS_REVISION 152

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:

/* 23 */
ITCLAPI Itcl_InterpState Itcl_SaveInterpState(Tcl_Interp *interp, int status);
/* 24 */
ITCLAPI int		Itcl_RestoreInterpState(Tcl_Interp *interp,
				Itcl_InterpState state);
/* 25 */
ITCLAPI void		Itcl_DiscardInterpState(Itcl_InterpState state);
/* 26 */
ITCLAPI void *		Itcl_Alloc(size_t size);
/* 27 */
ITCLAPI void		Itcl_Free(void *ptr);

typedef struct {
    const struct ItclIntStubs *itclIntStubs;
} ItclStubHooks;

typedef struct ItclStubs {
    int magic;

    void (*itcl_SetListValue) (Itcl_ListElem *elemPtr, ClientData val); /* 19 */
    void (*itcl_EventuallyFree) (ClientData cdata, Tcl_FreeProc *fproc); /* 20 */
    void (*itcl_PreserveData) (ClientData cdata); /* 21 */
    void (*itcl_ReleaseData) (ClientData cdata); /* 22 */
    Itcl_InterpState (*itcl_SaveInterpState) (Tcl_Interp *interp, int status); /* 23 */
    int (*itcl_RestoreInterpState) (Tcl_Interp *interp, Itcl_InterpState state); /* 24 */
    void (*itcl_DiscardInterpState) (Itcl_InterpState state); /* 25 */
    void * (*itcl_Alloc) (size_t size); /* 26 */
    void (*itcl_Free) (void *ptr); /* 27 */
} ItclStubs;

extern const ItclStubs *itclStubsPtr;

#ifdef __cplusplus
}
#endif

	(itclStubsPtr->itcl_ReleaseData) /* 22 */
#define Itcl_SaveInterpState \
	(itclStubsPtr->itcl_SaveInterpState) /* 23 */
#define Itcl_RestoreInterpState \
	(itclStubsPtr->itcl_RestoreInterpState) /* 24 */
#define Itcl_DiscardInterpState \
	(itclStubsPtr->itcl_DiscardInterpState) /* 25 */
#define Itcl_Alloc \
	(itclStubsPtr->itcl_Alloc) /* 26 */
#define Itcl_Free \
	(itclStubsPtr->itcl_Free) /* 27 */

#endif /* defined(USE_ITCL_STUBS) */

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

#endif /* _ITCLDECLS */

    Tcl_Obj *hullWindowNamePtr;   /* the window path name for the hull
                                   * (before renaming in installhull) */
    int destructorHasBeenCalled;  /* is set when the destructor is called
                                   * to avoid callin destructor twice */
    int noComponentTrace;         /* don't call component traces if
                                   * setting components in DelegationInstall */
    int hadConstructorError;      /* needed for multiple calls of CallItclObjectCmd */

} ItclObject;

#define ITCL_IGNORE_ERRS  0x002  /* useful for construction/destruction */

typedef struct ItclResolveInfo {
    int flags;
    ItclClass *iclsPtr;

    Tcl_Obj *bodyPtr;           /* the function body */
    ItclArgList *argListPtr;    /* the parsed arguments */
    union {
        Tcl_CmdProc *argCmd;    /* (argc,argv) C implementation */
        Tcl_ObjCmdProc *objCmd; /* (objc,objv) C implementation */
    } cfunc;
    ClientData clientData;      /* client data for C implementations */

} ItclMemberCode;

/*
 *  Flag bits for ItclMemberCode:
 */
#define ITCL_IMPLEMENT_NONE    0x001  /* no implementation */
#define ITCL_IMPLEMENT_TCL     0x002  /* Tcl implementation */

    Tcl_Obj *origArgsPtr;       /* the argument string of the original definition */
    Tcl_Obj *bodyPtr;           /* the function body */
    ItclArgList *argListPtr;    /* the parsed arguments */
    ItclClass *declaringClassPtr; /* the class which declared the method/proc */
    ClientData tmPtr;           /* TclOO methodPtr */
    ItclDelegatedFunction *idmPtr;
                                /* if the function is delegated != NULL */

} ItclMemberFunc;

/*
 *  Instance variables.
 */
typedef struct ItclVariable {
    Tcl_Obj *namePtr;           /* member name */

#endif

MODULE_SCOPE Tcl_ObjCmdProc ItclCallCCommand;
MODULE_SCOPE Tcl_ObjCmdProc ItclObjectUnknownCommand;
MODULE_SCOPE int ItclCheckCallProc(ClientData clientData, Tcl_Interp *interp,
        Tcl_ObjectContext contextPtr, Tcl_CallFrame *framePtr, int *isFinished);




MODULE_SCOPE void ItclPreserveClass(ItclClass *iclsPtr);
MODULE_SCOPE void ItclReleaseClass(ClientData iclsPtr);







MODULE_SCOPE ItclFoundation *ItclGetFoundation(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc ItclClassCommandDispatcher;
MODULE_SCOPE Tcl_Command Itcl_CmdAliasProc(Tcl_Interp *interp,
        Tcl_Namespace *nsPtr, const char *cmdName, ClientData clientData);
MODULE_SCOPE Tcl_Var Itcl_VarAliasProc(Tcl_Interp *interp,
        Tcl_Namespace *nsPtr, const char *VarName, ClientData clientData);
MODULE_SCOPE int ItclIsClass(Tcl_Interp *interp, Tcl_Command cmd);

/*
 * This file is (mostly) automatically generated from itcl.decls.
 */

#ifndef _ITCLINTDECLS
#define _ITCLINTDECLS

/* !BEGIN!: Do not edit below this line. */

#define ITCLINT_STUBS_EPOCH 0
#define ITCLINT_STUBS_REVISION 152

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:

        ItclArgList *realArgs);
static int ItclCreateMemberCode(Tcl_Interp* interp, ItclClass *iclsPtr,
        const char* arglist, const char* body, ItclMemberCode** mcodePtr,
        Tcl_Obj *namePtr, int flags);
static int ItclCreateMemberFunc(Tcl_Interp* interp, ItclClass *iclsPtr,
	Tcl_Obj *namePtr, const char* arglist, const char* body,
        ItclMemberFunc** imPtrPtr, int flags);






















static void FreeMemberCode(ItclMemberCode *mcodePtr);













/*
 * ------------------------------------------------------------------------
 *  Itcl_BodyCmd()
 *
 *  Invoked by Tcl whenever the user issues an "itcl::body" command to
 *  define or redefine the implementation for a class method/proc.
 *  Handles the following syntax:

    if (Itcl_CreateMemberCode(interp, iclsPtr, NULL, token,
            &mcode) != TCL_OK) {
        status = TCL_ERROR;
        goto configBodyCmdDone;
    }

    Itcl_PreserveData(mcode);

    if (ivPtr->codePtr) {
        Itcl_ReleaseData(ivPtr->codePtr);
    }
    ivPtr->codePtr = mcode;

configBodyCmdDone:
    Tcl_DStringFree(&buffer);
    return status;
}

        Tcl_DeleteHashEntry(hPtr);
        return TCL_ERROR;
    }

    /*
     *  Allocate a member function definition and return.
     */
    imPtr = (ItclMemberFunc*)Itcl_Alloc(sizeof(ItclMemberFunc));
    Itcl_EventuallyFree(imPtr, (Tcl_FreeProc *)Itcl_DeleteMemberFunc);
    imPtr->iclsPtr    = iclsPtr;
    imPtr->infoPtr    = iclsPtr->infoPtr;
    imPtr->protection = Itcl_Protection(interp, 0);
    imPtr->namePtr    = Tcl_NewStringObj(Tcl_GetString(namePtr), -1);
    Tcl_IncrRefCount(imPtr->namePtr);
    imPtr->fullNamePtr = Tcl_NewStringObj(
            Tcl_GetString(iclsPtr->fullNamePtr), -1);
    Tcl_AppendToObj(imPtr->fullNamePtr, "::", 2);
    Tcl_AppendToObj(imPtr->fullNamePtr, Tcl_GetString(namePtr), -1);
    Tcl_IncrRefCount(imPtr->fullNamePtr);
    if (arglist != NULL) {
        imPtr->origArgsPtr = Tcl_NewStringObj(arglist, -1);
        Tcl_IncrRefCount(imPtr->origArgsPtr);
    }
    imPtr->codePtr    = mcode;
    Itcl_PreserveData(mcode);

    if (imPtr->protection == ITCL_DEFAULT_PROTECT) {
        imPtr->protection = ITCL_PUBLIC;
    }

    imPtr->declaringClassPtr = iclsPtr;

        imPtr->flags |= ITCL_CONSTRUCTOR;
    }
    if (strcmp(name, "destructor") == 0) {
        imPtr->flags |= ITCL_DESTRUCTOR;
    }

    Tcl_SetHashValue(hPtr, imPtr);
    Itcl_PreserveData(imPtr);

    *imPtrPtr = imPtr;
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------

	}
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "argument list changed for function \"",
            Tcl_GetString(imPtr->fullNamePtr), "\": should be \"",
            argsStr, "\"",
            NULL);

	Itcl_PreserveData(mcode);
	Itcl_ReleaseData(mcode);
        return TCL_ERROR;
    }

    if (imPtr->flags & ITCL_CONSTRUCTOR) {
	/*
	 * REVISE mcode->bodyPtr here!
	 * Include a [my ItclConstructBase $iclsPtr] method call.

	mcode->bodyPtr = newBody;
	Tcl_IncrRefCount(mcode->bodyPtr);
    }

    /*
     *  Free up the old implementation and install the new one.
     */
    Itcl_PreserveData(mcode);
    Itcl_ReleaseData(imPtr->codePtr);
    imPtr->codePtr = mcode;
    if (mcode->flags & ITCL_IMPLEMENT_TCL) {
	ClientData pmPtr;
        imPtr->tmPtr = Itcl_NewProcClassMethod(interp,
	    imPtr->iclsPtr->clsPtr, ItclCheckCallMethod, ItclAfterCallMethod,
	    ItclProcErrorProc, imPtr, imPtr->namePtr, mcode->argumentPtr,
	    mcode->bodyPtr, &pmPtr);

    ItclMemberCode *mcode;
    const char **cPtrPtr;
    int haveError;

    /*
     *  Allocate some space to hold the implementation.
     */
    mcode = (ItclMemberCode*)Itcl_Alloc(sizeof(ItclMemberCode));
    Itcl_EventuallyFree(mcode, (Tcl_FreeProc *)FreeMemberCode);

    if (arglist) {
        if (ItclCreateArgList(interp, arglist, &argc, &maxArgc, &usagePtr,
	        &argListPtr, NULL, NULL) != TCL_OK) {
	    Itcl_PreserveData(mcode);
	    Itcl_ReleaseData(mcode);
            return TCL_ERROR;
        }
        mcode->argcount = argc;
        mcode->maxargcount = maxArgc;
        mcode->argListPtr = argListPtr;
        mcode->usagePtr = usagePtr;
	Tcl_IncrRefCount(mcode->usagePtr);

			    startStr = "";
			}
		        Tcl_AppendResult(interp, startStr,
				namePtr == NULL ? "??" :
			        Tcl_GetString(namePtr),
				"'s arglist may not contain \"",
				*cPtrPtr, "\" explicitly", NULL);
			Itcl_PreserveData(mcode);
			Itcl_ReleaseData(mcode);
                        return TCL_ERROR;
		    }
		    cPtrPtr++;
	        }
	        argListPtr = argListPtr->nextPtr;
	    }
	}

	    }
	    if (!isDone) {
                if (!Itcl_FindC(interp, body+1, &argCmdProc, &objCmdProc,
		        &cdata)) {
		    Tcl_AppendResult(interp,
                            "no registered C procedure with name \"",
			    body+1, "\"", NULL);
		    Itcl_PreserveData(mcode);
		    Itcl_ReleaseData(mcode);
                    return TCL_ERROR;
                }

	/*
	 * WARNING! WARNING! WARNING!
	 * This is a pretty dangerous approach.  What's done here is
	 * to copy over the proc + clientData implementation that

 *
 *  Creates the data record representing the implementation behind a
 *  class member function.  This includes the argument list and the body
 *  of the function.  If the body is of the form "@name", then it is
 *  treated as a label for a C procedure registered by Itcl_RegisterC().
 *
 *  A member function definition holds a handle for the implementation, and
 *  uses Itcl_PreserveData and Itcl_ReleaseData to manage its interest in it.
 *
 *  If any errors are encountered, this procedure returns TCL_ERROR
 *  along with an error message in the interpreter.  Otherwise, it
 *  returns TCL_OK, and stores a pointer to the new implementation in
 *  "mcodePtr".
 * ------------------------------------------------------------------------
 */

 *  Itcl_DeleteMemberCode()
 *
 *  Destroys all data associated with the given command implementation.
 *  Invoked automatically by ItclReleaseData() when the implementation
 *  is no longer being used.
 * ------------------------------------------------------------------------
 */
void FreeMemberCode (
    ItclMemberCode* mCodePtr)
{
    if (mCodePtr == NULL) {
        return;
    }
    if (mCodePtr->argListPtr != NULL) {
        ItclDeleteArgList(mCodePtr->argListPtr);
    }
    if (mCodePtr->usagePtr != NULL) {
        Tcl_DecrRefCount(mCodePtr->usagePtr);
    }
    if (mCodePtr->argumentPtr != NULL) {
        Tcl_DecrRefCount(mCodePtr->argumentPtr);
    }
    if (mCodePtr->bodyPtr != NULL) {
        Tcl_DecrRefCount(mCodePtr->bodyPtr);
    }
    Itcl_Free(mCodePtr);
}


void
Itcl_DeleteMemberCode(
    void* cdata)  /* pointer to member code definition */
{
    Itcl_ReleaseData((ItclMemberCode *)cdata);
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_GetMemberCode()
 *

    }
    mcode = imPtr->codePtr;

    /*
     *  Bump the reference count on this code, in case it is
     *  redefined or deleted during execution.
     */
    Itcl_PreserveData(mcode);

    if ((imPtr->flags & ITCL_DESTRUCTOR) && (contextIoPtr != NULL)) {
        contextIoPtr->destructorHasBeenCalled = 1;
    }

    /*
     *  Execute the code body...

            callbackPtr = Itcl_GetCurrentCallbackPtr(interp);
            Tcl_NRAddCallback(interp, CallItclObjectCmd, imPtr, contextIoPtr,
	            INT2PTR(objc), (void *)objv);
            result = Itcl_NRRunCallbacks(interp, callbackPtr);
         }
    }

    Itcl_ReleaseData(mcode);
    return result;
}

/*
 * ------------------------------------------------------------------------
 *  ItclEquivArgLists()
 *

        }
    }

    /*
     *  Execute the code for the method.  Be careful to protect
     *  the method in case it gets deleted during execution.
     */
    Itcl_PreserveData(imPtr);
    result = Itcl_EvalMemberCode(interp, imPtr, ioPtr, objc, objv);
    Itcl_ReleaseData(imPtr);
    return result;
}

/* ARGSUSED */
int
Itcl_ExecMethod(
    ClientData clientData,

        }
    }

    /*
     *  Execute the code for the proc.  Be careful to protect
     *  the proc in case it gets deleted during execution.
     */
    Itcl_PreserveData(imPtr);

    result = Itcl_EvalMemberCode(interp, imPtr, NULL,
        objc, objv);
    Itcl_ReleaseData(imPtr);
    return result;
}

/* ARGSUSED */
int
Itcl_ExecProc(
    ClientData clientData,

            &cmdlinec, &cmdlinev);

        ItclShowArgs(1, "EMC", cmdlinec, cmdlinev);
        /*
         *  Execute the code for the method.  Be careful to protect
         *  the method in case it gets deleted during execution.
         */
	Itcl_PreserveData(imPtr);

	if (contextObjectPtr->oPtr == NULL) {
            Tcl_DecrRefCount(cmdlinePtr);
            return TCL_ERROR;
	}
        result = Itcl_EvalMemberCode(interp, imPtr, contextObjectPtr,
	        cmdlinec, cmdlinev);
	Itcl_ReleaseData(imPtr);
        Tcl_DecrRefCount(cmdlinePtr);
    } else {
        if (contextClassPtr->flags &
	        (ITCL_ECLASS|ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
	    if (strcmp(name, "constructor") == 0) {
                if (objc > 0) {
                    if (contextClassPtr->numOptions == 0) {

    int min_allowed_args;

    ItclObjectInfo *infoPtr;

    oPtr = NULL;
    hPtr = NULL;
    imPtr = (ItclMemberFunc *)clientData;
    Itcl_PreserveData(imPtr);
    if (imPtr->flags & ITCL_CONSTRUCTOR) {
        ioPtr = imPtr->iclsPtr->infoPtr->currIoPtr;
    } else {
	if (contextPtr == NULL) {
	    if ((imPtr->flags & ITCL_COMMON) ||
                    (imPtr->codePtr->flags & ITCL_BUILTIN)) {
                if (!imPtr->iclsPtr->infoPtr->useOldResolvers) {

	stackPtr = (Itcl_Stack *)Tcl_GetHashValue(hPtr);
    }

    Itcl_PushStack(framePtr, stackPtr);

    if (ioPtr != NULL) {
        ioPtr->callRefCount++;
	Itcl_PreserveData(ioPtr);
    }
    imPtr->iclsPtr->callRefCount++;
    if (!imPtr->iclsPtr->infoPtr->useOldResolvers) {
        Itcl_SetCallFrameResolver(interp, ioPtr->resolvePtr);
    }
    result = TCL_OK;

    if (isFinished != NULL) {
        *isFinished = 0;
    }
    return result;
finishReturn:
    Itcl_ReleaseData(imPtr);
    return result;
}

/*
 * ------------------------------------------------------------------------
 *  ItclAfterCallMethod()
 *

    if (callContextPtr->refCount-- <= 1) {
        if (callContextPtr->ioPtr != NULL) {
	    hPtr = Tcl_FindHashEntry(&callContextPtr->ioPtr->contextCache,
	            (char *)callContextPtr->imPtr);
            if (hPtr == NULL) {
                ckfree((char *)callContextPtr);
	    }
	    Itcl_ReleaseData(ioPtr);
        } else {
            ckfree((char *)callContextPtr);
        }
    }
    result = call_result;
finishReturn:
    Itcl_ReleaseData(imPtr);
    return result;
}

void
ItclProcErrorProc(
    Tcl_Interp *interp,
    Tcl_Obj *procNameObj)

	const char *name1, const char *name2, int flags);
static char* ItclTraceComponentVar(ClientData cdata, Tcl_Interp *interp,
	const char *name1, const char *name2, int flags);
static char* ItclTraceItclHullVar(ClientData cdata, Tcl_Interp *interp,
	const char *name1, const char *name2, int flags);

static void ItclDestroyObject(ClientData clientData);
static Tcl_FreeProc FreeObject;

static int ItclDestructBase(Tcl_Interp *interp, ItclObject *contextObj,
        ItclClass *contextClass, int flags);

static int ItclInitObjectVariables(Tcl_Interp *interp, ItclObject *ioPtr,
        ItclClass *iclsPtr);
static int ItclInitObjectCommands(Tcl_Interp *interp, ItclObject *ioPtr,
        ItclClass *iclsPtr, const char *name);
static int ItclInitExtendedClassOptions(Tcl_Interp *interp, ItclObject *ioPtr);
static int ItclInitObjectOptions(Tcl_Interp *interp, ItclObject *ioPtr,
        ItclClass *iclsPtr);
static const char * GetConstructorVar(Tcl_Interp *interp, ItclClass *iclsPtr,
        const char *varName);
static ItclClass * GetClassFromClassName(Tcl_Interp *interp,
	const char *className, ItclClass *iclsPtr);




















/*
 * ------------------------------------------------------------------------
 *  ItclDeleteObjectMetadata()
 *
 *  Delete the metadata data if any
 *-------------------------------------------------------------------------

    if (infoPtr != NULL) {
      infoPtr->lastIoPtr = NULL;
    }
    /*
     *  Create a new object and initialize it.
     */
    ioPtr = (ItclObject*)Itcl_Alloc(sizeof(ItclObject));
    Itcl_EventuallyFree(ioPtr, FreeObject);
    ioPtr->iclsPtr = iclsPtr;
    ioPtr->interp = interp;
    ioPtr->infoPtr = infoPtr;
    ItclPreserveClass(iclsPtr);

    ioPtr->constructed = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitObjHashTable(ioPtr->constructed);

    ioPtr->oPtr = Tcl_NewObjectInstance(interp, iclsPtr->clsPtr, NULL,
            /* nsName */ NULL, /* objc */ -1, /* objv */ NULL, /* skip */ 0);
    if (ioPtr->oPtr == NULL) {
	Itcl_Free(ioPtr);
        return TCL_ERROR;
    }

    /*
     *  Add a command to the current namespace with the object name.
     *  This is done before invoking the constructors so that the
     *  command can be used during construction to query info.
     */
    Itcl_PreserveData(ioPtr);

    ioPtr->namePtr = Tcl_NewStringObj(name, -1);
    Tcl_IncrRefCount(ioPtr->namePtr);
    nsName = Tcl_GetCurrentNamespace(interp)->fullName;
    ioPtr->origNamePtr = Tcl_NewStringObj("", -1);
    if ((name[0] != ':') && (name[1] != ':')) {
        Tcl_AppendToObj(ioPtr->origNamePtr, nsName, -1);

    Tcl_InitObjHashTable(&ioPtr->objectOptions);
    Tcl_InitObjHashTable(&ioPtr->objectComponents);
    Tcl_InitObjHashTable(&ioPtr->objectDelegatedOptions);
    Tcl_InitObjHashTable(&ioPtr->objectDelegatedFunctions);
    Tcl_InitObjHashTable(&ioPtr->objectMethodVariables);
    Tcl_InitHashTable(&ioPtr->contextCache, TCL_ONE_WORD_KEYS);

    Itcl_PreserveData(ioPtr);

    /*
     *  Install the class namespace and object context so that
     *  the object's data members can be initialized via simple
     *  "set" commands.
     */

	if (ioPtr->accessCmd != (Tcl_Command) NULL) {
	    Tcl_DeleteCommandFromToken(interp, ioPtr->accessCmd);
	    ioPtr->accessCmd = NULL;
	}
        result = Itcl_RestoreInterpState(interp, istate);
	infoPtr->currIoPtr = saveCurrIoPtr;
	/* need this for 2 ReleaseData at errorReturn!! */
	Itcl_PreserveData(ioPtr);
        goto errorReturn;
    } else {
	/* a constructor cannot return a result as the object name
	 * is returned as result */
        Tcl_ResetResult(interp);
    }

	 */
	if (ioPtr->accessCmd != (Tcl_Command) NULL) {
	    Tcl_DeleteCommandFromToken(interp, ioPtr->accessCmd);
	    ioPtr->accessCmd = NULL;
	}
        result = Itcl_RestoreInterpState(interp, istate);
	/* need this for 2 ReleaseData at errorReturn!! */
	Itcl_PreserveData(ioPtr);
        goto errorReturn;
    }

    if (iclsPtr->flags & ITCL_WIDGETADAPTOR) {

	if (saveNsNamePtr) {
	    Tcl_SetVar2Ex(interp, "::itcl::internal::varNsName", name,

            istate = Itcl_SaveInterpState(interp, result);
	    if (ioPtr->accessCmd != (Tcl_Command) NULL) {
	        Tcl_DeleteCommandFromToken(interp, ioPtr->accessCmd);
	        ioPtr->accessCmd = NULL;
	    }
            result = Itcl_RestoreInterpState(interp, istate);
	    /* need this for 2 ReleaseData at errorReturn!! */
	    Itcl_PreserveData(ioPtr);
            goto errorReturn;
	}
    }

    /*
     *  Add it to the list of all known objects. The only
     *  tricky thing to watch out for is the case where the

        infoPtr->currIoPtr = saveCurrIoPtr;
    }
    infoPtr->lastIoPtr = ioPtr;
    Tcl_DeleteHashTable(ioPtr->constructed);
    ckfree((char*)ioPtr->constructed);
    ioPtr->constructed = NULL;
    ItclAddObjectsDictInfo(interp, ioPtr);
    Itcl_ReleaseData(ioPtr);
    return result;

errorReturn:
    /*
     *  At this point, the object is not constructed as there was an error.
     *  Destroy the "constructed" table in the object data, since
     *  it is no longer needed.

    }
    if (ioPtr->constructed != NULL) {
        Tcl_DeleteHashTable(ioPtr->constructed);
        ckfree((char*)ioPtr->constructed);
        ioPtr->constructed = NULL;
    }
    ItclDeleteObjectVariablesNamespace(interp, ioPtr);
    Itcl_ReleaseData(ioPtr);
    Itcl_ReleaseData(ioPtr);
    return result;
}

/*
 * ------------------------------------------------------------------------
 *  ItclInitObjectCommands()
 *

    Tcl_CmdInfo cmdInfo;
    Tcl_HashEntry *hPtr;


    Tcl_GetCommandInfoFromToken(contextIoPtr->accessCmd, &cmdInfo);

    contextIoPtr->flags |= ITCL_OBJECT_IS_DELETED;
    Itcl_PreserveData(contextIoPtr);

    /*
     *  Invoke the object's destructors.
     */
    if (Itcl_DestructObject(interp, contextIoPtr, 0) != TCL_OK) {
	Itcl_ReleaseData(contextIoPtr);
	contextIoPtr->flags |=
	        ITCL_TCLOO_OBJECT_IS_DELETED|ITCL_OBJECT_DESTRUCT_ERROR;
        return TCL_ERROR;
    }
    /*
     *  Remove the object from the global list.
     */

     *  safely deleted without attempting to destruct the object
     *  again.  Then delete the access command.  If this is
     *  the last use of the object data, the object will die here.
     */
    if ((contextIoPtr->accessCmd != NULL) && (!(contextIoPtr->flags &
            (ITCL_OBJECT_IS_RENAMED)))) {
    if (Tcl_GetCommandInfoFromToken(contextIoPtr->accessCmd, &cmdInfo) == 1) {
        cmdInfo.deleteProc = (Tcl_CmdDeleteProc *)Itcl_ReleaseData;
	Tcl_SetCommandInfoFromToken(contextIoPtr->accessCmd, &cmdInfo);

        Tcl_DeleteCommandFromToken(interp, contextIoPtr->accessCmd);
    }
    }
    contextIoPtr->oPtr = NULL;
    contextIoPtr->accessCmd = NULL;

    Itcl_ReleaseData(contextIoPtr);

    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclDeleteObjectVariablesNamespace()

            (char*)contextIoPtr);

        if (hPtr) {
            Tcl_DeleteHashEntry(hPtr);
        }
        contextIoPtr->accessCmd = NULL;
    }
    Itcl_ReleaseData(contextIoPtr);
}

/*
 * ------------------------------------------------------------------------
 *  FreeObject()
 *
 *  Deletes all instance variables and frees all memory associated with
 *  the given object instance.  Called when releases match preserves.

 * ------------------------------------------------------------------------
 */
static void
FreeObject(
    char * cdata)  /* object instance data */
{
    FOREACH_HASH_DECLS;
    Tcl_HashSearch place;
    ItclCallContext *callContextPtr;
    ItclObject *ioPtr;
    Tcl_Var var;

        Tcl_DecrRefCount(ioPtr->hullWindowNamePtr);
    }
    Tcl_DecrRefCount(ioPtr->varNsNamePtr);
    if (ioPtr->resolvePtr != NULL) {
	ckfree((char *)ioPtr->resolvePtr->clientData);
        ckfree((char*)ioPtr->resolvePtr);
    }
    Itcl_Free(ioPtr);
}

/*
 * ------------------------------------------------------------------------
 *  ItclObjectCmd()
 *
 * ------------------------------------------------------------------------

static Tcl_MethodCallProc ArgCallProc;
static Tcl_CloneProc CloneProc;

static const Tcl_MethodType itclObjMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
    "itcl objv method",
    ObjCallProc,
    Itcl_ReleaseData,
    CloneProc
};

static const Tcl_MethodType itclArgMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
    "itcl argv method",
    ArgCallProc,
    Itcl_ReleaseData,
    CloneProc
};

static int
CloneProc(
    Tcl_Interp *interp,
    ClientData original,
    ClientData *copyPtr)
{
    Itcl_PreserveData((ItclMemberFunc *)original);
    *copyPtr = original;
    return TCL_OK;
}

static int
CallAfterCallMethod(
    ClientData data[],

	    bodyPtr = imPtr->codePtr->bodyPtr;

if (imPtr->codePtr->flags & ITCL_IMPLEMENT_OBJCMD) {
    /* Implementation of this member is coded in C expecting Tcl_Obj */

    imPtr->tmPtr = Tcl_NewMethod(interp, iclsPtr->clsPtr, imPtr->namePtr,
	    1, &itclObjMethodType, imPtr);
    Itcl_PreserveData(imPtr);

    if (iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
	imPtr->tmPtr = Tcl_NewInstanceMethod(interp, iclsPtr->oPtr,
		imPtr->namePtr, 1, &itclObjMethodType, imPtr);
	Itcl_PreserveData(imPtr);
    }

} else if (imPtr->codePtr->flags & ITCL_IMPLEMENT_ARGCMD) {
    /* Implementation of this member is coded in C expecting (char *) */

    imPtr->tmPtr = Tcl_NewMethod(interp, iclsPtr->clsPtr, imPtr->namePtr,
	    1, &itclArgMethodType, imPtr);

		Itcl_PreserveData(imPtr);



} else {
	    if (imPtr->codePtr->flags & ITCL_BUILTIN) {
		int isDone;
		isDone = 0;

                    ItclProcErrorProc, imPtr, imPtr->namePtr, argumentPtr,
		    bodyPtr, &pmPtr);
	    }
}
	    if ((imPtr->flags & ITCL_COMMON) == 0) {
	        imPtr->accessCmd = Tcl_CreateObjCommand(interp,
		        Tcl_GetString(imPtr->fullNamePtr),
		        Itcl_ExecMethod, imPtr, Itcl_ReleaseData);
		Itcl_PreserveData(imPtr);
	    } else {
	        imPtr->accessCmd = Tcl_CreateObjCommand(interp,
		        Tcl_GetString(imPtr->fullNamePtr),
			Itcl_ExecProc, imPtr, Itcl_ReleaseData);
		Itcl_PreserveData(imPtr);
	    }
    }
    if (iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGETADAPTOR)) {
	/* initialize the typecomponents and typevariables */
        if (Itcl_PushCallFrame(interp, &frame, iclsPtr->nsPtr,
                /*isProcCallFrame*/0) != TCL_OK) {
	    result = TCL_ERROR;

	    hPtr = Tcl_FirstHashEntry(&infoPtr->objects, &place);
	    /*hPtr = Tcl_NextHashEntry(&place);*/
    }
    Tcl_DeleteHashTable(&infoPtr->objects);
    Tcl_DeleteHashTable(&infoPtr->frameContext);

    Itcl_DeleteStack(&infoPtr->clsStack);
    Itcl_Free(infoPtr);
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_ClassFilterCmd()
 *
 *

    }
    classNamePtr = ItclCapitalize(className);
    init = defaultValue;
    if ((newObjc > 1) && (init == NULL)) {
        init = Tcl_GetString(newObjv[1]);
    }

    ioptPtr = (ItclOption*)Itcl_Alloc(sizeof(ItclOption));

    ioptPtr->protection   = Itcl_Protection(interp, 0);
    if (ioptPtr->protection == ITCL_DEFAULT_PROTECT) {
        ioptPtr->protection = ITCL_PROTECTED;
    }
    ioptPtr->namePtr      = Tcl_NewStringObj(name, -1);
    Tcl_IncrRefCount(ioptPtr->namePtr);
    ioptPtr->resourceNamePtr = Tcl_NewStringObj(resourceName, -1);

	if (hPtr != NULL) {
	    Tcl_AppendResult(interp, "option \"", option,
	            "\" has been defined locally", NULL);
	    goto errorOut1;
	    return TCL_ERROR;
	}
    }

    idoPtr = (ItclDelegatedOption *)Itcl_Alloc(sizeof(ItclDelegatedOption));
    Tcl_InitObjHashTable(&idoPtr->exceptions);
    if (*option != '*') {
        if (targetPtr == NULL) {
	    targetPtr = optionNamePtr;
	}
        if (resourceNamePtr == NULL) {
	    resourceNamePtr = Tcl_NewStringObj(option+1, -1);

    if (idoPtrPtr != NULL) {
        *idoPtrPtr = idoPtr;
    }
    ckfree((char *)argv);
    ItclAddDelegatedOptionDictInfo(interp, iclsPtr, idoPtr);
    return TCL_OK;
errorOut2:
    Itcl_ReleaseData(idoPtr);
errorOut1:
    Tcl_DecrRefCount(optionNamePtr);
    if (resourceNamePtr != NULL) {
        Tcl_DecrRefCount(resourceNamePtr);
    }
    if (classNamePtr != NULL) {
        Tcl_DecrRefCount(classNamePtr);

    Itcl_SetListValue, /* 19 */
    Itcl_EventuallyFree, /* 20 */
    Itcl_PreserveData, /* 21 */
    Itcl_ReleaseData, /* 22 */
    Itcl_SaveInterpState, /* 23 */
    Itcl_RestoreInterpState, /* 24 */
    Itcl_DiscardInterpState, /* 25 */
    Itcl_Alloc, /* 26 */
    Itcl_Free, /* 27 */
};

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

 * ========================================================================
 *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
 * ------------------------------------------------------------------------
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
#include "itclInt.h"
#include <limits.h>

/*
 *  POOL OF LIST ELEMENTS FOR LINKED LIST
 */
static Itcl_ListElem *listPool = NULL;
static int listPoolLen = 0;

 * ------------------------------------------------------------------------
 */
void
Itcl_SetListValue(
    Itcl_ListElem *elemPtr, /* list element being modified */
    ClientData val)         /* new value associated with element */
{


    assert(elemPtr != NULL);
    assert(elemPtr->owner->validate == ITCL_VALID_LIST);
    elemPtr->value = val;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_FinishList()


/*
 * ========================================================================
 *  REFERENCE-COUNTED DATA
 *
 *  The following procedures manage generic reference-counted data.
 *  They are similar in spirit to the Tcl_Preserve/Tcl_Release
 *  procedures defined in the Tcl/Tk core.  But these procedures attach a
 *  refcount directly to the allocated memory, and then use it to govern
 *  shared access and properly timed release.
 */

typedef struct PresMemoryPrefix {
    Tcl_FreeProc *freeProc;     /* called by last Itcl_ReleaseData */
    size_t refCount;            /* refernce (resp preserving) counter */
} PresMemoryPrefix;

/*
 * ------------------------------------------------------------------------
 *  Itcl_EventuallyFree()
 *
 *  Asscociates with cdata (allocated by Itcl_Alloc()) a routine to
 *  be called when cdata should be freed. This routine will be called


 *  when the number of Itcl_ReleaseData() calls on cdata  matches the
 *  number of Itcl_PreserveData() calls on cdata.
 * ------------------------------------------------------------------------
 */
void
Itcl_EventuallyFree(
    ClientData cdata,          /* data to be freed when not in use */
    Tcl_FreeProc *fproc)       /* procedure called to free data */
{
    PresMemoryPrefix *blk;


    if (cdata == NULL) {
        return;
    }

    /* Itcl memory block to ckalloc block */
    blk = ((PresMemoryPrefix *)cdata)-1;

    /* Set new free proc */
    blk->freeProc = fproc;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_PreserveData()
 *
 *  Increases the usage count for a piece of data that will be freed
 *  later when no longer needed.  Each call to Itcl_PreserveData()
 *  puts one claim on a piece of data, and subsequent calls to
 *  Itcl_ReleaseData() remove those claims.  When Itcl_EventuallyFree()
 *  is called, and when the usage count reaches zero, the data is
 *  freed.
 * ------------------------------------------------------------------------
 */
void
Itcl_PreserveData(
    ClientData cdata)     /* data to be preserved */
{
    PresMemoryPrefix *blk;




    if (cdata == NULL) {
        return;
    }

    /* Itcl memory block to ckalloc block */
    blk = ((PresMemoryPrefix *)cdata)-1;

    /* Increment preservation count */
    ++blk->refCount;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_ReleaseData()
 *
 *  Decreases the usage count for a piece of data that was registered
 *  previously via Itcl_PreserveData().  After Itcl_EventuallyFree()
 *  is called and the usage count reaches zero, the data is
 *  automatically freed.
 * ------------------------------------------------------------------------
 */
void
Itcl_ReleaseData(
    ClientData cdata)      /* data to be released */
{
    PresMemoryPrefix *blk;
    Tcl_FreeProc *freeProc;

    if (cdata == NULL) {
        return;
    }

    /* Itcl memory block to ckalloc block */
    blk = ((PresMemoryPrefix *)cdata)-1;

    /* Usage sanity check */
    assert(blk->refCount != 0); /* must call Itcl_PreserveData() first */
    assert(blk->freeProc);	/* must call Itcl_EventuallyFree() first */

    /* Decrement preservation count */
    if (--blk->refCount) {
	return;
    }

    /* Free cdata now */
    freeProc = blk->freeProc;
    blk->freeProc = NULL;
    freeProc(cdata);
}

/*

 * ------------------------------------------------------------------------
 * Itcl_Alloc()
 *
 *	Allocate preservable memory. In opposite to ckalloc the result can be
 *	supplied to preservation facilities of Itcl (Itcl_PreserveData).
 *
 * Results:
 *	Pointer to new allocated memory.
 * ------------------------------------------------------------------------
 */
void * Itcl_Alloc(
    size_t size)	/* Size of memory to allocate */
{
    size_t numBytes;
    PresMemoryPrefix *blk;

    /* The ckalloc() in Tcl 8 can alloc at most UINT_MAX bytes */
    assert (size <= UINT_MAX - sizeof(PresMemoryPrefix));
    numBytes = size + sizeof(PresMemoryPrefix);

    /* This will panic on allocation failure. No need to check return value. */
    blk = (PresMemoryPrefix *)ckalloc(numBytes);

    /* Itcl_Alloc defined to zero-init memory it allocates */
    memset(blk, 0, numBytes);

    /* ckalloc block to Itcl memory block */
    return blk+1;
}
/*
 * ------------------------------------------------------------------------
 * ItclFree()
 *
 *	Release memory allocated by Itcl_Alloc() that was never preserved.
 *
 * Results:
 *	None.
 *
 * ------------------------------------------------------------------------
 */
void Itcl_Free(void *ptr) {
    PresMemoryPrefix *blk;
    
    if (ptr == NULL) {
	return;
    }
    /* Itcl memory block to ckalloc block */
    blk = ((PresMemoryPrefix *)ptr)-1;

    assert(blk->refCount == 0); /* it should be not preserved */
    assert(blk->freeProc == NULL); /* it should be released */
    ckfree(blk);
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_SaveInterpState()
 *
 *  Takes a snapshot of the current result state of the interpreter.