/*
 *      nsf.c --
 *
 *      Basic Machinery of the Next Scripting Framework, a Tcl-based framework
 *      for supporting language-oriented programming.  For details, see
 *      https://next-scripting.org/.
 *
 * Copyright (C) 1999-2020 Gustaf Neumann (a) (b)
 * Copyright (C) 1999-2007 Uwe Zdun (a) (b)
 * Copyright (C) 2007-2008 Martin Matuska (b)
 * Copyright (C) 2010-2019 Stefan Sobernig (b)
 *
 *
 * (a) University of Essen
 *      Specification of Software Systems
 *      Altendorferstrasse 97-101
 *      D-45143 Essen, Germany
 *
 * (b) Vienna University of Economics and Business
 *      Institute of Information Systems and New Media
 *      A-1020, Welthandelsplatz 1
 *      Vienna, Austria
 *
 * This work is licensed under the MIT License
 * https://www.opensource.org/licenses/MIT
 *
 * Copyright:
 *
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and associated documentation files (the "Software"),
 * to deal in the Software without restriction, including without limitation
 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 * and/or sell copies of the Software, and to permit persons to whom the
 * Software is furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in
 * all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 * DEALINGS IN THE SOFTWARE.
 *
 *
 *      This software is based upon MIT Object Tcl by David Wetherall and
 *      Christopher J. Lindblad, that contains the following copyright
 *      message:
 *
 *   "Copyright 1993 Massachusetts Institute of Technology
 *
 *      Permission to use, copy, modify, distribute, and sell this
 *      software and its documentation for any purpose is hereby granted
 *      without fee, provided that the above copyright notice appear in
 *      all copies and that both that copyright notice and this
 *      permission notice appear in supporting documentation, and that
 *      the name of M.I.T. not be used in advertising or publicity
 *      pertaining to distribution of the software without specific,
 *      written prior permission.  M.I.T. makes no representations about
 *      the suitability of this software for any purpose.  It is
 *      provided "as is" without express or implied warranty."
 */

#define NSF_FORWARD_WITH_ONERROR 1

#define NSF_C 1
#include "nsfInt.h"
#include "nsfAccessInt.h"

#ifdef COMPILE_NSF_STUBS
# if defined(PRE86)
EXTERN NsfStubs nsfStubs;
# else
MODULE_SCOPE const NsfStubs nsfStubs;
# endif
#endif

#ifdef USE_TCL_STUBS
# define Nsf_ExprObjCmd(clientData, interp, objc, objv)        \
  NsfCallCommand(interp, NSF_EXPR, objc, objv)
#else
# define Nsf_ExprObjCmd(clientData, interp, objc, objv)        \
  Tcl_ExprObjCmd(clientData, interp, objc, objv)
#endif

/*
 * Call Stack specific definitions
 */

typedef enum { CALLING_LEVEL, ACTIVE_LEVEL } CallStackLevel;

typedef struct callFrameContext {
  Tcl_CallFrame *framePtr;
  Tcl_CallFrame *varFramePtr;
  bool           frameSaved;
} callFrameContext;

/* #define COLON_CMD_STATS 1 */

typedef struct {
  void        *context;
  Tcl_Command  cmd;
  NsfClass    *class;
  unsigned int methodEpoch;
  unsigned int flags;
#if defined(COLON_CMD_STATS)
  size_t       hits;
  size_t       invalidates;
  size_t       requiredRefetches;
  Tcl_Obj     *obj;
#endif
} NsfColonCmdContext;

typedef struct NsfProcContext {
  ClientData          oldDeleteData;
  Tcl_CmdDeleteProc  *oldDeleteProc;
  NsfParamDefs       *paramDefs;
  int                *colonLocalVarCache;
  unsigned int        checkAlwaysFlag;
  Tcl_Namespace      *execNsPtr;
  Tcl_Obj            *returnsObj;
} NsfProcContext;

/*
 * TclCmdClientdata is an incomplete type containing the common
 * field(s) of ForwardCmdClientData, AliasCmdClientData and
 * SetterCmdClientData used for filling in at run time the actual
 * object.
 */
typedef struct TclCmdClientData {
  NsfObject *object;
} TclCmdClientData;

typedef struct SetterCmdClientData {
  NsfObject *object;
  Nsf_Param *paramsPtr;
} SetterCmdClientData;

typedef struct ForwardCmdClientData {
  NsfObject      *object;
  Tcl_Obj        *cmdName;
  Tcl_ObjCmdProc *objProc;
  ClientData      clientData;
  bool            passthrough;
  bool            needobjmap;
  bool            verbose;
  bool            hasNonposArgs;
  Tcl_Obj        *args;
  int             nr_args;
  int             frame;
#if defined(NSF_FORWARD_WITH_ONERROR)
  Tcl_Obj        *onerror;
#endif
  Tcl_Obj        *prefix;
  Tcl_Obj        *subcommands;
  int             nr_subcommands;
} ForwardCmdClientData;

typedef struct AliasCmdClientData {
  NsfObject      *object;
  Tcl_Obj        *cmdName;
  Tcl_ObjCmdProc *objProc;
  ClientData      clientData;
  NsfClass       *class;
  Tcl_Interp     *interp;
  Tcl_Command     aliasedCmd;
  Tcl_Command     aliasCmd;
} AliasCmdClientData;

/*
 * When NSF_MEM_COUNT is set, we want to trace as well the mem-count frees
 * associated with the interp. Therefore, we need in this case a special
 * client data structure.
 */
#ifdef NSF_MEM_COUNT
typedef struct NsfNamespaceClientData {
  NsfObject     *object;
  Tcl_Namespace *nsPtr;
  Tcl_Interp    *interp;
} NsfNamespaceClientData;
#endif

/*
 * Argv parsing specific definitions
 */

#define PARSE_CONTEXT_PREALLOC 20
typedef struct {
  ClientData   *clientData;   /* 4 members pointer to the actual parse context data */
  Tcl_Obj     **objv;
  Tcl_Obj     **full_objv;    /* contains method as well */
  unsigned int *flags;
  ClientData    clientData_static[PARSE_CONTEXT_PREALLOC]; /* 3 preallocated parse context data */
  Tcl_Obj      *objv_static[PARSE_CONTEXT_PREALLOC+1];
  unsigned int  flags_static[PARSE_CONTEXT_PREALLOC+1];
  unsigned int  status;
  int           lastObjc;     /* points to the first "unprocessed" argument */
  int           objc;
  NsfObject    *object;
  bool          varArgs;      /* does the parameter end with some kind of "args" */
} ParseContext;

static Nsf_TypeConverter ConvertToNothing, ConvertViaCmd, ConvertToObjpattern;

static const char  *autonamePrefix = "::nsf::__#";
static const size_t autonamePrefixLength = 10u;
static const char * nsfClassesPrefix = "::nsf::classes";
static const size_t nsfClassesPrefixLength = 14u;
/*
 * Tcl_Obj Types for Next Scripting Objects
 */

static Tcl_ObjType CONST86
  *Nsf_OT_byteCodeType = NULL,
  *Nsf_OT_tclCmdNameType = NULL,
  *Nsf_OT_listType = NULL,
  *Nsf_OT_doubleType = NULL,
  *Nsf_OT_intType = NULL,
  *Nsf_OT_parsedVarNameType = NULL,
  *Nsf_OT_byteArrayType = NULL,
  *Nsf_OT_properByteArrayType = NULL,
  *Nsf_OT_bignumType = NULL;

/*
 * Function prototypes
 */

/*
 * Prototypes for method definitions
 */
static Tcl_ObjCmdProc NsfForwardMethod;
static Tcl_ObjCmdProc NsfObjscopedMethod;
static Tcl_ObjCmdProc NsfSetterMethod;
static Tcl_ObjCmdProc NsfProcAliasMethod;
static Tcl_ObjCmdProc NsfAsmProc;
Tcl_ObjCmdProc NsfProcStub;

/*
 * Prototypes for interpreter life-cyle
 */
EXTERN Tcl_PackageInitProc Nsf_SafeInit;
EXTERN Tcl_PackageInitProc Nsf_Init;
static Tcl_ExitProc Nsf_ExitProc;
static Tcl_ExitProc ExitHandler;

#if defined(TCL_THREADS)
static Tcl_ExitProc Nsf_ThreadExitProc;
#endif


/*
 * Prototypes for methods called directly when CallDirectly() returns NULL
 */
static int NsfCAllocMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *nameObj)
  nonnull(1) nonnull(2);
static int NsfCAllocMethod_(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *nameObj, Tcl_Namespace *parentNsPtr)
  nonnull(1) nonnull(2) nonnull(3);
static int NsfCCreateMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *nameObj, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(3) nonnull(5);
static int NsfOCleanupMethod(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);
static int NsfOConfigureMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[], Tcl_Obj *objv0)
  nonnull(1) nonnull(2) nonnull(4) nonnull(5);
static int NsfODestroyMethod(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);
static int MethodDispatch(
    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    Tcl_Command cmd, NsfObject *object, NsfClass *class,
    const char *methodName, unsigned short frameType, unsigned int flags
) nonnull(1) nonnull(3) nonnull(4) nonnull(5) nonnull(7);
static int DispatchDefaultMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *obj, unsigned int flags)
  nonnull(1) nonnull(2) nonnull(3);
static int DispatchDestroyMethod(Tcl_Interp *interp, NsfObject *object, unsigned int flags)
  nonnull(1) nonnull(2);
static int DispatchUnknownMethod(
    Tcl_Interp *interp, NsfObject *object,
    int objc, Tcl_Obj *const objv[], Tcl_Obj *callInfoObj,
    Tcl_Obj *methodObj, unsigned int flags
) nonnull(1) nonnull(2) nonnull(4) nonnull(6);

NSF_INLINE static int ObjectDispatch(
    ClientData clientData, Tcl_Interp *interp, int objc,
    Tcl_Obj *const objv[], unsigned int flags
) nonnull(1) nonnull(2) nonnull(4);

NSF_INLINE static int ObjectDispatchFinalize(
    Tcl_Interp *interp, NsfCallStackContent *cscPtr,
    int result /*, const char *string , const char *methodName*/
) nonnull(1) nonnull(2);

/*
 * Prototypes for object life-cycle management
 */
static int RecreateObject(Tcl_Interp *interp, NsfClass *class, NsfObject *object, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(3) nonnull(5);
static void FinalObjectDeletion(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

#if defined(DO_CLEANUP)
static void FreeAllNsfObjectsAndClasses(Tcl_Interp *interp,  NsfCmdList **instances)
  nonnull(1) nonnull(2);
#endif
static void CallStackDestroyObject(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);
static void PrimitiveCDestroy(ClientData clientData)
  nonnull(1);
static void PrimitiveODestroy(ClientData clientData)
  nonnull(1);
static void PrimitiveDestroy(ClientData clientData)
  nonnull(1);

static int VolatileMethod(Tcl_Interp *interp, NsfObject *object, bool shallow)
  nonnull(1) nonnull(2);

/*
 * Prototypes for object and command lookup
 */
static NsfObject *GetObjectFromString(Tcl_Interp *interp, const char *name)
  nonnull(1) nonnull(2);
static NsfClass *GetClassFromString(Tcl_Interp *interp, const char *name)
  nonnull(1) nonnull(2);
static int GetClassFromObj(Tcl_Interp *interp, register Tcl_Obj *objPtr, NsfClass **classPtr, bool withUnknown)
  nonnull(1) nonnull(2) nonnull(3);
static void GetAllInstances(Tcl_Interp *interp, NsfCmdList **instances, NsfClass *startClass)
  nonnull(1) nonnull(2) nonnull(3);
NSF_INLINE static Tcl_Command FindMethod(
    const Tcl_Namespace *nsPtr,
    const char *methodName
) nonnull(1) nonnull(2);
NSF_INLINE static NsfClasses *PrecedenceOrder(
    NsfClass *class
) nonnull(1);


/*
 * Prototypes for namespace specific calls
 */
static Tcl_Obj *NameInNamespaceObj(const char *name, Tcl_Namespace *nsPtr)
  nonnull(1) nonnull(2);
static Tcl_Namespace *CallingNameSpace(Tcl_Interp *interp)
  nonnull(1) returns_nonnull;
NSF_INLINE static Tcl_Command NSFindCommand(Tcl_Interp *interp, const char *name)
  nonnull(1) nonnull(2);
static Tcl_Namespace *NSGetFreshNamespace(Tcl_Interp *interp, NsfObject *object, const char *name)
  nonnull(1) nonnull(2) nonnull(3);
static Tcl_Namespace *RequireObjNamespace(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);
static int NSDeleteCmd(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *methodName)
  nonnull(1) nonnull(2) nonnull(3);
static void NSNamespaceDeleteProc(ClientData clientData)
  nonnull(1);
static void NSNamespacePreserve(Tcl_Namespace *nsPtr)
  nonnull(1);
static void NSNamespaceRelease(Tcl_Namespace *nsPtr)
  nonnull(1);

/*
 * Prototypes for filters and mixins
 */
static void FilterComputeDefined(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);
static void MixinComputeDefined(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);
NSF_INLINE static void GuardAdd(NsfCmdList *guardList, Tcl_Obj *guardObj)
  nonnull(1) nonnull(2);
static int GuardCall(NsfObject *object, Tcl_Interp *interp,
                     Tcl_Obj *guardObj, NsfCallStackContent *cscPtr)
  nonnull(1) nonnull(2) nonnull(3);
static void GuardDel(NsfCmdList *guardList)
  nonnull(1);

/*
 * Prototypes for forwarders
 */
static void ForwardCmdDeleteProc(ClientData clientData)
  nonnull(1);
static int ForwardProcessOptions(
    Tcl_Interp *interp, Tcl_Obj *nameObj,
    Tcl_Obj *withDefault, int withEarlybinding,
    Tcl_Obj *withOnerror, Tcl_Obj *withMethodprefix,
    int withFrame, bool withVerbose,
    Tcl_Obj *target, int objc, Tcl_Obj * const objv[],
    ForwardCmdClientData **tcdPtr
) nonnull(1) nonnull(2) nonnull(11);

/*
 * Properties of objects and classes
 */
static bool IsRootClass(
    const NsfClass *class
) nonnull(1) NSF_pure;

static bool IsRootMetaClass(
    const NsfClass *class
) nonnull(1) NSF_pure;

static bool IsBaseClass(
    const NsfObject *object
) nonnull(1) NSF_pure;

static bool IsMetaClass(
    Tcl_Interp *interp, NsfClass *class, bool withMixins
) nonnull(1) nonnull(2);

static bool IsSubType(
    NsfClass *subClass, const NsfClass *class
) nonnull(1) nonnull(2);

static NsfClass *DefaultSuperClass(
    Tcl_Interp *interp, const NsfClass *class, const NsfClass *metaClass, bool isMeta
) nonnull(1) nonnull(2) nonnull(3);


/*
 * Prototypes for call stack specific calls
 */
NSF_INLINE static void CscInit_(
    NsfCallStackContent *cscPtr,
    NsfObject *object,
    NsfClass *class,
    const Tcl_Command cmd,
    unsigned short frameType,
    unsigned int flags
) nonnull(1) nonnull(2);

NSF_INLINE static void CscFinish_(Tcl_Interp *interp, NsfCallStackContent *cscPtr)
  nonnull(1) nonnull(2);
NSF_INLINE static void CallStackDoDestroy(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);
static void NsfShowStack(Tcl_Interp *interp)
  nonnull(1);

/*
 * Prototypes for parameter and argument management
 */
static int NsfParameterCacheClassInvalidateCmd(Tcl_Interp *interp, NsfClass *class)
  nonnull(1) nonnull(2);
static int ProcessMethodArguments(
    ParseContext *pcPtr,
    Tcl_Interp *interp,
    NsfObject *object,
    unsigned int processFlags,
    NsfParamDefs *paramDefs,
    Tcl_Obj *methodNameObj,
    int objc, Tcl_Obj *const objv[]
) nonnull(1) nonnull(2) nonnull(5) nonnull(6) nonnull(8);

static int ParameterCheck(
    Tcl_Interp *interp, Tcl_Obj *paramObjPtr, Tcl_Obj *valueObj,
    const char *argNamePrefix,
    unsigned int doCheckArguments,
    bool isNamed,
    bool doConfigureParameter,
    Nsf_Param **paramPtrPtr,
    const char *qualifier
) nonnull(1) nonnull(2) nonnull(3);

static void ParamDefsRefCountIncr(NsfParamDefs *paramDefs)
  nonnull(1);

static void ParamDefsRefCountDecr(
    NsfParamDefs *paramDefs
) nonnull(1);

static void ParsedParamFree(
    NsfParsedParam *parsedParamPtr
) nonnull(1);

NSF_INLINE static NsfParamDefs *ParamDefsGet(
    const Tcl_Command cmdPtr,
    unsigned int *checkAlwaysFlagPtr,
    Tcl_Namespace **execNsPtrPtr
) nonnull(1);

NSF_INLINE static NsfProcContext *ProcContextGet(
    const Tcl_Command cmdPtr
) nonnull(1) NSF_pure;

static NsfProcContext *ProcContextRequire(
    Tcl_Command cmd
) nonnull(1);

static int ArgumentParse(
    Tcl_Interp *interp,
    int objc, Tcl_Obj *const objv[],
    NsfObject *object,
    Tcl_Obj *procNameObj,
    const Nsf_Param *paramPtr,
    int nrParams,
    int serial,
    unsigned int processFlags,
    ParseContext *pcPtr
) nonnull(1) nonnull(5) nonnull(6) nonnull(10);

static int ArgumentCheck(
    Tcl_Interp *interp, Tcl_Obj *objPtr, const struct Nsf_Param *pPtr,
    unsigned int doCheckArguments,
    unsigned int *flags, ClientData *clientData, Tcl_Obj **outObjPtr
) nonnull(1) nonnull(2) nonnull(3) nonnull(5) nonnull(6) nonnull(7);

static int GetMatchObject(
    Tcl_Interp *interp, Tcl_Obj *patternObj, Tcl_Obj *origObj,
    NsfObject **matchObjectPtr, const char **patternPtr
) nonnull(1) nonnull(4) nonnull(5);

static void NsfProcDeleteProc(ClientData clientData)
  nonnull(1);

static int NsfParameterCacheObjectInvalidateCmd(
    Tcl_Interp *interp, NsfObject *object
) nonnull(1) nonnull(2);

static int GetObjectParameterDefinition(
    Tcl_Interp *interp, Tcl_Obj *procNameObj,
    NsfObject *object, NsfClass *class,
    NsfParsedParam *parsedParamPtr
) nonnull(1) nonnull(2) nonnull(5);

typedef Tcl_Obj *(NsfFormatFunction)(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr,
    NsfObject *contextObject, const char *pattern
);

static Tcl_Obj *NsfParamDefsVirtualFormat(
    Tcl_Interp *interp, const Nsf_Param *pPtr,
    NsfObject *contextObject, const char *pattern,
    NsfFormatFunction formatFunction
) nonnull(1) nonnull(2) nonnull(3) nonnull(5);

static bool NsfParamDefsAppendVirtual(
    Tcl_Interp *interp, Tcl_Obj *listObj,
    const Nsf_Param *paramsPtr,
    NsfObject *contextObject,
    const char *pattern,
    NsfFormatFunction formatFunction
) nonnull(1) nonnull(2) nonnull(3) nonnull(6);

/*
 * Prototypes for methods.
 */

static const char *MethodName(Tcl_Obj *methodObj)
  nonnull(1) returns_nonnull;

/*
 * Prototypes for alias management.
 */
static int AliasDelete(Tcl_Interp *interp, Tcl_Obj *cmdName, const char *methodName, bool withPer_object)
  nonnull(1) nonnull(2) nonnull(3);

static Tcl_Obj *AliasGet(Tcl_Interp *interp, Tcl_Obj *cmdName, const char *methodName,
                         bool withPer_object, bool leaveError)
  nonnull(1) nonnull(2) nonnull(3);

static bool AliasDeleteObjectReference(Tcl_Interp *interp, Tcl_Command cmd)
  nonnull(1) nonnull(2);

static int AliasRefetch(Tcl_Interp *interp, NsfObject *object, const char *methodName,
                        AliasCmdClientData *tcd)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

NSF_INLINE static Tcl_Command AliasDereference(Tcl_Interp *interp, NsfObject *object,
                                               const char *methodName, Tcl_Command cmd)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

/*
 * Prototypes for (class) list handling
 */
static NsfClasses ** NsfClassListAdd(NsfClasses **firstPtrPtr, NsfClass *class, ClientData clientData)
  nonnull(1) returns_nonnull;

/*
 * Misc prototypes
 */
static int SetInstVar(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *nameObj, Tcl_Obj *valueObj, unsigned int flags)
  nonnull(1) nonnull(2) nonnull(3);

static int UnsetInstVar(Tcl_Interp *interp, int withNocomplain, NsfObject *object, const char *name)
  nonnull(1) nonnull(3) nonnull(4);

static int NextSearchAndInvoke(
    Tcl_Interp *interp,
    const char *methodName, int objc, Tcl_Obj *const objv[],
    NsfCallStackContent *cscPtr, bool freeArgumentVector
) nonnull(1) nonnull(2) nonnull(5);

static void CmdListFree(NsfCmdList **cmdList, NsfFreeCmdListClientData *freeFct)
  nonnull(1);
static void NsfCommandPreserve(Tcl_Command cmd)
  nonnull(1);
static void NsfCommandRelease(Tcl_Command cmd)
  nonnull(1);
static Tcl_Command GetOriginalCommand(Tcl_Command cmd)
  nonnull(1) returns_nonnull;

EXTERN void NsfDStringArgv(Tcl_DString *dsPtr, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(3);

static NsfObjectOpt *NsfRequireObjectOpt(NsfObject *object)
  nonnull(1) returns_nonnull;

static int ObjectSystemsCheckSystemMethod(
    Tcl_Interp *interp, const char *methodName,
    const NsfObject *object, unsigned int flags
) nonnull(1) nonnull(2) nonnull(3);

#ifdef DO_CLEANUP
static void DeleteNsfProcs(Tcl_Interp *interp, Tcl_Namespace *nsPtr)
  nonnull(1);
#endif

#if defined(NSF_WITH_ASSERTIONS)
static void AssertionRemoveProc(NsfAssertionStore *aStore, const char *name)
  nonnull(1) nonnull(2);
#endif

#ifdef DO_FULL_CLEANUP
static void DeleteProcsAndVars(Tcl_Interp *interp, Tcl_Namespace *nsPtr, bool withKeepvars)
  nonnull(1) nonnull(2);
#endif


/*
 *----------------------------------------------------------------------
 *
 * NsfDListInit --
 *
 *      Function similar to Tcl_DStringInit, but works on (void*)
 *      elements instead of chars.
 *
 *      In general, the NsfDList* operations work on static data as long
 *      the space is sufficient, and doubles in size afterwards. In the
 *      worst case, half of the data is unused, but that is the same
 *      size of overhead like for a single linked list.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void
NsfDListInit(NsfDList *dlPtr) {
  dlPtr->data = &dlPtr->static_data[0];
  dlPtr->avail = nr_elements(dlPtr->static_data);
  dlPtr->size = 0u;
}

/*
 *----------------------------------------------------------------------
 *
 * NsfDListAppend --
 *
 *      Function similar to Tcl_DStringAppend, but works on (void*)
 *      elements instead of chars.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Potentially allocating/reallocating memory.
 *
 *----------------------------------------------------------------------
 */
static void
NsfDListAppend(NsfDList *dlPtr, void *element) {
  if (dlPtr->avail < 1) {
    size_t requiredSize = dlPtr->size * 2u;

    if (dlPtr->data != &dlPtr->static_data[0]) {
      dlPtr->data = (void **)ckrealloc((char *)dlPtr->data, sizeof(dlPtr->data[0]) * requiredSize);
    } else {
      dlPtr->data = (void **)ckalloc(sizeof(dlPtr->data[0]) * requiredSize);
      memcpy(dlPtr->data, &dlPtr->static_data[0], dlPtr->size * sizeof(dlPtr->data[0]));
    }
    dlPtr->avail = requiredSize - dlPtr->size;
  }
  dlPtr->avail --;
  dlPtr->data[dlPtr->size] = element;
  dlPtr->size ++;
}

/*
 *----------------------------------------------------------------------
 *
 * NsfDListFree --
 *
 *      Functions similar to Tcl_DStringFree, but but works on (void*)
 *      elements instead of chars.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Potentially freeing memory.
 *
 *----------------------------------------------------------------------
 */
#ifdef DO_CLEANUP
static void
NsfDListFree(NsfDList *dlPtr) {
  if (dlPtr->data != &dlPtr->static_data[0]) {
    ckfree((char*)dlPtr->data);
  }
  NsfDListInit(dlPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * NsfErrorContext --
 *
 *      Print the current errorCode and errorInfo to stderr.  This
 *      should be used as the last resort, when e.g. logging fails
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Output to stderr
 *
 *----------------------------------------------------------------------
 */
static void NsfErrorContext(
    Tcl_Interp *interp, const char *context
) nonnull(1) nonnull(2);

static void
NsfErrorContext(
    Tcl_Interp *interp, const char *context
) {
  Tcl_DString ds, *dsPtr = &ds;

  nonnull_assert(interp != NULL);
  nonnull_assert(context != NULL);

  Tcl_DStringInit(dsPtr);
  Tcl_DStringAppend(dsPtr, "puts stderr \"Error in ", -1);
  Tcl_DStringAppend(dsPtr, context, -1);
  Tcl_DStringAppend(dsPtr, ":\n$::errorCode $::errorInfo\"", -1);
  Tcl_EvalEx(interp, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr), 0);
  Tcl_DStringFree(dsPtr);
}

#if 0
static char *
NsfErrorInfo(
    Tcl_Interp *interp
) {
  Tcl_Obj *valueObj;
  nonnull_assert(interp != NULL);

  valueObj = Tcl_GetVar2Ex(interp, "::errorInfo", NULL, TCL_GLOBAL_ONLY);
  if (valueObj != NULL) {
    return ObjStr(valueObj);
  }
  return NULL;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * NsfDStringEval --
 *
 *      Evaluate the provided Tcl_DString as a Tcl command and output
 *      the error stack in case of a failure.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Output to stderr possible.
 *
 *----------------------------------------------------------------------
 */
int
NsfDStringEval(
    Tcl_Interp *interp, Tcl_DString *dsPtr, const char *context,
    unsigned int traceEvalFlags
) {
  Tcl_InterpState  state = NULL;
  NsfRuntimeState *rst;
  int              result, prevDoProfile;
  unsigned int     prevPreventRecursionFlags;

  nonnull_assert(interp != NULL);
  nonnull_assert(dsPtr != NULL);
  nonnull_assert(context != NULL);

  rst = RUNTIME_STATE(interp);

  if ((traceEvalFlags & NSF_EVAL_PREVENT_RECURSION) != 0u) {
    /*
     * We do not want to debug the debug statements, since this would
     * cause an infinite recursion.  Check whether we allow execution of
     * the eval call.
     */
    if ((rst->preventRecursionFlags & traceEvalFlags) != 0) {
      /*
       * Recursive case, do NOT execute the cmd and return silently.
       */
      return TCL_OK;
    }
    prevPreventRecursionFlags = rst->preventRecursionFlags;
    rst->preventRecursionFlags |= traceEvalFlags;
  } else {
    prevPreventRecursionFlags = 0u;
  }

  if ((traceEvalFlags & NSF_EVAL_NOPROFILE) && rst->doProfile == 1) {
    /*
     * Profiling should be deactivated for the eval.
     */
    prevDoProfile = 1;
    rst->doProfile = 0;
  } else {
    prevDoProfile = 0;
  }

  if ((traceEvalFlags & NSF_EVAL_SAVE) != 0u) {
    state = Tcl_SaveInterpState(interp, TCL_OK);
  }
  result = Tcl_EvalEx(interp, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr), 0);

  if (unlikely(result == TCL_ERROR)) {
    NsfErrorContext(interp, context);
  }

  if ((traceEvalFlags & NSF_EVAL_SAVE) != 0u) {
    Tcl_RestoreInterpState(interp, state);
  }
  if ((traceEvalFlags & NSF_EVAL_PREVENT_RECURSION) != 0u) {
      rst->preventRecursionFlags = prevPreventRecursionFlags;
  }

  if (prevDoProfile == 1) {
    rst->doProfile = 1;
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 *
 * NsfLog --
 *
 *      Produce a formatted warning by calling an external function
 *      ::nsf::log. It is defined static to allow for inlining.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Output of the warning.
 *
 *----------------------------------------------------------------------
 */

void
NsfLog(
    Tcl_Interp *interp, int requiredLevel, const char *fmt, ...
) {
  nonnull_assert(interp != NULL);
  nonnull_assert(fmt != NULL);

  if (requiredLevel >= RUNTIME_STATE(interp)->logSeverity) {
    int          destroyRound = RUNTIME_STATE(interp)->exitHandlerDestroyRound;
    Tcl_DString  cmdString, ds;
    const char  *level;
    va_list      ap;

    switch (requiredLevel) {
    case NSF_LOG_DEBUG: level = "Debug"; break;
    case NSF_LOG_NOTICE: level = "Notice"; break;
    default: level = "Warning"; break;
    }

    Tcl_DStringInit(&ds);
    va_start(ap, fmt);
    NsfDStringVPrintf(&ds, fmt, ap);
    va_end(ap);

    Tcl_DStringInit(&cmdString);
    Tcl_DStringAppendElement(&cmdString, "::nsf::log");
    Tcl_DStringAppendElement(&cmdString, level);
    Tcl_DStringAppendElement(&cmdString, Tcl_DStringValue(&ds));

    if (destroyRound != NSF_EXITHANDLER_ON_PHYSICAL_DESTROY) {
      NsfDStringEval(interp, &cmdString, "log command", (NSF_EVAL_LOG|NSF_EVAL_NOPROFILE));
    } else {
      /*
       * On physical destroy, we can't rely on NsfDStringEval() working
       * properly.
       */
      fprintf(stderr, "%s", cmdString.string);
    }
    Tcl_DStringFree(&cmdString);
    Tcl_DStringFree(&ds);
  }
}


/*
 *----------------------------------------------------------------------
 *
 * NsfDeprecatedCmd --
 *
 *      Provide a warning about a deprecated command or method. The
 *      message is produced via calling the external Tcl function
 *      ::nsf::deprecated. In case, profiling is turned on, it is
 *      deactivated temporarily. Saving the interp result should not be
 *      an issue, since the command is called before the body of the
 *      command is executed.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Output of the warning.
 *
 *----------------------------------------------------------------------
 */
void
NsfDeprecatedCmd(
    Tcl_Interp *interp, const char *what, const char *oldCmd, const char *newCmd
) {
  Tcl_DString ds, *dsPtr = &ds;

  nonnull_assert(interp != NULL);
  nonnull_assert(newCmd != NULL);
  nonnull_assert(what != NULL);
  nonnull_assert(oldCmd != NULL);

  Tcl_DStringInit(dsPtr);
  Tcl_DStringAppendElement(dsPtr, "::nsf::deprecated");
  Tcl_DStringAppendElement(dsPtr, what);
  Tcl_DStringAppendElement(dsPtr, oldCmd);
  Tcl_DStringAppendElement(dsPtr, newCmd);

  NsfDStringEval(interp, dsPtr, "deprecated command", (NSF_EVAL_DEPRECATED|NSF_EVAL_NOPROFILE));

  Tcl_DStringFree(dsPtr);
}


/***********************************************************************
 * argv parsing
 ***********************************************************************/
/*
 *----------------------------------------------------------------------
 *
 * ParseContextInit --
 *
 *      Initialize a ParseContext with default values and allocate
 *      memory if needed. Every ParseContext has to be initialized
 *      before usage and has to be freed with ParseContextRelease().
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Allocate potentially memory.
 *
 *----------------------------------------------------------------------
 */
static void ParseContextInit(
    ParseContext *pcPtr, int objc, NsfObject *object, Tcl_Obj *procName
) nonnull(1) nonnull(4);

static void
ParseContextInit(
    ParseContext *pcPtr, int objc, NsfObject *object, Tcl_Obj *procName
) {
  nonnull_assert(pcPtr != NULL);
  nonnull_assert(procName != NULL);

  if (likely(objc < PARSE_CONTEXT_PREALLOC)) {
    /*
     * The single larger memset below ....
     */
    memset(pcPtr, 0, sizeof(ParseContext));
    /*
     * ... is faster than the two smaller memsets below.
     */
    /* memset(pcPtr->clientData_static, 0, sizeof(ClientData)*(objc));
       memset(pcPtr->objv_static, 0, sizeof(Tcl_Obj *)*(objc+1));*/
    pcPtr->full_objv  = &pcPtr->objv_static[0];
    pcPtr->clientData = &pcPtr->clientData_static[0];
    pcPtr->flags      = &pcPtr->flags_static[0];
  } else {
    pcPtr->full_objv  = (Tcl_Obj **)ckalloc((int)sizeof(Tcl_Obj *) * ((unsigned)objc+1u));
    pcPtr->flags      = (unsigned *)ckalloc((unsigned)sizeof(int) * ((unsigned)objc+1u));
    MEM_COUNT_ALLOC("pcPtr.objv", pcPtr->full_objv);
    pcPtr->clientData = (ClientData *)ckalloc((unsigned)sizeof(ClientData) * (unsigned)objc);
    MEM_COUNT_ALLOC("pcPtr.clientData", pcPtr->clientData);
    /*fprintf(stderr, "ParseContextMalloc %d objc, %p %p\n", objc, pcPtr->full_objv, pcPtr->clientData);*/
    memset(pcPtr->full_objv,  0, sizeof(Tcl_Obj *)  * (size_t)(objc+1));
    memset(pcPtr->flags,      0, sizeof(int)        * (size_t)(objc+1));
    memset(pcPtr->clientData, 0, sizeof(ClientData) * (size_t)objc);
    pcPtr->status     = NSF_PC_STATUS_FREE_OBJV|NSF_PC_STATUS_FREE_CD;
    pcPtr->varArgs    = NSF_FALSE;
    pcPtr->objc       = 0;
  }
  pcPtr->objv = &pcPtr->full_objv[1];
  pcPtr->full_objv[0] = procName;
  pcPtr->object = object;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseContextExtendObjv --
 *
 *      Extend Tcl_Obj array at run time, when more elements are
 *      needed. This function is called to extend an already
 *      initialized ParseContext.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Allocate potentially memory.
 *
 *----------------------------------------------------------------------
 */

static void ParseContextExtendObjv(
    ParseContext *pcPtr, unsigned from, unsigned elts, Tcl_Obj *const source[]
) nonnull(1) nonnull(4);

static void
ParseContextExtendObjv(
    ParseContext *pcPtr, unsigned from, unsigned elts, Tcl_Obj *const source[]
) {
  unsigned requiredSize = from + elts + 1;

  nonnull_assert(pcPtr != NULL);
  nonnull_assert(source != NULL);

  /*NsfPrintObjv("BEFORE: ", pcPtr->objc, pcPtr->full_objv);*/

  if (unlikely(requiredSize >= PARSE_CONTEXT_PREALLOC)) {
    if (pcPtr->objv == &pcPtr->objv_static[1]) {
      /*
       * Realloc from preallocated memory
       */
      pcPtr->full_objv = (Tcl_Obj **)ckalloc((int)sizeof(Tcl_Obj *) * requiredSize);
      pcPtr->flags     = (unsigned *)ckalloc((int)sizeof(int) * requiredSize);
      MEM_COUNT_ALLOC("pcPtr.objv", pcPtr->full_objv);
      memcpy(pcPtr->full_objv, &pcPtr->objv_static[0], sizeof(Tcl_Obj *) * PARSE_CONTEXT_PREALLOC);
      memcpy(pcPtr->flags, &pcPtr->flags_static[0], sizeof(int) * PARSE_CONTEXT_PREALLOC);
      /* fprintf(stderr, "ParseContextExtendObjv: extend %p alloc %d new objv=%p pcPtr %p\n",
         pcPtr, requiredSize, pcPtr->full_objv, pcPtr);*/

      pcPtr->status     |= NSF_PC_STATUS_FREE_OBJV;
    } else {
      /*
       *  Realloc from mallocated memory
       */
      pcPtr->full_objv = (Tcl_Obj **)ckrealloc((char *)pcPtr->full_objv, (unsigned)sizeof(Tcl_Obj *) * requiredSize);
      pcPtr->flags     = (unsigned *)ckrealloc((char *)pcPtr->flags,     (unsigned)sizeof(int) * requiredSize);
      /*fprintf(stderr, "ParseContextExtendObjv: extend %p realloc %d  new objv=%p pcPtr %p\n",
        pcPtr, requiredSize, pcPtr->full_objv, pcPtr);*/
    }
    pcPtr->objv = &pcPtr->full_objv[1];
  }

  memcpy(pcPtr->objv + from,  source, sizeof(Tcl_Obj *) * (size_t)elts);
  memset(pcPtr->flags + from, 0,      sizeof(int) * (size_t)elts);
  pcPtr->objc += (int)elts;

  /*NsfPrintObjv("AFTER:  ", pcPtr->objc, pcPtr->full_objv);*/
}

/*
 *----------------------------------------------------------------------
 *
 * ParseContextRelease --
 *
 *      Release (and potentially free) the content of a
 *      ParseContext. This function is the counterpart of
 *      ParseContextInit(),
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free potentially memory.
 *
 *----------------------------------------------------------------------
 */
static void ParseContextRelease(ParseContext *pcPtr)
  nonnull(1);

static void
ParseContextRelease(ParseContext *pcPtr) {
  unsigned int status;

  nonnull_assert(pcPtr != NULL);

  status = pcPtr->status;

  /*fprintf(stderr, "ParseContextRelease %p status %.6x %d elements\n",
    pcPtr, status, pcPtr->objc);*/

#if defined(NSF_DEVELOPMENT_TEST)
  {
    /*
     * Perform a general consistency check: although the contents of the parse
     * context are at release time sometimes only partially initialized, the
     * following holds true for ensuring correct release of Tcl_Objs:
     *
     *  1) if one of the objv-flags has NSF_PC_MUST_DECR set,
     *     then the status flag NSF_PC_STATUS_MUST_DECR has to
     *     be set as well.
     *
     *  2) if objc > 0 then for all objv entries having a flag
     *     different from 0  must have a
     *     TCL_OBJ in the vector.
     *
     *  3) for preallocated objvs, all elements of the objv
     *     after the argument vector must be 0 or
     *     NSF_PC_IS_DEFAULT (sanity check)
     */
    /*
     * (1) make sure that the status correctly reflects MUST_DECR.
     */
    int i;
    if (status == 0u || (status & NSF_PC_STATUS_MUST_DECR) == 0u) {
      for (i = 0; i < pcPtr->objc - 1; i++) {
        assert((pcPtr->flags[i] & NSF_PC_MUST_DECR) == 0);
      }
    }

    /*
     * (2) make sure, Tcl_Objs are set when needed for reclaiming memory.
     */
    if (pcPtr->objc > 0) {
      /*fprintf(stderr, "%s ", ObjStr(pcPtr->full_objv[0]));*/
      for (i = 0; i < pcPtr->objc; i++) {
        if (pcPtr->flags[i] != 0u) {
          assert(pcPtr->objv[i]);
          /*fprintf(stderr, "[%d]%s %.6x ", i, ObjStr(pcPtr->objv[i]), pcPtr->flags[i]);*/
        }
      }
    }
    /*
     * (3) All later flags must be empty or DEFAULT.
     */
    if (pcPtr->full_objv == &pcPtr->objv_static[0] && pcPtr->objc > 0) {
      for (i = pcPtr->objc; i < PARSE_CONTEXT_PREALLOC; i++) {
        assert(pcPtr->flags[i] == 0u || pcPtr->flags[i] == NSF_PC_IS_DEFAULT);
      }
    }
  }
#endif

  if (unlikely(status != 0u)) {
    if ((status & NSF_PC_STATUS_MUST_DECR) != 0u) {
      int i;
      /*fprintf(stderr, "ParseContextRelease %p loop from 0 to %d\n", pcPtr, pcPtr->objc-1);*/
      for (i = 0; i < pcPtr->objc; i++) {
        /*fprintf(stderr, "ParseContextRelease %p check [%d] obj %p flags %.6x & %p\n",
                pcPtr, i, pcPtr->objv[i],
                pcPtr->flags[i], &(pcPtr->flags[i]));*/
        if ((pcPtr->flags[i] & NSF_PC_MUST_DECR) != 0u) {
          assert(pcPtr->objv[i]);
          assert(pcPtr->objv[i]->refCount > 0);
          /*fprintf(stderr, "... decr ref count on %p\n", pcPtr->objv[i]);*/
          DECR_REF_COUNT2("valueObj", pcPtr->objv[i]);
        }
      }
    }
    /*
     * Objv can be separately extended; also flags are extend when this
     * happens.
     */
    if (unlikely((status & NSF_PC_STATUS_FREE_OBJV) != 0u)) {
      /*fprintf(stderr, "ParseContextRelease %p free %p %p\n",
        pcPtr, pcPtr->full_objv, pcPtr->clientData);*/
      MEM_COUNT_FREE("pcPtr.objv", pcPtr->full_objv);
      ckfree((char *)pcPtr->full_objv);
      ckfree((char *)pcPtr->flags);
    }
    /*
     * If the parameter definition was extended at creation time also
     * clientData is extended.
     */
    if ((status & NSF_PC_STATUS_FREE_CD) != 0u) {
      /*fprintf(stderr, "free client-data for %p\n", pcPtr);*/
      MEM_COUNT_FREE("pcPtr.clientData", pcPtr->clientData);
      ckfree((char *)pcPtr->clientData);
    }
  }
}

/*
 *----------------------------------------------------------------------
 *
 * CallMethod --
 *
 *      Call a Next Scripting method. The provided "clientData" has to
 *      contain the object, on which the method is to be dispatched,
 *      "methodDobj" denotes the method, "objc" (which has to be >=2)
 *      and "objv" denotes the argument vector.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      potentially via the called method.
 *
 *----------------------------------------------------------------------
 */
/*
 * call a Next Scripting method
 */
static int
CallMethod(ClientData clientData, Tcl_Interp *interp, Tcl_Obj *methodObj,
           int objc, Tcl_Obj *const objv[], unsigned int flags)
  nonnull(1) nonnull(2) nonnull(3);

static int
CallMethod(ClientData clientData, Tcl_Interp *interp, Tcl_Obj *methodObj,
           int objc, Tcl_Obj *const objv[], unsigned int flags) {
  NsfObject *object;
  int        result;
  ALLOC_ON_STACK(Tcl_Obj*, objc, tov);

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(methodObj != NULL);
  assert(objc > 1);

  object = (NsfObject *) clientData;
  tov[0] = object->cmdName;
  tov[1] = methodObj;

  if (likely(objc > 2)) {
    memcpy(tov+2, objv, sizeof(Tcl_Obj *) * ((size_t)objc - 2u));
  }

  /*fprintf(stderr, "%%%% CallMethod cmdName=%s, method=%s, objc=%d\n",
    ObjStr(tov[0]), ObjStr(tov[1]), objc);
    {int i; fprintf(stderr, "\t CALL: %s ", ObjStr(methodObj));for(i = 0; i < objc-2; i++) {
    fprintf(stderr, "%s ", ObjStr(objv[i]));} fprintf(stderr, "\n");}*/

  result = ObjectDispatch(clientData, interp, objc, tov, flags);

  FREE_ON_STACK(Tcl_Obj*, tov);

  return result;
}

/*
 *----------------------------------------------------------------------
 *
 * NsfCallMethodWithArgs --
 *
 *      Call method (passed in methodObj) on the object, with the often
 *      provided arg1 and the optional remaining args (passed vis objv).
 *      This way, we save the memcpy in case no argument or a single
 *      argument are provided (common cases).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Called method might side effect.
 *
 *----------------------------------------------------------------------
 */

int NsfCallMethodWithArgs(Tcl_Interp *interp, Nsf_Object *object, Tcl_Obj *methodObj,
                      Tcl_Obj *arg1, int givenObjc, Tcl_Obj *const objv[], unsigned int flags)
  nonnull(1) nonnull(2) nonnull(3);

int
NsfCallMethodWithArgs(Tcl_Interp *interp, Nsf_Object *object, Tcl_Obj *methodObj,
                      Tcl_Obj *arg1, int givenObjc, Tcl_Obj *const objv[], unsigned int flags) {
  int       objc = givenObjc + 2;
  int       result;
  ALLOC_ON_STACK(Tcl_Obj*, objc, tov);

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  assert(ISOBJ_(methodObj));
  assert(objc > 1);

  tov[0] = object->cmdName;
  tov[1] = methodObj;
  if (objc > 2) {
    tov[2] = arg1;
  }
  if (objc > 3) {
    memcpy(tov+3, objv, sizeof(Tcl_Obj *) * ((size_t)objc - 3u));
  }

  /*fprintf(stderr, "%%%% CallMethodWithArgs cmdName=%s, method=%s, arg1 %s objc=%d\n",
          ObjStr(tov[0]), ObjStr(tov[1]), (objc > 2) ? ObjStr(tov[2]) : "",  objc);*/

  result = ObjectDispatch(object, interp, objc, tov, flags);

  FREE_ON_STACK(Tcl_Obj*, tov);

  return result;
}

/*
 * Support for variable hash tables
 */
static NSF_INLINE Var *VarHashCreateVar(TclVarHashTable *tablePtr, const Tcl_Obj *key, int *newPtr)
  nonnull(1) nonnull(2);

static NSF_INLINE Var *
VarHashCreateVar(TclVarHashTable *tablePtr, const Tcl_Obj *key, int *newPtr) {
  Var                 *varPtr;
  const Tcl_HashEntry *hPtr;

  nonnull_assert(tablePtr != NULL);
  nonnull_assert(key != NULL);

  hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr,
                             (char *) key, newPtr);
  if (likely(hPtr != NULL)) {
    varPtr = TclVarHashGetValue(hPtr);
  } else {
    varPtr = NULL;
  }

  return varPtr;
}

static NSF_INLINE TclVarHashTable *
VarHashTableCreate(void) {
  TclVarHashTable *varTablePtr = (TclVarHashTable *) ckalloc((int)sizeof(TclVarHashTable));

  TclInitVarHashTable(varTablePtr, NULL);
  return varTablePtr;
}

#include "nsfCmdPtr.c"
#include "nsfStack.c"

/***********************************************************************
 * Value added replacements of Tcl functions
 ***********************************************************************/
/*
 *----------------------------------------------------------------------
 * Nsf_NextHashEntry --
 *
 *      Function very similar to Tcl_NextHashEntry. If during the
 *      iteration of hash entries some of these entries are removed,
 *      Tcl_NextHashEntry() can lead to a valid looking but invalid
 *      hPtr, when the next entry was already deleted. This seem to
 *      occur only, when there are more than 12 hash entries in the
 *      table (multiple buckets).  Therefore, we use numEntries to check
 *      whether it is sensible to return a hash entry. We can trigger
 *      refetch of the hSrchPtr, when the number of expected entries
 *      differs from the numbers of the actual entries.
 *
 * Results:
 *      Hash Entry or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_HashEntry * Nsf_NextHashEntry(Tcl_HashTable *tablePtr, int expected, Tcl_HashSearch *hSrchPtr)
  nonnull(1) nonnull(3);

static Tcl_HashEntry *
Nsf_NextHashEntry(Tcl_HashTable *tablePtr, int expected, Tcl_HashSearch *hSrchPtr) {
  Tcl_HashEntry *result;

  nonnull_assert(tablePtr != NULL);
  nonnull_assert(hSrchPtr != NULL);

  /*fprintf(stderr, "Nsf_NextHashEntry %p expected %d numEntries %d\n",
    tablePtr, expected, tablePtr->numEntries);*/
  if (tablePtr->numEntries < 1) {
    result = NULL;
  } else if (tablePtr->numEntries != expected) {
    result = Tcl_FirstHashEntry(tablePtr, hSrchPtr);
  } else {
    result = Tcl_NextHashEntry(hSrchPtr);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * NsfCommandPreserve --
 *
 *      Increment Tcl's command refCount
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void
NsfCommandPreserve(Tcl_Command cmd) {

  nonnull_assert(cmd != NULL);

  Tcl_Command_refCount(cmd)++;
  MEM_COUNT_ALLOC("command.refCount", cmd);
}

/*
 *----------------------------------------------------------------------
 * NsfCommandRelease --
 *
 *      Decrement Tcl command refCount and free it if necessary.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free potentially memory
 *
 *----------------------------------------------------------------------
 */
static void
NsfCommandRelease(Tcl_Command cmd) {

  nonnull_assert(cmd != NULL);

  /*fprintf(stderr, "NsfCommandRelease %p\n", cmd);*/
  MEM_COUNT_FREE("command.refCount", cmd);
  TclCleanupCommandMacro((Command *)cmd);
}

/***********************************************************************
 * EXTERN callable routines for the preliminary C interface
 ***********************************************************************/
Nsf_Object * NsfGetSelfObj(const Tcl_Interp *interp)
  nonnull(1) NSF_pure;
Nsf_Object * NsfGetObject(Tcl_Interp *interp, const char *name)
  nonnull(1) nonnull(2);
Nsf_Class * NsfGetClass(Tcl_Interp *interp, const char *name)
  nonnull(1) nonnull(2);
Nsf_Class * NsfIsClass(Tcl_Interp *interp, ClientData clientData)
  nonnull(1) nonnull(2) NSF_pure;
void NsfRequireObjNamespace(Tcl_Interp *interp, Nsf_Object *object)
  nonnull(1) nonnull(2);
Tcl_Obj * Nsf_ObjSetVar2(Nsf_Object *object, Tcl_Interp *interp, Tcl_Obj *name1, Tcl_Obj *name2,
                         Tcl_Obj *valueObj, unsigned int flags)
  nonnull(1) nonnull(2) nonnull(3) nonnull(5);
Tcl_Obj * Nsf_ObjGetVar2(Nsf_Object *object, Tcl_Interp *interp, Tcl_Obj *name1, Tcl_Obj *name2, unsigned int flags)
  nonnull(1) nonnull(2) nonnull(3);
int NsfCreate(Tcl_Interp *interp, Nsf_Class *class, Tcl_Obj *nameObj, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(3) nonnull(5);
int NsfDeleteObject(Tcl_Interp *interp, Nsf_Object *object)
  nonnull(1) nonnull(2);
int NsfRemoveObjectMethod(Tcl_Interp *interp, Nsf_Object *object, const char *methodName)
  nonnull(1) nonnull(2) nonnull(3);
int NsfRemoveClassMethod(Tcl_Interp *interp, Nsf_Class *class, const char *methodName)
  nonnull(1) nonnull(2) nonnull(3);
int Nsf_UnsetVar2(Nsf_Object *object, Tcl_Interp *interp,
                  const char *name1, const char *name2, unsigned int flags)
  nonnull(1) nonnull(2) nonnull(4);

void NsfSetObjClientData(Tcl_Interp *UNUSED(interp), Nsf_Object *object, ClientData data)
  nonnull(1) nonnull(2);
ClientData NsfGetObjClientData(Tcl_Interp *UNUSED(interp), Nsf_Object *object)
  nonnull(1) nonnull(2) NSF_pure;
void NsfSetClassClientData(Tcl_Interp *UNUSED(interp), Nsf_Class *class, ClientData data)
  nonnull(1) nonnull(2);
ClientData NsfGetClassClientData(Tcl_Interp *UNUSED(interp), Nsf_Class *class)
  nonnull(1) nonnull(2) NSF_pure;

Nsf_Object *
NsfGetSelfObj(const Tcl_Interp *interp) {
  nonnull_assert(interp != NULL);
  return (Nsf_Object *) GetSelfObj(interp);
}

Nsf_Object *
NsfGetObject(Tcl_Interp *interp, const char *name) {
  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);
  return (Nsf_Object *) GetObjectFromString(interp, name);
}

Nsf_Class *
NsfGetClass(Tcl_Interp *interp, const char *name) {
  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);
  return (Nsf_Class *)GetClassFromString(interp, name);
}

Nsf_Class *
NsfIsClass(Tcl_Interp *UNUSED(interp), ClientData clientData) {

  nonnull_assert(clientData != NULL);

  if (NsfObjectIsClass((NsfObject *)clientData)) {
    return (Nsf_Class *) clientData;
  }
  return NULL;
}

void
NsfRequireObjNamespace(Tcl_Interp *interp, Nsf_Object *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  RequireObjNamespace(interp, (NsfObject *) object);
}

const char *
NsfMethodName(Tcl_Obj *methodObj) {

  nonnull_assert(methodObj != NULL);

  return MethodName(methodObj);
}

Tcl_Obj *
Nsf_ObjSetVar2(Nsf_Object *object, Tcl_Interp *interp, Tcl_Obj *name1, Tcl_Obj *name2,
                 Tcl_Obj *valueObj, unsigned int flags) {
  Tcl_Obj *result;
  CallFrame frame, *framePtr = &frame;

  nonnull_assert(object != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(name1 != NULL);
  nonnull_assert(valueObj != NULL);

  Nsf_PushFrameObj(interp, (NsfObject *)object, framePtr);
  if (((NsfObject *)object)->nsPtr != NULL) {
    flags |= TCL_NAMESPACE_ONLY;
  }
  result = Tcl_ObjSetVar2(interp, name1, name2, valueObj, (int)flags);
  Nsf_PopFrameObj(interp, framePtr);
  return result;
}


Tcl_Obj *
Nsf_ObjGetVar2(Nsf_Object *object, Tcl_Interp *interp, Tcl_Obj *name1, Tcl_Obj *name2,
               unsigned int flags) {
  Tcl_Obj  *result;
  CallFrame frame, *framePtr = &frame;

  nonnull_assert(object != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(name1 != NULL);

  Nsf_PushFrameObj(interp, (NsfObject *)object, framePtr);
  if (((NsfObject *)object)->nsPtr != NULL) {
    flags |= TCL_NAMESPACE_ONLY;
  }
  result = Tcl_ObjGetVar2(interp, name1, name2, (int)flags);
  Nsf_PopFrameObj(interp, framePtr);

  return result;
}

int
Nsf_UnsetVar2(Nsf_Object *object, Tcl_Interp *interp,
                   const char *name1, const char *name2, unsigned int flags) {
  CallFrame  frame, *framePtr = &frame;
  NsfObject *o;
  int        result;

  nonnull_assert(object != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(name1 != NULL);
  nonnull_assert(name2 != NULL);

  o = (NsfObject *) object;
  Nsf_PushFrameObj(interp, o, framePtr);
  if (o->nsPtr != NULL) {
    flags |= TCL_NAMESPACE_ONLY;
  }
  result = Tcl_UnsetVar2(interp, name1, name2, (int)flags);
  Nsf_PopFrameObj(interp, framePtr);
  return result;
}

int
NsfCreate(Tcl_Interp *interp, Nsf_Class *class, Tcl_Obj *nameObj,
          int objc, Tcl_Obj *const objv[]) {
  NsfClass *cl = (NsfClass *) class;
  int       result;
  ALLOC_ON_STACK(Tcl_Obj*, objc, tov);

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(objv != NULL);

  INCR_REF_COUNT2("nameObj", nameObj);

  tov[0] = NULL;
  tov[1] = nameObj;
  if (objc > 0) {
    memcpy(tov+2, objv, sizeof(Tcl_Obj *) * (size_t)objc);
  }
  result = NsfCCreateMethod(interp, cl, nameObj, objc+2, tov);

  FREE_ON_STACK(Tcl_Obj*, tov);
  DECR_REF_COUNT2("nameObj", nameObj);

  return result;
}

int
NsfDeleteObject(Tcl_Interp *interp, Nsf_Object *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  return DispatchDestroyMethod(interp, (NsfObject *)object, 0u);
}

int
NsfRemoveObjectMethod(Tcl_Interp *interp, Nsf_Object *object, const char *methodName) {
  NsfObject *currentObject;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);

  currentObject = (NsfObject *) object;
  /*fprintf(stderr, "... NsfRemoveObjectMethod %s %s\n", ObjectName(currentObject), methodName);*/

  NsfObjectMethodEpochIncr("NsfRemoveObjectMethod");
  AliasDelete(interp, currentObject->cmdName, methodName, NSF_TRUE);

#if defined(NSF_WITH_ASSERTIONS)
  if (currentObject->opt != NULL && currentObject->opt->assertions != NULL) {
    AssertionRemoveProc(currentObject->opt->assertions, methodName);
  }
#endif

  if (currentObject->nsPtr != NULL) {
    int rc = NSDeleteCmd(interp, currentObject->nsPtr, methodName);
    if (rc < 0) {
      return NsfPrintError(interp, "%s: cannot delete object specific method '%s'",
                           ObjectName_(currentObject), methodName);
    }
  }
  return TCL_OK;
}

int
NsfRemoveClassMethod(Tcl_Interp *interp, Nsf_Class *class, const char *methodName) {
  const NsfClass *c;
  int             rc;
#if defined(NSF_WITH_ASSERTIONS)
  NsfClassOpt    *opt;
#endif

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(methodName != NULL);

  c = (NsfClass *)class;
  /*fprintf(stderr, "... NsfRemoveClassMethod %s %s\n", ClassName(class), methodName);*/

  NsfInstanceMethodEpochIncr("NsfRemoveClassMethod");
  AliasDelete(interp, class->object.cmdName, methodName, NSF_FALSE);

#if defined(NSF_WITH_ASSERTIONS)
  opt = c->opt;
  if (opt != NULL && opt->assertions != NULL) {
    AssertionRemoveProc(opt->assertions, methodName);
  }
#endif

  rc = NSDeleteCmd(interp, c->nsPtr, methodName);
  if (rc < 0) {
    return NsfPrintError(interp, "%s: cannot delete method '%s'", ClassName_(c), methodName);
  }
  return TCL_OK;
}

/*
 * obj/cl ClientData setter/getter
 */

void
NsfSetObjClientData(Tcl_Interp *UNUSED(interp), Nsf_Object *object, ClientData data) {

  nonnull_assert(object != NULL);
  nonnull_assert(data != NULL);

  NsfRequireObjectOpt((NsfObject *) object) -> clientData = data;
}

ClientData
NsfGetObjClientData(Tcl_Interp *UNUSED(interp), Nsf_Object *object) {
  NsfObject *object_;

  nonnull_assert(object != NULL);

  object_ = (NsfObject *) object;
  return (object_->opt != NULL) ? object_->opt->clientData : NULL;
}

void
NsfSetClassClientData(Tcl_Interp *UNUSED(interp), Nsf_Class *class, ClientData data) {

  nonnull_assert(class != NULL);

  NsfRequireClassOpt((NsfClass *)class) -> clientData = data;
}

ClientData
NsfGetClassClientData(Tcl_Interp *UNUSED(interp), Nsf_Class *class) {
  NsfClass *c;

  c = (NsfClass *) class;
  return (c->opt != NULL) ? c->opt->clientData : NULL;
}

/***********************************************************************
 * Utility functions
 ***********************************************************************/

#if defined(NSFOBJ_TRACE)
void ObjTrace(const char *string, NsfObject *object)
  nonnull(1) nonnull(2);

void
ObjTrace(const char *string, NsfObject *object) {

  nonnull_assert(string != NULL);
  nonnull_assert(object != NULL);

  fprintf(stderr, "--- %s Tcl %p %s (%d %p) nsf %p (%d) %s \n", string,
          (void *)object->cmdName, ObjTypeStr(object->cmdName),
          object->cmdName->refCount, object->cmdName->internalRep.twoPtrValue.ptr1,
          (void *)object, object->refCount, ObjectName(object));
}
#else
# define ObjTrace(a, b)
#endif


/*
 *----------------------------------------------------------------------
 * NSTail --
 *
 *      Return the namespace tail of a name.
 *
 * Results:
 *      String.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static const char * NSTail(const char *string)
  nonnull(1) NSF_pure;

static const char *
NSTail(const char *string) {
  register const char *p;

  nonnull_assert(string != NULL);

  p = string + strlen(string);
  while (p > string) {
    if (unlikely(*p == ':' && *(p-1) == ':')) {
      return p+1;
    }
    p--;
  }
  return string;
}

/*
 *----------------------------------------------------------------------
 * IsClassNsName --
 *
 *      Check whether the provided string starts with the prefix of the
 *      classes namespace.
 *
 * Results:
 *      A Boolean value..
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static bool IsClassNsName(const char *string, const char **cont)
  nonnull(1);

NSF_INLINE static bool
IsClassNsName(const char *string, const char **cont) {

  nonnull_assert(string != NULL);

  if (*string == ':' && strncmp(string, nsfClassesPrefix, nsfClassesPrefixLength) == 0) {
    if (cont != NULL) {
      *cont = string + nsfClassesPrefixLength;
    }
    return NSF_TRUE;
  }
  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * GetObjectFromNsName --
 *
 *      Get object or class from a fully qualified cmd name, such as
 *      e.g. ::nsf::classes::X
 *
 * Results:
 *      NsfObject and *fromClasses
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static NsfObject * GetObjectFromNsName(Tcl_Interp *interp, const char *string, bool *fromClassNS)
  nonnull(1) nonnull(2) nonnull(3);

NSF_INLINE static NsfObject *
GetObjectFromNsName(Tcl_Interp *interp, const char *string, bool *fromClassNS) {
  const char *className;

  nonnull_assert(interp != NULL);
  nonnull_assert(string != NULL);
  nonnull_assert(fromClassNS != NULL);

  if (IsClassNsName(string, &className)) {
    *fromClassNS = NSF_TRUE;
    return (NsfObject *)GetClassFromString(interp, className);
  } else {
    *fromClassNS = NSF_FALSE;
    return GetObjectFromString(interp, string);
  }
}

/*
 *----------------------------------------------------------------------
 * DStringAppendQualName --
 *
 *      Append to initialized DString the name of the namespace followed
 *      by a simple name (methodName, cmdName).
 *
 * Results:
 *      String pointing to DString value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static char *DStringAppendQualName(Tcl_DString *dsPtr, const Tcl_Namespace *nsPtr, const char *name)
  nonnull(1) nonnull(2) nonnull(3);

static char *
DStringAppendQualName(Tcl_DString *dsPtr, const Tcl_Namespace *nsPtr, const char *name) {
  int oldLength;

  nonnull_assert(dsPtr != NULL);
  nonnull_assert(nsPtr != NULL);
  nonnull_assert(name != NULL);

  oldLength = Tcl_DStringLength(dsPtr);

  Tcl_DStringAppend(dsPtr, nsPtr->fullName, -1);
  if (Tcl_DStringLength(dsPtr) > (oldLength + 2)) {
    Tcl_DStringAppend(dsPtr, "::", 2);
  }
  Tcl_DStringAppend(dsPtr, name, -1);
  return Tcl_DStringValue(dsPtr);
}

/*
 *----------------------------------------------------------------------
 * NsfCleanupObject --
 *
 *      Delete an object physically (performing ckfree()) when its refCount
 *      reaches 0
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees memory.
 *
 *----------------------------------------------------------------------
 */
void
NsfCleanupObject_(NsfObject *object) {

  nonnull_assert(object != NULL);

  NsfObjectRefCountDecr(object);
  /*fprintf(stderr, "NsfCleanupObject obj refCount of %p after decr %d id %p interp %p flags %.6x\n",
    object, object->refCount, object->id, object->teardown, object->flags);*/

  if (unlikely(object->refCount <= 0)) {
    /*fprintf(stderr, "NsfCleanupObject %p ref-count %d\n", object, object->refCount);*/
    assert(object->refCount == 0);
    assert((object->flags & NSF_DELETED) != 0u);

    /*
     * During FinalObjectDeletion(), object->teardown is NULL, we cannot access
     * the object and class names anymore.
     */
    if (object->teardown && NSF_DTRACE_OBJECT_FREE_ENABLED()) {
      NSF_DTRACE_OBJECT_FREE(ObjectName(object), ClassName(object->cl));
    }

    MEM_COUNT_FREE("NsfObject/NsfClass", object);
#if defined(NSFOBJ_TRACE)
    fprintf(stderr, "CKFREE Object %p refCount=%d\n", (void *)object, object->refCount);
#endif
#if !defined(NDEBUG)
    memset(object, 0, sizeof(NsfObject));
#endif
    ckfree((char *) object);
  }
}


/*
 *      Tcl_Obj functions for objects
 */

/*
 *----------------------------------------------------------------------
 * TclObjIsNsfObject --
 *
 *      Check whether the provided Tcl_Obj is bound to an NSF object. If
 *      so, return the NsfObject in the third argument.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool TclObjIsNsfObject(
    Tcl_Interp *interp, Tcl_Obj *objPtr, NsfObject **objectPtr
) nonnull(1) nonnull(2) nonnull(3);

static bool
TclObjIsNsfObject(Tcl_Interp *interp, Tcl_Obj *objPtr, NsfObject **objectPtr) {
  Tcl_ObjType CONST86 *cmdType;
  bool                 result = NSF_FALSE;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(objectPtr != NULL);

  cmdType = objPtr->typePtr;
  if (cmdType == Nsf_OT_tclCmdNameType) {
    const Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objPtr);
    if (likely(cmd != NULL)) {
      NsfObject *object = NsfGetObjectFromCmdPtr(cmd);
      if (object != NULL) {
        *objectPtr = object;
        result = NSF_TRUE;
      }
    }
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * GetObjectFromObj --
 *
 *      Lookup a Next Scripting object from the given objPtr, preferably
 *      from an object of type "cmdName". On success the NsfObject is
 *      returned in the third argument. The objPtr might be converted by
 *      this function.
 *
 * Results:
 *      True or false,
 *
 * Side effects:
 *      object type of objPtr might be changed
 *
 *----------------------------------------------------------------------
 */
static int GetObjectFromObj(
    Tcl_Interp *interp, Tcl_Obj *objPtr, NsfObject **objectPtr
) nonnull(1) nonnull(2) nonnull(3);

static int
GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, NsfObject **objectPtr) {
  NsfObject    *object;
  const char   *string;
  Tcl_Command   cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(objectPtr != NULL);

  /*fprintf(stderr, "GetObjectFromObj obj %p %s is of type %s\n",
    objPtr, ObjStr(objPtr), ObjTypeStr(objPtr));*/

  /*
   * Use the standard Tcl_GetCommandFromObj() which might convert the objPtr
   * to type cmdName.
   */
  cmd = Tcl_GetCommandFromObj(interp, objPtr);

  /*fprintf(stderr, "GetObjectFromObj obj %p %s (type %p) => cmd=%p (refCount %d)\n",
    objPtr, ObjStr(objPtr), objPtr->typePtr, cmd, (cmd != NULL) ? Tcl_Command_refCount(cmd) : -1);*/

  if (cmd != NULL) {
    NsfObject *cmdObject;

    /*
     * Tcl returned us a command. At least in Tcl 8.7, we cannot trust that
     * the returned cmd is still valid. Unfortunately, we can't check more
     * details here, since "struct ResolvedCmdName" is defined locally in
     * generic/tclObj.c. For cmd epochs>0 we take the conservative approach
     * not to trust in internal representation and fetch the cmd new.
     */

    cmdObject = NsfGetObjectFromCmdPtr(cmd);

    /* fprintf(stderr, "GetObjectFromObj obj %s, o is %p objProc %p NsfObjDispatch %p\n",
       ObjStr(objPtr), cmdObject, Tcl_Command_objProc(cmd), NsfObjDispatch);*/

    if (likely(cmdObject != NULL)) {
      *objectPtr = cmdObject;
      return TCL_OK;
    }
  }
  /*fprintf(stderr, "GetObjectFromObj convertFromAny for %s type %p %s\n", ObjStr(objPtr),
    objPtr->typePtr, ObjTypeStr(objPtr));*/

  /*
   * In case, we have to revolve via the CallingNameSpace (i.e. the argument
   * is not fully qualified), we retry here.
   */
  string = ObjStr(objPtr);

  if (isAbsolutePath(string)) {
    object = NULL;
  } else {
    Tcl_Obj    *tmpName = NameInNamespaceObj(string, CallingNameSpace(interp));
    const char *nsString = ObjStr(tmpName);

    INCR_REF_COUNT(tmpName);
    object = GetObjectFromString(interp, nsString);
    /* fprintf(stderr, " RETRY, string '%s' returned %p\n", nsString, object);*/
    DECR_REF_COUNT(tmpName);
  }

  if (likely(object != NULL)) {
    *objectPtr = object;
    return TCL_OK;
  }

  return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 * NsfCallObjectUnknownHandler --
 *
 *      Call ::nsf::object::unknown; this function is typically called,
 *      when an unknown object or class is passed as an argument.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Called handler might side effect.
 *
 *----------------------------------------------------------------------
 */

static int NsfCallObjectUnknownHandler(
    Tcl_Interp *interp, Tcl_Obj *nameObj
) nonnull(1) nonnull(2);

static int
NsfCallObjectUnknownHandler(Tcl_Interp *interp, Tcl_Obj *nameObj) {
  int      result;
  Tcl_Obj *ov[3];

  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);

  /*fprintf(stderr, "try ::nsf::object::unknown for '%s'\n", ObjStr(nameObj));*/

  ov[0] = NsfGlobalObjs[NSF_OBJECT_UNKNOWN_HANDLER];
  ov[1] = nameObj;

  INCR_REF_COUNT(ov[1]);
  result = Tcl_EvalObjv(interp, 2, ov, 0);
  DECR_REF_COUNT(ov[1]);

  return result;
}

#if defined(NSF_EXPERIMENTAL)
static int NsfCallArgumentUnknownHandler(
    Tcl_Interp *interp,
    Tcl_Obj *methodObj,
    Tcl_Obj *argumentObj,
    NsfObject *object
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static int
NsfCallArgumentUnknownHandler(
    Tcl_Interp *interp,
    Tcl_Obj *methodObj,
    Tcl_Obj *argumentObj,
    NsfObject *object
) {
  Tcl_Obj *ov[4];
  int      result, oc = 3;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodObj != NULL);
  nonnull_assert(argumentObj != NULL);
  nonnull_assert(object != NULL);

  /*fprintf(stderr, "try ::nsf::argument::unknown for '%s'\n", ObjStr(nameObj));*/

  ov[0] = NsfGlobalObjs[NSF_ARGUMENT_UNKNOWN_HANDLER];
  ov[1] = methodObj;
  ov[2] = argumentObj;
  if (object != NULL) {
    ov[3] = object->cmdName;
    oc ++;
  }

  INCR_REF_COUNT(ov[1]);
  result = Tcl_EvalObjv(interp, oc, ov, 0);
  DECR_REF_COUNT(ov[1]);

  return result;
}
#endif

/*
 *----------------------------------------------------------------------
 * GetClassFromObj --
 *
 *      Lookup a Next Scripting class from the given objPtr. If the
 *      class could not be directly converted and withUnknown is true,
 *      the function calls the unknown function (::nsf::object::unknown)
 *      to fetch the class on demand and retries the conversion.  On
 *      success the NsfClass is returned in the third argument. The
 *      objPtr might be converted by this function.
 *
 * Results:
 *      True or false,
 *
 * Side effects:
 *      object type of objPtr might be changed
 *
 *----------------------------------------------------------------------
 */

static int
GetClassFromObj(Tcl_Interp *interp, register Tcl_Obj *objPtr,
                NsfClass **classPtr, bool withUnknown) {
  NsfObject   *object;
  NsfClass    *class;
  const char  *objName;
  Tcl_Command  cmd;
  int          result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(classPtr != NULL);

  objName = ObjStr(objPtr);
  cmd = Tcl_GetCommandFromObj(interp, objPtr);
  /*fprintf(stderr, "GetClassFromObj %p %s unknown %d cmd %p\n", objPtr, objName, withUnknown, cmd);*/

  if (likely(cmd != NULL)) {
    class = NsfGetClassFromCmdPtr(cmd);
    if (class == NULL) {
      /*
       * We have a cmd, but no class; namespace-imported classes are already
       * resolved, but we have to care, if a class is "imported" via "interp
       * alias".
       */
      Tcl_Interp *alias_interp;
      const char *alias_cmd_name, *qualifiedObjName;
      Tcl_Obj    *nameObj = objPtr;
      Tcl_Obj   **alias_ov;
      int         alias_oc = 0;

      if (!isAbsolutePath(objName)) {
        nameObj = NameInNamespaceObj(objName, CallingNameSpace(interp));
        qualifiedObjName = ObjStr(nameObj);
        INCR_REF_COUNT(nameObj);
      } else {
        qualifiedObjName = objName;
      }

      result = Tcl_GetAliasObj(interp, qualifiedObjName,
                               &alias_interp, &alias_cmd_name, &alias_oc, &alias_ov);
      Tcl_ResetResult(interp);

      /*
       * We only want interp-aliases with 0 args
       */
      if (likely(result == TCL_OK) && likely(alias_oc == 0)) {
        cmd = NSFindCommand(interp, alias_cmd_name);
        /*fprintf(stderr, "..... alias arg 0 '%s' cmd %p\n", alias_cmd_name, cmd);*/
        if (cmd != NULL) {
          class = NsfGetClassFromCmdPtr(cmd);
        }
      }

      /*fprintf(stderr, "..... final cmd %p, class %p\n", cmd , class);*/
      if (nameObj != objPtr) {
        DECR_REF_COUNT(nameObj);
      }
    }

    if (likely(class != NULL)) {
      *classPtr = class;
      return TCL_OK;
    }
  }

  result = GetObjectFromObj(interp, objPtr, &object);
  if (likely(result == TCL_OK)) {
    class = NsfObjectToClass(object);
    if (likely(class != NULL)) {
      *classPtr = class;
      return TCL_OK;
    } else {
      /*
       * Flag, that we could not convert so far.
       */
      result = TCL_ERROR;
    }
  }

  if (withUnknown) {
    /*fprintf(stderr, "**** withUnknown 1 obj %s is shared %d\n", ObjStr(objPtr), Tcl_IsShared(objPtr));*/
    INCR_REF_COUNT(objPtr);
    result = NsfCallObjectUnknownHandler(interp, isAbsolutePath(objName) ? objPtr :
                                         NameInNamespaceObj(objName, CallingNameSpace(interp)));
    if (likely(result == TCL_OK)) {
      /*
       * Retry, but now, the last argument (withUnknown) has to be FALSE
       */
      result = GetClassFromObj(interp, objPtr, classPtr, NSF_FALSE);
    }
    DECR_REF_COUNT(objPtr);
    /*fprintf(stderr, "... ::nsf::object::unknown for '%s',
      result %d cl %p\n", objName, result, cl);*/
  }

  return result;
}

/*
 * Version of GetClassFromObj() with external symbol
 */
int
NsfGetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
                   NsfClass **classPtr, bool withUnknown) {

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(classPtr != NULL);

  return GetClassFromObj(interp, objPtr, classPtr, withUnknown);
}
/*
 *----------------------------------------------------------------------
 * IsObjectOfType --
 *
 *      Check whether the provided NsfObject is of a certain type. The
 *      arguments "what" and "objPtr" are just used for the error
 *      messages. "objPtr" is the value from which the object was
 *      converted from.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int IsObjectOfType(
    Tcl_Interp *interp, NsfObject *object, const char *what, Tcl_Obj *objPtr,
    const Nsf_Param *pPtr
) nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

static int
IsObjectOfType(
    Tcl_Interp *interp, NsfObject *object, const char *what, Tcl_Obj *objPtr,
    const Nsf_Param *pPtr
) {
  NsfClass *class;
  int       result = TCL_ERROR;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(what != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);

  if (unlikely((pPtr->flags & NSF_ARG_BASECLASS) != 0u)
      && !IsBaseClass(object)
     ) {
    what = "baseclass";

  } else if (unlikely((pPtr->flags & NSF_ARG_METACLASS) != 0u)
             && !IsMetaClass(interp, (NsfClass *)object, NSF_TRUE)
            ) {
    what = "metaclass";

  } else if (likely(pPtr->converterArg == NULL)) {
    result = TCL_OK;

  } else if (likely((GetClassFromObj(interp, pPtr->converterArg, &class, NSF_FALSE) == TCL_OK))
             && IsSubType(object->cl, class)
            ) {
    result = TCL_OK;
  }

  if (result == TCL_ERROR) {
    Tcl_DString ds, *dsPtr = &ds;

    DSTRING_INIT(dsPtr);
    Tcl_DStringAppend(dsPtr, what, -1);
    if (pPtr->converterArg != NULL) {
      Tcl_DStringAppend(dsPtr, " of type ", -1);
      Tcl_DStringAppend(dsPtr, ObjStr(pPtr->converterArg), -1);
    }
    NsfObjErrType(interp, NULL, objPtr, Tcl_DStringValue(dsPtr), (Nsf_Param *)pPtr);
    DSTRING_FREE(dsPtr);
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * NameInNamespaceObj --
 *
 *      Create a fully qualified name in the provided namespace or in
 *      the current namespace in form of a Tcl_Obj (with 0 refCount);
 *
 * Results:
 *      Tcl_Obj containing fully qualified name
 *
 * Side effects:
 *      Allocates fresh copies of list elements
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj *
NameInNamespaceObj(const char *name, Tcl_Namespace *nsPtr) {
  Tcl_Obj *objPtr;
  Tcl_DString ds, *dsPtr = &ds;

  nonnull_assert(name != NULL);
  nonnull_assert(nsPtr != NULL);

  /*fprintf(stderr, "NameInNamespaceObj %s (%p, %s) ", name, nsPtr, nsPtr->fullName);*/

  DSTRING_INIT(dsPtr);
  DStringAppendQualName(dsPtr, nsPtr, name);
  objPtr = Tcl_NewStringObj(Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr));

  /*fprintf(stderr, "returns %s\n", ObjStr(objPtr));*/
  DSTRING_FREE(dsPtr);
  return objPtr;
}

/*
 *----------------------------------------------------------------------
 * NewTclCommand --
 *
 *      Given a provided prefix in dsPtr, make it a name of a command
 *      that does not exist.  This function is used by the *new command,
 *      when "anonymous" objects are created
 *
 * Results:
 *      dsPtr will be complete to represent a new (unused) name of a command.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
void NewTclCommand(Tcl_Interp *interp, Tcl_DString *dsPtr)
  nonnull(1) nonnull(2);

void
NewTclCommand(Tcl_Interp *interp, Tcl_DString *dsPtr) {
  int prefixLength;
  NsfStringIncrStruct *iss;

  nonnull_assert(interp != NULL);
  nonnull_assert(dsPtr != NULL);

  prefixLength = dsPtr->length;
  iss = &RUNTIME_STATE(interp)->iss;

  while (1) {

    (void)NsfStringIncr(iss);
    Tcl_DStringAppend(dsPtr, iss->start, (int)iss->length);
    if (!Tcl_FindCommand(interp, Tcl_DStringValue(dsPtr), NULL, TCL_GLOBAL_ONLY)) {
      break;
    }
    /*
     * In case the symbol existed already, reset prefix to the
     * original length.
     */
    Tcl_DStringSetLength(dsPtr, prefixLength);
  }
}

/*
 *----------------------------------------------------------------------
 * NsfReverseClasses --
 *
 *      Reverse class list. Caller is responsible for freeing data.
 *
 * Results:
 *      Pointer to start of the reversed list
 *
 * Side effects:
 *      Allocates fresh copies of list elements
 *
 *----------------------------------------------------------------------
 */
static NsfClasses *NsfReverseClasses(NsfClasses *sl)
  nonnull(1) returns_nonnull;

static NsfClasses *
NsfReverseClasses(NsfClasses *sl) {
  NsfClasses *firstPtr = NULL;

  nonnull_assert(sl != NULL);

  do {
    NsfClasses *element = NEW(NsfClasses);

    element->cl = sl->cl;
    element->clientData = sl->clientData;
    element->nextPtr = firstPtr;
    firstPtr = element;

    sl = sl->nextPtr;
  } while (likely(sl != NULL));

  return firstPtr;
}

/*
 *----------------------------------------------------------------------
 * NsfClassListFree --
 *
 *      Frees all elements of the provided class list.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees memory.
 *
 *----------------------------------------------------------------------
 */
static void NsfClassListFree(NsfClasses *classList)
  nonnull(1);

static void
NsfClassListFree(NsfClasses *classList) {
  NsfClasses *nextPtr;

 nonnull_assert(classList != NULL);

 do {
   nextPtr = classList->nextPtr;
   FREE(NsfClasses, classList);
   classList = nextPtr;
 } while (likely(classList != NULL));
}

/*
 *----------------------------------------------------------------------
 * NsfClassListAdd --
 *
 *      Add class list entry to the specified list. In case the initial
 *      list is empty, *firstPtrPtr is updated as well.
 *
 * Results:
 *      Returns address of next-pointer.
 *
 * Side effects:
 *      New list element is allocated.
 *
 *----------------------------------------------------------------------
 */

static NsfClasses **
NsfClassListAdd(NsfClasses **firstPtrPtr, NsfClass *class, ClientData clientData) {
  NsfClasses *classListPtr, *element = NEW(NsfClasses);

  nonnull_assert(firstPtrPtr != NULL);

  element->cl = class;
  element->clientData = clientData;
  element->nextPtr = NULL;

  classListPtr = *firstPtrPtr;
  if (classListPtr != NULL) {
    while (classListPtr->nextPtr != NULL) {
      classListPtr = classListPtr->nextPtr;
    }
    classListPtr->nextPtr = element;
  } else {
    *firstPtrPtr = element;
  }
  return &(element->nextPtr);
}

/*
 *----------------------------------------------------------------------
 * NsfClassListAddNoDup --
 *
 *      Add class list entry to the specified list without
 *      duplicates. In case the initial list is empty, *firstPtrPtr is
 *      updated as well.
 *
 * Results:
 *      Returns address of next pointer.
 *
 * Side effects:
 *      New list element is allocated.
 *
 *----------------------------------------------------------------------
 */

static NsfClasses **NsfClassListAddNoDup(NsfClasses **firstPtrPtr, NsfClass *class,
                                         ClientData clientData)
  nonnull(1) nonnull(2);

static NsfClasses **
NsfClassListAddNoDup(NsfClasses **firstPtrPtr, NsfClass *class, ClientData clientData) {
  NsfClasses *clPtr, **nextPtr;

  nonnull_assert(firstPtrPtr != NULL);
  nonnull_assert(class != NULL);

  clPtr = *firstPtrPtr;
  if (clPtr != NULL) {
    while ((clPtr->nextPtr != NULL) && (clPtr->cl != class)) {
      clPtr = clPtr->nextPtr;
    }
    nextPtr = &clPtr->nextPtr;
  } else {
    nextPtr = firstPtrPtr;
  }

  if (*nextPtr == NULL) {
    NsfClasses *element = NEW(NsfClasses);

    element->cl = class;
    element->clientData = clientData;
    element->nextPtr = NULL;
    *nextPtr = element;
  }
  return nextPtr;
}

/*
 *----------------------------------------------------------------------
 * NsfClassListFind --
 *
 *      Find an element in the class list and return it if found.
 *
 * Results:
 *      Found element or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClasses *NsfClassListFind(NsfClasses *clPtr, const NsfClass *class)
  nonnull(2) NSF_pure;

static NsfClasses *
NsfClassListFind(NsfClasses *clPtr, const NsfClass *class) {

  nonnull_assert(class != NULL);

  for (; clPtr != NULL; clPtr = clPtr->nextPtr) {
    if (clPtr->cl == class) {
      break;
    }
  }
  return clPtr;
}

#if defined(NSF_CLASSLIST_PRINT)
/* debugging purposes only */
/*
 *----------------------------------------------------------------------
 * NsfClassListStats --
 *
 *      Print some statistics about generated Class List structures for
 *      debugging purpose.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static void NsfClassListStats(const char *title, NsfClasses *classList)
  nonnull(1);

static void
NsfClassListStats(const char *title, NsfClasses *classListPtr) {
  NsfClass *class;
  int count = 0;

  nonnull_assert(title != NULL);

  class = (classListPtr != NULL) ? classListPtr->cl : NULL;
  for (; classListPtr != NULL; classListPtr = classListPtr->nextPtr) {
    count++;
  }

  fprintf(stderr, "%s class list starting with %s has %d elements\n",
          title, (class != NULL) ? ClassName(class) : "none", count);
}

static void NsfClassListPrint(const char *title, const NsfClasses *clsList)
  nonnull(1);

static void
NsfClassListPrint(const char *title, const NsfClasses *clsList) {

  nonnull_assert(title != NULL);

  fprintf(stderr, "%s", title);
  /* fprintf(stderr, " %p:", clsList); */
  while (clsList != NULL) {
    /* fprintf(stderr, " %p", clsList->cl); */
    fprintf(stderr, " %p", (void *)clsList);
    fprintf(stderr, " %s", ClassName(clsList->cl));
    clsList = clsList->nextPtr;
  }
  fprintf(stderr, "\n");
}
#endif

/*
 *----------------------------------------------------------------------
 * NsfClassListUnlink --
 *
 *      Return removed item with matching key form nsfClasses.
 *      Key is void to allow not only class pointers as keys.
 *
 * Results:
 *      unlinked element or NULL.
 *      In case the first element is unlinked, *firstPtrPtr
 *      is updated.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClasses *NsfClassListUnlink(NsfClasses **firstPtrPtr, const void *key)
  nonnull(1) nonnull(2);

static NsfClasses *
NsfClassListUnlink(NsfClasses **firstPtrPtr, const void *key) {
  NsfClasses *entryPtr;

  nonnull_assert(firstPtrPtr != NULL);
  nonnull_assert(key != NULL);

  if (*firstPtrPtr != NULL) {
    NsfClasses *prevPtr = NULL;

    /*
     * List is nonempty.
     */
    for (entryPtr = *firstPtrPtr;
         entryPtr != NULL;
         prevPtr = entryPtr, entryPtr = entryPtr->nextPtr
         ) {
      if ((void *)entryPtr->cl == key) {
        /*
         * Found entry.
         */
        if (prevPtr != NULL) {
          /*
           * Later item.
           */
          prevPtr->nextPtr = entryPtr->nextPtr;
        } else {
          /*
           * First item.
           */
          *firstPtrPtr = entryPtr->nextPtr;
        }
        entryPtr->nextPtr = NULL;
        break;
      }
    }
  } else {
    entryPtr = NULL;
  }

  return entryPtr;
}


/*
 * Functions for computing Precedence Order
 */

/*
 *----------------------------------------------------------------------
 * TopoSortSub --
 *
 *      Performs a topological sort of the subclass hierarchy of a given
 *      class. The resulting list contains no duplicates or cycles and
 *      is returned in the class member "order". During computation, it
 *      colors the processed nodes in WHITE, GRAY or BLACK.
 *
 * Results:
 *      Boolean values indicating whether a cycle was detected
 *      (NSF_FALSE) or not (NSF_TRUE); and, therefore, whether the sort
 *      failed (NSF_FALSE) or succeeded (NSF_TRUE).
 *
 * Side effects:
 *      Allocates class list.
 *
 *----------------------------------------------------------------------
 */

enum colors { WHITE, GRAY, BLACK };

static bool TopoSortSub(NsfClass *class, NsfClass *baseClass, bool withMixinOfs)
  nonnull(1) nonnull(2);

static bool
TopoSortSub(NsfClass *class, NsfClass *baseClass, bool withMixinOfs) {
  NsfClasses *sl, *pl;
  bool        isAcyclic = NSF_TRUE;

  nonnull_assert(class != NULL);
  nonnull_assert(baseClass != NULL);

  sl = class->sub;

  /*
   * Be careful to reset the color of unreported classes to
   * white in case we unwind with error, and on final exit
   * reset color of reported classes to WHITE. Meaning of colors:
   *
   *     WHITE ... not processed
   *     GRAY  ... in work
   *     BLACK ... done
   */

  class->color = GRAY;

  for (; sl != NULL; sl = sl->nextPtr) {
    NsfClass *sc = sl->cl;

    if (sc->color == GRAY ||
        unlikely(sc->color == WHITE
                 && !TopoSortSub(sc, baseClass, withMixinOfs))
        ) {
      isAcyclic = NSF_FALSE;
      break;
    }

  }

  if (isAcyclic && withMixinOfs) {
    NsfCmdList *classMixins = ((class->opt != NULL) ? class->opt->isClassMixinOf : NULL);

    for (; classMixins != NULL; classMixins = classMixins->nextPtr) {
      NsfClass *sc = NsfGetClassFromCmdPtr(classMixins->cmdPtr);

      if (likely(sc != NULL)
          && unlikely(sc->color == WHITE &&
                      !TopoSortSub(sc, baseClass, withMixinOfs))) {
        NsfLog(sc->object.teardown, NSF_LOG_WARN,
               "cycle in the mixin graph list detected for class %s",
               ClassName_(sc));
      }
    }
  }

  class->color = BLACK;
  pl = NEW(NsfClasses);
  pl->cl = class;
  pl->nextPtr = baseClass->order;
  baseClass->order = pl;

  if (unlikely(class == baseClass)) {
    register const NsfClasses *pc;

    for (pc = class->order; pc != NULL; pc = pc->nextPtr) {
      pc->cl->color = WHITE;
    }
    assert(isAcyclic && baseClass->order != NULL);
  }

  return isAcyclic;
}


/*
 *----------------------------------------------------------------------
 * MustBeBefore --
 *
 *      Check the partial ordering of classes based on precedence list
 *      in the form of prior ordering from the topological sort. We
 *      compare here orderings based the class hierarchies with single
 *      inheritance and prior solved multiple inheritance orderings. The
 *      test is true, if b must be before a.
 *
 * Results:
 *      Boolean value indicating success.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool MustBeBefore(const NsfClass *aClass, const NsfClass *bClass, const NsfClasses *superClasses)
  nonnull(1) nonnull(2) nonnull(3) NSF_pure;

static bool
MustBeBefore(const NsfClass *aClass, const NsfClass *bClass, const NsfClasses *superClasses) {
  bool success;

  nonnull_assert(aClass != NULL);
  nonnull_assert(bClass != NULL);
  nonnull_assert(superClasses != NULL);
  assert(bClass->order != NULL);

  /*
   * Check whether "x" is in the precedence order of "y". E.g.
   *
   *   x c1 object
   *   y c2 x object
   *
   * If so then "y" must be before "x" to preserve the precedence order based on
   * single inheritance (monotonicity).
   */
  success = (NsfClassListFind(bClass->order, aClass) != NULL);

  /*
   * When the partital ordering can't be decided based on the local order
   * test, we take the specified multiple inheritance ordering in superClasses
   * (e.g. coming from -superclass {x y}) which is not taken account by the
   * class hierarchy.
   */
  if (!success) {
    const NsfClasses *sl;
    bool              found = NSF_FALSE;

#if defined(NSF_LINEARIZER_TRACE)
    fprintf(stderr, "--> check %s before %s?\n", ClassName(bClass), ClassName(aClass));
    NsfClassListPrint("superClasses", superClasses);
#endif
    for (sl = superClasses; sl != NULL; sl = sl->nextPtr) {
      if (sl->cl == bClass) {
        found = NSF_TRUE;
      } else if (found && sl->cl == aClass) {
#if defined(NSF_LINEARIZER_TRACE)
        fprintf(stderr, "%s in inheritanceList before %s therefore a < b\n",
                ClassName(bClass), ClassName(aClass));
#endif
        success = NSF_TRUE;
        break;
      }
    }
  }

#if defined(NSF_LINEARIZER_TRACE)
  fprintf(stderr, "compare a: %s %p b: %s %p -> %d\n",
          ClassName(aClass), (void *)aClass->order,
          ClassName(bClass), (void *)bClass->order, (int)success);
  NsfClassListPrint("\ta", aClass->order);
  NsfClassListPrint("\tb", bClass->order);
#endif
  return success;
}


/*
 *----------------------------------------------------------------------
 * ValidClassListTail --
 *
 *      Debug function to assure that the provided class lists are
 *      valid. The tail of the class list must be a base class of the
 *      current object system.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
#if defined(NSF_DEVELOPMENT_TEST)
static void
ValidClassListTail(const char *what, NsfClasses *classListPtr) {
  NsfClasses *sl, *tail;

  for (sl = classListPtr, tail = NULL; sl != NULL; sl = sl->nextPtr) {
    tail = sl;
  }
  if (tail != NULL) {
    /* fprintf(stderr, "check tail what %s %p\n", what, ClassName(tail->cl), tail->nextPtr);*/
    assert(IsBaseClass(&tail->cl->object));
    assert(tail->nextPtr == NULL);
  }
}
#else
# define ValidClassListTail(what, classListPtr)
#endif

/*
 *----------------------------------------------------------------------
 * MergeInheritanceLists --
 *
 *      Merge the PrecedenceOrders of class cl. This function is called,
 *      when cl is defined with multiple inheritance. The precedence
 *      orders of the specified classes are merged in an order
 *      preserving manner to achieve monotonicity.
 *
 * Results:
 *      precedence order.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClasses *MergeInheritanceLists(NsfClasses *pl, NsfClass *class)
  nonnull(1) nonnull(2) returns_nonnull;

static NsfClasses *
MergeInheritanceLists(NsfClasses *pl, NsfClass *class) {
  NsfClasses *sl, *baseList, **plNext, *superClasses,
    *deletionList = NULL;

  nonnull_assert(pl != NULL);
  nonnull_assert(class != NULL);

#if defined(NSF_LINEARIZER_TRACE)
  fprintf(stderr, "=== MergeInheritanceLists working on %s\n", ClassName(class));
#endif

  /*
   * The available multiple inheritance list is in reversed order so we have
   * to reverse it to obtain the specified superClasses in the provided order.
   */
  superClasses = NsfReverseClasses(class->super);

  /*
   * We distinguish between a
   *
   *  - baseList (which might be later a result of partial merges), and a
   *  - mergeList, which is merged order-preserving into the baseList.
   *
   * The first baseList is the precedence list of the first element of the
   * specified superClasses.
   */

  baseList = superClasses->cl->order;
  assert(baseList != NULL);

#if defined(NSF_LINEARIZER_TRACE)
  fprintf(stderr, "=== baseList from %s = %p\n", ClassName(superClasses->cl), (void *)baseList);
  NsfClassListPrint("baseList", baseList);
#endif

  /*
   * The first element of the result list of the merge operation is the first
   * element of the baseList.
   */
  plNext = NsfClassListAdd(&pl, baseList->cl, NULL);

  /*
   * For every element but the first (which is already in baseList), we have to
   * perform the merge operation. For n elements in superClasses, the merge
   * operation is performed n-1 times.
   */

  sl = superClasses->nextPtr;
  assert(superClasses->nextPtr != NULL);

  do {
    NsfClasses *mergeList = sl->cl->order, *baseListCurrent;

#if defined(NSF_LINEARIZER_TRACE)
    NsfClassListPrint("mergeList", mergeList);
#endif

    /*
     * Merge mergeList into baseList. We start with the 2nd (later probably
     * nth) entry of the baseList
     */
    baseListCurrent = baseList->nextPtr;
    assert(baseListCurrent != NULL);

    while (mergeList != NULL) {
      NsfClass *addClass;

      ValidClassListTail("baseList",  baseList);
      ValidClassListTail("mergeList", mergeList);

      assert(baseListCurrent != NULL);
      /* NsfClassListPrint("baseListCurrent", baseListCurrent); */

      if (mergeList->cl == baseListCurrent->cl) {
        /*
         * The first element of mergeList and the current baseList element are
         * identical. The element is in the result, keep the element in the
         * result, advance in both lists.
         */
        /* fprintf(stderr, "\t\tadvance both\n"); */
        addClass = mergeList->cl;
        baseListCurrent = baseListCurrent->nextPtr;
        mergeList = mergeList->nextPtr;

      } else if (MustBeBefore(baseListCurrent->cl, mergeList->cl, superClasses)) {
        /*
         * Check whether current element of mergeList must be before the current
         * element of baseList. If so, insert current mergelist element before
         * baseListCurrent,
         */
        addClass  = mergeList->cl;
        mergeList = mergeList->nextPtr;
        /* fprintf(stderr, "\t\tadd from mergeList %s\n", ClassName(addClass)); */

      } else {
        /*
         * Two cases above do not apply, add from baseList and advance
         * baseList pointer.
         */
        addClass = baseListCurrent->cl;
        baseListCurrent = baseListCurrent->nextPtr;
        /* fprintf(stderr, "\t\tadd from baselist %s\n", ClassName(addClass)); */
      }

      if (addClass != NULL) {
        /*
         * We have to add an element to the precedence list. When the class to
         * be added is already in the result list (which might happen just in
         * crippled cases) then delete it. In the final step it will be added
         * again to the end.
         */
        NsfClasses *deletedElement = NsfClassListUnlink(&pl, addClass);

        if (deletedElement != NULL) {
#if defined(NSF_LINEARIZER_TRACE)
          fprintf(stderr, "\t\t%s is redundant (in resultList)\n", ClassName(addClass));
#endif
          /*
           * When plNext points to the nextPtr of the deleted element, search
           * the list from the begin
           */
          if (plNext == &(deletedElement->nextPtr)) {
            plNext = &pl;
          }
          NsfClassListFree(deletedElement);
        }

        /*
         * Add the new element.
         */
        plNext = NsfClassListAdd(plNext, addClass, NULL);
      }

#if defined(NSF_LINEARIZER_TRACE)
      NsfClassListPrint("pl:", pl);
#endif
    }
    /*
     * mergeList is processed, we have a final precedence list in pl.  In case
     * are at then of superClasses, we are done. Otherwise, use the resulting
     * pl as next baseList and continue with the next mergeList from
     * superClasses.
     */
#if defined(NSF_LINEARIZER_TRACE)
    NsfClassListPrint("plFinal:", pl);
#endif

    if (sl->nextPtr != NULL) {
      /*
       * We are not at the end, use pl as new base list.
       */
      baseList = pl;

#if defined(NSF_LINEARIZER_TRACE)
      fprintf(stderr, "=== setting new baseList\n");
      NsfClassListPrint("new baseList", baseList);
#endif
      /*
       * Add old pl to deletion list; these entries are deleted once merging
       * is finished.
       */
      NsfClassListAdd(&deletionList, NULL, pl);

      /*
       * Create a fresh pl for the next iteration.
       */
      pl = NULL;
      plNext = NsfClassListAdd(&pl, class, NULL);
    }
    /*
     * Get next element from the list.
     */
    sl = sl->nextPtr;
  } while (sl != NULL);

  for (sl = deletionList; sl != NULL; sl = sl->nextPtr) {
    /* fprintf(stderr, "delete from deletion list %p client data %p\n", sl, sl->clientData); */
    NsfClassListFree(sl->clientData);
  }

  if (deletionList != NULL) {
    NsfClassListFree(deletionList);
  }
  NsfClassListFree(superClasses);

  return pl;
}

#if defined(NSF_DEVELOPMENT_TEST)
static void AssertOrderIsWhite(NsfClasses *order) {
  register NsfClasses *pc;

  for (pc = order; pc != NULL; pc = pc->nextPtr) {
    assert(pc->cl->color == WHITE);
  }
}
#else
# define AssertOrderIsWhite(arg)
#endif

/*
 *----------------------------------------------------------------------
 * TopoSortSuper --
 *
 *      Compute the precedence order for baseClass based on the
 *      superclasses. If the order is computable, update base class and
 *      return NSF_TRUE. Otherwise return NSF_FALSE.
 *
 * Results:
 *      Boolean value indicating success.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool TopoSortSuper(NsfClass *class, NsfClass *baseClass)
  nonnull(1) nonnull(2);

static bool
TopoSortSuper(NsfClass *class, NsfClass *baseClass) {
  NsfClasses *pl, *sl;

  nonnull_assert(class != NULL);
  nonnull_assert(baseClass != NULL);

  /*
   * Be careful to reset the color of unreported classes to
   * white in the caller on all exits to WHITE.
   *
   *     WHITE ... not processed
   *     GRAY  ... in work
   *     BLACK ... done
   */

  class->color = GRAY;
  for (sl = class->super; likely(sl != NULL); sl = sl->nextPtr) {
    NsfClass *sc = sl->cl;

    if (sc->color == GRAY) {
      class->color = WHITE;
      return NSF_FALSE;
    }
    if (unlikely(sc->color == WHITE && !TopoSortSuper(sc, baseClass))) {
      class->color = WHITE;
      return NSF_FALSE;
    }
  }

  /*
   * Create a new precedence list containing cl.
   */
  pl = NEW(NsfClasses);
  pl->cl = class;
  pl->nextPtr = NULL;

  /*
   * If we have multiple inheritance we merge the precomputed inheritance
   * orders of the involved classes in the provided order.
   */
  if (likely(class->super != NULL) && unlikely(class->super->nextPtr != NULL)) {

    pl = MergeInheritanceLists(pl, class);

    if (baseClass->order != NULL) {
      NsfClassListFree(baseClass->order);
      /*
       * baseClass->order is reset below.
       */
    }


  } else {
    /*
     * Add baseClass order to the end of the precedence list.
     */

    assert(pl->nextPtr == NULL);
    pl->nextPtr = baseClass->order;
  }

  class->color = BLACK;
  /*
   * Set baseClass order to the newly computed list (the result of this
   * function).
   */
  baseClass->order = pl;

  return NSF_TRUE;
}


/*
 *----------------------------------------------------------------------
 * PrecedenceOrder --
 *
 *      Return a class list containing the transitive list of
 *      superclasses starting with (and containing) the provided
 *      class. The superclass list is cached in cl->order and has to be
 *      invalidated by FlushPrecedences() in case the order changes. The
 *      caller does not have to free the returned class list (like for
 *      TransitiveSubClasses);
 *
 * Results:
 *      Class list, NULL on error
 *
 * Side effects:
 *      Updating cl->order.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static NsfClasses *
PrecedenceOrder(NsfClass *class) {
  register const NsfClasses *sl;
  bool                       success, haveMultipleInheritance;

  nonnull_assert(class != NULL);

  /*
   * Check, of the superclass order is already cached.
   */
  if (likely(class->order != NULL)) {
    return class->order;
  }

  /*
   * For multiple inheritance (more than one superclass), make sure that
   * required precedence orders are precomputed. But first check whether we
   * have to do this rather expensive operation now, or we can do it
   * lazily. We can't do this in MergeInheritanceLists() within
   * TopoSortSuper(), since there the class node coloring might be half done.
   */
  haveMultipleInheritance = NSF_FALSE;
  for (sl = class->super; sl != NULL; sl = sl->cl->super) {
    if (sl != NULL && sl->nextPtr != NULL) {
      haveMultipleInheritance = NSF_TRUE;
      break;
    }
  }

  if (unlikely(haveMultipleInheritance)) {
    /*
     * In the class hierarchy is somewhere a place with multiple
     * inheritance. All precedence orders of superclasses must be computed,
     * otherwise merging of sublists will not work.
     */

    for (sl = class->super; sl != NULL; sl = sl->nextPtr) {
      const NsfClasses *pl;

#if defined(NSF_LINEARIZER_TRACE)
      fprintf(stderr, "====== PrecedenceOrder multiple inheritance: check %s %p \n",
              ClassName(sl->cl), (void *)sl->cl->order);
#endif
      if (unlikely(sl->cl->order == NULL) && likely(class != sl->cl)) {
#if defined(NSF_LINEARIZER_TRACE)
        fprintf(stderr, "====== PrecedenceOrder multiple inheritance computes required order for %s \n",
                ClassName(sl->cl));
#endif
        PrecedenceOrder(sl->cl);
#if defined(NSF_LINEARIZER_TRACE)
        NsfClassListPrint("====== PrecedenceOrder multiple inheritance:", sl->cl->order);
#endif
      }

      for (pl = sl->cl->order; pl != NULL; pl = pl->nextPtr) {
#if defined(NSF_LINEARIZER_TRACE)
        fprintf(stderr, "====== PrecedenceOrder multiple inheritance: %s %p\n",
                ClassName(pl->cl), (void *)pl->cl->order);
#endif
        if (pl->cl->order == NULL) {
#if defined(NSF_LINEARIZER_TRACE)
          fprintf(stderr, "========== recurse\n");
#endif
          PrecedenceOrder(pl->cl);
        }
      }
    }
  }

  success = TopoSortSuper(class, class);

  /*
   * Reset the color of all nodes.
   */
  for (sl = class->order; sl != NULL; sl = sl->nextPtr) {
    sl->cl->color = WHITE;
  }

  /*
   * If computation is successful, return cl->order.
   * Otherwise clear cl->order if necessary.
   */
  if (likely(success)) {
    AssertOrderIsWhite(class->order);
    /*
     * TopoSortSuper succeeded, the cl-order is already set.
     */
  } else if (class->order != NULL) {
    /*
     * TopoSortSuper failed, but there is a computed cl->order. Flush it.
     */
    NsfClassListFree(class->order);
    class->order = NULL;
  } else {
    /*
     * TopoSortSuper failed, but there is no computed cl->order. Nothing to
     * do.
     */
  }

#if defined(NSF_LINEARIZER_TRACE)
  NsfClassListPrint("!!! PrecedenceOrder computed", class->order);
#endif

  return class->order;
}

/*
 *----------------------------------------------------------------------
 * GetSubClasses --
 *
 *      Return a class list containing the transitive or dependent
 *      subclasses starting with (and containing) the provided
 *      class. The caller has to free the returned class list.
 *
 * Results:
 *      Class list, at least with one element (i.e., the provided class).
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

NSF_INLINE static NsfClasses *
GetSubClasses(NsfClass *class, bool withMixinOfs)
  nonnull(1) returns_nonnull;

#define TransitiveSubClasses(class)                         \
  GetSubClasses((class), NSF_FALSE)

#define DependentSubClasses(class)                         \
  GetSubClasses((class), NSF_TRUE)

NSF_INLINE static NsfClasses *
GetSubClasses(NsfClass *class, bool withMixinOfs) {
  NsfClasses *order, *savedOrder;

  nonnull_assert(class != NULL);

  /*
   * Since TopoSort() places its result in cl->order, we have to save the old
   * cl->order, perform the computation, and restore the old order.
   */
  savedOrder = class->order;
  class->order = NULL;

  (void)TopoSortSub(class, class, withMixinOfs);

  order = class->order;
  assert(order != NULL);

  AssertOrderIsWhite(order);

  class->order = savedOrder;
  return order;
}

/*
 *----------------------------------------------------------------------
 * FlushPrecedences --
 *
 *      This function iterations over the provided class list and
 *      flushes (and frees) the superclass caches in cl->order for every
 *      element.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Freeing class lists cached in cl->order.
 *
 *----------------------------------------------------------------------
 */
static void FlushPrecedences(const NsfClasses *subClasses)
  nonnull(1);

static void
FlushPrecedences(const NsfClasses *subClasses) {

  nonnull_assert(subClasses != NULL);

  do {
    if (subClasses->cl->order != NULL) {
      NsfClassListFree(subClasses->cl->order);
    }
    subClasses->cl->order = NULL;
    subClasses = subClasses->nextPtr;
  } while (subClasses != NULL);
}


/*
 *----------------------------------------------------------------------
 * AddInstance --
 *
 *      Add an instance to a class.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Add entry to children hash-table.
 *
 *----------------------------------------------------------------------
 */
static void AddInstance(NsfObject *object, NsfClass *class)
  nonnull(1) nonnull(2);

static void
AddInstance(NsfObject *object, NsfClass *class) {
  int isNewItem;

  nonnull_assert(object != NULL);
  nonnull_assert(class != NULL);

  object->cl = class;
  (void) Tcl_CreateHashEntry(&class->instances, (char *)object, &isNewItem);
  /*if (newItem == 0) {
    fprintf(stderr, "instance %p %s was already an instance of %p %s\n",
    (void *)object, ObjectName(object), (void *)cl, ClassName(class));
    }*/
  assert(isNewItem != 0);
}


/*
 *----------------------------------------------------------------------
 * RemoveInstance --
 *
 *      Remove an instance from a class. The function checks, whether
 *      the entry is actually still an instance before it deletes it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Entry deleted from instances hash-table
 *
 *----------------------------------------------------------------------
 */
static void RemoveInstance(const NsfObject *object, NsfClass *class)
  nonnull(1) nonnull(2);

static void
RemoveInstance(const NsfObject *object, NsfClass *class) {

  nonnull_assert(object != NULL);
  nonnull_assert(class != NULL);

  /*
   * If we are during a delete, which should not happen under normal
   * operations, prevent an abort due to a deleted hash table.
   */
  if (unlikely(class->object.flags & NSF_DURING_DELETE) != 0u) {
    NsfLog(class->object.teardown, NSF_LOG_WARN,
           "The class %s, from which an instance is to be removed, is currently under deletion",
            ObjStr((class)->object.cmdName));
  } else {
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&class->instances, (char *)object, NULL);

    /*if (hPtr == NULL) {
      fprintf(stderr, "instance %s is not an instance of %s\n", ObjectName(object), ClassName(class));
      }*/
    assert(hPtr != NULL);
    Tcl_DeleteHashEntry(hPtr);
  }
}

/*
 * superclass/subclass list maintenance
 */
static void AddSuper1(NsfClass *class, NsfClasses **sl)
  nonnull(1) nonnull(2);
static void AddSuper(NsfClass *class, NsfClass *superClass)
  nonnull(1);
static bool RemoveSuper1(NsfClass *class, NsfClasses **sl)
  nonnull(1) nonnull(2);
static bool RemoveSuper(NsfClass *class, NsfClass *superClass)
  nonnull(1) nonnull(2);

static void
AddSuper1(NsfClass *class, NsfClasses **sl) {
  NsfClasses *sc = NEW(NsfClasses);

  nonnull_assert(class != NULL);
  nonnull_assert(sl != NULL);

  sc->cl = class;
  sc->nextPtr = *sl;
  *sl = sc;
}

static void
AddSuper(NsfClass *class, NsfClass *superClass) {

  nonnull_assert(class != NULL);

  if (superClass != NULL) {
    /*
     * keep corresponding sub in step with super
     */
    AddSuper1(superClass, &class->super);
    AddSuper1(class, &superClass->sub);
  }
}

static bool
RemoveSuper1(NsfClass *class, NsfClasses **sl) {
  NsfClasses *l;
  bool        result;

  nonnull_assert(class != NULL);
  nonnull_assert(sl != NULL);

  l = *sl;

  if (l == NULL) {
    result = NSF_FALSE;

  } else if (l->cl == class) {
    *sl = l->nextPtr;
    FREE(NsfClasses, l);
    result = NSF_TRUE;

  } else {
    while ((l->nextPtr != NULL) && (l->nextPtr->cl != class)) {
      l = l->nextPtr;
    }
    if (l->nextPtr != NULL) {
      NsfClasses *n = l->nextPtr->nextPtr;
      FREE(NsfClasses, l->nextPtr);
      l->nextPtr = n;
      result = NSF_TRUE;
    } else {
      result = NSF_FALSE;
    }
  }
  return result;
}

static bool
RemoveSuper(NsfClass *class, NsfClass *superClass) {
  bool sp, sb;

  nonnull_assert(class != NULL);
  nonnull_assert(superClass != NULL);

  /*
   * Keep corresponding sub in step with super
   */

  sp = RemoveSuper1(superClass, &class->super);
  sb = RemoveSuper1(class, &superClass->sub);

  return sp && sb;
}

/*
 * methods lookup
 */

/*
 *----------------------------------------------------------------------
 * GetEnsembleObjectFromName --
 *
 *      Get an ensemble object from a method name.  If the method name
 *      is fully qualified, just use a Tcl lookup, otherwise get it from
 *      the provided namespace.
 *
 * Results:
 *      Ensemble object or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfObject *GetEnsembleObjectFromName(
    Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *nameObj,
    Tcl_Command *cmdPtr, bool *fromClassNS
) nonnull(1) nonnull(3) nonnull(4) nonnull(5);

static NsfObject *
GetEnsembleObjectFromName(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *nameObj,
                         Tcl_Command *cmdPtr, bool *fromClassNS) {
  Tcl_Command  cmd;
  const char  *nameString;
  NsfObject   *result;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(cmdPtr != NULL);
  nonnull_assert(fromClassNS != NULL);

  nameString = ObjStr(nameObj);
  if (*nameString == ':') {
    cmd = Tcl_GetCommandFromObj(interp, nameObj);
    *fromClassNS = IsClassNsName(nameString, NULL);
  } else {
    cmd = (nsPtr != NULL) ? FindMethod(nsPtr, nameString) : NULL;
  }

  if (cmd != NULL) {
    *cmdPtr = cmd;
    result = NsfGetObjectFromCmdPtr(GetOriginalCommand(cmd));
  } else {
    result = NULL;
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * GetRegObject --
 *
 *      Try to get the object, on which the method was registered from a
 *      fully qualified method handle.
 *
 * Results:
 *      NsfObject * or NULL on failure.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfObject *GetRegObject(Tcl_Interp *interp, Tcl_Command cmd, const char *methodName,
                               const char **methodName1, bool *fromClassNS)
  nonnull(1) nonnull(3) nonnull(5) nonnull(2);

static NsfObject *
GetRegObject(Tcl_Interp *interp, Tcl_Command cmd, const char *methodName,
             const char **methodName1, bool *fromClassNS) {
  NsfObject  *regObject;
  const char *procName;
  size_t      objNameLength;

  nonnull_assert(interp != NULL);
  nonnull_assert(cmd != NULL);
  nonnull_assert(methodName != NULL);
  assert(*methodName == ':');
  nonnull_assert(fromClassNS != NULL);
  nonnull_assert(cmd != NULL);

  procName = Tcl_GetCommandName(interp, cmd);
  objNameLength = strlen(methodName) - strlen(procName) - 2;

  if (objNameLength > 0) {
    Tcl_DString ds, *dsPtr = &ds;

    /*
     * Obtain parent name.
     */
    Tcl_DStringInit(dsPtr);
    Tcl_DStringAppend(dsPtr, methodName, (int)objNameLength);
    regObject = GetObjectFromNsName(interp, Tcl_DStringValue(dsPtr), fromClassNS);
    if (regObject != NULL && methodName1 != NULL) {
      *methodName1 = procName;
    }
    Tcl_DStringFree(dsPtr);
  } else {
    regObject = NULL;
  }

  /*fprintf(stderr, "GetRegObject cmd %p methodName '%s' => %p\n", (void *)cmd, methodName, (void *)regObject);*/
  return regObject;
}

/*
 *----------------------------------------------------------------------
 * ResolveMethodName --
 *
 *      Resolve a method name relative to a provided namespace.
 *      The method name can be
 *      a) a fully qualified name
 *      b) a list of method name and subcommands
 *      c) a simple name
 *
 * Results:
 *      Tcl_Command or NULL on failure
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Command ResolveMethodName(
    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr,
    Tcl_Obj *methodObj,
    Tcl_DString *methodNameDs,
    NsfObject **regObject,
    NsfObject **defObject,
    const char **methodName1, bool *fromClassNS
) nonnull(1) nonnull(3) nonnull(8);

static Tcl_Command
ResolveMethodName(
    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr,
    Tcl_Obj *methodObj,
    Tcl_DString *methodNameDs,
    NsfObject **regObject,
    NsfObject **defObject,
    const char **methodName1,
    bool *fromClassNS
) {
  const char *methodName;
  NsfObject  *referencedObject;
  bool        containsSpace, tailContainsSpace;
  Tcl_Command cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodObj != NULL);
  nonnull_assert(fromClassNS != NULL);

  methodName = ObjStr(methodObj);

  /*fprintf(stderr, "methodName '%s' comp %d type %s\n",
    methodName, strchr(methodName, ' ')>0, ObjTypeStr(methodObj));*/

  if (methodObj->typePtr == Nsf_OT_listType) {
    int length;

    Tcl_ListObjLength(interp, methodObj, &length);
    containsSpace = (length > 1);

  } else if (methodObj->typePtr == Nsf_OT_tclCmdNameType) {
    containsSpace = NSF_FALSE;
  } else {
    containsSpace = NsfHasTclSpace(methodName);
  }

  if (containsSpace) {
    tailContainsSpace = NsfHasTclSpace(NSTail(methodName));
  } else {
    tailContainsSpace = NSF_FALSE;
  }
  /*fprintf(stderr, "<%s> containsSpace %d tailContainsSpace %d\n", methodName, containsSpace, tailContainsSpace);*/

#if !defined(NDEBUG)
  if (containsSpace) {
    assert(NsfHasTclSpace(methodName));
  } else {
    assert(!tailContainsSpace);
  }
#endif

  if (tailContainsSpace) {
    const char          *firstElementString;
    const Tcl_Namespace *parentNsPtr;
    const NsfObject     *ensembleObject;
    Tcl_Obj             *methodHandleObj, **ov;
    int                  oc, i;

    /*
     * When the methodName is required, we have to provide a methodNameDS as
     * well.
     */
    assert(methodName1 == NULL || methodNameDs != NULL);

    /*fprintf(stderr, "name '%s' contains space \n", methodName);*/

    if (likely(Tcl_ListObjGetElements(interp, methodObj, &oc, &ov) != TCL_OK)
        || ((referencedObject = GetEnsembleObjectFromName(interp, nsPtr, ov[0],
                                                          &cmd, fromClassNS)) == NULL)
        ) {
      if (methodName1 != NULL) {
        *methodName1 = NULL;
      }
      if (regObject != NULL) {
        *regObject = NULL;
      }
      if (defObject != NULL) {
        *defObject = NULL;
      }
      return NULL;
    }

    /*
     * We have an ensemble object. First, figure out, on which
     * object/class the ensemble object was registered. We determine
     * the regObject on the first element of the list. If we can't,
     * then the current object is the regObject.
     */
    firstElementString = ObjStr(ov[0]);
    if (*firstElementString == ':') {
      NsfObject *registrationObject;

      registrationObject = GetRegObject(interp, cmd, firstElementString, methodName1, fromClassNS);
      if (regObject != NULL) {
        *regObject = registrationObject;
      }
    } else {
      if (regObject != NULL) {
        *regObject = NULL;
      }
    }

    /*fprintf(stderr, "... regObject object '%s' reg %p, fromClassNS %d\n",
      ObjectName(referencedObject), (void *)*regObject, *fromClassNS);*/

    /*
     * Build a fresh methodHandleObj to held method name and names of
     * subcmds.
     */
    methodHandleObj = Tcl_DuplicateObj(referencedObject->cmdName);
    INCR_REF_COUNT(methodHandleObj);

    if (methodNameDs != NULL) {
      Tcl_DStringAppend(methodNameDs, Tcl_GetCommandName(interp, cmd), -1);
    }
    parentNsPtr = NULL;

    /*
     * Iterate over the objects and append to the methodNameDs and methodHandleObj
     */
    for (i = 1; i < oc; i++) {
      cmd = Tcl_GetCommandFromObj(interp, methodHandleObj);
      ensembleObject = (cmd != NULL) ? NsfGetObjectFromCmdPtr(cmd) : NULL;

      if (ensembleObject == NULL) {
        DECR_REF_COUNT(methodHandleObj);
        if (methodName1 != NULL) {
          *methodName1 = NULL;
        }
        if (regObject != NULL) {
          *regObject = NULL;
        }
        if (defObject != NULL) {
          *defObject = NULL;
        }
        return NULL;
      }

      if (parentNsPtr != NULL
          && (Tcl_Command_nsPtr(ensembleObject->id) != parentNsPtr)) {
        /* fprintf(stderr, "*** parent change saved parent %p %s computed parent %p %s\n",
                (void *)parentNsPtr, parentNsPtr->fullName,
                Tcl_Command_nsPtr(ensembleObject->id),
                Tcl_Command_nsPtr(ensembleObject->id)->fullName);*/
        DECR_REF_COUNT(methodHandleObj);
        methodHandleObj = Tcl_DuplicateObj(ensembleObject->cmdName);
      }
      parentNsPtr = ensembleObject->nsPtr;

      Tcl_AppendLimitedToObj(methodHandleObj, "::", 2, INT_MAX, NULL);
      Tcl_AppendLimitedToObj(methodHandleObj, ObjStr(ov[i]), -1, INT_MAX, NULL);
      if (methodNameDs != NULL) {
        Tcl_DStringAppendElement(methodNameDs, ObjStr(ov[i]));
      }
    }

    /*
     * cmd contains now the parent-obj, on which the method was
     * defined. Get from this cmd the defObj.
     */
    if (defObject != NULL) {
      *defObject = NsfGetObjectFromCmdPtr(cmd);
    }

    /*fprintf(stderr, "... handle '%s' last cmd %p defObject %p\n",
      ObjStr(methodHandleObj), (void *)cmd, *defObject);*/

    /*
     * Obtain the command from the method handle and report back the
     * final methodName,
     */
    cmd = Tcl_GetCommandFromObj(interp, methodHandleObj);
    if (methodNameDs != NULL && methodName1 != NULL) {
      *methodName1 = Tcl_DStringValue(methodNameDs);
    }

    /*fprintf(stderr, "... methodname1 '%s' cmd %p\n", Tcl_DStringValue(methodNameDs), (void *)cmd);*/
    DECR_REF_COUNT(methodHandleObj);

  } else if (*methodName == ':') {

    cmd = Tcl_GetCommandFromObj(interp, methodObj);
    if (likely(cmd != NULL)) {
      referencedObject = GetRegObject(interp, cmd, methodName, methodName1, fromClassNS);
      if (regObject != NULL) {
        *regObject = referencedObject;
      }
      if (defObject != NULL) {
        *defObject = referencedObject;
      }
      if (methodName1 && *methodName1 == NULL) {
        /*
         * The return value for the method name is required and was not
         * computed by GetRegObject()
         */
        *methodName1 = Tcl_GetCommandName(interp, cmd);
      }
    } else {
      /*
       * The cmd was not registered on an object or class, but we
       * still report back the cmd (might be e.g. a primitive cmd).
       */
      if (regObject != NULL) {
        *regObject = NULL;
      }
      if (defObject != NULL) {
        *defObject = NULL;
      }
    }
  } else {
    if (methodName1 != NULL) {
      *methodName1 = methodName;
    }
    cmd = (nsPtr != NULL) ? FindMethod(nsPtr, methodName) : NULL;
    if (regObject != NULL) {
      *regObject = NULL;
    }
    if (defObject != NULL) {
      *defObject = NULL;
    }
  }

  return cmd;
}

/*
 *----------------------------------------------------------------------
 * CmdIsProc --
 *
 *      Check, whether the cmd is interpreted
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static bool CmdIsProc(const Tcl_Command cmd)
  nonnull(1) NSF_pure;

NSF_INLINE static bool
CmdIsProc(const Tcl_Command cmd) {
  /*
   * In 8.6: TclIsProc((Command *)cmd) is not equivalent to the definition
   * below.
   */
  nonnull_assert(cmd != NULL);
  return (Tcl_Command_objProc(cmd) == TclObjInterpProc);
}

/*
 *----------------------------------------------------------------------
 * CmdIsNsfObject --
 *
 *      Check whether the provided cmd refers to an NsfObject or Class.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static bool CmdIsNsfObject(Tcl_Command cmd)
  nonnull(1) NSF_pure;

NSF_INLINE static bool
CmdIsNsfObject(Tcl_Command cmd) {
  nonnull_assert(cmd != NULL);
  return Tcl_Command_objProc(cmd) == NsfObjDispatch;
}

/*
 *----------------------------------------------------------------------
 * GetTclProcFromCommand --
 *
 *      Check whether cmd refers to a Tcl proc, and if so, return the
 *      proc definition.
 *
 * Results:
 *      The found proc of cmd or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Proc *GetTclProcFromCommand(const Tcl_Command cmd)
  nonnull(1) NSF_pure;

static Proc *
GetTclProcFromCommand(const Tcl_Command cmd) {
  Tcl_ObjCmdProc *proc;
  Proc           *result;

  nonnull_assert(cmd != NULL);
  proc = Tcl_Command_objProc(cmd);
  if (proc == TclObjInterpProc) {
    result = (Proc *)Tcl_Command_objClientData(cmd);
  } else {
    result = NULL;
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * FindMethod --
 *
 *      Lookup the cmd for methodName in a namespace.
 *
 * Results:
 *      The found cmd of the method or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

NSF_INLINE static Tcl_Command
FindMethod(
    const Tcl_Namespace *nsPtr,
    const char *methodName
) {
  register const Tcl_HashEntry *entryPtr;
  Tcl_Command                   result;

  nonnull_assert(nsPtr != NULL);
  nonnull_assert(methodName != NULL);

  if ((entryPtr = Tcl_CreateHashEntry(Tcl_Namespace_cmdTablePtr(nsPtr), methodName, NULL))) {
    result = (Tcl_Command) Tcl_GetHashValue(entryPtr);
  } else {
    result = NULL;
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * FindProcMethod --
 *
 *      Lookup the proc for methodName in a namespace.
 *
 * Results:
 *      The found proc of the method or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Proc * FindProcMethod(const Tcl_Namespace *nsPtr, const char *methodName)
  nonnull(1) nonnull(2);

static Proc *
FindProcMethod(const Tcl_Namespace *nsPtr, const char *methodName) {
  Tcl_Command cmd;

  nonnull_assert(nsPtr != NULL);
  nonnull_assert(methodName != NULL);

  cmd = FindMethod(nsPtr, methodName);
  return (cmd != NULL) ? GetTclProcFromCommand(cmd) : NULL;
}

/*
 *----------------------------------------------------------------------
 * SearchPLMethod, SearchPLMethod0 --
 *
 *      Search a method along a provided class list.  The methodName
 *      must be simple (must not contain space). While SearchPLMethod()
 *      allows one to specify a flag for filtering the command,
 *      SearchPLMethod0() is a lightly optimized function without the
 *      filtering option.
 *
 * Results:
 *      The found class defining the method or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClass * SearchPLMethod(
    register const NsfClasses *pl, const char *methodName,
    Tcl_Command *cmdPtr, unsigned int flags
) nonnull(1) nonnull(2) nonnull(3);

static NsfClass * SearchPLMethod0(
    register const NsfClasses *pl, const char *methodName,
    Tcl_Command *cmdPtr
) nonnull(1) nonnull(2) nonnull(3);

static NsfClass *
SearchPLMethod0(
    register const NsfClasses *pl, const char *methodName, Tcl_Command *cmdPtr
) {
  nonnull_assert(pl != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cmdPtr != NULL);

  /*
   * Search the precedence list (class hierarchy).
   */
  do {
    register const Tcl_HashEntry *entryPtr =
      Tcl_CreateHashEntry(Tcl_Namespace_cmdTablePtr(pl->cl->nsPtr), methodName, NULL);

    if (entryPtr != NULL) {
      *cmdPtr = (Tcl_Command) Tcl_GetHashValue(entryPtr);
      return pl->cl;
    }
    pl = pl->nextPtr;
  } while (pl != NULL);

  return NULL;
}

static NsfClass *
SearchPLMethod(
    register const NsfClasses *pl, const char *methodName,
    Tcl_Command *cmdPtr, unsigned int flags
) {

  nonnull_assert(pl != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cmdPtr != NULL);

  /*
   * Search the precedence list (class hierarchy).
   */
  do {
    register const Tcl_HashEntry *entryPtr =
      Tcl_CreateHashEntry(Tcl_Namespace_cmdTablePtr(pl->cl->nsPtr), methodName, NULL);

    if (entryPtr != NULL) {
      Tcl_Command cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);

      if (likely(((unsigned int)Tcl_Command_flags(cmd) & flags) == 0u)) {
        *cmdPtr = cmd;
        return pl->cl;
      }
    }
    pl = pl->nextPtr;
  } while (pl != NULL);

  return NULL;
}

/*
 *----------------------------------------------------------------------
 * SearchCMethod --
 *
 *      Search a method along the superclass hierarchy of the provided
 *      class. The methodObj must be simple (must not contain
 *      space). The method has the interface for internal calls during
 *      interpretation, while SearchSimpleCMethod() has the interface
 *      with more overhead for introspection.
 *
 * Results:
 *      The found class defining the method or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClass * SearchCMethod(NsfClass *class, const char *methodName, Tcl_Command *cmdPtr)
  nonnull(1) nonnull(2) nonnull(3);

static NsfClass *
SearchCMethod(NsfClass *class, const char *methodName, Tcl_Command *cmdPtr) {

  nonnull_assert(methodName != NULL);
  nonnull_assert(cmdPtr != NULL);
  nonnull_assert(class != NULL);

  return SearchPLMethod0(PrecedenceOrder(class), methodName, cmdPtr);
}

/*
 *----------------------------------------------------------------------
 * SearchSimpleCMethod --
 *
 *      Search a method along the superclass hierarchy of the provided
 *      class. The methodObj must be simple (must not contain
 *      space). The method has the same interface as
 *      SearchComplexCMethod().
 *
 * Results:
 *      The found class defining the method or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClass * SearchSimpleCMethod(Tcl_Interp *UNUSED(interp),
                                      NsfClass *class, Tcl_Obj *methodObj,
                                      Tcl_Command *cmdPtr)
  nonnull(2) nonnull(3) nonnull(4);

static NsfClass *
SearchSimpleCMethod(
    Tcl_Interp *UNUSED(interp), NsfClass *class,
    Tcl_Obj *methodObj, Tcl_Command *cmdPtr
) {

  nonnull_assert(class != NULL);
  nonnull_assert(methodObj != NULL);
  nonnull_assert(cmdPtr != NULL);

  return SearchPLMethod0(PrecedenceOrder(class), ObjStr(methodObj), cmdPtr);
}

/*
 *----------------------------------------------------------------------
 * SearchComplexCMethod --
 *
 *      Search a method along the superclass hierarchy of the provided
 *      class. The methodObj can refer to an ensemble object (can
 *      contain space). The method has the same interface as
 *      SearchSimpleCMethod().
 *
 * Results:
 *      The found class defining the method or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClass * SearchComplexCMethod(Tcl_Interp *interp, NsfClass *class,
                     Tcl_Obj *methodObj, Tcl_Command *cmdPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static NsfClass *
SearchComplexCMethod(Tcl_Interp *interp, NsfClass *class,
                     Tcl_Obj *methodObj, Tcl_Command *cmdPtr) {
  NsfClasses *pl;
  bool        fromClassNS = NSF_TRUE;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(methodObj != NULL);
  nonnull_assert(cmdPtr != NULL);

  for (pl = PrecedenceOrder(class); pl != NULL;  pl = pl->nextPtr) {
    Tcl_Command cmd = ResolveMethodName(interp, pl->cl->nsPtr, methodObj,
                                        NULL, NULL, NULL, NULL, &fromClassNS);
    if (cmd != NULL) {
      *cmdPtr = cmd;
      return pl->cl;
    }
  }

  return NULL;
}

/*
 *----------------------------------------------------------------------
 * ObjectFindMethod --
 *
 *      Find a method for a given object in the precedence path. The
 *      provided methodObj might be an ensemble object. This function
 *      tries to optimize access by calling different implementations
 *      for simple and ensemble method names.
 *
 * Results:
 *      Tcl command.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Command ObjectFindMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *methodObj, NsfClass **classPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static Tcl_Command
ObjectFindMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *methodObj, NsfClass **classPtr) {
  Tcl_Command cmd = NULL;
  NsfClass *(*lookupFunction)(Tcl_Interp *interp, NsfClass *class,
                              Tcl_Obj *methodObj, Tcl_Command *cmdPtr);

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodObj != NULL);
  nonnull_assert(classPtr != NULL);

  if (NsfHasTclSpace(ObjStr(methodObj))) {
    lookupFunction = SearchComplexCMethod;
  } else {
    lookupFunction = SearchSimpleCMethod;
  }

  if (unlikely(object->flags & NSF_MIXIN_ORDER_VALID) == 0u) {
    MixinComputeDefined(interp, object);
  }

  if ((object->flags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) != 0u) {
    NsfCmdList *mixinList;

    for (mixinList = object->mixinOrder; mixinList; mixinList = mixinList->nextPtr) {
      NsfClass *mixin = NsfGetClassFromCmdPtr(mixinList->cmdPtr);

      if ((mixin != NULL)
          && (*classPtr = (*lookupFunction)(interp, mixin, methodObj, &cmd))) {
        if (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_CLASS_ONLY_METHOD) != 0u
            && !NsfObjectIsClass(object)
           ) {
          cmd = NULL;
          continue;
        }
        break;
      }
    }
  }

  if ((cmd == NULL) && (object->nsPtr != NULL)) {
    bool fromClassNS = NSF_FALSE;

    cmd = ResolveMethodName(interp, object->nsPtr, methodObj,
                            NULL, NULL, NULL, NULL, &fromClassNS);
  }

  if (cmd == NULL && object->cl != NULL) {
    *classPtr = (*lookupFunction)(interp, object->cl, methodObj, &cmd);
  }

  return cmd;
}

/*
 *----------------------------------------------------------------------
 * GetObjectSystem --
 *
 *      Return the object system for which the object was defined
 *
 * Results:
 *      Object system pointer
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfObjectSystem * GetObjectSystem(const NsfObject *object)
  nonnull(1) NSF_pure;

static NsfObjectSystem *
GetObjectSystem(const NsfObject *object) {

  nonnull_assert(object != NULL);

  if (NsfObjectIsClass(object)) {
    return ((NsfClass *)object)->osPtr;
  }
  assert(object->cl != NULL);
  return object->cl->osPtr;
}

/*
 *----------------------------------------------------------------------
 * ObjectSystemFree --
 *
 *      Free a single object system structure including its root-classes.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free memory of structure, free the root-classes.
 *
 *----------------------------------------------------------------------
 */

static void ObjectSystemFree(Tcl_Interp *interp, NsfObjectSystem *osPtr)
  nonnull(1) nonnull(2);

static void
ObjectSystemFree(Tcl_Interp *interp, NsfObjectSystem *osPtr) {
  int idx;

  nonnull_assert(interp != NULL);
  nonnull_assert(osPtr != NULL);

  for (idx = 0; idx <= NSF_s_set_idx; idx++) {
    if (osPtr->methods[idx]) {
      DECR_REF_COUNT(osPtr->methods[idx]);
      osPtr->methodNames[idx] = NULL;
    }
    if (osPtr->handles[idx]) {
      DECR_REF_COUNT(osPtr->handles[idx]);
    }
  }

  if (osPtr->rootMetaClass != NULL && osPtr->rootClass != NULL) {
    RemoveSuper(osPtr->rootMetaClass, osPtr->rootClass);
    RemoveInstance((NsfObject *)osPtr->rootMetaClass, osPtr->rootMetaClass);
    RemoveInstance((NsfObject *)osPtr->rootClass, osPtr->rootMetaClass);

    FinalObjectDeletion(interp, &osPtr->rootClass->object);
    FinalObjectDeletion(interp, &osPtr->rootMetaClass->object);
  }

  FREE(NsfObjectSystem, osPtr);
}

/*
 *----------------------------------------------------------------------
 * ObjectSystemAdd --
 *
 *      Add and entry to the list of object systems of the interpreter.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Updating the per interp list of object systems.
 *
 *----------------------------------------------------------------------
 */
static void ObjectSystemAdd(Tcl_Interp *interp, NsfObjectSystem *osPtr)
  nonnull(1) nonnull(2);

static void
ObjectSystemAdd(Tcl_Interp *interp, NsfObjectSystem *osPtr) {

  nonnull_assert(interp != NULL);
  nonnull_assert(osPtr != NULL);

  osPtr->nextPtr = RUNTIME_STATE(interp)->objectSystems;
  RUNTIME_STATE(interp)->objectSystems = osPtr;
}



/*
 *----------------------------------------------------------------------
 * ObjectSystemsCleanup --
 *
 *      Delete all objects from all defined object systems.  This method
 *      is to be called when a Next Scripting process or thread exists.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      All commands and objects are deleted, memory is freed.
 *
 *----------------------------------------------------------------------
 */
static int ObjectSystemsCleanup(Tcl_Interp *interp, bool withKeepvars)
  nonnull(1);

static int
ObjectSystemsCleanup(Tcl_Interp *interp, bool withKeepvars) {
  NsfCmdList      *instances = NULL, *entryPtr;
  NsfObjectSystem *osPtr;

  nonnull_assert(interp != NULL);

  /*
   * Deletion is performed in two rounds:
   *  (a) SOFT DESTROY: invoke all user-defined destroy methods
   *      without destroying objects
   *  (b) PHYSICAL DESTROY: delete the objects and classes,
   *      destroy methods are not invoked anymore
   *
   * This is to prevent that the destroy order causes classes to be
   * deleted before the methods invoked by destroy are executed.  Note
   * that it is necessary to iterate over all object systems
   * simultaneous, since the might be dependencies between objects of
   * different object systems.
   */

  /*
   * Collect all instances from all object systems
   */

  for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr != NULL; osPtr = osPtr->nextPtr) {
    GetAllInstances(interp, &instances, osPtr->rootClass);
  }

  /***** SOFT DESTROY *****/
  RUNTIME_STATE(interp)->exitHandlerDestroyRound = NSF_EXITHANDLER_ON_SOFT_DESTROY;

  /*fprintf(stderr, "===CALL destroy on OBJECTS\n");*/

  for (entryPtr = instances; entryPtr != NULL; entryPtr = entryPtr->nextPtr) {
    NsfObject *object = (NsfObject *)entryPtr->clorobj;

    /*fprintf(stderr, "key = %s %p %d flags %.6x\n",
      ObjectName(object), (void *)object, object && !NsfObjectIsClass(object), object->flags);*/

    if (object != NULL
        && !NsfObjectIsClass(object)
        && ((object->flags & NSF_DESTROY_CALLED) == 0u)
       ) {
      DispatchDestroyMethod(interp, object, 0u);
    }
  }

  /*fprintf(stderr, "===CALL destroy on CLASSES\n");*/

  for (entryPtr = instances; entryPtr != NULL; entryPtr = entryPtr->nextPtr) {
    const NsfClass *class = entryPtr->clorobj;

    if (class != NULL
        && ((class->object.flags & NSF_DESTROY_CALLED) == 0u)
       ) {
      DispatchDestroyMethod(interp, (NsfObject *)class, 0u);
    }
  }

  /*
   * Now turn off filters, all destroy callbacks are done.
   */
  RUNTIME_STATE(interp)->doFilters = 0;
  (void)Tcl_RemoveInterpResolvers(interp, "nsf");

#ifdef DO_CLEANUP
  FreeAllNsfObjectsAndClasses(interp, &instances);
# ifdef DO_FULL_CLEANUP
  DeleteProcsAndVars(interp, Tcl_GetGlobalNamespace(interp), withKeepvars);
# endif
#endif
  (void)withKeepvars; /* make sure, the variable is not reported as unused */

#ifdef DO_CLEANUP
  {
    NsfObjectSystem *nPtr;
    /*
     * Free all objects systems with their root-classes.
     */
    for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr != NULL; osPtr = nPtr) {
      nPtr = osPtr->nextPtr;
      ObjectSystemFree(interp, osPtr);
    }
  }

  /*
   * Finally, free all nsfprocs.
   */
  DeleteNsfProcs(interp, NULL);
#endif

  CmdListFree(&instances, NULL);

  return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 * CallDirectly --
 *
 *      Determine when it is possible/necessary to call a method
 *      implementation directly or via method dispatch.
 *
 * Results:
 *      NSF_TRUE is returned when command should be invoked directly,
 *      NSF_FALSE otherwise.
 *
 * Side effects:
 *      methodObjPtr is set with the Tcl_Obj of the name of the method,
 *      if there is one defined.
 *
 *----------------------------------------------------------------------
 */
static bool CallDirectly(Tcl_Interp *interp, NsfObject *object, int methodIdx, Tcl_Obj **methodObjPtr)
  nonnull(1) nonnull(2) nonnull(4);

static bool
CallDirectly(Tcl_Interp *interp, NsfObject *object, int methodIdx, Tcl_Obj **methodObjPtr) {
  /*
   * We can/must call a C-implemented method directly, when
   *
   *   a) the object system has no such appropriate method defined
   *
   *   b) the script does not contain a method with the appropriate
   *     name, and
   *
   *   c) filters are not active on the object
   */
  NsfObjectSystem *osPtr = GetObjectSystem(object);
  bool             callDirectly = NSF_TRUE;
  Tcl_Obj         *methodObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodObjPtr != NULL);

  methodObj = osPtr->methods[methodIdx];
  /*fprintf(stderr, "OS of %s is %s, method %s methodObj %p osPtr %p defined %.8x %.8x overloaded %.8x %.8x flags %.8x\n",
          ObjectName(object), ObjectName(&osPtr->rootClass->object),
          Nsf_SystemMethodOpts[methodIdx]+1, (void *)methodObj,
          (void *)osPtr,
          osPtr->definedMethods, osPtr->definedMethods & (1 << methodIdx),
          osPtr->overloadedMethods, osPtr->overloadedMethods & (1 << methodIdx),
          1 << methodIdx );*/

  if (methodObj != NULL) {
    unsigned int flag = 1u << methodIdx;

    if ((osPtr->overloadedMethods & flag) != 0u) {
      /*
       * The method is overloaded, we must dispatch.
       */
      /*fprintf(stderr, "overloaded\n");*/
      callDirectly = NSF_FALSE;
    } else if ((osPtr->definedMethods & flag) == 0u) {
      /*
       * The method is not defined, we must call directly.
       */
      /*fprintf(stderr, "Warning: CallDirectly object %s idx %s not defined\n",
        ObjectName(object), Nsf_SystemMethodOpts[methodIdx]+1);*/
    } else {
#if defined(DISPATCH_ALWAYS_DEFINED_METHODS)
      callDirectly = NSF_FALSE;
#else
      if ((object->flags & NSF_FILTER_ORDER_VALID) == 0u) {
        FilterComputeDefined(interp, object);
      }
      /*fprintf(stderr, "CallDirectly object %s idx %s object flags %.6x %.6x \n",
              ObjectName(object), Nsf_SystemMethodOpts[methodIdx]+1,
              (object->flags & NSF_FILTER_ORDER_DEFINED_AND_VALID),
              NSF_FILTER_ORDER_DEFINED_AND_VALID);*/
      if ((object->flags & NSF_FILTER_ORDER_DEFINED_AND_VALID) == NSF_FILTER_ORDER_DEFINED_AND_VALID) {
        /*fprintf(stderr, "CallDirectly object %s idx %s has filter \n",
          ObjectName(object), Nsf_SystemMethodOpts[methodIdx]+1);*/
        callDirectly = NSF_FALSE;
      }
#endif
    }
  }

  /*fprintf(stderr, "CallDirectly object %s idx %d returns %s => %d\n",
          ObjectName(object), methodIdx, (methodObj != NULL) ? ObjStr(methodObj) : "(null)", callDirectly);*/

  /*
   * Teturn the methodObj in every case.
   */
  *methodObjPtr = methodObj;
  return callDirectly;
}

/*
 *----------------------------------------------------------------------
 * NsfMethodObj --
 *
 *      Return the methodObj for a given method index.
 *
 * Results:
 *      Returns Tcl_Obj* or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
Tcl_Obj *
NsfMethodObj(const NsfObject *object, int methodIdx) {
  NsfObjectSystem *osPtr = GetObjectSystem(object);

  nonnull_assert(object != NULL);
  /*
  fprintf(stderr, "NsfMethodObj object %s os %p idx %d %s methodObj %p\n",
          ObjectName(object), (void *)osPtr, methodIdx,
          Nsf_SystemMethodOpts[methodIdx]+1,
          osPtr->methods[methodIdx]);
  */
  return osPtr->methods[methodIdx];
}


/*
 * Conditional memory allocations of optional storage
 */

/*
 *----------------------------------------------------------------------
 * NsfRequireObjectOpt --
 *
 *      Makes sure that the provided object has the optional data member
 *      set.
 *
 * Results:
 *      Optional data for the object.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfObjectOpt *
NsfRequireObjectOpt(NsfObject *object) {

  nonnull_assert(object != NULL);

  if (object->opt == NULL) {
    object->opt = NEW(NsfObjectOpt);
    memset(object->opt, 0, sizeof(NsfObjectOpt));
  }
  return object->opt;
}

/*
 *----------------------------------------------------------------------
 * NsfRequireClassOpt --
 *
 *      Makes sure that the provided class has the optional data member
 *      set.
 *
 * Results:
 *      Optional data for the class.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NsfClassOpt *
NsfRequireClassOpt(NsfClass *class) {

  nonnull_assert(class != NULL);

  if (class->opt == NULL) {
    class->opt = NEW(NsfClassOpt);
    memset(class->opt, 0, sizeof(NsfClassOpt));
    if ((class->object.flags & NSF_IS_CLASS) != 0u) {
      class->opt->id = class->object.id;  /* probably a temporary solution */
    }
  }
  return class->opt;
}

/*
 *----------------------------------------------------------------------
 * MakeObjNamespace --
 *
 *      Creates for the object a namespace, if it does not exist.
 *      already.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Might create a namespace.
 *
 *----------------------------------------------------------------------
 */
static void MakeObjNamespace(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

static void
MakeObjNamespace(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

#ifdef NAMESPACE_TRACE
  fprintf(stderr, "+++ MakeObjNamespace for %s\n", ObjectName(object));
#endif
  if (object->nsPtr == NULL) {
    Tcl_Namespace *nsPtr;

    nsPtr = object->nsPtr = NSGetFreshNamespace(interp, object,
                                                ObjStr(object->cmdName));
    assert(nsPtr != NULL);

    /*
     * Copy all obj variables to the newly created namespace
     */
    if (object->varTablePtr != NULL) {
      Tcl_HashSearch  search;
      Tcl_HashEntry   *hPtr;
      TclVarHashTable *varTablePtr = Tcl_Namespace_varTablePtr(nsPtr);
      Tcl_HashTable   *varHashTablePtr = TclVarHashTablePtr(varTablePtr);
      Tcl_HashTable   *objHashTablePtr = TclVarHashTablePtr(object->varTablePtr);

      *varHashTablePtr = *objHashTablePtr; /* copy the table */

      if (objHashTablePtr->buckets == objHashTablePtr->staticBuckets) {
        varHashTablePtr->buckets = varHashTablePtr->staticBuckets;
      }
      for (hPtr = Tcl_FirstHashEntry(varHashTablePtr, &search);
           hPtr != NULL;
           hPtr = Tcl_NextHashEntry(&search)) {
        hPtr->tablePtr = varHashTablePtr;
      }
      CallStackReplaceVarTableReferences(interp, object->varTablePtr,
                                         (TclVarHashTable *)varHashTablePtr);

      ckfree((char *) object->varTablePtr);
      object->varTablePtr = NULL;
    }
  }
}

/*
 *----------------------------------------------------------------------
 * CompiledLocalsLookup --
 *
 *      Lookup variable from the compiled locals. The function performs
 *      a linear search in an unsorted list maintained by Tcl. This
 *      function is just used for the rather deprecated "instvar"
 *      method.
 *
 * Results:
 *      Returns Tcl_Var (or NULL, when lookup is not successful).
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Var CompiledLocalsLookup(CallFrame *varFramePtr, const char *varName)
  nonnull(1) nonnull(2);

static Tcl_Var
CompiledLocalsLookup(CallFrame *varFramePtr, const char *varName) {
  int localCt;

  nonnull_assert(varFramePtr != NULL);
  nonnull_assert(varName != NULL);

  localCt = varFramePtr->numCompiledLocals;
  if (localCt > 0) {
    Tcl_Obj  **varNameObjPtr;
    int        i, nameLength;

    varNameObjPtr = &varFramePtr->localCachePtr->varName0;
    nameLength = (int)strlen(varName);

    /* fprintf(stderr, "=== compiled local search #local vars %d for <%s> flags %.8x\n",
       localCt, varName, varFramePtr->isProcCallFrame);
    */

    for (i = 0 ; i < localCt ; i++, varNameObjPtr++) {
      Tcl_Obj *varNameObj = *varNameObjPtr;
      int      len;

      if (likely(varNameObj != NULL)) {
        const char *localName = TclGetStringFromObj(varNameObj, &len);

        /* fprintf(stderr, ".. [%d] varNameObj %p %p <%s>\n",
           i, (void *)varNameObj, (void *)varNameObj->typePtr, localName);
        */

        if (unlikely(varName[0] == localName[0]
                     && varName[1] == localName[1]
                     && len == nameLength
                     && memcmp(varName, localName, (size_t)len) == 0)) {
          return (Tcl_Var) &varFramePtr->compiledLocals[i];
        }
      }
    }
  }
  return NULL;
}


/*
 *----------------------------------------------------------------------
 * CompiledColonLocalsLookupBuildCache --
 *
 *      Helper function for CompiledColonLocalsLookup(): build up a
 *      sorted cache consisting only of colon prefixed variables, such
 *      that e.g.  non-successful lookup can be performed in O(n/2).  In
 *      comparison to CompiledLocalsLookup() this function is about a
 *      factor of 4 faster.
 *
 * Results:
 *      Returns Tcl_Var (or NULL, when lookup is not successful).
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Var CompiledColonLocalsLookupBuildCache(CallFrame     *varFramePtr,
                                                   const char    *varName,
                                                   int             nameLength,
                                                   Tcl_Obj       **localNames,
                                                   NsfProcContext *ctxPtr)
  nonnull(1) nonnull(2) nonnull(4) nonnull(5);

static Tcl_Var
CompiledColonLocalsLookupBuildCache(CallFrame *varFramePtr, const char *varName,
                                    int nameLength, Tcl_Obj **localNames,
                                    NsfProcContext *ctxPtr) {
  int       nrColonVars = 0, localCt, i, j;
  Tcl_Var   result;
  Tcl_Obj **varNameObjPtr;

  nonnull_assert(varFramePtr != NULL);
  nonnull_assert(varName != NULL);
  nonnull_assert(localNames != NULL);
  nonnull_assert(ctxPtr != NULL);

  assert(ctxPtr->colonLocalVarCache == NULL);
  assert(varFramePtr->localCachePtr != NULL);

  localCt = varFramePtr->numCompiledLocals;
  varNameObjPtr = &varFramePtr->localCachePtr->varName0;

  /*
   * Count colonVars
   */
  for (i = 0; i < localCt; i++, varNameObjPtr++) {
    Tcl_Obj *varNameObj = *varNameObjPtr;

    if (varNameObj != NULL) {
      const char *localName = TclGetString(varNameObj);

      if (localName[0] == ':') {
        nrColonVars ++;
      }
    }
  }

  /*fprintf(stderr, ".. build cache #local vars %d for <%s> flags %.8x ctxPtr %p colonvars %d\n",
          localCt, varName, varFramePtr->isProcCallFrame,
          (void *)ctxPtr, nrColonVars
          );*/

  /*
   * Allocate colonLocalVarCache in the proper size (keep space for a
   * terminating element).
   */
  ctxPtr->colonLocalVarCache = NEW_ARRAY(int, nrColonVars+1);
  varNameObjPtr = &varFramePtr->localCachePtr->varName0;

  /*
   * Fill colonLocalVarCache; since we have to go through the whole list, we
   * might find and return the variable.
   */
  j = 0;
  result = NULL;

  for (i = 0; i < localCt ; i++, varNameObjPtr++) {
    Tcl_Obj *varNameObj = *varNameObjPtr;

    if (varNameObj != NULL) {
      int         len;
      const char *localName = TclGetStringFromObj(varNameObj, &len);

      if (localName[0] == ':') {
        int     k;
        Tcl_Var var = (Tcl_Var) &varFramePtr->compiledLocals[i];

        if (varName[1] == localName[1]
            && len == nameLength
            && memcmp(varName, localName, (size_t)len) == 0) {
          result = var;
        }

        /* fprintf(stderr, ".. insert %s (%d) on pos %d; check j %d entries \n", localName, i, j, j); */
        for (k = 0; k < j; k++) {
          int         idx, cmp;
          const char *cachedName;

          idx = ctxPtr->colonLocalVarCache[k];
          cachedName = TclGetStringFromObj(localNames[idx], &len);
          cmp = strcmp(localName, cachedName);

          /* fprintf(stderr, "... [%d] cmp newVarName <%s> (%d) with cachendName <%s> (%d) => %d\n",
                k, localName, i, cachedName, idx, cmp);
          */
          if (cmp < 0) {
            int ii;

            /*
             * Make space on position k for inserting the new element. We
             * might uses memmove() instead.
             */
            for (ii = j; ii > k; ii--) {
              ctxPtr->colonLocalVarCache[ii] = ctxPtr->colonLocalVarCache[ii - 1];
            }
            break;
          }
        }
        ctxPtr->colonLocalVarCache[k] = i;

        j++;
        if (j == nrColonVars) {
          break;
        }
      }
    }
  }
  /*
   * Terminate list of indices with -1
   */
  ctxPtr->colonLocalVarCache[j] = -1;

  /* fprintf(stderr, ".. search #local vars %d varName <%s> colonvars %d found %p\n",
     localCt, varName, nrColonVars, (void*)result);
  */

  return result;
}

/*
 *----------------------------------------------------------------------
 * CompiledColonLocalsLookup --
 *
 *      Lookup single colon prefixed variables from the compiled
 *      locals. This function uses a cache consisting of colon prefixed
 *      variables to speed up variable access.
 *
 * Results:
 *      Returns Tcl_Var (or NULL, when lookup is not successful)
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Var CompiledColonLocalsLookup(CallFrame *varFramePtr, const char *varName)
  nonnull(1) nonnull(2);

static Tcl_Var
CompiledColonLocalsLookup(CallFrame *varFramePtr, const char *varName) {
  Tcl_Var result;

  nonnull_assert(varFramePtr != NULL);
  nonnull_assert(varName != NULL);

  if (varFramePtr->numCompiledLocals == 0) {
    result = NULL;
  } else {
    Tcl_Obj       **localNames;
    int             nameLength;
    Tcl_Command     cmd;
    NsfProcContext *ctxPtr;

    /*
     * Get the string table of the compiled locals and the length of the
     * variable to search for faster access into local variables.
     */
    localNames = &varFramePtr->localCachePtr->varName0;
    nameLength = (int)strlen(varName);

    cmd = (Tcl_Command )varFramePtr->procPtr->cmdPtr;
    ctxPtr = ProcContextRequire(cmd);

    /*
     * Check whether we have already a sorted cache (colonLocalVarCache). If not,
     * build the cache and check in the same step for the wanted variable.
     */
    if (unlikely(ctxPtr->colonLocalVarCache == NULL)) {
      result = CompiledColonLocalsLookupBuildCache(varFramePtr, varName, nameLength, localNames, ctxPtr);

    } else {
      int i, j;

      /*
       * We have a colonLocalVarCache.
       *
       * Search the colonVarCache, which is alphabetically sorted to allow e.g.
       * termination after O(n/2) on failures.
       */
      result = NULL;
      for (i = 0, j = ctxPtr->colonLocalVarCache[0]; j > -1; ++i, j = ctxPtr->colonLocalVarCache[i]) {
        int         len;
        const char *localName;

        localName = TclGetStringFromObj(localNames[j], &len);

        /* fprintf(stderr, ".. [%d] varNameObj %p <%s> vs <%s>\n",
           j, (void *)varNameObj, localName, varName); */

        /*
         * The first char of colon varName is always a colon, so we do not need to
         * compare.
         */
        if (varName[1] < localName[1]) {
          break;

        } else if (varName[1] == localName[1]) {
          int cmp;
          /*
           * Even when the first character is identical, we call compare() only
           * when the lengths are equal.
           */
          if (len != nameLength) {
            continue;
          }

          cmp = strcmp(varName, localName);
          if (cmp == 0) {
            result = (Tcl_Var) &varFramePtr->compiledLocals[j];
            break;

          } else if (cmp < 0) {
            /*
             * We are past the place, where the variable should be, so give up.
             */
            break;
          }
        }
      }

#if 0
      if (result != NULL) {
        fprintf(stderr, "... <%s> found -> [%d] %p\n", varName, j, (void *)result);
      }
#endif
    }
  }
  return result;
}


/*
 *----------------------------------------------------------------------
 * GetVarAndNameFromHash --
 *
 *      Convenience function to obtain variable and name from
 *      a variable hash entry.
 *
 * Results:
 *      Results are passed back in argument 2 and 3
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void GetVarAndNameFromHash(const Tcl_HashEntry *hPtr, Var **val, Tcl_Obj **varNameObj)
  nonnull(1) nonnull(2) nonnull(3);

static void
GetVarAndNameFromHash(const Tcl_HashEntry *hPtr, Var **val, Tcl_Obj **varNameObj) {

  nonnull_assert(hPtr != NULL);
  nonnull_assert(val != NULL);
  nonnull_assert(varNameObj != NULL);

  *val = TclVarHashGetValue(hPtr);
  *varNameObj = TclVarHashGetKey(*val);
}


/*********************************************************
 *
 * Variable resolvers
 *
 *********************************************************/
#define FOR_COLON_RESOLVER(ptr) (*(ptr) == ':' && *((ptr)+1) != ':')

/*
 *----------------------------------------------------------------------
 * MethodName --
 *
 *      Return the methodName from a Tcl_Obj, strips potentially the
 *      colon prefix
 *
 * Results:
 *      method name
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static const char *
MethodName(Tcl_Obj *methodObj) {
  const char *methodName;

  nonnull_assert(methodObj != NULL);

  methodName = ObjStr(methodObj);
  if (FOR_COLON_RESOLVER(methodName)) {
    methodName ++;
  }
  return methodName;
}

/*
 *----------------------------------------------------------------------
 * NsfMethodNamePath --
 *
 *      Compute the full method name for error messages containing the
 *      ensemble root.
 *
 * Results:
 *      Tcl_Obj of reference count 0, caller has to take care for
 *      refcounting.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
NsfMethodNamePath(Tcl_Interp *interp,
                  Tcl_CallFrame *framePtr,
                  const char *methodName) {

  Tcl_Obj *resultObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodName != NULL);

  if (framePtr != NULL) {
    resultObj = CallStackMethodPath(interp, framePtr);
  } else {
    resultObj = Tcl_NewListObj(0, NULL);
  }

  Tcl_ListObjAppendElement(interp, resultObj,
                           Tcl_NewStringObj(methodName, -1));
  return resultObj;
}


/*
 *----------------------------------------------------------------------
 * NsColonVarResolver --
 *
 *      Namespace resolver for namespace specific variable lookup.
 *      colon prefix
 *
 * Results:
 *      method name
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int NsColonVarResolver(Tcl_Interp *interp, const char *varName, Tcl_Namespace *UNUSED(nsPtr),
                              int flags, Tcl_Var *varPtr)
  nonnull(1) nonnull(2) nonnull(5);

static int
NsColonVarResolver(Tcl_Interp *interp, const char *varName, Tcl_Namespace *UNUSED(nsPtr),
                   int flags, Tcl_Var *varPtr) {
  Tcl_CallFrame *varFramePtr;
  TclVarHashTable *varTablePtr;
  NsfObject *object;
  int new;
  unsigned int frameFlags;
  Tcl_Obj *key;

  nonnull_assert(interp != NULL);
  nonnull_assert(varName != NULL);
  nonnull_assert(varPtr != NULL);

#if defined(VAR_RESOLVER_TRACE)
  fprintf(stderr, "NsColonVarResolver '%s' flags %.6x\n", varName, flags);
#endif

  /*
   * Case 1: The variable is to be resolved in global scope, proceed in
   * resolver chain
   */
  if (unlikely((flags & TCL_GLOBAL_ONLY) != 0u)) {
    /*fprintf(stderr, "global-scoped lookup for var '%s' in NS '%s'\n", varName,
      nsPtr->fullName);*/
    return TCL_CONTINUE;
  }

  /*
   * Case 2: The lookup happens in a proc frame (lookup in compiled
   * locals and hash-table vars).  We are not interested to handle
   * these cases here, so proceed in resolver chain.
   */
  varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp);
  assert(varFramePtr != NULL);

  frameFlags = (unsigned int)Tcl_CallFrame_isProcCallFrame(varFramePtr);
#if defined(VAR_RESOLVER_TRACE)
  fprintf(stderr, "NsColonVarResolver '%s' frame flags %.6x\n", varName,
          Tcl_CallFrame_isProcCallFrame(varFramePtr));
#endif

  if ((frameFlags & FRAME_IS_PROC) != 0u) {
#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, "...... forwarding to next resolver\n");
#endif
    /*fprintf(stderr, "proc-scoped var '%s' assumed, frame %p flags %.6x\n",
      name, (void *)varFramePtr, Tcl_CallFrame_isProcCallFrame(varFramePtr));*/
    return TCL_CONTINUE;
  }

  /*
   * FRAME_IS_NSF_CMETHOD has always FRAME_IS_PROC set, so it is
   * handled already above
   */
  assert((frameFlags & FRAME_IS_NSF_CMETHOD) == 0u);

  if ((frameFlags & FRAME_IS_NSF_OBJECT) == 0u) {
    /*
     * Case 3: we are not in a Next Scripting frame, so proceed as well
     */
    return TCL_CONTINUE;

  } else {
    /*
     *  Case 4: we are in a Next Scripting object frame
     */

    if (*varName == ':') {
      if (*(varName+1) != ':') {
        /*
         * Case 4a: The variable name starts with a single ":". Skip
         * the char, but stay in the resolver.
         */
        varName ++;
      } else {
        /*
         * Case 4b: Names starting  with "::" are not for us
         */
        return TCL_CONTINUE;
      }
    } else if (NSTail(varName) != varName) {
      /*
       * Case 4c: Names containing "::" are not for us
       */
      return TCL_CONTINUE;
    }

    /*
     * Since we know that we are here always in an object frame, we
     * can blindly get the object from the client data .
     */
    object = (NsfObject *)Tcl_CallFrame_clientData(varFramePtr);
  }

  /*
   * We have an object and create the variable if not found
   */
  assert(object != NULL);

  varTablePtr = (object->nsPtr != NULL) ? Tcl_Namespace_varTablePtr(object->nsPtr) : object->varTablePtr;
  assert(varTablePtr != NULL);

  /*
   * Does the variable exist in the object's namespace?
   */
  key = Tcl_NewStringObj(varName, -1);
  INCR_REF_COUNT(key);

  *varPtr = (Tcl_Var)VarHashCreateVar(varTablePtr, key, NULL);

#if defined(VAR_RESOLVER_TRACE)
  fprintf(stderr, "...... lookup of '%s' for object '%s' returns %p\n",
          varName, ObjectName(object), (void *)*varPtr);
#endif
  if (*varPtr == NULL) {
    /*
     * We failed to find the variable so far, therefore, we create it
     * in this var table.  Note that in several cases above,
     * TCL_CONTINUE takes care for variable creation.
     */

    const Var *newVar = VarHashCreateVar(varTablePtr, key, &new);
    *varPtr = (Tcl_Var)newVar;
  }
  DECR_REF_COUNT(key);

  return likely(*varPtr != NULL) ? TCL_OK : TCL_ERROR;
}

/*********************************************************
 *
 * Begin of compiled var resolver
 *
 *********************************************************/

typedef struct NsfResolvedVarInfo {
  Tcl_ResolvedVarInfo vInfo;        /* This must be the first element. */
  NsfObject          *lastObject;
  Tcl_Var             var;
  Tcl_Obj            *nameObj;
} NsfResolvedVarInfo;

/*
 *----------------------------------------------------------------------
 * HashVarFree --
 *
 *      Free hashed variables based on refCount.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Changed refCount or freed variable.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static void
HashVarFree(Tcl_Var var) {
  if (unlikely(VarHashRefCount(var) < 2)) {
    /*fprintf(stderr, "#### free %p\n", (void *)var);*/
    ckfree((char *) var);
  } else {
    VarHashRefCount(var)--;
  }
}

/*
 *----------------------------------------------------------------------
 * CompiledColonVarFetch --
 *
 *      This function is the actual variable resolution handler for a
 *      colon-prefixed (":/varName/") found in a compiled script
 *      registered by the compiling var resolver (see
 *      InterpCompiledColonVarResolver()). When initializing a call
 *      frame, this handler is called, crawls the object's var table
 *      (creating a variable, if needed), and returns a Var
 *      structure. Based on this, a link variable ":/varName/" pointing
 *      to this object variable (i.e., "varName") is created and is
 *      stored in the compiled locals array of the call frame. Beware
 *      that these link variables interact with the family of
 *      link-creating commands ([variable], [global], [upvar]) by being
 *      subject to "retargeting" upon name conflicts (see
 *      tests/varresolutiontest.tcl for some examples).
 *
 * Results:
 *      Tcl_Var containing value or NULL.
 *
 * Side effects:
 *      Updates of Variable structure cache in necessary.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Var CompiledColonVarFetch(Tcl_Interp *interp, Tcl_ResolvedVarInfo *vinfoPtr)
  nonnull(1) nonnull(2);

static Tcl_Var
CompiledColonVarFetch(Tcl_Interp *interp, Tcl_ResolvedVarInfo *vinfoPtr) {
  NsfResolvedVarInfo  *resVarInfo;
  NsfCallStackContent *cscPtr;
  NsfObject           *object;
  Tcl_Var              var;

  nonnull_assert(interp != NULL);
  nonnull_assert(vinfoPtr != NULL);

  resVarInfo = (NsfResolvedVarInfo *)vinfoPtr;
  var = resVarInfo->var;

#if defined(VAR_RESOLVER_TRACE)
  {
    unsigned int flags = (var != NULL) ? (unsigned int)((Var *)var)->flags : 0u;
    fprintf(stderr, "CompiledColonVarFetch var '%s' var %p flags = %.4x dead? %.4x\n",
            ObjStr(resVarInfo->nameObj), (void *)var, flags, flags & VAR_DEAD_HASH);
  }
#endif

  cscPtr = CallStackGetTopFrame0(interp);
  if (likely(cscPtr != NULL)) {
    object = cscPtr->self;
  } else {
    object = NULL;
  }

  /*
   * We cache lookups based on nsf objects; we have to care about
   * cases, where the instance variables are in some delete states.
   *
   */

  if ((var != NULL)
      && ((object == resVarInfo->lastObject))
      && (((((Var *)var)->flags) & VAR_DEAD_HASH) == 0u)) {
    /*
     * The variable is valid.
     */
#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, ".... cached var '%s' var %p flags = %.4x\n",
            ObjStr(resVarInfo->nameObj), (void *)var, ((Var *)var)->flags);
#endif
    /*
     * return var;
     */

  } else if (unlikely(object == NULL)) {
    var = NULL;

  } else {
    TclVarHashTable  *varTablePtr;
    int               new;

    if (var != NULL) {
      /*
       * The variable is not valid anymore. Clean it up.
       */
      HashVarFree(var);
    }

    if (object->nsPtr != NULL) {
      varTablePtr = Tcl_Namespace_varTablePtr(object->nsPtr);
    } else if (object->varTablePtr != NULL) {
      varTablePtr = object->varTablePtr;
    } else {
      /*
       * In most situations, we have a varTablePtr through the clauses
       * above. However, if someone redefines e.g. the method "configure" or
       * "objectparameter", we might find an object with a still empty
       * varTable, since these are lazy initiated.
       */
      varTablePtr = object->varTablePtr = VarHashTableCreate();
    }
    assert(varTablePtr != NULL);

    resVarInfo->lastObject = object;
#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, "Fetch var %s in object %s\n", TclGetString(resVarInfo->nameObj), ObjectName(object));
#endif
    resVarInfo->var = var = (Tcl_Var) VarHashCreateVar(varTablePtr, resVarInfo->nameObj, &new);
    /*
     * Increment the reference counter to avoid ckfree() of the variable
     * in Tcl's FreeVarEntry(); for cleanup, we provide our own
     * HashVarFree();
     */
    VarHashRefCount(var)++;
#if defined(VAR_RESOLVER_TRACE)
    {
      const Var *v = (Var *)(resVarInfo->var);
      fprintf(stderr, ".... looked up existing var %s var %p flags = %.6x undefined %d\n",
              ObjStr(resVarInfo->nameObj),
              (void *)v, v->flags,
              TclIsVarUndefined(v));
    }
#endif
  }

  return var;
}

/*
 *----------------------------------------------------------------------
 * CompiledColonVarFree --
 *
 *      DeleteProc of the compiled variable handler.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free compiled variable structure and variable.
 *
 *----------------------------------------------------------------------
 */
static void CompiledColonVarFree(Tcl_ResolvedVarInfo *vInfoPtr)
  nonnull(1);

static void
CompiledColonVarFree(Tcl_ResolvedVarInfo *vInfoPtr) {
  NsfResolvedVarInfo *resVarInfo;

  nonnull_assert(vInfoPtr != NULL);

  resVarInfo = (NsfResolvedVarInfo *)vInfoPtr;
#if defined(VAR_RESOLVER_TRACE)
  fprintf(stderr, "CompiledColonVarFree %p for variable '%s'\n",
          (void *)resVarInfo, ObjStr(resVarInfo->nameObj));
#endif

  DECR_REF_COUNT(resVarInfo->nameObj);
  if (resVarInfo->var != NULL) {
    HashVarFree(resVarInfo->var);
  }
  FREE(NsfResolvedVarInfo, vInfoPtr);
}

/*
 *----------------------------------------------------------------------
 * InterpCompiledColonVarResolver --
 *
 *      For colon-prefixed (":/varName/") variables, we provide our own
 *      var resolver for compiling scripts and evaluating compiled
 *      scripts (e.g., proc bodies). At the time of first compilation
 *    (or re-compilation), this resolver is processed (see
 *      tclProc.c:InitResolvedLocals()). It registers two handlers for a
 *      given, colon-prefixed variable found in the script: the actual
 *      variable fetcher and a variable cleanup handler. The variable
 *      fetcher is executed whenever a Tcl call frame is initialized and
 *      the array of compiled locals is constructed (see also
 *      InitResolvedLocals()).
 *
 *      The Tcl var resolver protocol dictates that per-namespace
 *      compiling var resolvers take precedence over this per-interp
 *      compiling var resolver. That is, per-namespace resolvers are
 *      processed first and can effectively out-rule per-interp
 *      resolvers by signaling TCL_OK or TCL_BREAK.
 *
 * Results:
 *      TCL_OK or TCL_CONTINUE (according to Tcl's var resolver protocol)
 *
 * Side effects:
 *      Registers per-variable resolution and cleanup handlers.
 *
 *----------------------------------------------------------------------
 */
static int InterpCompiledColonVarResolver(Tcl_Interp *interp, const char *name, int length,
                                          Tcl_Namespace *UNUSED(context), Tcl_ResolvedVarInfo **rPtr)
  nonnull(1) nonnull(2) nonnull(5);

static int
InterpCompiledColonVarResolver(Tcl_Interp *interp,
                               const char *name, int length, Tcl_Namespace *UNUSED(context),
                               Tcl_ResolvedVarInfo **rPtr) {
  /*
   *  The variable handler is registered, when we have an active Next
   *  Scripting object and the variable starts with the appropriate
   *  prefix. Note that getting the "self" object is a weak protection against
   *  handling of wrong vars
   */
  NsfObject *object;

  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);
  nonnull_assert(rPtr != NULL);

  object = GetSelfObj(interp);
#if defined(VAR_RESOLVER_TRACE)
  fprintf(stderr, "compiled var resolver for %s, obj %p\n", name, (void *)object);
#endif

  if (likely(object != NULL) && FOR_COLON_RESOLVER(name)) {
    NsfResolvedVarInfo *resVarInfo = NEW(NsfResolvedVarInfo);

    resVarInfo->vInfo.fetchProc = CompiledColonVarFetch;
    resVarInfo->vInfo.deleteProc = CompiledColonVarFree; /* if NULL, Tcl does a ckfree on proc clean up */
    resVarInfo->lastObject = NULL;
    resVarInfo->var = NULL;
    resVarInfo->nameObj = Tcl_NewStringObj(name+1, length-1);
    INCR_REF_COUNT(resVarInfo->nameObj);

#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, "... resVarInfo %p nameObj %p '%s' obj %p %s\n",
            (void *)resVarInfo, (void *)resVarInfo->nameObj, ObjStr(resVarInfo->nameObj),
            (void *)object, ObjectName(object));
#endif

    *rPtr = (Tcl_ResolvedVarInfo *)resVarInfo;

    return TCL_OK;
  }
  return TCL_CONTINUE;
}

/*
 *----------------------------------------------------------------------
 * InterpGetFrameAndFlags --
 *
 *      Return for the provided interp the flags of the frame (returned
 *      as result) and the actual varFrame (returned in the second
 *      argument). In case, the top-level frame is a LAMBDA frame, skip
 *      it.
 *
 * Results:
 *      Frame flags, varFrame.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

NSF_INLINE static int InterpGetFrameAndFlags(Tcl_Interp *interp, CallFrame **framePtr)
  nonnull(1) nonnull(2);

NSF_INLINE static int
InterpGetFrameAndFlags(Tcl_Interp *interp, CallFrame **framePtr) {
  int frameFlags;

  nonnull_assert(interp != NULL);
  nonnull_assert(framePtr != NULL);

  *framePtr = Tcl_Interp_varFramePtr(interp);
  frameFlags = Tcl_CallFrame_isProcCallFrame(*framePtr);
  /*
   * If the resolver is called from a lambda frame, use always the parent frame
   */
  if ((frameFlags & FRAME_IS_LAMBDA) != 0u) {
    *framePtr = (CallFrame *)Tcl_CallFrame_callerPtr(*framePtr);
    frameFlags = Tcl_CallFrame_isProcCallFrame(*framePtr);
#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, "InterpColonVarResolver skip lambda frame flags %.6x\n",
            Tcl_CallFrame_isProcCallFrame(*framePtr));
#endif
  }
#if defined(VAR_RESOLVER_TRACE)
  fprintf(stderr, "... final frame flags %.6x\n", frameFlags);
#endif
  return frameFlags;
}

/*
 *----------------------------------------------------------------------
 * InterpColonVarResolver --
 *
 *      For accessing object (instance) variables using the colon-prefix
 *      notation (":/varName/"), we provide our own var resolvers. This
 *      function is the non-compiling var resolver; its services are
 *      requested in two situations: a) when evaluating non-compiled
 *      statements, b) when executing slow-path bytecode instructions,
 *      with "slow path" referring to bytecode instructions not making
 *      use of the compiled locals array (and, e.g., reverting to
 *      TclObjLookupVar*() calls).
 *
 *      The Tcl variable resolver protocol dictates that per-namespace,
 *      non-compiling var resolvers take precedence over this per-interp
 *      non-compiling var resolver. That is, per-namespace resolvers are
 *      processed first and can effectively out-rule per-interp
 *      resolvers by signaling TCL_OK or TCL_BREAK. See
 *      e.g. TclLookupSimpleVar().
 *
 * Results:
 *      TCL_OK or TCL_CONTINUE (according to on Tcl's var resolver
 *      protocol).
 *
 * Side effects:
 *      If successful, return varPtr, pointing to instance variable.
 *
 *----------------------------------------------------------------------
 */

static int InterpColonVarResolver(Tcl_Interp *interp, const char *varName, Tcl_Namespace *UNUSED(nsPtr),
                                  int flags, Tcl_Var *varPtr)
  nonnull(1) nonnull(2) nonnull(5);

static int
InterpColonVarResolver(Tcl_Interp *interp, const char *varName, Tcl_Namespace *UNUSED(nsPtr),
                       int flags, Tcl_Var *varPtr) {
  int              new;
  unsigned int     frameFlags;
  CallFrame       *varFramePtr;
  TclVarHashTable *varTablePtr;
  NsfObject       *object;
  Tcl_Obj         *keyObj;
  Tcl_Var          var;

  nonnull_assert(interp != NULL);
  nonnull_assert(varName != NULL);
  nonnull_assert(varPtr != NULL);

  if (!FOR_COLON_RESOLVER(varName) || (flags & (TCL_NAMESPACE_ONLY)) != 0u) {
    /*
     * Ordinary names (not starting with our prefix) and namespace only
     * lookups are not for us. We cannot filter for TCL_GLOBAL_ONLY, since
     * "vwait :varName" is called with this flag.
     */
#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, "InterpColonVarResolver '%s' flags %.6x not for us\n",
            varName, flags);
#endif
    return TCL_CONTINUE;
  }

  frameFlags = (unsigned int)InterpGetFrameAndFlags(interp, &varFramePtr);

  if (likely((frameFlags & FRAME_IS_NSF_METHOD) != 0u)) {
    /* varPtr = CompiledLocalsLookup(varFramePtr, varName);
       fprintf(stderr, "CompiledLocalsLookup for %p %s returned %p\n",
       (void *)varFramePtr, varName, (void *)*varPtr);
    */
    if ((*varPtr = CompiledColonLocalsLookup(varFramePtr, varName))) {
      /*
       * This section is reached under notable circumstances and represents a
       * point of interaction between our resolvers for non-compiled (i.e.,
       * InterpColonVarResolver()) and compiled script execution (i.e.,
       * InterpCompiledColonVarResolver()).
       *
       * Expect this branch to be hit iff...
       *
       * 1. ... InterpCompiledColonVarResolver() is called from within the Tcl
       * bytecode interpreter when executing a bytecode-compiled script on a
       * *slow path* (i.e., involving a TclObjLookupVarEx() call)
       *
       * 2. ... the act of variable resolution (i.e., TclObjLookupVarEx()) has
       * not been restricted to an effective namespace (TCL_NAMESPACE_ONLY)
       *
       * 3. ..., resulting from the fact of participating in a bytecode
       * interpretation, CompiledColonVarFetch() stored a link variable
       * (pointing to the actual/real object variable, whether defined or not)
       * under the given varName value into the current call frame's array of
       * compiled locals (when initializing the call frame; see
       * tclProc.c:InitResolvedLocals()).
       */
#if defined(VAR_RESOLVER_TRACE)
      fprintf(stderr, ".... found local %s varPtr %p flags %.6x\n",
              varName, (void *)*varPtr, flags);
#endif
      /*
       * By looking up the compiled-local directly and signaling TCL_OK, we
       * optimize a little by avoiding further lookups down the Tcl var
       * resolution infrastructure. Note that signaling TCL_CONTINUE would
       * work too, however, it would involve extra resolution overhead.
       */
      return TCL_OK;
    }

    object = ((NsfCallStackContent *)varFramePtr->clientData)->self;

  } else if ((frameFlags & FRAME_IS_NSF_CMETHOD) != 0u) {
    object = ((NsfCallStackContent *)varFramePtr->clientData)->self;

  } else if ((frameFlags & FRAME_IS_NSF_OBJECT) != 0u) {
    object = (NsfObject *)(varFramePtr->clientData);

  } else {
#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, ".... not found %s\n", varName);
#endif
    return TCL_CONTINUE;
  }

  /*
   * Trim the varName for the colon prefix (":").
   */
  varName ++;

  /*
   * We have an object and create the variable if not found
   */
  assert(object != NULL);
  if (unlikely(object->nsPtr != NULL)) {
    varTablePtr = Tcl_Namespace_varTablePtr(object->nsPtr);
  } else if (likely(object->varTablePtr != NULL)) {
    varTablePtr = object->varTablePtr;
  } else {
    /*
     * In most situations, we have a varTablePtr through the clauses
     * above. However, if someone redefines e.g. the method "configure" or
     * "objectparameter", we might find an object with a still empty
     * varTable, since these are lazy initiated.
     */
    varTablePtr = object->varTablePtr = VarHashTableCreate();
  }
  assert(varTablePtr != NULL);

  /*fprintf(stderr, "Object Var Resolver, name=%s, obj %p, nsPtr %p, varTablePtr %p\n",
    varName, (void *)object, (void *)object->nsPtr, (void *)varTablePtr);*/

  keyObj = Tcl_NewStringObj(varName, -1);
  INCR_REF_COUNT(keyObj);

  var = (Tcl_Var)VarHashCreateVar(varTablePtr, keyObj, NULL);
  if (likely(var != NULL)) {
#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, ".... found in hash-table %s %p flags %.6x ns %p\n",
            varName, (void *)var, ((Var *)var)->flags, (void *)object->nsPtr);
#endif
    /*
     * Make coverage analysis easier.
     */
    assert(1);
  } else {
    /*
     * We failed to find the variable, therefore, we create it new
     */
    var = (Tcl_Var)VarHashCreateVar(varTablePtr, keyObj, &new);
#if defined(VAR_RESOLVER_TRACE)
    fprintf(stderr, ".... var %p %s created in hash-table %p\n", (void *)var, varName, (void *)varTablePtr);
#endif
  }

  *varPtr = var;
  DECR_REF_COUNT(keyObj);

  return TCL_OK;
}

/*********************************************************
 *
 * End of var resolvers
 *
 *********************************************************/

/*********************************************************
 *
 * Begin of cmd resolver
 *
 *********************************************************/
/*
 *----------------------------------------------------------------------
 * InterpColonCmdResolver --
 *
 *      Resolve command names. If the command starts with the Next
 *      Scripting specific prefix and we are on a Next Scripting stack
 *      frame, treat command as OO method.
 *
 * Results:
 *      TCL_OK or TCL_CONTINUE (based on Tcl's command resolver protocol)
 *
 * Side effects:
 *      If successful, return cmdPtr, pointing to method.
 *
 *----------------------------------------------------------------------
 */
static int InterpColonCmdResolver(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *UNUSED(nsPtr),
                                  unsigned int flags, Tcl_Command *cmdPtr)
  nonnull(1) nonnull(2) nonnull(5);

static int
InterpColonCmdResolver(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *UNUSED(nsPtr),
                       unsigned int flags, Tcl_Command *cmdPtr) {
  CallFrame   *varFramePtr;
  unsigned int frameFlags;

  nonnull_assert(interp != NULL);
  nonnull_assert(cmdName != NULL);
  nonnull_assert(cmdPtr != NULL);

  /* fprintf(stderr, "InterpColonCmdResolver %s flags %.6x\n", cmdName, flags); */

  if (likely((*cmdName == ':' && *(cmdName + 1) == ':') || (flags & TCL_GLOBAL_ONLY) != 0u)) {
    /* fully qualified names and global lookups are not for us */
    /*fprintf(stderr, "... not for us %s flags %.6x\n", cmdName, flags);*/
    return TCL_CONTINUE;
  }
  frameFlags = (unsigned int)InterpGetFrameAndFlags(interp, &varFramePtr);

  /*
   * The resolver is called as well, when a body of a method is
   * compiled.  In these situations, Tcl stacks a non-proc frame, that
   * we have to skip. In order to safely identify such situations, we
   * stuff into the call flags of the proc frame during the
   * compilation step NSF_CSC_CALL_IS_COMPILE.
   */
  if ((frameFlags == 0u) && (Tcl_CallFrame_callerPtr(varFramePtr) != NULL)) {
    ClientData clientData;

    varFramePtr = (CallFrame *)Tcl_CallFrame_callerPtr(varFramePtr);
    frameFlags = (unsigned int)Tcl_CallFrame_isProcCallFrame(varFramePtr);
    clientData = varFramePtr->clientData;

    if ( (frameFlags != 0u)
         && (clientData != NULL)
         && ((((NsfCallStackContent *)clientData)->flags & NSF_CSC_CALL_IS_COMPILE) == 0u)
         ) {
      frameFlags = 0u;
    } else {
#if defined(CMD_RESOLVER_TRACE)
      fprintf(stderr, "InterpColonCmdResolver got parent frame cmdName %s flags %.6x, frame flags %.6x\n",
              cmdName, flags, Tcl_CallFrame_isProcCallFrame(varFramePtr));
#endif
    }
 }

#if defined(CMD_RESOLVER_TRACE)
  fprintf(stderr, "InterpColonCmdResolver cmdName %s flags %.6x, frame flags %.6x\n",
          cmdName, flags, frameFlags);
#endif

  if ((frameFlags & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_OBJECT|FRAME_IS_NSF_CMETHOD)) != 0u) {
    if (*cmdName == ':') {
#if defined(CMD_RESOLVER_TRACE)
      fprintf(stderr, "    ... call colonCmd for %s\n", cmdName);
#endif
      /*
       * We have a cmd starting with ':', we are in an NSF frame, so
       * forward to the colonCmd.
       */
      *cmdPtr = RUNTIME_STATE(interp)->colonCmd;

      return TCL_OK;
    } else {

#if defined(NSF_WITH_OS_RESOLVER)
      /*
       * Experimental Object-System specific resolver: If an un-prefixed
       * method name is found in a body of a method, we try to perform a
       * lookup for this method in the namespace of the object system for the
       * current object. If this lookup is not successful the standard lookups
       * are performed. The object-system specific resolver allows one to use
       * the "right" (un-prefixed) "self" or "next" calls without namespace
       * imports.
       */
      NsfObject *object;
      NsfObjectSystem *osPtr;

      if ((frameFlags & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) != 0u) {
        const NsfCallStackContent *cscPtr = (NsfCallStackContent *)varFramePtr->clientData;
        assert(cscPtr != NULL);
        object = cscPtr->self;
      } else if ((frameFlags & (FRAME_IS_NSF_OBJECT)) != 0u) {
        object = (NsfObject *)(varFramePtr->clientData);
      } else {
        object = NULL;
      }

      if (object != NULL) {
        Tcl_HashEntry *entryPtr;
        Tcl_HashTable *cmdTablePtr;
        Tcl_Command cmd;

        osPtr = GetObjectSystem(object);
        cmd = osPtr->rootClass->object.id;
        cmdTablePtr = Tcl_Namespace_cmdTablePtr(((Command *)cmd)->nsPtr);
        entryPtr = Tcl_CreateHashEntry(cmdTablePtr, cmdName, NULL);
        /*fprintf(stderr, "InterpColonCmdResolver OS specific resolver tried to lookup %s for os %s in ns %s\n",
          cmdName, ClassName(osPtr->rootClass), ((Command *)cmd)->nsPtr->fullName);*/

        if (entryPtr != NULL) {
          /*fprintf(stderr, "InterpColonCmdResolver OS specific resolver found %s::%s frameFlags %.6x\n",
            ((Command *)cmd)->nsPtr->fullName, cmdName, frameFlags);*/
          *cmdPtr = Tcl_GetHashValue(entryPtr);

          return TCL_OK;
        }
      }
#endif
    }
  }

#if defined(CMD_RESOLVER_TRACE)
  fprintf(stderr, "    ... not found %s\n", cmdName);
  NsfShowStack(interp);
#endif

  return TCL_CONTINUE;
}
/*********************************************************
 *
 * End of cmd resolver
 *
 *********************************************************/


/*
 *----------------------------------------------------------------------
 * NsfNamespaceInit --
 *
 *      Initialize a provided namespace by setting its resolvers and
 *      namespace path
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Change behavior of NSF resolving.
 *
 *----------------------------------------------------------------------
 */

static void NsfNamespaceInit(Tcl_Namespace *nsPtr)
  nonnull(1);

static void
NsfNamespaceInit(Tcl_Namespace *nsPtr) {

  nonnull_assert(nsPtr != NULL);

  /*
   * This puts a per-object namespace resolver into position upon
   * acquiring the namespace. Works for object-scoped commands/procs
   * and object-only ones (set, unset, ...)
   */
  Tcl_SetNamespaceResolvers(nsPtr,
                            (Tcl_ResolveCmdProc *)NULL,
                            NsColonVarResolver,
                            (Tcl_ResolveCompiledVarProc *)NULL);

#if defined(NSF_WITH_INHERIT_NAMESPACES)
  /*
   * In case there is a namespace path set for the parent namespace,
   * apply this as well to the object namespace to avoid surprises
   * with "namespace path nx".
   */
  { Namespace *parentNsPtr = Tcl_Namespace_parentPtr(nsPtr);
    int pathLength = Tcl_Namespace_commandPathLength(parentNsPtr);

    if (pathLength > 0) {
      Namespace **pathArray = (Namespace **)ckalloc((int)sizeof(Namespace *) * pathLength);
      NamespacePathEntry *tmpPathArray = Tcl_Namespace_commandPathArray(parentNsPtr);
      int i;

      for (i = 0; i < pathLength; i++) {
        pathArray[i] = tmpPathArray[i].nsPtr;
      }
      TclSetNsPath((Namespace *)nsPtr, pathLength, (Tcl_Namespace **)pathArray);
      ckfree((char *)pathArray);
    }
  }
#endif
}

static NsfObject *NSNamespaceClientDataObject(ClientData clientData) nonnull(1) NSF_pure;

static NsfObject *
NSNamespaceClientDataObject(ClientData clientData) {
#ifdef NSF_MEM_COUNT
  NsfNamespaceClientData *nsClientData = (NsfNamespaceClientData *)clientData;

  nonnull_assert(clientData != NULL);

  /*fprintf(stderr, "NSNamespaceDeleteProc cd %p\n", (void *)clientData);
    fprintf(stderr, "... nsPtr %p name '%s'\n", (void *)nsClientData->nsPtr, nsClientData->nsPtr->fullName);*/

  return nsClientData->object;
#else
  nonnull_assert(clientData != NULL);
  return (NsfObject *) clientData;
#endif
}


/*
 *----------------------------------------------------------------------
 * SlotContainerCmdResolver --
 *
 *      This is a specialized cmd resolver for slotcontainer.  The
 *      command resolver should be registered for a namespace and avoids
 *      the lookup of childobjs for unqualified calls. This way, it is
 *      e.g. possible to call in a slot-obj a method [list], even in
 *      cases, where a property "list" is defined.
 *
 * Results:
 *      Either TCL_CONTINUE or TCL_OK.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int SlotContainerCmdResolver(Tcl_Interp *interp, const char *cmdName,
                         Tcl_Namespace *nsPtr, unsigned int flags, Tcl_Command *cmdPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(5);

static int
SlotContainerCmdResolver(Tcl_Interp *interp, const char *cmdName,
                         Tcl_Namespace *nsPtr, unsigned int flags, Tcl_Command *cmdPtr) {

  nonnull_assert(cmdName != NULL);
  nonnull_assert(nsPtr != NULL);
  nonnull_assert(cmdPtr != NULL);

  if (*cmdName == ':' || ((flags & TCL_GLOBAL_ONLY) != 0u)) {
    /*
     * Colon names (InterpColonCmdResolver) and global lookups are not for us.
     */
    return TCL_CONTINUE;
  }

  /*fprintf(stderr, "SlotContainerCmdResolver called with %s ns %s ourNs %d clientData %p\n",
          cmdName, nsPtr->fullName, nsPtr->deleteProc == NSNamespaceDeleteProc,
          (void *)nsPtr->clientData);*/

  /*
   * Check whether this already a namespace handled by NSF
   */
  if (nsPtr->deleteProc == NSNamespaceDeleteProc && nsPtr->clientData) {
    NsfObject *parentObject = NSNamespaceClientDataObject(nsPtr->clientData);

    /*fprintf(stderr, "SlotContainerCmdResolver parentObject %p %s\n",
      (void *)parentObject, ObjectName(parentObject));*/
    /*
     * Make global lookups when the parent is a slotcontainer
     */
    /* parentObject = (NsfObject *) GetObjectFromString(interp, nsPtr->fullName);*/
    if ((parentObject->flags & NSF_IS_SLOT_CONTAINER) != 0u) {
      Tcl_Command cmd = Tcl_FindCommand(interp, cmdName, NULL, TCL_GLOBAL_ONLY);

      if (likely(cmd != NULL)) {
        *cmdPtr = cmd;
        return TCL_OK;
      }
    }
  }

  return TCL_CONTINUE;
 }

/*
 *----------------------------------------------------------------------
 * RequireObjNamespace --
 *
 *      Obtain for an object a namespace if necessary and initialize it.
 *      In this function, variables existing outside of the namespace
 *      get copied over to the fresh namespace.
 *
 * Results:
 *      Tcl_Namespace
 *
 * Side effects:
 *      Allocate potentially a Tcl_Namespace
 *
 *----------------------------------------------------------------------
 */

static Tcl_Namespace *
RequireObjNamespace(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (object->nsPtr == NULL) {
    MakeObjNamespace(interp, object);
    NsfNamespaceInit(object->nsPtr);
  }
  assert(object->nsPtr != NULL);

  return object->nsPtr;
}

/*
 * Namespace related commands
 */
/*
 *----------------------------------------------------------------------
 * NSNamespacePreserve --
 *
 *      Increment namespace refCount
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void
NSNamespacePreserve(Tcl_Namespace *nsPtr) {

  nonnull_assert(nsPtr != NULL);

  MEM_COUNT_ALLOC("NSNamespace", nsPtr);
  Tcl_Namespace_refCount(nsPtr)++;
}
/*
 *----------------------------------------------------------------------
 * NSNamespaceRelease --
 *
 *      Decrement namespace's "refCount" and free namespace if
 *      necessary.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free potentially memory.
 *
 *----------------------------------------------------------------------
 */
static void
NSNamespaceRelease(Tcl_Namespace *nsPtr) {

  nonnull_assert(nsPtr != NULL);

  MEM_COUNT_FREE("NSNamespace", nsPtr);
  Tcl_Namespace_refCount(nsPtr)--;
  if (unlikely(Tcl_Namespace_refCount(nsPtr) == 0 && (Tcl_Namespace_flags(nsPtr) & NS_DEAD))) {
    /*
     * The namespace "refCount" has reached 0, we have to free
     * it. Unfortunately, NamespaceFree() is not exported.
     */
    /*fprintf(stderr, "HAVE TO FREE namespace %p\n", (void *)nsPtr); */

    /*NamespaceFree(nsPtr);*/
    ckfree(nsPtr->fullName);
    ckfree(nsPtr->name);
    ckfree((char *)nsPtr);
  }
}

/*
 *----------------------------------------------------------------------
 * NSDeleteCmd --
 *
 *      Delete the Tcl command for the provided methodName located in
 *      the provided namespace.
 *
 * Results:
 *      Tcl result or -1, if no such method exists int.
 *
 * Side effects:
 *      Command is deleted.
 *
 *----------------------------------------------------------------------
 */
static int
NSDeleteCmd(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *methodName) {
  Tcl_Command token;

  nonnull_assert(interp != NULL);
  nonnull_assert(nsPtr != NULL);
  nonnull_assert(methodName != NULL);

  if ((token = FindMethod(nsPtr, methodName))) {
    return Tcl_DeleteCommandFromToken(interp, token);
  }
  return -1;
}


/*
 *----------------------------------------------------------------------
 * NSDeleteChild --
 *
 *      Delete a child of an object in cases, when the parent object is
 *      deleted. It is designed to delete either objects or classes to
 *      be a little bit more graceful on destructors. Not perfect yet.
 *
 * Results:
 *      Boolean value indicating success.
 *
 * Side effects:
 *      Might destroy an object.
 *
 *----------------------------------------------------------------------
 */
static bool NSDeleteChild(Tcl_Interp *interp, Tcl_Command cmd, bool deleteObjectsOnly)
  nonnull(1) nonnull(2);

static bool
NSDeleteChild(Tcl_Interp *interp, Tcl_Command cmd, bool deleteObjectsOnly) {
  bool deleted;

  nonnull_assert(cmd != NULL);
  nonnull_assert(interp != NULL);

  /*fprintf(stderr, "NSDeleteChildren child %p flags %.6x epoch %d\n",
    (void *)cmd, Tcl_Command_flags(cmd), Tcl_Command_cmdEpoch(cmd));*/

  /*
   * In some situations (e.g. small buckets, less than 12 entries), we
   * get from the cmd-table already deleted cmds; we had previously an
   * assert(Tcl_Command_cmdEpoch(cmd) == 0);
   * which will fail in such cases.
   */

  if (Tcl_Command_cmdEpoch(cmd) != 0) {
    deleted = NSF_FALSE;

  } else {
    NsfObject *object = NsfGetObjectFromCmdPtr(cmd);

    /*fprintf(stderr, "NSDeleteChildren child %p (%s) epoch %d\n",
      (void *)cmd, Tcl_GetCommandName(interp, cmd), Tcl_Command_cmdEpoch(cmd));*/

    if (object == NULL) {
      /*
       * This is just a plain Tcl command; let Tcl handle the
       * deletion.
       */
      deleted = NSF_FALSE;

    } else if (object->id == cmd) {
      /*
       * delete here just true children
       */

      if (deleteObjectsOnly && NsfObjectIsClass(object)) {
        deleted = NSF_FALSE;

      } else if (RUNTIME_STATE(interp)->exitHandlerDestroyRound
          == NSF_EXITHANDLER_ON_PHYSICAL_DESTROY) {
        /*
         * in the exit handler physical destroy --> directly call destroy
         */
        PrimitiveDestroy(object);
        deleted = NSF_TRUE;

      } else {
        if (object->teardown && ((object->flags & NSF_DESTROY_CALLED) == 0u)) {
          int result;

          NsfObjectRefCountIncr(object);

          result = DispatchDestroyMethod(interp, object, 0u);
          if (unlikely(result != TCL_OK) && object->teardown != NULL) {
            /*
             * The destroy method failed. However, we have to remove
             * the command anyway, since its parent is currently being
             * deleted.
             */
            /*fprintf(stderr, "==== NSDeleteChild DispatchDestroyMethod FAILED object %p (cmd %p) id %p teardown %p flags %.6x\n",
              (void *)object, (void *)cmd, (void *)object->id, (void *)object->teardown, object->flags);*/

            NsfLog(interp, NSF_LOG_NOTICE, "Destroy failed for object %s %p %.6x, perform low-level deletion",
                   (object->flags & NSF_DURING_DELETE) == NSF_DURING_DELETE ? "deleted-object" : ObjectName_(object),
                   (void*)object, object->flags);
            CallStackDestroyObject(interp, object);
          }
          NsfCleanupObject(object, "NSDeleteChild");

          deleted = NSF_TRUE;
        } else {
          deleted = NSF_FALSE;
        }
      }
    } else {
      /*fprintf(stderr, "NSDeleteChild remove alias %p %s\n", (void*)object, Tcl_GetCommandName(interp, cmd));*/
      deleted = AliasDeleteObjectReference(interp, cmd);
    }
  }
  return deleted;
}

/*
 *----------------------------------------------------------------------
 * NSDeleteChildren --
 *
 *      Delete the child objects of a namespace.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Might destroy child objects.
 *
 *----------------------------------------------------------------------
 */

static void NSDeleteChildren(Tcl_Interp *interp, const Tcl_Namespace *nsPtr)
  nonnull(1) nonnull(2);

static void
NSDeleteChildren(Tcl_Interp *interp, const Tcl_Namespace *nsPtr) {
  Tcl_HashTable       *cmdTablePtr = Tcl_Namespace_cmdTablePtr(nsPtr);
  Tcl_HashSearch       hSrch;
  const Tcl_HashEntry *hPtr;
  int                  expected;

  nonnull_assert(interp != NULL);
  nonnull_assert(nsPtr != NULL);

#ifdef OBJDELETION_TRACE
  fprintf(stderr, "NSDeleteChildren %p %s activationCount %d\n",
          (void *)nsPtr, nsPtr->fullName, Tcl_Namespace_activationCount(nsPtr));
#endif

  /*
   * First, get rid of namespace imported objects; don't delete the
   * object, but the reference.
   */
  Tcl_ForgetImport(interp, (Tcl_Namespace*)nsPtr, "*"); /* don't destroy namespace imported objects */


#if defined(OBJDELETION_TRACE)
  /*
   * Deletion is always tricky. Show, what elements should be deleted
   * in this loop. The actually deleted elements might be actually
   * less, if a deletion of one item triggers the destroy of another
   * item.
   */
  for (hPtr = Tcl_FirstHashEntry(cmdTablePtr, &hSrch);
       hPtr != NULL;
       hPtr = Tcl_NextHashEntry(&hSrch)) {
    Tcl_Command cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
    fprintf(stderr, "will destroy %p %s\n", (void *)cmd, Tcl_GetCommandName(interp, cmd));
  }
#endif

  /*
   * Second, delete the objects.
   */

  /*
   * A destroy of one element of the hash-table can trigger the
   * destroy of another item of the same table. Therefore, we use
   * Nsf_NextHashEntry(), which handles this case.
   */
  for (hPtr = Tcl_FirstHashEntry(cmdTablePtr, &hSrch);
       hPtr != NULL;
       hPtr = Nsf_NextHashEntry(cmdTablePtr, expected, &hSrch)) {
    /*Tcl_Command cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
    fprintf(stderr, "NSDeleteChild %p table %p numEntries before %d\n",
    cmd, hPtr->tablePtr, cmdTablePtr->numEntries );*/
    expected = (NSDeleteChild(interp, (Tcl_Command)Tcl_GetHashValue(hPtr), NSF_TRUE)
                ? cmdTablePtr->numEntries - 1
                : cmdTablePtr->numEntries);
  }
 /*
  * Finally, delete the classes.
   */
  for (hPtr = Tcl_FirstHashEntry(cmdTablePtr, &hSrch);
       hPtr != NULL;
       hPtr = Nsf_NextHashEntry(cmdTablePtr, expected, &hSrch)) {
    expected = (NSDeleteChild(interp, (Tcl_Command)Tcl_GetHashValue(hPtr), NSF_FALSE)
                ? cmdTablePtr->numEntries - 1
                : cmdTablePtr->numEntries);
  }
}


/*
 *----------------------------------------------------------------------
 * UnsetTracedVars --
 *
 *      This is a helper function which, as a first pass, attempts to
 *      unset traced object variables before TclDeleteVars() performs a
 *      second pass.  This two-pass deletion of object variables is
 *      necessary because an unset trace might bring back the object
 *      variable currently being deleted. A single pass risks leaking
 *      so-revived Var structures. TclDeleteVars() requires variables
 *      under deletion to be untraced.
 *
 *      As Tcl does not provide access to the necessary lower-level Var
 *      API to extensions (ideally: TclDeleteNamespaceVars or
 *      TclPtrUnsetVar), we resort to a mix of navigating the variable
 *      table and calling high-level unset operations (UnsetInstVar).
 *
 *      With the fix to ticket
 *      https://core.tcl-lang.org/tcl/info/4dbdd9af144dbdd9af14, Tcl
 *      itself provides for two deletion passes for namespace variables
 *      (see TclDeleteNamespaceVars).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Triggers the unset traces, if any.
 *
 *----------------------------------------------------------------------
 */

static void UnsetTracedVars(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

static void
UnsetTracedVars(
    Tcl_Interp *interp,  /* Interpreter to which object belongs. */
    NsfObject *object)   /* Object to which variables belong. */
{
    Tcl_HashSearch search;
    TclVarHashTable *varTablePtr;
    Interp *iPtr = (Interp *)interp;

    varTablePtr = (object->nsPtr != NULL) ?
      Tcl_Namespace_varTablePtr(object->nsPtr) :
      object->varTablePtr;

    if (varTablePtr != NULL) {
      Tcl_HashEntry *entryPtr;

      for (entryPtr = Tcl_FirstHashEntry((Tcl_HashTable *)varTablePtr, &search);
           entryPtr != NULL;
           entryPtr = Tcl_NextHashEntry(&search)) {
        Tcl_Obj *nameObj;
        Var     *varPtr;

        GetVarAndNameFromHash(entryPtr, &varPtr, &nameObj);
        if ((varPtr->flags & VAR_TRACED_UNSET) != 0u /* TclIsVarTraced(varPtr) */) {

          VarHashRefCount(varPtr)++;
          (void)UnsetInstVar(interp, 1 /* no error msg */, object, ObjStr(nameObj));

          /*
           * The variable might have been brought back by an unset trace, plus
           * newly created unset traces; deactivate *all* traces on revived
           * vars.
           */
          if (TclIsVarTraced(varPtr)) {
            Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (const char *)varPtr);
            VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
            ActiveVarTrace *activePtr;

            while (tracePtr != NULL) {
              VarTrace *prevPtr = tracePtr;

              tracePtr = tracePtr->nextPtr;
              prevPtr->nextPtr = NULL;
              Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
            }
            Tcl_DeleteHashEntry(tPtr);
            varPtr->flags &= ~VAR_ALL_TRACES;
            for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
                 activePtr = activePtr->nextPtr) {
              if (activePtr->varPtr == varPtr) {
                activePtr->nextTracePtr = NULL;
              }
            }
          }
          VarHashRefCount(varPtr)--;
        }
      }
    }
}

/*
 *----------------------------------------------------------------------
 * NSCleanupNamespace --
 *
 *      Cleans up an object or class namespace by deleting 1) its
 *      variables, 2) resetting the var table, and 3) deleting
 *      user-defined namespace procs.
 *
 *      For namespaces holding variables with possible unset traces,
 *      make sure that UnsetTracedVars is called just before
 *      NSCleanupNamespace().
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Re-initializes the variable table of the cleaned-up namespace
 *      (TclInitVarHashTable).
 *
 *----------------------------------------------------------------------
 */

static void NSCleanupNamespace(Tcl_Interp *interp, Tcl_Namespace *nsPtr)
  nonnull(1) nonnull(2);

static void
NSCleanupNamespace(Tcl_Interp *interp, Tcl_Namespace *nsPtr) {
  TclVarHashTable *varTablePtr;
  Tcl_HashTable *cmdTablePtr;
  Tcl_HashSearch hSrch;
  const Tcl_HashEntry *hPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(nsPtr != NULL);

  varTablePtr = Tcl_Namespace_varTablePtr(nsPtr);
  cmdTablePtr = Tcl_Namespace_cmdTablePtr(nsPtr);

#ifdef OBJDELETION_TRACE
  fprintf(stderr, "NSCleanupNamespace %p flags %.6x\n", (void *)nsPtr, Tcl_Namespace_flags(nsPtr));
  fprintf(stderr, "NSCleanupNamespace %p %.6x varTablePtr %p\n", (void *)nsPtr,
          ((Namespace *)nsPtr)->flags, (void *)varTablePtr);
#endif
  /*
   * Delete all variables and initialize var table again (TclDeleteVars frees
   * the var table). Any unset-traced variable has been deleted before
   * (UnsetTracedVars).
   */
  TclDeleteVars((Interp *)interp, varTablePtr);
  TclInitVarHashTable(varTablePtr, (Namespace *)nsPtr);

  /*
   * Delete all user-defined procs in the namespace
   */
  for (hPtr = Tcl_FirstHashEntry(cmdTablePtr, &hSrch);
       hPtr != NULL;
       hPtr = Tcl_NextHashEntry(&hSrch)) {
      Tcl_Command cmd = (Tcl_Command) Tcl_GetHashValue(hPtr);

      if (CmdIsNsfObject(cmd)) {
        /*
         * Sub-objects should not be deleted here to preserve children
         * deletion order. Just delete aliases.
         */
        AliasDeleteObjectReference(interp, cmd);
        continue;
      }
      /*fprintf(stderr, "NSCleanupNamespace calls DeleteCommandFromToken for %p flags %.6x\n",
                cmd, ((Command *)cmd)->flags);
      fprintf(stderr, "    cmd = %s\n", Tcl_GetCommandName(interp, cmd));
      fprintf(stderr, "    nsPtr = %p\n", ((Command *)cmd)->nsPtr);
      fprintf(stderr, "    epoch = %d\n", Tcl_Command_cmdEpoch(cmd));
      fprintf(stderr, "    refCount = %d\n", Tcl_Command_refCount(cmd));
      fprintf(stderr, "    flags %.6x\n", ((Namespace *)((Command *)cmd)->nsPtr)->flags);*/

      Tcl_DeleteCommandFromToken(interp, cmd);
  }
}


static void
NSNamespaceDeleteProc(ClientData clientData) {
  NsfObject *object;

  nonnull_assert(clientData != NULL);

  object = NSNamespaceClientDataObject(clientData);
  assert(object != NULL);

#ifdef NSF_MEM_COUNT
  ckfree((char *)clientData);
#endif

  /*fprintf(stderr, "namespace delete-proc obj=%p ns=%p\n",
    clientData, (object != NULL) ? object->nsPtr : NULL);*/

  MEM_COUNT_FREE("NSNamespace", object->nsPtr);
  object->nsPtr = NULL;
}

void Nsf_DeleteNamespace(Tcl_Interp *interp, Tcl_Namespace *nsPtr)
  nonnull(1) nonnull(2);

void
Nsf_DeleteNamespace(Tcl_Interp *interp, Tcl_Namespace *nsPtr) {

#if defined(NSF_DEVELOPMENT_TEST)
  int activationCount = 0;
  Tcl_CallFrame *f = (Tcl_CallFrame *)Tcl_Interp_framePtr(interp);

  nonnull_assert(interp != NULL);
  nonnull_assert(nsPtr != NULL);

  /*fprintf(stderr, "Nsf_DeleteNamespace %p ", nsPtr);*/

  while (f != NULL) {
    if (f->nsPtr == nsPtr) {
      activationCount++;
    }
    f = Tcl_CallFrame_callerPtr(f);
  }


  if (Tcl_Namespace_activationCount(nsPtr) != activationCount) {
    fprintf(stderr, "WE HAVE TO FIX ACTIVATIONCOUNT\n");
    Tcl_Namespace_activationCount(nsPtr) = activationCount;
  }
  assert(Tcl_Namespace_activationCount(nsPtr) == activationCount);
  /*fprintf(stderr, "to %d. \n", ((Namespace *)nsPtr)->activationCount);*/
#else
  (void)interp;
#endif

  if (Tcl_Namespace_deleteProc(nsPtr)) {
    /*fprintf(stderr, "calling deteteNamespace %s\n", nsPtr->fullName);*/
    Tcl_DeleteNamespace(nsPtr);
  }
}

/*
 *----------------------------------------------------------------------
 * NSValidObjectName --
 *
 *      Check the provided colons in an object name. If the name is
 *      valid, the function NSF_TRUE.
 *
 * Results:
 *      Returns boolean value indicating success.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static bool NSValidObjectName(const char *name, size_t l)
  nonnull(1) NSF_pure;

NSF_INLINE static bool
NSValidObjectName(const char *name, size_t l) {
  register const char *n;
  bool           result = NSF_TRUE;

  nonnull_assert(name != NULL);

  n = name;
  if (*n == '\0') {
    result = NSF_FALSE; /* empty name */
  } else {
    /*
     * Compute size if not given.
     */
    if (l == 0) {
      l = strlen(n);
    }
    /*
     * Check string
     */
    if (*(n+l-1) == ':') {
      result = NSF_FALSE; /* name ends with : */

    } else if (*n == ':' && *(n+1) != ':') {
      result = NSF_FALSE; /* name begins with single : */

    } else {
      for (; *n != '\0'; n++) {
        if (*n == ':' && *(n+1) == ':' && *(n+2) == ':') {
          result = NSF_FALSE;  /* more than 2 colons in series in a name */
          break;
        }
      }
    }
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * NSGetFreshNamespace --
 *
 *      Create an object namespace, provide a deleteProc (avoid
 *      interference between object and namespace deletion order) and
 *      keep the object as client data.
 *
 * Results:
 *      Tcl_Namespace
 *
 * Side effects:
 *      Might allocate a namespace.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Namespace*
NSGetFreshNamespace(Tcl_Interp *interp, NsfObject *object, const char *name) {
  Namespace *dummy1Ptr, *dummy2Ptr, *nsPtr;
  const char *dummy;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(name != NULL);

  TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS|TCL_CREATE_NS_IF_UNKNOWN,
                             &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);

  if (nsPtr->deleteProc != NSNamespaceDeleteProc) {
    /*
     * Avoid hijacking a namespace with different client data
     */
    if (nsPtr->deleteProc || nsPtr->clientData) {
      Tcl_Panic("Namespace '%s' exists already with delProc 0x%" PRIxPTR " and clientData %p; "
                "Can only convert a plain Tcl namespace into an NSF namespace, my delete proc 0x%" PRIxPTR,
                name, (unsigned long)PTR2UINT(nsPtr->deleteProc),
                nsPtr->clientData, (unsigned long)PTR2UINT(NSNamespaceDeleteProc));
    }

    {
#ifdef NSF_MEM_COUNT
      NsfNamespaceClientData *nsClientData = (NsfNamespaceClientData *)ckalloc((int)sizeof(NsfNamespaceClientData));

      nsClientData->object = object;
      nsClientData->nsPtr = (Tcl_Namespace *)nsPtr;
      nsPtr->clientData = nsClientData;

      /*fprintf(stderr, "Adding NsfNamespaceClientData nsPtr %p cd %p name '%s'\n",
        nsPtr, nsClientData, nsPtr->fullName);*/
#else
      nsPtr->clientData = object;
#endif
      nsPtr->deleteProc = (Tcl_NamespaceDeleteProc *)NSNamespaceDeleteProc;
    }
    MEM_COUNT_ALLOC("NSNamespace", nsPtr);
  } else {
    fprintf(stderr, "NSGetFreshNamespace: reusing namespace %p %s\n", (void *)nsPtr, nsPtr->fullName);
  }

  return (Tcl_Namespace *)nsPtr;
}

/*
 *----------------------------------------------------------------------
 * NSRequireParentObject --
 *
 *      Try to require a parent object (e.g. during ttrace).  This function
 *      tries to load a parent object via ::nsf::object::unknown.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Might create an object.
 *
 *----------------------------------------------------------------------
 */
static int NSRequireParentObject(Tcl_Interp *interp, const char *parentName)
  nonnull(1) nonnull(2);

static int
NSRequireParentObject(Tcl_Interp *interp, const char *parentName) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(parentName != NULL);

  result = NsfCallObjectUnknownHandler(interp, Tcl_NewStringObj(parentName, -1));
  if (likely(result == TCL_OK)) {
    NsfObject *parentObj = (NsfObject *)GetObjectFromString(interp, parentName);

    if (parentObj != NULL) {
      RequireObjNamespace(interp, parentObj);
    }
    result = (Tcl_FindNamespace(interp, parentName,
                                (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY) != NULL
              ? TCL_OK: TCL_ERROR);
  }
  return result;

}

/*
 *----------------------------------------------------------------------
 * NSCheckNamespace --
 *
 *      Check whether a namespace with the given name exists. If not,
 *      make sure that a potential parent object has already required a
 *      namespace. If there is no parent namespace yet, try to create a
 *      parent object via __unknown.
 *
 *      If the provided parentNsPtr is not NULL, we know, that (a) the
 *      provided name was relative and simple (contains no ":"
 *      characters) and that (b) this namespace was used to build a
 *      fully qualified name. In these cases, the parentNsPtr points
 *      already to the parentName, containing potentially a parent
 *      Object. In all other cases, the parent name is either obtained
 *      from the full namespace, or from string operations working on
 *      the provided name.
 *
 * Results:
 *      Tcl_Namespace for the provided name.
 *
 * Side effects:
 *      Might create parent objects.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static Tcl_Namespace *NSCheckNamespace(
    Tcl_Interp *interp, const char *nameString, Tcl_Namespace *parentNsPtr1
)  nonnull(1) nonnull(2);

NSF_INLINE static Tcl_Namespace *
NSCheckNamespace(
    Tcl_Interp *interp, const char *nameString, Tcl_Namespace *parentNsPtr1
) {
  Namespace   *nsPtr, *dummy1Ptr, *dummy2Ptr, *parentNsPtr = (Namespace *)parentNsPtr1;
  const char  *parentName, *dummy;
  Tcl_DString ds, *dsPtr = &ds;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameString != NULL);

  /*fprintf(stderr, "NSCheckNamespace %s parentNsPtr %p\n", nameString, parentNsPtr);*/

  /*
   * Check whether there is an already a namespace for the full name. The
   * namespace will be only in rare cases, but we have to make this check in
   * every case. If there is a full namespace, we can use it to determine the
   * parent name.
   */
  TclGetNamespaceForQualName(interp, nameString, NULL,
                             TCL_GLOBAL_ONLY|TCL_FIND_ONLY_NS,
                             &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
  /*fprintf(stderr,
          "before create calls TclGetNamespaceForQualName with %s => %p (%s) %p %s %p %s %p %s\n",
          nameString, nsPtr, (nsPtr != NULL) ? nsPtr->fullName : "",
          dummy1Ptr, (dummy1Ptr != NULL) ? dummy1Ptr->fullName : "",
          parentNsPtr, (parentNsPtr != NULL) ? parentNsPtr->fullName : "",
          dummy, (dummy != NULL) ? dummy : "");*/

  /*
   * If there is a parentNs provided (or obtained from the full
   * namespace), we can determine the parent name from it. Otherwise,
   * we have to perform the string operations.
   */

  if (parentNsPtr == NULL && nsPtr != NULL) {
    parentNsPtr = Tcl_Namespace_parentPtr(nsPtr);
  }

  if (parentNsPtr != NULL) {
    parentName = parentNsPtr->fullName;
    if (*(parentName + 2) == '\0') {
      parentName = NULL;
    }
    /*fprintf(stderr, "NSCheckNamespace parentNs %s parentName of '%s' => '%s'\n",
      parentNsPtr->fullName, nameString, parentName);*/
  } else {
    int         parentNameLength;
    const char *n = nameString + strlen(nameString);
    /*
     * search for last '::'
     */
    while ((*n != ':' || *(n-1) != ':') && n-1 > nameString) {
      n--;
    }
    if (*n == ':' && n > nameString && *(n-1) == ':') {
      n--;
    }
    parentNameLength = (int)(n - nameString);
    if (parentNameLength > 0) {
      DSTRING_INIT(dsPtr);
      Tcl_DStringAppend(dsPtr, nameString, parentNameLength);
      parentName = Tcl_DStringValue(dsPtr);
      DSTRING_FREE(dsPtr);
    } else {
      parentName = NULL;
    }
  }

  if (parentName != NULL) {
    NsfObject *parentObj;

    parentObj = (NsfObject *) GetObjectFromString(interp, parentName);
    /*fprintf(stderr, "parentName %s parentObj %p\n", parentName, parentObj);*/

    if (parentObj != NULL) {
      RequireObjNamespace(interp, parentObj);
    } else if (nsPtr == NULL && parentNsPtr == NULL) {
      TclGetNamespaceForQualName(interp, parentName, NULL,
                                 TCL_GLOBAL_ONLY|TCL_FIND_ONLY_NS,
                                 &parentNsPtr, &dummy1Ptr,
                                 &dummy2Ptr, &dummy);
      if (parentNsPtr == NULL) {
        /*fprintf(stderr, "===== calling NSRequireParentObject %s", parentName);*/
        NSRequireParentObject(interp, parentName);
      }
    }
  }

  return (Tcl_Namespace *)nsPtr;
}


/*
 *----------------------------------------------------------------------
 * NSFindCommand --
 *
 *      Find the "real" command belonging e.g. to a Next Scripting class
 *      or object.  Do not return cmds produced by Tcl_Import, but the
 *      "real" cmd to which they point.
 *
 * Results:
 *      Tcl_Command or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

NSF_INLINE static Tcl_Command NSFindCommand(Tcl_Interp *interp, const char *name)
  nonnull(1) nonnull(2);

NSF_INLINE static Tcl_Command
NSFindCommand(Tcl_Interp *interp, const char *name) {
  Tcl_Command cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);
  assert(*name == ':' && *(name + 1) == ':');

  cmd = Tcl_FindCommand(interp, name, NULL, TCL_GLOBAL_ONLY);
  if (likely(cmd != NULL)) {
    Tcl_Command importedCmd = TclGetOriginalCommand(cmd);
    if (unlikely(importedCmd != NULL)) {
      cmd = importedCmd;
    }
  }
  return cmd;
}

#if defined(NSF_DEVELOPMENT_TEST)
/*
 *----------------------------------------------------------------------
 * ReverseLookupCmdFromCmdTable --
 *
 *      Allows for looking up objects in command tables (e.g., namespace
 *      cmd tables, the interp's hidden cmd table) based on their
 *      command pointer (rather than their command name).
 *
 * Results:
 *      Boolean result indicating success
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static bool ReverseLookupCmdFromCmdTable(
    const Tcl_Command searchCmdPtr,
    Tcl_HashTable *cmdTablePtr
) nonnull(1) nonnull(2);

static bool
ReverseLookupCmdFromCmdTable(
    const Tcl_Command searchCmdPtr,
    Tcl_HashTable *cmdTablePtr
) {
  Tcl_HashSearch       search;
  const Tcl_HashEntry *hPtr;
  bool                 result = NSF_FALSE;

  nonnull_assert(searchCmdPtr != NULL);
  nonnull_assert(cmdTablePtr != NULL);

  for (hPtr = Tcl_FirstHashEntry(cmdTablePtr, &search);
       hPtr != NULL;
       hPtr = Tcl_NextHashEntry(&search)) {
    Tcl_Command needleCmdPtr = (Tcl_Command)Tcl_GetHashValue(hPtr);

    if (needleCmdPtr == searchCmdPtr) {
      result = NSF_TRUE;
      break;
    }
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * GetHiddenObjectFromCmd --
 *
 *      Obtains a hidden object for a specified cmd. The function uses a
 *      reverse lookup of *hidden* object structures based on their
 *      commands. This helper is needed for handling hidden and
 *      re-exposed objects during the shutdown and the cleanup of object
 *      systems.
 *
 * Results:
 *      NsfObject* or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static NsfObject *GetHiddenObjectFromCmd(
    Tcl_Interp *interp, const Tcl_Command cmdPtr
) nonnull(1);

static NsfObject *
GetHiddenObjectFromCmd(
    Tcl_Interp *interp, const Tcl_Command cmdPtr
) {
  Interp    *iPtr = (Interp *) interp;
  NsfObject *screenedObject;

  nonnull_assert(cmdPtr != NULL);

  /*
   * We can provide a shortcut, knowing that a) exposed cmds have an epoch
   * counter > 0, and b) the commands originating namespace must be the global
   * one. See also Tcl_HideCommand() and Tcl_ExposeCommand().
   */
  if (Tcl_Command_cmdEpoch(cmdPtr) == 0 ||
      ((Command *)cmdPtr)->nsPtr != iPtr->globalNsPtr) {
    screenedObject = NULL;

  } else {
    bool found;

    /*
     * Reverse lookup object in the interp's hidden command table. We start
     * off with the hidden cmds as we suspect their number being smaller than
     * the re-exposed ones, living in the global namespace
     */
    found = ReverseLookupCmdFromCmdTable(cmdPtr, iPtr->hiddenCmdTablePtr);
    if (!found) {
      /*
       * Reverse lookup object in the interp's global command table. Most likely
       * needed due to hiding + exposing on a different name.
       */
      found = ReverseLookupCmdFromCmdTable(cmdPtr, &iPtr->globalNsPtr->cmdTable);
    }
    screenedObject = found ? NsfGetObjectFromCmdPtr(cmdPtr) : NULL;

#if !defined(NDEBUG)
    if (screenedObject != NULL) {
      NsfLog(interp, NSF_LOG_NOTICE, "screened object %s found: object %p (%s) cmd %p",
             Tcl_GetCommandName(interp, cmdPtr), (void *)screenedObject,
             ObjectName(screenedObject), (void *)cmdPtr);
    }
#endif
  }
  return screenedObject;
}
#endif

/*
 *----------------------------------------------------------------------
 * GetObjectFromString --
 *
 *      Lookup an object from a given string. The function performs a
 *      command lookup (every object is a command) and checks, if the
 *      command is bound to an NSF object.
 *
 * Results:
 *      NsfObject* or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfObject *
GetObjectFromString(Tcl_Interp *interp, const char *name) {
  register Tcl_Command cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);

  /*fprintf(stderr, "GetObjectFromString name = '%s'\n", name);*/
  cmd = NSFindCommand(interp, name);

  if (likely(cmd != NULL && CmdIsNsfObject(cmd))) {
    /*fprintf(stderr, "GetObjectFromString %s => %p\n", name, Tcl_Command_objClientData(cmd));*/
    return (NsfObject *)Tcl_Command_objClientData(cmd);
  }
  /*fprintf(stderr, "GetObjectFromString %s => NULL\n", name);*/
  return NULL;
}

/*
 *----------------------------------------------------------------------
 * GetClassFromString --
 *
 *      Lookup a class from a given string. The function performs an
 *      object lookup and checks, if the object is a class.
 *
 * Results:
 *      NsfClass* or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClass *
GetClassFromString(Tcl_Interp *interp, const char *name) {
  NsfObject *object = GetObjectFromString(interp, name);

  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);
  return (object != NULL && NsfObjectIsClass(object)) ? (NsfClass *)object : NULL;
}

/*
 *----------------------------------------------------------------------
 * CanRedefineCmd --
 *
 *      This function tests, whether a method (provided as a string) is
 *      allowed to be redefined in a provided namespace.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int CanRedefineCmd(
    Tcl_Interp *interp,
    const Tcl_Namespace *nsPtr,
    const NsfObject *object,
    const char *methodName,
    unsigned int flags
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static int
CanRedefineCmd(
    Tcl_Interp *interp,
    const Tcl_Namespace *nsPtr,
    const NsfObject *object,
    const char *methodName,
    unsigned int flags
) {
  int         result;
  bool        ok;
  Tcl_Command cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(nsPtr != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);

  cmd = FindMethod(nsPtr, methodName);

  if (cmd != NULL) {
    if ( NsfGetObjectFromCmdPtr(cmd) != NULL) {
      /*
       * Don't allow overwriting of an object with a method.
       */
      return NsfPrintError(interp,
                           "refuse to overwrite child object with method %s; delete/rename it before overwriting",
                           methodName);
    }
    ok = (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_REDEFINE_PROTECTED_METHOD) == 0u);
  } else {
    ok = NSF_TRUE;
  }

  if (likely(ok)) {
    result = TCL_OK;

  } else {
    /*
     * We could test, whether we are bootstrapping the "right" object
     * system, and allow only overwrites for the current bootstrap
     * object system, but this seems necessary by now.
     */
    Tcl_Obj *bootstrapObj = Tcl_GetVar2Ex(interp, "::nsf::bootstrap", NULL, TCL_GLOBAL_ONLY);

    if (bootstrapObj == NULL) {
      result = NsfPrintError(interp, "refuse to overwrite protected method '%s'; "
                             "derive e.g. a subclass!", methodName, ObjectName_(object));
    } else {
      result = TCL_OK;
    }
  }

  if (likely(result == TCL_OK)) {
    result = ObjectSystemsCheckSystemMethod(interp, methodName, object, flags);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * NsfAddObjectMethod --
 *
 *      Externally callable function to register an object level method
 *      for the provided object.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Newly created Tcl command.
 *
 *----------------------------------------------------------------------
 */
int NsfAddObjectMethod(
    Tcl_Interp *interp, Nsf_Object *object, const char *methodName,
    Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp,
    unsigned int flags
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

int
NsfAddObjectMethod(
    Tcl_Interp *interp, Nsf_Object *object, const char *methodName,
    Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp,
    unsigned int flags
) {
  NsfObject           *currentObject;
  Tcl_DString          newCmdName, *dsPtr = &newCmdName;
  const Tcl_Namespace *ns;
  Tcl_Command          newCmd;
  int                  result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(proc != NULL);

  currentObject = (NsfObject *)object;
  ns = RequireObjNamespace(interp, currentObject);

  /*
   * Check whether we are allowed to redefine the method
   */
  result = CanRedefineCmd(interp, currentObject->nsPtr, currentObject, (char *)methodName, flags);
  if (unlikely(result != TCL_OK)) {
    return result;
  }
  NsfObjectMethodEpochIncr("NsfAddObjectMethod");

  /*
   * Delete an alias definition, if it exists.
   */
  AliasDelete(interp, currentObject->cmdName, methodName, NSF_TRUE);

  Tcl_DStringInit(dsPtr);
  DStringAppendQualName(dsPtr, ns, methodName);

  newCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(dsPtr), proc, clientData, dp);

  if (flags != 0u) {
    ((Command *) newCmd)->flags |= (int)flags;
  }
  Tcl_DStringFree(dsPtr);
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * NsfAddClassMethod --
 *
 *      Externally callable function to register a class level method
 *      for the provided class.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Newly created Tcl command.
 *
 *----------------------------------------------------------------------
 */
int NsfAddClassMethod(
    Tcl_Interp *interp, Nsf_Class *class, const char *methodName,
    Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp,
    unsigned int flags
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

int
NsfAddClassMethod(
    Tcl_Interp *interp, Nsf_Class *class, const char *methodName,
    Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp,
    unsigned int flags
) {
  Tcl_DString  newCmdName, *dsPtr = &newCmdName;
  Tcl_Command  newCmd;
  NsfClass    *c;
  int          result;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(proc != NULL);

  c = (NsfClass *)class;
  assert(c->nsPtr != NULL);

  /*
   * Check whether we are allowed to redefine the method.
   */
  result = CanRedefineCmd(interp, c->nsPtr, &c->object, (char *)methodName, flags);
  if (unlikely(result != TCL_OK)) {
    return result;
  }

  NsfInstanceMethodEpochIncr("NsfAddClassMethod");

  /*
   * Delete the alias definition, if it exists already.
   */
  AliasDelete(interp, class->object.cmdName, methodName, NSF_FALSE);

  Tcl_DStringInit(dsPtr);
  DStringAppendQualName(dsPtr, c->nsPtr, methodName);

  newCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(dsPtr), proc, clientData, dp);

  if (flags != 0) {
    ((Command *) newCmd)->flags |= (int)flags;
  }
  Tcl_DStringFree(dsPtr);
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * AutonameIncr --
 *
 *      Returns a Tcl_Obj containing an autonamed (interpreter unique)
 *      value.
 *
 * Results:
 *      Tcl Obj.
 *
 * Side effects:
 *      Maintains counters in global Tcl arrays.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj *AutonameIncr(Tcl_Interp *interp, Tcl_Obj *nameObj, NsfObject *object,
             int isInstanceOpt, int doResetOpt)
  nonnull(1) nonnull(2) nonnull(3);

static Tcl_Obj *
AutonameIncr(Tcl_Interp *interp, Tcl_Obj *nameObj, NsfObject *object,
             int isInstanceOpt, int doResetOpt) {
  Tcl_Obj *valueObj, *resultObj;
  CallFrame frame, *framePtr = &frame;
  int flogs = TCL_LEAVE_ERR_MSG;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(object != NULL);

  Nsf_PushFrameObj(interp, object, framePtr);
  if (object->nsPtr != NULL) {
    flogs |= TCL_NAMESPACE_ONLY;
  }
  valueObj = Tcl_ObjGetVar2(interp, NsfGlobalObjs[NSF_AUTONAMES], nameObj, flogs);
  if (valueObj != NULL) {
    long autoname_counter;

    /*
     * The autoname counter can overflow, but this should cause no
     * troubles.
     */
    Tcl_GetLongFromObj(interp, valueObj, &autoname_counter);
    autoname_counter++;
    if (Tcl_IsShared(valueObj)) {
      valueObj = Tcl_DuplicateObj(valueObj);
    }
    Tcl_SetLongObj(valueObj, autoname_counter);
    resultObj = Tcl_ObjSetVar2(interp, NsfGlobalObjs[NSF_AUTONAMES], nameObj,
                               valueObj, flogs);
    if (unlikely(resultObj == NULL)) {
      return NULL;
    }
  } else {
    resultObj = NsfGlobalObjs[NSF_EMPTY];
  }

  if (doResetOpt == 1) {
    if (valueObj != NULL) {
      /*
       * We have such a variable. The reset operation has to unset it.
       */
      Tcl_UnsetVar2(interp, NsfGlobalStrings[NSF_AUTONAMES], ObjStr(nameObj), flogs);
    }
    resultObj = NsfGlobalObjs[NSF_EMPTY];
    INCR_REF_COUNT2("autoname", resultObj);
  } else {
    bool        mustCopy = NSF_TRUE, format = NSF_FALSE;
    const char *c;

    if (valueObj == NULL) {
      valueObj = Tcl_ObjSetVar2(interp, NsfGlobalObjs[NSF_AUTONAMES],
                                   nameObj, NsfGlobalObjs[NSF_ONE], flogs);
    }
    if (isInstanceOpt == 1) {
      char        firstChar;
      const char *nextChars = ObjStr(nameObj);

      firstChar = *(nextChars ++);
      if (isupper((int)firstChar)) {
        char buffer[1];

        buffer[0] = (char)tolower((int)firstChar);
        resultObj = Tcl_NewStringObj(buffer, 1);
        INCR_REF_COUNT2("autoname", resultObj);
        Tcl_AppendLimitedToObj(resultObj, nextChars, -1, INT_MAX, NULL);
        mustCopy = NSF_FALSE;
      }
    }
    if (mustCopy) {
      resultObj = Tcl_DuplicateObj(nameObj);
      INCR_REF_COUNT2("autoname", resultObj);
      /*
        fprintf(stderr, "*** copy %p %s = %p\n", name, ObjStr(name), resultObj);
      */
    }

    /*
     * If there is a "%" in the autoname, use Tcl_FormatObjCmd to let the
     * autoname string be formatted, like Tcl "format" command, with the
     * value. E.g.: autoname a%06d --> a000000, a000001, a000002, ...
     */
    for (c = ObjStr(resultObj); *c != '\0'; c++) {
      if (*c == '%') {
        if (*(c+1) != '%') {
          format = NSF_TRUE;
          break;
        } else {
          /*
           * When name contains "%%" format and then append autoname, e.g.
           * autoname a%% --> a%1, a%2, ...
           */
          c++;
        }
      }
    }
    if (format) {
      Tcl_Obj *savedResultObj, *ov[3];

      savedResultObj = Tcl_GetObjResult(interp);
      INCR_REF_COUNT(savedResultObj);
      ov[0] = NULL;
      ov[1] = resultObj;
      ov[2] = valueObj;
      if (NsfCallCommand(interp, NSF_FORMAT, 3, ov) != TCL_OK) {
        Nsf_PopFrameObj(interp, framePtr);
        DECR_REF_COUNT(savedResultObj);
        return NULL;
      }
      DECR_REF_COUNT(resultObj);
      resultObj = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
      INCR_REF_COUNT2("autoname", resultObj);
      Tcl_SetObjResult(interp, savedResultObj);
      DECR_REF_COUNT(savedResultObj);

    } else {
      const char *valueString = Tcl_GetString(valueObj);

      Tcl_AppendLimitedToObj(resultObj, valueString, valueObj->length, INT_MAX, NULL);
    }
  }

  Nsf_PopFrameObj(interp, framePtr);
  assert((doResetOpt == 1 && resultObj->refCount>=1) || (resultObj->refCount == 1));
  return resultObj;
}

/*
 * Next Scripting CallStack functions
 */

/*
 *----------------------------------------------------------------------
 * CallStackDoDestroy --
 *
 *      Deletion of objects has to take care on the callstack,
 *      e.g. whether an object is active on the callstack or not. The
 *      objects can only be deleted physically, when these are not
 *      activate anymore. This logic is implemented by
 *      CallStackDestroyObject() and CallStackDoDestroy(), where the
 *      latter is responsible for the finaly deletion.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees memory.
 *
 *----------------------------------------------------------------------
 */

NSF_INLINE static void CallStackDoDestroy(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

NSF_INLINE static void
CallStackDoDestroy(Tcl_Interp *interp, NsfObject *object) {
  Tcl_Command oid;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  /*fprintf(stderr, "CallStackDoDestroy %p flags %.6x\n", object, object->flags);*/
  PRINTOBJ("CallStackDoDestroy", object);

  /*
   * Don't do anything, if a recursive DURING_DELETE is for some
   * reason active.
   */
  if (unlikely((object->flags & NSF_DURING_DELETE) != 0u)) {
    return;
  }
  /*fprintf(stderr, "CallStackDoDestroy %p flags %.6x activation %d object->refCount %d cmd %p \n",
    object, object->flags, object->activationCount, object->refCount, object->id);*/

  object->flags |= NSF_DURING_DELETE;
  oid = object->id;

  /*
   * The oid might be freed already, we can't even use
   * (((Command *)oid)->flags & CMD_IS_DELETED)
   */
  if (object->teardown != NULL && oid != NULL) {
    /*
     * PrimitiveDestroy() has to be called before
     * DeleteCommandFromToken(), otherwise e.g. unset traces on this
     * object cannot be executed from Tcl. We make sure via refCounting
     * that the object structure is kept until after
     * DeleteCommandFromToken().
     */
    NsfObjectRefCountIncr(object);

    PrimitiveDestroy(object);

    if /*(object->teardown == NULL)*/ ((object->flags & NSF_TCL_DELETE) == 0u) {
      Tcl_Obj *savedResultObj = Tcl_GetObjResult(interp);
      INCR_REF_COUNT(savedResultObj);

      assert(object->teardown == NULL);

      /*fprintf(stderr, "    before DeleteCommandFromToken %p object flags %.6x\n", (void *)oid, object->flags);*/
      /*fprintf(stderr, "cmd dealloc %p refCount %d dodestroy \n", (void *)oid, Tcl_Command_refCount(oid));*/
      Tcl_DeleteCommandFromToken(interp, oid); /* this can change the result */
      /*fprintf(stderr, "    after DeleteCommandFromToken %p %.6x\n", (void *)oid, ((Command *)oid)->flags);*/
      Tcl_SetObjResult(interp, savedResultObj);
      DECR_REF_COUNT(savedResultObj);
    }

    NsfCleanupObject(object, "CallStackDoDestroy");
  }
}

/*
 *----------------------------------------------------------------------
 * CallStackDestroyObject --
 *
 *      See comments of CallStackDoDestroy() for the overall logic.  The
 *      function CallStackDestroyObject() checks, if an object is activ
 *      active on the call stack (via the activation count), and deletes
 *      only objects via CallStackDoDestroy() which are not activate.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Might frees memory.
 *
 *----------------------------------------------------------------------
 */
static void
CallStackDestroyObject(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

#ifdef OBJDELETION_TRACE
  fprintf(stderr, "CallStackDestroyObject %p %s activationcount %d flags %.6x\n",
          (void *)object, ObjectName(object), object->activationCount, object->flags);
#endif

  if ((object->flags & NSF_DESTROY_CALLED) == 0u) {
    int activationCount = object->activationCount;

    /*
     * If the destroy method was not called yet, do it now.
     */
#ifdef OBJDELETION_TRACE
    fprintf(stderr, "  CallStackDestroyObject has to DispatchDestroyMethod %p activationCount %d\n",
            (void *)object, activationCount);
#endif
    DispatchDestroyMethod(interp, object, 0u);

    if (activationCount == 0) {
      /*
       * We assume, the object is now freed. If the object is already
       * freed, we cannot access activation count, and we cannot call
       * CallStackDoDestroy.
       */
      /*fprintf(stderr, "  CallStackDestroyObject %p done\n",  obj);*/
      return;
    }
  }

  /*
   * If the object is not referenced on the call-stack anymore
   * we have to destroy it directly, because CscFinish won't
   * find the object destroy.
   */
  if (object->activationCount == 0) {
    CallStackDoDestroy(interp, object);
  } else {
    /*
     * To preserve the deletion order, call delete children now such that
     * child destructors are called before parent destructors.
     */
    if ((object->teardown != NULL) && (object->nsPtr != NULL)) {
      /*fprintf(stderr, "  CallStackDestroyObject calls NSDeleteChildren\n");*/
      NSDeleteChildren(interp, object->nsPtr);
    }
  }
  /*fprintf(stderr, "  CallStackDestroyObject %p DONE\n",  object);*/
}

/*
 * cmd list handling
 */

/*
 *----------------------------------------------------------------------
 * CmdListAdd --
 *
 *      Add an entry to a cmdlist. Optionally, the function checks for
 *      duplicates (does not insert a duplicate) or it allows one to add new
 *      entries to the end of the list.
 *
 * Results:
 *      The newly inserted command list item or a found item (never null).
 *
 * Side effects:
 *      Added List entry.
 *
 *----------------------------------------------------------------------
 */
static NsfCmdList *CmdListAdd(
    NsfCmdList **cList, const Tcl_Command cmd, NsfClass *clorobj,
    bool noDuplicates, bool atEnd
) nonnull(1) nonnull(2) returns_nonnull;

static NsfCmdList *
CmdListAdd(
    NsfCmdList **cList, const Tcl_Command cmd, NsfClass *clorobj,
    bool noDuplicates, bool atEnd
) {
  NsfCmdList *l, *nextPtr, *new;

  nonnull_assert(cmd != NULL);
  nonnull_assert(cList != NULL);

  if (unlikely(atEnd)) {
    l = *cList;
    nextPtr = NULL;
  } else {
    l = NULL;
    nextPtr = *cList;
  }

  /*
   * Check for duplicates, if necessary.
   */
  if (unlikely(noDuplicates)) {
    NsfCmdList *h = l, **end = NULL;

    while (h != NULL) {
      if (h->cmdPtr == cmd) {
        return h;
      }
      end = &(h->nextPtr);
      h = h->nextPtr;
    }
    if (end != NULL) {
      /*
       * No duplicates, no need to search below, we are at the end of the
       * list.
       */
      cList = end;
      l = NULL;
    }
  }

  /*
   * Ok, we have no duplicates -> append NsfCmdList "new" to the end of the
   * list.
   */
  new = NEW(NsfCmdList);
  new->cmdPtr = cmd;
  NsfCommandPreserve(new->cmdPtr);
  new->clientData = NULL;
  new->clorobj = clorobj;
  new->nextPtr = nextPtr;

  if (unlikely(l != NULL)) {
    /*
     * append new element at the end
     */
    while (l->nextPtr != NULL) {
      l = l->nextPtr;
    }
    l->nextPtr = new;
  } else {
    /*
     * prepend new element
     */
    *cList = new;
  }

  return new;
}

/*
 *----------------------------------------------------------------------
 * CmdListAddSorted --
 *
 *      Add an entry to a cmdlist without duplicates. The order of the
 *      entries is not supposed to be relevant. This function maintains
 *      a sorted list to reduce cost to n/2. Can be improved be using
 *      better data structures of needed.
 *
 * Results:
 *      The newly inserted command list item or a found item.
 *
 * Side effects:
 *      Added list entry.
 *
 *----------------------------------------------------------------------
 */
static NsfCmdList *CmdListAddSorted(NsfCmdList **cList, Tcl_Command cmd, NsfClass *clorobj)
  nonnull(1) nonnull(2) returns_nonnull;

static NsfCmdList *
CmdListAddSorted(NsfCmdList **cList, Tcl_Command cmd, NsfClass *clorobj) {
  NsfCmdList *prev, *new, *h;

  nonnull_assert(cmd != NULL);
  nonnull_assert(cList != NULL);

  for (h = *cList, prev = NULL; h != NULL; prev = h, h = h->nextPtr) {
    if (h->cmdPtr == cmd) {
      return h;
    } else if (h->cmdPtr > cmd) {
      break;
    }
  }

  new = NEW(NsfCmdList);
  new->cmdPtr = cmd;
  NsfCommandPreserve(new->cmdPtr);
  new->clientData = NULL;
  new->clorobj = clorobj;
  new->nextPtr = h;

  if (prev != NULL) {
    prev->nextPtr = new;
  } else {
    *cList = new;
  }

  return new;
}

static void CmdListReplaceCmd(NsfCmdList *replace, Tcl_Command cmd, NsfClass *clorobj)
  nonnull(1) nonnull(3);

static void
CmdListReplaceCmd(NsfCmdList *replace, Tcl_Command cmd, NsfClass *clorobj) {
  Tcl_Command del;

  nonnull_assert(replace != NULL);
  nonnull_assert(clorobj != NULL);

  del = replace->cmdPtr;
  replace->cmdPtr = cmd;
  replace->clorobj = clorobj;
  NsfCommandPreserve(cmd);
  NsfCommandRelease(del);
}

#if defined(NSF_DEBUGGING)
/** for debug purposes only */
static void CmdListPrint(Tcl_Interp *interp, const char *title, NsfCmdList *cmdList)
  nonnull(1) nonnull(3);

static void
CmdListPrint(Tcl_Interp *interp, const char *title, NsfCmdList *cmdList) {

  nonnull_assert(interp != NULL);
  nonnull_assert(cmdList != NULL);

  if (title != NULL) {
    fprintf(stderr, "%s %p:\n", title, cmdList);
  }
  while (cmdList != NULL) {
    fprintf(stderr, "   CL=%p, cmdPtr=%p %s, clorobj %p, clientData=%p\n",
            cmdList,
            cmdList->cmdPtr, (interp != NULL) ? Tcl_GetCommandName(interp, cmdList->cmdPtr) : "",
            cmdList->clorobj,
            cmdList->clientData);
    cmdList = cmdList->nextPtr;
  }
}
#endif

/*
 * physically delete an entry 'del'
 */
static void CmdListDeleteCmdListEntry(NsfCmdList *del, NsfFreeCmdListClientData *freeFct)
  nonnull(1);

static void
CmdListDeleteCmdListEntry(NsfCmdList *del, NsfFreeCmdListClientData *freeFct) {

  nonnull_assert(del != NULL);

  if (unlikely(freeFct != NULL)) {
    (*freeFct)(del);
  }
  NsfCommandRelease(del->cmdPtr);
  FREE(NsfCmdList, del);
}

/*
 * remove a command 'delCL' from a command list, but do not
 * free it ... returns the removed NsfCmdList*
 */
static NsfCmdList *CmdListRemoveFromList(NsfCmdList **cmdList, NsfCmdList *delCL)
  nonnull(1) nonnull(2);

static NsfCmdList *
CmdListRemoveFromList(NsfCmdList **cmdList, NsfCmdList *delCL) {
  register NsfCmdList *c;
  NsfCmdList          *del = NULL;

  nonnull_assert(cmdList != NULL);
  nonnull_assert(delCL != NULL);

  c = *cmdList;
  if (likely(c != NULL)) {
    if (c == delCL) {
      *cmdList = c->nextPtr;
      del = c;
    } else {
      while ((c->nextPtr != NULL) && (c->nextPtr != delCL)) {
        c = c->nextPtr;
      }
      if (c->nextPtr == delCL) {
        del = delCL;
        c->nextPtr = delCL->nextPtr;
      }
    }
  }
  return del;
}

/*
 *----------------------------------------------------------------------
 * CmdListRemoveDeleted --
 *
 *      Remove all command pointers from a command list which are marked
 *    "deleted". The condition for deletion is the presence of the flag
 *      CMD_IS_DELETED, with the flag bit being set by
 *      Tcl_DeleteCommandFromToken().
 *
 * Results:
 *      The cmd list filtered for non-deleted commands
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void CmdListRemoveDeleted(NsfCmdList **cmdList, NsfFreeCmdListClientData *freeFct)
  nonnull(1) nonnull(2);

static void
CmdListRemoveDeleted(NsfCmdList **cmdList, NsfFreeCmdListClientData *freeFct) {
  NsfCmdList *f, *del;

  nonnull_assert(cmdList != NULL);
  nonnull_assert(freeFct != NULL);

  f = *cmdList;
  while (f != NULL) {
    /*
     * HIDDEN OBJECTS: For supporting hidden mixins, we cannot rely on
     * the cmdEpoch as indicator of the deletion status of a cmd because
     * the epoch counters of hidden and re-exposed commands are
     * bumped. Despite of this, their object structures remain valid. We
     * resort to the use of the per-cmd flag CMD_IS_DELETED, set upon
     * processing a command in Tcl_DeleteCommandFromToken().
     */
    if (((unsigned int)Tcl_Command_flags(f->cmdPtr) & CMD_IS_DELETED) != 0u)  {
      del = f;
      f = f->nextPtr;
      del = CmdListRemoveFromList(cmdList, del);
      CmdListDeleteCmdListEntry(del, freeFct);
    } else
      f = f->nextPtr;
  }
}


/*
 * Delete all cmds with given context class object
 */
static void CmdListRemoveContextClassFromList(
    NsfCmdList **cmdList, const NsfClass *clorobj,
    NsfFreeCmdListClientData *freeFct
) nonnull(1) nonnull(2) nonnull(3);

static void
CmdListRemoveContextClassFromList(
    NsfCmdList **cmdList, const NsfClass *clorobj,
    NsfFreeCmdListClientData *freeFct
) {
  NsfCmdList *c, *del = NULL;

  nonnull_assert(cmdList != NULL);
  nonnull_assert(clorobj != NULL);
  nonnull_assert(freeFct != NULL);

  /*
    CmdListRemoveDeleted(cmdList, freeFct);
  */
  c = *cmdList;
  while (c != NULL && c->clorobj == clorobj) {
    del = c;
    *cmdList = c->nextPtr;
    CmdListDeleteCmdListEntry(del, freeFct);
    c = *cmdList;
  }

  while (c != NULL) {
    if (c->clorobj == clorobj) {
      del = c;
      c = *cmdList;
      while ((c->nextPtr != NULL) && (c->nextPtr != del)) {
        c = c->nextPtr;
      }
      if (c->nextPtr == del) {
        c->nextPtr = del->nextPtr;
      }
      CmdListDeleteCmdListEntry(del, freeFct);
    }
    c = c->nextPtr;
  }
}

/*
 * free the memory of a whole 'cmdList'
 */
static void
CmdListFree(NsfCmdList **cmdList, NsfFreeCmdListClientData *freeFct) {

  nonnull_assert(cmdList != NULL);

  while (*cmdList != NULL) {
    NsfCmdList *del = *cmdList;
    *cmdList = (*cmdList)->nextPtr;
    CmdListDeleteCmdListEntry(del, freeFct);
  }
}

/*
 * simple list search proc to search a list of cmds
 * for a command ptr
 */
static NsfCmdList * CmdListFindCmdInList(const Tcl_Command cmd, NsfCmdList *l)
  nonnull(2) nonnull(1) NSF_pure;

static NsfCmdList *
CmdListFindCmdInList(const Tcl_Command cmd, NsfCmdList *l) {
  register NsfCmdList *h;

  nonnull_assert(cmd != NULL);
  nonnull_assert(l != NULL);

  for (h = l; h != NULL; h = h->nextPtr) {
    if (h->cmdPtr == cmd) {
      return h;
    }
  }
  return NULL;
}

/*
 * simple list search proc to search a list of cmds
 * for a simple Name
 */
static NsfCmdList * CmdListFindNameInList(Tcl_Interp *interp, const char *name, NsfCmdList *cmdList)
  nonnull(1) nonnull(2) nonnull(3);

static NsfCmdList *
CmdListFindNameInList(Tcl_Interp *interp, const char *name, NsfCmdList *cmdList) {

  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);
  nonnull_assert(cmdList != NULL);

  do {
    const char *cmdName = Tcl_GetCommandName(interp, cmdList->cmdPtr);
    if (cmdName[0] == name[0] && strcmp(cmdName, name) == 0) {
      return cmdList;
    }
    cmdList = cmdList->nextPtr;
  } while (cmdList != NULL);

  return NULL;
}

/*
 *----------------------------------------------------------------------
 * CheckConditionInScope --
 *
 *      Check a given condition in the current call-frame's scope. It is
 *      the responsibility of the caller to push the intended call-frame.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int CheckConditionInScope(Tcl_Interp *interp, Tcl_Obj *condition)
  nonnull(1) nonnull(2);

static int
CheckConditionInScope(Tcl_Interp *interp, Tcl_Obj *condition) {
  int      result, success;
  Tcl_Obj *ov[2] = {NULL, condition};

  nonnull_assert(interp != NULL);
  nonnull_assert(condition != NULL);

  INCR_REF_COUNT(condition);
  result = Nsf_ExprObjCmd(NULL, interp, 2, ov);
  DECR_REF_COUNT(condition);

  if (likely(result == TCL_OK)) {
    result = Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp), &success);
    if (result == TCL_OK && success == 0) {
      result = NSF_CHECK_FAILED;
    }
  }
  return result;
}

/*
 * Generic Obj-List handling functions.
 */

/*
 *----------------------------------------------------------------------
 * TclObjListFreeList --
 *
 *      Free the elements of the obj list.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      free memory.
 *
 *----------------------------------------------------------------------
 */
static void TclObjListFreeList(NsfTclObjList *list)
  nonnull(1);

static void
TclObjListFreeList(NsfTclObjList *list) {

  nonnull_assert(list != NULL);

  do {
    NsfTclObjList *del = list;

    list = list->nextPtr;
    DECR_REF_COUNT2("listContent", del->content);
    if (del->payload != NULL) {
      DECR_REF_COUNT2("listPayload", del->payload);
    }
    FREE(NsfTclObjList, del);
  } while (list != NULL);
}

/*
 *----------------------------------------------------------------------
 * TclObjListNewElement --
 *
 *      Add a new element to the obj list with an optional value (stored
 *      in payload).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      allocate memory.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj * TclObjListNewElement(NsfTclObjList **list, Tcl_Obj *obj, Tcl_Obj *valueObj)
  nonnull(1) nonnull(2) returns_nonnull;

static Tcl_Obj *
TclObjListNewElement(NsfTclObjList **list, Tcl_Obj *obj, Tcl_Obj *valueObj) {
  NsfTclObjList *elt = NEW(NsfTclObjList);

  nonnull_assert(list != NULL);
  nonnull_assert(obj != NULL);

  INCR_REF_COUNT2("listContent", obj);
  elt->content = obj;
  elt->payload = valueObj;
  if (valueObj != NULL) {
    INCR_REF_COUNT2("listPayload", valueObj);
  }
  elt->nextPtr = *list;
  *list = elt;

  return obj;
}

/*
 *----------------------------------------------------------------------
 * TclObjListAdd --
 *
 *      Add an NsfTclObjList element to the obj list indexed by a key
 *      into a sorted list of elements. Duplicates are appended to the
 *      payload elements.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Add element to the obj-list.
 *
 *----------------------------------------------------------------------
 */
static void TclObjListAdd(Tcl_Interp *interp, NsfTclObjList **list, Tcl_Obj *key, Tcl_Obj *value)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static void
TclObjListAdd(Tcl_Interp *interp, NsfTclObjList **list, Tcl_Obj *key, Tcl_Obj *value) {
  NsfTclObjList *elt, **prevPtr;
  const char    *keyString;

  nonnull_assert(interp != NULL);
  nonnull_assert(list != NULL);
  nonnull_assert(key != NULL);
  nonnull_assert(value != NULL);

  keyString = ObjStr(key);
  for (elt = *list, prevPtr = list; elt != NULL; prevPtr = &elt->nextPtr, elt = elt->nextPtr) {
    const char *eltString = ObjStr(elt->content);

    if (key == elt->content || strcmp(keyString, eltString) == 0) {
      /*
       * Found the element, append to it
       */
      /* fprintf(stderr, "TclObjListAdd: insert %s/%s equal, append to %s\n",
         keyString, ObjStr(value), ObjStr(elt->payload));*/
      Tcl_ListObjAppendElement(interp, elt->payload, value);
      return;
    }
    if (strcmp(keyString, eltString) < 0) {
      /*
       * Element not found, insert new before as a new entry.
       */
      /*fprintf(stderr, "TclObjListAdd: insert %s/%s before %s isshared %d\n",
        keyString, ObjStr(value), eltString, Tcl_IsShared(key));*/
      TclObjListNewElement(prevPtr, key, Tcl_IsShared(value) ? Tcl_DuplicateObj(value) : value);
      return;
    }
  }
  /*
   * Element not found, insert new as last entry.
   */
  /* fprintf(stderr, "TclObjListAdd: insert last %s value %s\n", keyString, ObjStr(value)); */
  TclObjListNewElement(prevPtr, key, Tcl_NewListObj(1, &value));

  return;
}

/*
 *----------------------------------------------------------------------
 * AddObjToTclList --
 *
 *      Add a Tcl_Obj to a potential not-existing Tcl list, which is
 *      created on demand.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Add Tcl_Obj to the Tcl list, potentially creating list.
 *
 *----------------------------------------------------------------------
 */
static void
AddObjToTclList(
    Tcl_Interp  *interp,
    Tcl_Obj    **listObjPtr,
    Tcl_Obj     *obj
) nonnull(2) nonnull(3);

static void
AddObjToTclList(
    Tcl_Interp  *interp,
    Tcl_Obj    **listObjPtr,
    Tcl_Obj     *obj
) {
  nonnull_assert(listObjPtr != NULL);
  nonnull_assert(obj != NULL);

  if (*listObjPtr == NULL) {
    *listObjPtr = Tcl_NewListObj(1, &obj);
    INCR_REF_COUNT2("AddObjToTclList", *listObjPtr);
  } else {
    Tcl_ListObjAppendElement(interp, *listObjPtr, obj);
  }
}


#if defined(NSF_WITH_ASSERTIONS)
/*********************************************************************
 * Assertions
 **********************************************************************/

static NsfTclObjList * AssertionNewList(Tcl_Interp *interp, Tcl_Obj *aObj)
  nonnull(1);

static NsfTclObjList *
AssertionNewList(Tcl_Interp *interp, Tcl_Obj *aObj) {
  Tcl_Obj **ov; int oc;
  NsfTclObjList *last = NULL;

  nonnull_assert(interp != NULL);

  if (aObj && Tcl_ListObjGetElements(interp, aObj, &oc, &ov) == TCL_OK) {
    if (oc > 0) {
      int i;
      for (i = oc - 1; i >= 0; i--) {
        TclObjListNewElement(&last, ov[i], NULL);
      }
    }
  }
  return last;
}

static Tcl_Obj *AssertionList(Tcl_Interp *interp, NsfTclObjList *alist)
  nonnull(1);

static Tcl_Obj *
AssertionList(Tcl_Interp *interp, NsfTclObjList *alist) {
  Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);

  nonnull_assert(interp != NULL);

  for (; alist != NULL; alist = alist->nextPtr) {
    Tcl_ListObjAppendElement(interp, listObj, alist->content);
  }
  return listObj;
}

static int AssertionListCheckOption(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

static int
AssertionListCheckOption(Tcl_Interp *interp, NsfObject *object) {
  NsfObjectOpt *opt;
  Tcl_Obj      *resultObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  opt = object->opt;
  if (opt == NULL) {
    return TCL_OK;
  }

  resultObj = Tcl_GetObjResult(interp);

  if (opt->checkoptions & CHECK_OBJINVAR) {
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("object-invar", -1));
  }
  if (opt->checkoptions & CHECK_CLINVAR) {
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("class-invar", -1));
  }
  if (opt->checkoptions & CHECK_PRE) {
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("pre", -1));
  }
  if (opt->checkoptions & CHECK_POST) {
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("post", -1));
  }

  return TCL_OK;
}

static NsfProcAssertion *AssertionFindProcs(NsfAssertionStore *aStore, const char *name)
  nonnull(1) nonnull(2);

static NsfProcAssertion *
AssertionFindProcs(NsfAssertionStore *aStore, const char *name) {
  const Tcl_HashEntry *hPtr;

  nonnull_assert(aStore != NULL);
  nonnull_assert(name != NULL);

  hPtr = Tcl_CreateHashEntry(&aStore->procs, name, NULL);
  if (hPtr == NULL) {
    return NULL;
  }
  return (NsfProcAssertion *) Tcl_GetHashValue(hPtr);
}

static void AssertionRemoveProc(NsfAssertionStore *aStore, const char *name)
  nonnull(1) nonnull(2);

static void
AssertionRemoveProc(NsfAssertionStore *aStore, const char *name) {
  Tcl_HashEntry *hPtr;

  nonnull_assert(aStore != NULL);
  nonnull_assert(name != NULL);

  hPtr = Tcl_CreateHashEntry(&aStore->procs, name, NULL);
  if (hPtr != NULL) {
    NsfProcAssertion *procAss = (NsfProcAssertion *) Tcl_GetHashValue(hPtr);

    if (procAss->pre != NULL) {
      TclObjListFreeList(procAss->pre);
    }
    if (procAss->post != NULL) {
      TclObjListFreeList(procAss->post);
    }
    FREE(NsfProcAssertion, procAss);
    Tcl_DeleteHashEntry(hPtr);
  }
}

static void AssertionAddProc(Tcl_Interp *interp, const char *name, NsfAssertionStore *aStore,
                 Tcl_Obj *pre, Tcl_Obj *post)
  nonnull(1) nonnull(2) nonnull(3);

static void
AssertionAddProc(Tcl_Interp *interp, const char *name, NsfAssertionStore *aStore,
                 Tcl_Obj *pre, Tcl_Obj *post) {
  int isNew = 0;
  Tcl_HashEntry *hPtr;
  NsfProcAssertion *procs = NEW(NsfProcAssertion);

  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);
  nonnull_assert(aStore != NULL);

  AssertionRemoveProc(aStore, name);
  procs->pre = AssertionNewList(interp, pre);
  procs->post = AssertionNewList(interp, post);
  hPtr = Tcl_CreateHashEntry(&aStore->procs, name, &isNew);
  if (isNew != 0) {
    Tcl_SetHashValue(hPtr, procs);
  }
}

static NsfAssertionStore *AssertionCreateStore(void) returns_nonnull;

static NsfAssertionStore *
AssertionCreateStore(void) {
  NsfAssertionStore *aStore = NEW(NsfAssertionStore);

  aStore->invariants = NULL;
  Tcl_InitHashTable(&aStore->procs, TCL_STRING_KEYS);
  MEM_COUNT_ALLOC("Tcl_InitHashTable", &aStore->procs);
  return aStore;
}

static void AssertionRemoveStore(NsfAssertionStore *aStore)
  nonnull(1);

static void
AssertionRemoveStore(NsfAssertionStore *aStore) {
  Tcl_HashSearch hSrch;
  const Tcl_HashEntry *hPtr;

  nonnull_assert(aStore != NULL);

  for (hPtr = Tcl_FirstHashEntry(&aStore->procs, &hSrch);
       hPtr != NULL;
       hPtr = Tcl_FirstHashEntry(&aStore->procs, &hSrch)) {
    /*
     * AssertionRemoveProc calls Tcl_DeleteHashEntry(hPtr), thus
     * we get the FirstHashEntry afterwards again to proceed
     */
    AssertionRemoveProc(aStore, Tcl_GetHashKey(&aStore->procs, hPtr));
  }
  Tcl_DeleteHashTable(&aStore->procs);
  MEM_COUNT_FREE("Tcl_InitHashTable", &aStore->procs);
  if (aStore->invariants != NULL) {
    TclObjListFreeList(aStore->invariants);
  }
  FREE(NsfAssertionStore, aStore);
}

static int AssertionCheckList(Tcl_Interp *interp, NsfObject *object,
                              NsfTclObjList *alist, const char *methodName)
  nonnull(1) nonnull(2) nonnull(4);

static int
AssertionCheckList(Tcl_Interp *interp, NsfObject *object,
                   NsfTclObjList *alist, const char *methodName) {
  NsfTclObjList *checkFailed = NULL;
  Tcl_Obj       *savedResultObj;
  CheckOptions   savedCheckoptions;
  int            acResult = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);

  /*
   * No obj->opt -> checkoption == CHECK_NONE
   */
  if (object->opt == NULL) {
    return TCL_OK;
  }

  /*
   * Do not check assertion modifying methods, otherwise we cannot react in
   * catch on a run time assertion check failure
   */

#if 1
  /*
   * TODO: the following check operations is XOTcl1 legacy and is not
   * generic. It should be replaced by another method-property.  Most of the
   * is*String() definition are then obsolete and should be deleted from
   * nsfInt.h as well.
   */

  if (isCheckString(methodName)) {
    return TCL_OK;
  }
#endif

  savedResultObj = Tcl_GetObjResult(interp);
  INCR_REF_COUNT(savedResultObj);

  Tcl_ResetResult(interp);

  while (alist != NULL) {
    /*
     * Eval instead of IfObjCmd => the substitutions in the conditions will be
     * done by Tcl.
     */
    const char *assStr = ObjStr(alist->content), *c = assStr;
    int         comment = 0;

    for (; c && *c != '\0'; c++) {
      if (*c == '#') {
        comment = 1; break;
      }
    }

    if (comment == 0) {
      CallFrame frame, *framePtr = &frame;
      Nsf_PushFrameObj(interp, object, framePtr);

      /*
       * Don't check assertions during the condition check.
       */
      savedCheckoptions = object->opt->checkoptions;
      object->opt->checkoptions = CHECK_NONE;

      /* fprintf(stderr, "Checking Assertion %s ", assStr); */

      /*
       * Now check the condition in the pushed call-frame's scope.
       */
      acResult = CheckConditionInScope(interp, alist->content);
      if (acResult != TCL_OK) {
        checkFailed = alist;
      }
      object->opt->checkoptions = savedCheckoptions;
      /* fprintf(stderr, "...%s\n", (checkFailed != 0) ? "failed" : "ok"); */
      Nsf_PopFrameObj(interp, framePtr);
    }
    if (checkFailed != 0) {
      break;
    }
    alist = alist->nextPtr;
  }

  if (unlikely(checkFailed != 0)) {
    DECR_REF_COUNT(savedResultObj);
    if (acResult == TCL_ERROR) {
      Tcl_Obj *sr = Tcl_GetObjResult(interp);
      INCR_REF_COUNT(sr);
      NsfPrintError(interp, "error in Assertion: {%s} in proc '%s'\n%s",
                    ObjStr(checkFailed->content), methodName, ObjStr(sr));
      DECR_REF_COUNT(sr);
      return TCL_ERROR;
    }
    return NsfPrintError(interp, "assertion failed check: {%s} in proc '%s'",
                         ObjStr(checkFailed->content), methodName);
  }

  Tcl_SetObjResult(interp, savedResultObj);
  DECR_REF_COUNT(savedResultObj);

  return TCL_OK;
}

static int AssertionCheckInvars(Tcl_Interp *interp, NsfObject *object,
                     const char *methodName,
                     CheckOptions checkoptions)
  nonnull(1) nonnull(2) nonnull(3);

static int
AssertionCheckInvars(Tcl_Interp *interp, NsfObject *object,
                     const char *methodName,
                     CheckOptions checkoptions) {
  int result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);

  if (checkoptions & CHECK_OBJINVAR && object->opt->assertions) {
    result = AssertionCheckList(interp, object, object->opt->assertions->invariants,
                                methodName);
  }

  if (result != TCL_ERROR && checkoptions & CHECK_CLINVAR) {
    NsfClasses *clPtr;

    clPtr = PrecedenceOrder(object->cl);
    while ((clPtr != NULL) && (result != TCL_ERROR)) {
      NsfAssertionStore *aStore = (clPtr->cl->opt != NULL) ? clPtr->cl->opt->assertions : NULL;

      if (aStore != NULL) {
        result = AssertionCheckList(interp, object, aStore->invariants, methodName);
      }
      clPtr = clPtr->nextPtr;
    }
  }
  return result;
}

static int AssertionCheck(Tcl_Interp *interp, NsfObject *object, NsfClass *class,
                          const char *method, CheckOptions checkOption)
  nonnull(1) nonnull(2) nonnull(4);

static int
AssertionCheck(Tcl_Interp *interp, NsfObject *object, NsfClass *class,
               const char *method, CheckOptions checkOption) {
  int                result = TCL_OK;
  NsfAssertionStore *aStore;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(method != NULL);
  assert(object->opt != NULL);

  if (class != NULL) {
    aStore = (class->opt != NULL) ? class->opt->assertions : NULL;
  } else {
    aStore = (object->opt != NULL) ? object->opt->assertions : NULL;
  }

  if ((aStore != NULL)
      && (checkOption & object->opt->checkoptions)
      ) {
    NsfProcAssertion *procs = AssertionFindProcs(aStore, method);

    if (procs != NULL) {
      switch (checkOption) {
      case CHECK_PRE:
        result = AssertionCheckList(interp, object, procs->pre, method);
        break;
      case CHECK_POST:
        result = AssertionCheckList(interp, object, procs->post, method);
        break;
      case CHECK_ALL:      NSF_FALL_THROUGH; /* fall through */
      case CHECK_NONE:     NSF_FALL_THROUGH; /* fall through */
      case CHECK_CLINVAR:  NSF_FALL_THROUGH; /* fall through */
      case CHECK_OBJINVAR: NSF_FALL_THROUGH; /* fall through */
      case CHECK_INVAR:
        break;
      }
    }
    if (likely(result != TCL_ERROR)) {
      result = AssertionCheckInvars(interp, object, method, object->opt->checkoptions);
    }
  }
  return result;
}

static int AssertionSetCheckOptions(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *arg)
  nonnull(1) nonnull(2) nonnull(3);

static int
AssertionSetCheckOptions(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *arg) {
  NsfObjectOpt *opt;
  int ocArgs;
  Tcl_Obj **ovArgs;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(arg != NULL);

  opt = NsfRequireObjectOpt(object);
  opt->checkoptions = CHECK_NONE;

  if (Tcl_ListObjGetElements(interp, arg, &ocArgs, &ovArgs) == TCL_OK
      && ocArgs > 0) {
    int i;
    for (i = 0; i < ocArgs; i++) {
      const char *option = ObjStr(ovArgs[i]);
      if (option != NULL) {
        switch (*option) {
        case 'c':
          if (strcmp(option, "class-invar") == 0) {
            opt->checkoptions |= CHECK_CLINVAR;
          }
          break;
        case 'o':
          if (strcmp(option, "object-invar") == 0) {
            opt->checkoptions |= CHECK_OBJINVAR;
          }
          break;
        case 'p':
          if (strcmp(option, "pre") == 0) {
            opt->checkoptions |= CHECK_PRE;
          } else if (strcmp(option, "post") == 0) {
            opt->checkoptions  |= CHECK_POST;
          }
          break;
        case 'a':
          if (strcmp(option, "all") == 0) {
            opt->checkoptions |= CHECK_ALL;
          }
          break;
        }
      }
    }
  }
  if (opt->checkoptions == CHECK_NONE && ocArgs > 0) {
    return NsfPrintError(interp, "unknown check option in command '%s' check %s, ",
                         "valid: all pre post object-invar class-invar",
                         ObjectName_(object), ObjStr(arg));
  }
  return TCL_OK;
}

static void AssertionSetInvariants(Tcl_Interp *interp, NsfAssertionStore **assertions, Tcl_Obj *arg)
  nonnull(1) nonnull(2) nonnull(3);

static void
AssertionSetInvariants(Tcl_Interp *interp, NsfAssertionStore **assertions, Tcl_Obj *arg) {

  nonnull_assert(interp != NULL);
  nonnull_assert(assertions != NULL);
  nonnull_assert(arg != NULL);

  if (*assertions != NULL) {
    TclObjListFreeList((*assertions)->invariants);
  } else {
    *assertions = AssertionCreateStore();
  }
  (*assertions)->invariants = AssertionNewList(interp, arg);
}
#endif /* NSF_WITH_ASSERTIONS */




/***********************************************************************
 * Mixin support
 ***********************************************************************/

/*
 * push a mixin stack information on this object
 */
static void MixinStackPush(NsfObject *object)
  nonnull(1);

static void
MixinStackPush(NsfObject *object) {
  register NsfMixinStack *h = NEW(NsfMixinStack);

  nonnull_assert(object != NULL);

  h->currentCmdPtr = NULL;
  h->nextPtr = object->mixinStack;
  object->mixinStack = h;
  /*fprintf(stderr, "MixinStackPush %p %s\n", object, ObjectName(object));*/
}

/*
 * Pop a mixin stack information on this object.
 */
static void MixinStackPop(NsfObject *object)
  nonnull(1);

static void
MixinStackPop(NsfObject *object) {
  register const NsfMixinStack *h;

  nonnull_assert(object != NULL);

  /*fprintf(stderr, "MixinStackPop %p %s\n", object, ObjectName(object));*/
  h = object->mixinStack;
  object->mixinStack = h->nextPtr;
  FREE(NsfMixinStack, h);
}

/*
 * Appends NsfClasses (containing the mixin-classes and their
 * superclasses) to 'mixinClasses' list from a given mixinList.
 */
static void MixinComputeOrderFullList(
    Tcl_Interp *interp, NsfCmdList **mixinList,
    NsfClasses **mixinClasses,
    NsfClasses **checkList, int level
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static void
MixinComputeOrderFullList(
    Tcl_Interp *interp, NsfCmdList **mixinList,
    NsfClasses **mixinClasses,
    NsfClasses **checkList, int level
) {
  NsfCmdList *m;
  NsfClasses *pl, **clPtr = mixinClasses;

  nonnull_assert(interp != NULL);
  nonnull_assert(mixinList != NULL);
  nonnull_assert(mixinClasses != NULL);
  nonnull_assert(checkList != NULL);

  CmdListRemoveDeleted(mixinList, GuardDel);

  for (m = *mixinList; m != NULL; m = m->nextPtr) {
    NsfClass *mixinClass = NsfGetClassFromCmdPtr(m->cmdPtr);

    if (mixinClass != NULL) {
      for (pl = PrecedenceOrder(mixinClass); pl != NULL; pl = pl->nextPtr) {
        if (!IsRootClass(pl->cl)) {
          NsfClassOpt *opt = pl->cl->opt;

          /* fprintf(stderr, "find %p %s in checklist 1 %p\n",
             pl->cl, ClassName(pl->cl), *checkList);*/
          if (*checkList != NULL && (NsfClassListFind(*checkList, pl->cl) != NULL)) {
            /*fprintf(stderr, "+++ never add %s\n", ClassName(pl->cl));*/
          } else {
            if (opt != NULL && opt->classMixins != NULL) {
              /*
               * Compute transitively the (class) mixin-classes of this
               * added class.
               */
              NsfClassListAdd(checkList, pl->cl, NULL);
              /*fprintf(stderr, "+++ transitive %s\n", ClassName(pl->cl));*/
              MixinComputeOrderFullList(interp, &opt->classMixins, mixinClasses,
                                        checkList, level+1);
            }
            /*fprintf(stderr, "+++ add to mixinClasses %p path: %s clPtr %p\n",
              mixinClasses, ClassName(pl->cl), clPtr);*/
            clPtr = NsfClassListAddNoDup(clPtr, pl->cl, m->clientData);
          }
        }
      }
    }
  }

  if (level == 0 && *checkList) {
    NsfClassListFree(*checkList);
    *checkList = NULL;
  }
}

/*
 *----------------------------------------------------------------------
 * MixinResetOrder --
 *
 *      Free the mixin order of the provided object if it exists.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees potentially the mixinOrder list.
 *
 *----------------------------------------------------------------------
 */
static void MixinResetOrder(NsfObject *object)
  nonnull(1);

static void
MixinResetOrder(NsfObject *object) {

  nonnull_assert(object != NULL);

  CmdListFree(&object->mixinOrder, NULL /*GuardDel*/);
  object->mixinOrder = NULL;
}

/*
 *----------------------------------------------------------------------
 * NsfClassListAddPerClassMixins --
 *
 *      Append the class mixins to the provided list. CheckList is used
 *      to eliminate potential duplicates.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Appends potentially elements to classListPtr and checkList.
 *
 *----------------------------------------------------------------------
 */
static void NsfClassListAddPerClassMixins(Tcl_Interp *interp, NsfClass *class,
                              NsfClasses **classListPtr, NsfClasses **checkList)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static void
NsfClassListAddPerClassMixins(Tcl_Interp *interp, NsfClass *class,
                              NsfClasses **classListPtr, NsfClasses **checkList) {
  NsfClasses *pl;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(classListPtr != NULL);
  nonnull_assert(checkList != NULL);

  for (pl = PrecedenceOrder(class); pl != NULL; pl = pl->nextPtr) {
    NsfClassOpt *clopt = pl->cl->opt;
    if (clopt != NULL && clopt->classMixins) {
      MixinComputeOrderFullList(interp, &clopt->classMixins,
                                classListPtr, checkList, 1);
    }
  }
}

/*
 *----------------------------------------------------------------------
 * MixinComputeOrder --
 *
 *      Compute a duplicate-free linearized order of per-object and
 *      per-class mixins and the class inheritance. The precedence rule
 *      is that the last occurrence makes it into the final list.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      object->mixinOrder is updated.
 *
 *----------------------------------------------------------------------
 */
static void MixinComputeOrder(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

static void
MixinComputeOrder(Tcl_Interp *interp, NsfObject *object) {
  NsfClasses *fullList, *checkList = NULL, *mixinClasses = NULL, *clPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (object->mixinOrder != NULL) {
    MixinResetOrder(object);
  }

  /*
   * Append per-obj mixins.
   */
  if (object->opt != NULL) {
    NsfCmdList *m;

    MixinComputeOrderFullList(interp, &object->opt->objMixins, &mixinClasses,
                              &checkList, 1);
    /*
     * Add per-object mixins to checkList to avoid these classes in the
     * class mixins.
     *
     * TODO: we could add this already in MixinComputeOrderFullList() if we
     * provide an additional flag.
     */
    for (m = object->opt->objMixins; m != NULL; m = m->nextPtr) {
      NsfClass *mixinClass = NsfGetClassFromCmdPtr(m->cmdPtr);
      if (mixinClass != NULL) {
        NsfClassListAddNoDup(&checkList, mixinClass, NULL);
      }
    }
  }
  /*fprintf(stderr, "%s ", ObjectName(object));
  NsfClassListPrint("MixinComputeOrder poms", mixinClasses);
  NsfClassListPrint("MixinComputeOrder poms checkList", checkList);*/

  /*
   * Append per-class mixins.
   */
  NsfClassListAddPerClassMixins(interp, object->cl, &mixinClasses, &checkList);

  /*fprintf(stderr, "%s ", ObjectName(object));
  NsfClassListPrint("MixinComputeOrder poms+pcms", mixinClasses);
  CmdListPrint(interp, "mixinOrder", object->mixinOrder);*/

  if (checkList != NULL) {
    NsfClassListFree(checkList);
  }

  fullList = mixinClasses;

  /*
   * Don't add duplicates or classes of the precedence order to the resulting
   * list.
   */
  for (clPtr = mixinClasses; clPtr != NULL; clPtr = clPtr->nextPtr) {
    const NsfClass *class = clPtr->cl;
    NsfClasses     *checker;

    /*fprintf(stderr, "--- Work on %s\n", ClassName(cl));
      CmdListPrint(interp, "mixinOrder", object->mixinOrder);*/

    checker = NsfClassListFind(clPtr->nextPtr, class);

    /*
     * If checker is set, it is a duplicate and ignored.
     */
    if (checker == NULL) {
      /*
       * Check object->cl hierarchy
       */
      checker = NsfClassListFind(PrecedenceOrder(object->cl), class);
      /*
       * If checker is set, it was found in the class hierarchy and it is
       * ignored.
       */
    }
    if (checker == NULL) {
      /*
       * Add the class to the mixinOrder list.
       */
      NsfCmdList *new;

      /*fprintf(stderr, "--- adding to mixinOrder %s to cmdlist %p of object %s\n",
        ClassName(class), object->mixinOrder, ObjectName(object));*/
      new = CmdListAdd(&object->mixinOrder, class->object.id, NULL,
                       /*noDuplicates*/ NSF_FALSE, NSF_TRUE);
      /*CmdListPrint(interp, "mixinOrder", object->mixinOrder);*/

      /*
       * We require the first matching guard of the full list in the new
       * client data
       */
      checker = NsfClassListFind(fullList, class);
      if (checker != NULL) {
        new->clientData = checker->clientData;
      }
    }

  }

  /*
   * ... and free the memory of the full list.
   */
  if (fullList != NULL) {
    NsfClassListFree(fullList);
  }

  /*CmdListPrint(interp, "mixin order\n", obj->mixinOrder);*/
}


/*
 *----------------------------------------------------------------------
 * MixinAdd --
 *
 *      Add a mixinreg (mixin-class with a potential guard) provided as
 *      a Tcl_Obj* to 'mixinList' by appending it to the provided
 *      cmdList.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Potentially allocating cmd list elements added to the mixinList.
 *
 *----------------------------------------------------------------------
 */
static int MixinAdd(Tcl_Interp *interp, NsfCmdList **mixinList, Tcl_Obj *nameObj)
  nonnull(1) nonnull(2) nonnull(3);

static int
MixinAdd(Tcl_Interp *interp, NsfCmdList **mixinList, Tcl_Obj *nameObj) {
  int         result;

  nonnull_assert(interp != NULL);
  nonnull_assert(mixinList != NULL);
  nonnull_assert(nameObj != NULL);

  /*fprintf(stderr, "MixinAdd gets obj %p type %p %s\n",
    nameObj, nameObj->typePtr, ObjTypeStr(nameObj));*/

  /*
   * When the provided nameObj is of type NsfMixinregObjType, the nsf specific
   * converter was called already; otherwise call the converter here.
   */
  if (nameObj->typePtr != &NsfMixinregObjType
      && Tcl_ConvertToType(interp, nameObj, &NsfMixinregObjType) != TCL_OK
     ) {
    result = TCL_ERROR;

  } else {
    Tcl_Obj  *guardObj = NULL;
    NsfClass *mixinCl = NULL;

    result = NsfMixinregGet(interp, nameObj, &mixinCl, &guardObj);
    if (result == TCL_OK) {
      NsfCmdList *new;

      assert(mixinCl != NULL);
      assert(((unsigned int)Tcl_Command_flags(mixinCl->object.id) & CMD_IS_DELETED) == 0);

      new = CmdListAdd(mixinList, mixinCl->object.id, NULL,
                       /*noDuplicates*/ NSF_TRUE, NSF_TRUE);

      if (guardObj != NULL) {
        GuardAdd(new, guardObj);
      } else if (new->clientData != NULL) {
        GuardDel(new);
      }
    }
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * AppendMatchingElement --
 *
 *      Call AppendElement to the resultObj for values matching the specified
 *      pattern.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Appends element to the result object
 *
 *----------------------------------------------------------------------
 */
static void AppendMatchingElement(
    Tcl_Interp *interp, Tcl_Obj *resultObj, Tcl_Obj *nameObj, const char *pattern
) nonnull(1) nonnull(2) nonnull(3);

static void
AppendMatchingElement(
    Tcl_Interp *interp, Tcl_Obj *resultObj, Tcl_Obj *nameObj, const char *pattern
) {

  nonnull_assert(interp != NULL);
  nonnull_assert(resultObj != NULL);
  nonnull_assert(nameObj != NULL);

  if (pattern == NULL || Tcl_StringMatch( ObjStr(nameObj), pattern)) {
    Tcl_ListObjAppendElement(interp, resultObj, nameObj);
  }
}

/*
 *----------------------------------------------------------------------
 * AppendMatchingElementsFromCmdList --
 *
 *      Apply AppendMatchingElement() to all elements of the passed
 *      Cmdlist
 *
 * Results:
 *      NSF_TRUE iff a matching object was provided and it was found;
 *      NSF_FALSE otherwise
 *
 * Side effects:
 *      Appends elements to the result
 *
 *----------------------------------------------------------------------
 */
static bool AppendMatchingElementsFromCmdList(
    Tcl_Interp *interp, const NsfCmdList *cmdList,
    Tcl_Obj *resultObj,
    const char *pattern, NsfObject *matchObject
) nonnull(1) nonnull(2) nonnull(3);

static bool
AppendMatchingElementsFromCmdList(
    Tcl_Interp *interp, const NsfCmdList *cmdList,
    Tcl_Obj *resultObj,
    const char *pattern, NsfObject *matchObject
) {
  int success = NSF_FALSE;

  nonnull_assert(interp != NULL);
  nonnull_assert(cmdList != NULL);
  nonnull_assert(resultObj != NULL);

  do {
    NsfObject *object = NsfGetObjectFromCmdPtr(cmdList->cmdPtr);
    if (object != NULL) {
      if (matchObject == object) {
        return NSF_TRUE;
      } else {
        AppendMatchingElement(interp, resultObj, object->cmdName, pattern);
      }
    }
    cmdList = cmdList->nextPtr;
  } while (cmdList != NULL);

  return success;
}

/*
 *----------------------------------------------------------------------
 * AppendMatchingElementsFromClasses --
 *
 *      Apply AppendMatchingElement() to all elements of the passed
 *      class list
 *
 * Results:
 *      NSF_TRUE iff a matching object was provided and it was found;
 *      NSF_FALSE otherwise
 *
 * Side effects:
 *      Appends elements to the result
 *
 *----------------------------------------------------------------------
 */
static bool AppendMatchingElementsFromClasses(
    Tcl_Interp *interp, const NsfClasses *cls,
    const char *pattern, NsfObject *matchObject
) nonnull(1);

static bool
AppendMatchingElementsFromClasses(
    Tcl_Interp *interp, const NsfClasses *cls,
    const char *pattern, NsfObject *matchObject
) {
  Tcl_Obj *resultObj;

  nonnull_assert(interp != NULL);

  resultObj = Tcl_GetObjResult(interp);
  for ( ; cls != NULL; cls = cls->nextPtr) {
    NsfObject *object = (NsfObject *)cls->cl;

    if (object != NULL) {
      if (matchObject != NULL && object == matchObject) {
        /*
         * We have a matchObject and it is identical to obj,
         * just return true and don't continue search
         */
        return NSF_TRUE;
      } else {
        AppendMatchingElement(interp, resultObj, object->cmdName, pattern);
      }
    }
  }
  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * GetAllInstances --
 *
 *      Get all instances of a class recursively into an initialized
 *      String key hash-table.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Passed hash-table contains instances.
 *
 *----------------------------------------------------------------------
 */
static void
GetAllInstances(Tcl_Interp *interp, NsfCmdList **instances, NsfClass *startClass) {
  NsfClasses *clPtr, *subClasses;

  nonnull_assert(interp != NULL);
  nonnull_assert(instances != NULL);
  nonnull_assert(startClass != NULL);

  subClasses = TransitiveSubClasses(startClass);
  for (clPtr = subClasses; clPtr != NULL; clPtr = clPtr->nextPtr) {
    Tcl_HashTable *tablePtr = &clPtr->cl->instances;
    Tcl_HashSearch search;
    const Tcl_HashEntry *hPtr;

    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&search)) {
      NsfObject *inst = (NsfObject *)Tcl_GetHashKey(tablePtr, hPtr);
      Command *cmdPtr;

      assert(inst != NULL);

      if (unlikely((inst->flags & NSF_TCL_DELETE) != 0u)) {
        NsfLog(interp, NSF_LOG_NOTICE, "Object %s is apparently deleted", ObjectName(inst));
        continue;
      }

      cmdPtr = (Command *)inst->id;
      assert(cmdPtr != NULL);

      if (unlikely((cmdPtr->nsPtr->flags & NS_DYING) != 0u)) {
        NsfLog(interp, NSF_LOG_WARN, "Namespace of %s is apparently deleted", ObjectName_(inst));
        continue;
      }

#if defined(NSF_DEVELOPMENT_TEST)
      {
        /*
         * Make sure, we can still lookup the object; the object has to be still
         * alive.
         */
        NsfObject *object = GetObjectFromString(interp, ObjectName(inst));
        /*
         * HIDDEN OBJECTS: Provide a fallback to a pointer-based lookup. This is
         * needed because objects can be hidden or re-exposed under a different
         * name which is not reported back to the object system by the [interp
         * hide|expose] mechanism. However, we still want to process hidden and
         * re-exposed objects during cleanup like ordinary, exposed ones.
         */
        if (unlikely(object == NULL)) {
          object = GetHiddenObjectFromCmd(interp, inst->id);
        }
        assert(object != NULL);
      }
#endif

      /*fprintf (stderr, " -- %p flags %.6x activation %d %s id %p id->flags %.6x "
        "nsPtr->flags %.6x (instance of %s)\n",
        inst, inst->flags, inst->activationCount,
        ObjectName(inst), inst->id, cmdPtr->flags, (cmdPtr->nsPtr != NULL) ? cmdPtr->nsPtr->flags : 0,
        ClassName(clPtr->cl));*/

      CmdListAdd(instances, inst->id, (NsfClass *)inst,
                 NSF_FALSE, NSF_FALSE);
    }
  }

  if (subClasses != NULL) {
    NsfClassListFree(subClasses);
  }
}

/*
 *----------------------------------------------------------------------
 * AddToResultSet --
 *
 *      Helper function to add classes to the result set (implemented as
 *      a hash-table), flagging test for matchObject as result.
 *
 * Results:
 *      NSF_TRUE iff a matching object was provided and it was found;
 *      NSF_FALSE otherwise
 *
 * Side effects:
 *      Appends optionally element to the result object.
 *
 *----------------------------------------------------------------------
 */
static bool AddToResultSet(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, const NsfObject *object, int *isNewPtr,
    bool appendResult, const char *pattern, NsfObject *matchObject
) nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

static bool
AddToResultSet(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, const NsfObject *object, int *isNewPtr,
    bool appendResult, const char *pattern, NsfObject *matchObject
) {

  nonnull_assert(interp != NULL);
  nonnull_assert(destTablePtr != NULL);
  nonnull_assert(resultSet != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(isNewPtr != NULL);

  Tcl_CreateHashEntry(destTablePtr, (char *)object, isNewPtr);
  if (*isNewPtr != 0) {
    if (matchObject != NULL && matchObject == object) {
      return NSF_TRUE;
    }
    if (appendResult) {
      AppendMatchingElement(interp, resultSet, object->cmdName, pattern);
    }
  }
  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * AddToResultSetWithGuards --
 *
 *      Helper function to add classes with guards to the result set
 *      (implemented as a hash-table, full version as a Tcl list),
 *      flagging test for matchObject as result.
 *
 * Results:
 *      NSF_TRUE iff a matching object was provided and it was found;
 *      NSF_FALSE otherwise
 *
 * Side effects:
 *      Appends optionally element to the result object
 *
 *----------------------------------------------------------------------
 */
static bool AddToResultSetWithGuards(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, const NsfClass *class,
    ClientData clientData, int *isNewPtr, bool appendResult,
    const char *pattern, NsfObject *matchObject
) nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(6) nonnull(5);

static bool
AddToResultSetWithGuards(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, const NsfClass *class,
    ClientData clientData, int *isNewPtr, bool appendResult,
    const char *pattern, NsfObject *matchObject
) {
  bool result;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(destTablePtr != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(resultSet != NULL);
  nonnull_assert(isNewPtr != NULL);

  Tcl_CreateHashEntry(destTablePtr, (char *)class, isNewPtr);
  if (*isNewPtr != 0 && appendResult) {
    if (pattern == NULL || Tcl_StringMatch(ClassName_(class), pattern)) {
      Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
      Tcl_Obj *g       = (Tcl_Obj *)clientData;

      INCR_REF_COUNT(listObj);
      Tcl_ListObjAppendElement(interp, listObj, class->object.cmdName);
      Tcl_ListObjAppendElement(interp, listObj, NsfGlobalObjs[NSF_GUARD_OPTION]);
      Tcl_ListObjAppendElement(interp, listObj, g);
      Tcl_ListObjAppendElement(interp, resultSet, listObj);
      DECR_REF_COUNT(listObj);
    }
    result = (matchObject != NULL && matchObject == (NsfObject *)class);
  } else {
    result = NSF_FALSE;
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * GetAllObjectMixinsOf --
 *
 *      Computes a set of classes, into which this class was mixed in
 *      via per object mixin. The function gets recursively all per
 *      object mixins from a class and its subclasses/isClassMixinOf
 *      and adds it into an initialized object ptr hash-table
 *      (TCL_ONE_WORD_KEYS).
 *
 * Results:
 *      Boolean value indicating when done.
 *
 * Side effects:
 *      The set of classes is returned in the provided hash-table.
 *
 *----------------------------------------------------------------------
 */
static bool GetAllObjectMixinsOf(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, const NsfClass *startClass, bool isMixin,
    bool appendResult, const char *pattern, NsfObject *matchObject
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static bool
GetAllObjectMixinsOf(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, const NsfClass *startClass, bool isMixin,
    bool appendResult, const char *pattern, NsfObject *matchObject
) {
  int         isNew = 0;
  NsfClasses *sc;
  bool        done = NSF_FALSE;

  nonnull_assert(interp != NULL);
  nonnull_assert(destTablePtr != NULL);
  nonnull_assert(resultSet != NULL);
  nonnull_assert(startClass != NULL);

  /*fprintf(stderr, "startClass = %s, opt %p, isMixin %d, pattern '%s', matchObject %p\n",
    ClassName(startClass), startClass->opt, isMixin, pattern, matchObject);*/

  /*
   * check all subclasses of startCl for mixins
   */
  for (sc = startClass->sub; sc != NULL; sc = sc->nextPtr) {
    done = GetAllObjectMixinsOf(interp, destTablePtr, resultSet,
                              sc->cl, isMixin, appendResult,
                              pattern, matchObject);
    if (done) {
      return done;
    }
  }
  /*fprintf(stderr, "check subclasses of %s done\n", ClassName(startClass));*/

  if (startClass->opt != NULL) {
    NsfCmdList *m;

    /*
     * Check whether startCl has associated per-class mixins.
     */
    for (m = startClass->opt->isClassMixinOf; m != NULL; m = m->nextPtr) {
      NsfClass *class;

      /*
       * There should be no deleted commands in the list.
       */
      assert(((unsigned int)Tcl_Command_flags(m->cmdPtr) & CMD_IS_DELETED) == 0);

      class = NsfGetClassFromCmdPtr(m->cmdPtr);
      assert(class != NULL);
      /*fprintf(stderr, "check %s mixinof %s\n", ClassName(class), ClassName((startClass)));*/
      done = GetAllObjectMixinsOf(interp, destTablePtr, resultSet,
                                class, isMixin, appendResult,
                                pattern, matchObject);
      /* fprintf(stderr, "check %s mixinof %s done\n",
         ClassName(class), ClassName(startClass));*/
      if (done) {
        return done;
      }
    }

    /*
     * Check whether startCl has associated per-object mixins.
     */
    for (m = startClass->opt->isObjectMixinOf; m != NULL; m = m->nextPtr) {
      NsfObject *object;

      /*
       * There should not be deleted commands in the list.
       */
      assert(((unsigned int)Tcl_Command_flags(m->cmdPtr) & CMD_IS_DELETED) == 0);

      object = NsfGetObjectFromCmdPtr(m->cmdPtr);
      assert(object != NULL);

      done = AddToResultSet(interp, destTablePtr, resultSet,
                            object, &isNew, appendResult,
                            pattern, matchObject);
      if (done) {
        return done;
      }
    }
  }
  return done;
}

/*
 *----------------------------------------------------------------------
 * AddClassListEntriesToMixinsOfSet --
 *
 *      Helper function of GetAllClassMixinsOf(). Iterate over the
 *      provided class list (mixinOfs) and add every entry to the result
 *      set. If the entry is new, GetAllClassMixinsOf() is called
 *      recursively.
 *
 * Results:
 *      Boolean value indicating when done.
 *
 * Side effects:
 *      The set of classes is returned in the provided hash-table.
 *
 *----------------------------------------------------------------------
 */
static bool
AddClassListEntriesToMixinsOfSet(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, const NsfCmdList *mixinOfs,
    bool appendResult,
    const char *pattern, NsfObject *matchObject
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static bool GetAllClassMixinsOf(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, NsfClass *startClass,
    bool isPCM, bool appendResult,
    const char *pattern, NsfObject *matchObject
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static bool
AddClassListEntriesToMixinsOfSet(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, const NsfCmdList *mixinOfs,
    bool appendResult,
    const char *pattern, NsfObject *matchObject
) {
  const NsfCmdList *m;

  nonnull_assert(interp != NULL);
  nonnull_assert(destTablePtr != NULL);
  nonnull_assert(resultSet != NULL);
  nonnull_assert(mixinOfs != NULL);

  for (m = mixinOfs; m != NULL; m = m->nextPtr) {
    NsfClass *class;
    int       isNew;
    bool      done;

    /*
     * We must not have deleted commands in the list
     */
    assert(((unsigned int)Tcl_Command_flags(m->cmdPtr) & CMD_IS_DELETED) == 0);

    class = NsfGetClassFromCmdPtr(m->cmdPtr);
    assert(class != NULL);

    done = AddToResultSet(interp, destTablePtr, resultSet,
                        &class->object, &isNew,
                        appendResult, pattern, matchObject);
    if (done) {
      return done;
    }
    if (isNew != 0) {
      done = GetAllClassMixinsOf(interp, destTablePtr, resultSet, class,
                                 NSF_TRUE, appendResult, pattern, matchObject);
      if (done) {
        return done;
      }
    }
  }
  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * GetAllClassMixinsOf --
 *
 *      Computes a set of classes, into which this class was mixed in
 *      via as a class mixin. The function gets recursively all per
 *      class mixins from a class and its subclasses and adds it
 *      into an initialized object ptr hash-table (TCL_ONE_WORD_KEYS)
 *
 * Results:
 *      Boolean value indicating when done.
 *
 * Side effects:
 *      The set of classes is returned in the provided hash-table
 *
 *----------------------------------------------------------------------
 */

static bool
GetAllClassMixinsOf(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultSet, NsfClass *startClass,
    bool isPCM, bool appendResult,
    const char *pattern, NsfObject *matchObject
) {
  NsfClasses *sc;
  int         isNew = 0;
  bool        done = NSF_FALSE;

  nonnull_assert(interp != NULL);
  nonnull_assert(destTablePtr != NULL);
  nonnull_assert(resultSet != NULL);
  nonnull_assert(startClass != NULL);

  /*fprintf(stderr, "GetAllClassMixinsOf startClass = %p %s, opt %p, isPCM %d\n",
    startClass, ClassName(startClass), startClass->opt, isPCM);*/

  /*
   * If the startClass is a per class mixin, add it to the result set
   */
  if (isPCM) {
    done = AddToResultSet(interp, destTablePtr, resultSet,
                        &startClass->object, &isNew,
                        appendResult, pattern, matchObject);
    if (done) {
      return done;
    }

    /*
     * check all subclasses of startClass for mixins
     */
    for (sc = startClass->sub; sc != NULL; sc = sc->nextPtr) {
#if !defined(NDEBUG)
      if (sc->cl == startClass) {
        /*
         * Sanity check: it seems that we can create via
         *  __default_superclass a class which has itself as subclass!
         */
        fprintf(stderr, "... STRANGE %p is subclass of %p %s, sub %p\n",
                (void *)sc->cl, (void *)startClass, ClassName_(startClass),
                (void *)startClass->sub);
        continue;
      }
#endif
      assert(sc->cl != startClass);
      done = GetAllClassMixinsOf(interp, destTablePtr, resultSet,
                               sc->cl, isPCM,
                               appendResult, pattern, matchObject);
      if (done) {
        return done;
      }
    }
  }

  /*
   * Check whether "startClass" has a subclass which is a per-class mixin of some other
   * class(es)
   */
  {
    NsfClasses *subClasses = TransitiveSubClasses(startClass), *subClass;

    for (subClass = subClasses; subClass; subClass = subClass->nextPtr) {
      const NsfClass *subSubClass = subClass->cl;

      /*fprintf(stderr, "... check subclass = %p %s, opt %p, isPCM %d\n",
        subSubClass, ClassName(subSubClass), subSubClass->opt, isPCM);*/

      if (subSubClass->opt != NULL && subSubClass->opt->isClassMixinOf) {
        done = AddClassListEntriesToMixinsOfSet(interp, destTablePtr, resultSet,
                                                subSubClass->opt->isClassMixinOf,
                                                appendResult, pattern, matchObject);
        if (done) {
          goto subclassExit;
        }
      }
    }

  subclassExit:
    if (subClasses != NULL) {
      NsfClassListFree(subClasses);
    }
    if (done) {
      return done;
    }
  }

  /*
   * Check whether "startClass" is a per-class mixin of some other classes.
   */
  if (startClass->opt != NULL && startClass->opt->isClassMixinOf) {
    done = AddClassListEntriesToMixinsOfSet(interp, destTablePtr, resultSet,
                                            startClass->opt->isClassMixinOf,
                                            appendResult, pattern, matchObject);
  }

  return done;
}

/*
 *----------------------------------------------------------------------
 * GetAllClassMixins --
 *
 *      Computes a set class-mixins of a given class and handles
 *      transitive cases. The classes are added it into an initialized
 *      object ptr hash-table (TCL_ONE_WORD_KEYS)
 *
 * Results:
 *      Boolean value indicating when done.
 *
 * Side effects:
 *      The set of classes is returned in the provided hash-table
 *
 *----------------------------------------------------------------------
 */

static bool GetAllClassMixins(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultObj, const NsfClass *startClass,
    bool withGuards, const char *pattern, NsfObject *matchObject
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static bool
GetAllClassMixins(
    Tcl_Interp *interp, Tcl_HashTable *destTablePtr,
    Tcl_Obj *resultObj, const NsfClass *startClass,
    bool withGuards, const char *pattern, NsfObject *matchObject
) {
  int         isNew = 0;
  NsfClass   *class;
  NsfClasses *sc;
  bool        done = NSF_FALSE;

  nonnull_assert(interp != NULL);
  nonnull_assert(destTablePtr != NULL);
  nonnull_assert(resultObj != NULL);
  nonnull_assert(startClass != NULL);

  /*
   * check this class for class mixins.
   */
  if (startClass->opt != NULL) {
    NsfCmdList *m;

    for (m = startClass->opt->classMixins; m != NULL; m = m->nextPtr) {

      /*
       * Make sure, there are no deleted commands in the list.
       */
      assert(((unsigned int)Tcl_Command_flags(m->cmdPtr) & CMD_IS_DELETED) == 0);

      class = NsfGetClassFromCmdPtr(m->cmdPtr);
      assert(class != NULL);

      /* fprintf(stderr, "class mixin found: %s\n", ClassName(class)); */

      if (withGuards && (m->clientData)) {
        /* fprintf(stderr, "AddToResultSetWithGuards: %s\n", ClassName(class)); */
        done = AddToResultSetWithGuards(interp, destTablePtr, resultObj,
                                        class, m->clientData, &isNew,
                                        NSF_TRUE, pattern, matchObject);
      } else {
        /* fprintf(stderr, "AddToResultSet: %s\n", ClassName(class)); */
        done = AddToResultSet(interp, destTablePtr, resultObj,
                              &class->object, &isNew,
                              NSF_TRUE, pattern, matchObject);
      }
      if (done) {
        return done;
      }

      if (isNew != 0) {
        /* fprintf(stderr, "class mixin GetAllClassMixins for: %s (%s)\n",
           ClassName(class), ClassName(startClass)); */
        done = GetAllClassMixins(interp, destTablePtr, resultObj,
                               class, withGuards,
                               pattern, matchObject);
        if (done) {
          return done;
        }
      }
    }
  }


  /*
   * Check all superClasses of startCl for class mixins.
   */
  for (sc = startClass->super; sc != NULL; sc = sc->nextPtr) {
    /* fprintf(stderr, "Superclass GetAllClassMixins for %s (%s)\n",
       ClassName(sc->cl), ClassName(startClass)); */
    done = GetAllClassMixins(interp, destTablePtr, resultObj,
                             sc->cl, withGuards,
                             pattern, matchObject);
    if (done) {
      return done;
    }
  }
  return done;
}

/*
 *----------------------------------------------------------------------
 * RemoveFromClassMixinsOf --
 *
 *      Remove the class (provided as a cmd) from all isClassMixinOf
 *      definitions from the provided classes (provided as cmdlist).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletes potentially some entries in the isClassMixinOf lists.
 *
 *----------------------------------------------------------------------
 */

static void RemoveFromClassMixinsOf(Tcl_Command cmd, NsfCmdList *cmdList)
  nonnull(1) nonnull(2);

static void
RemoveFromClassMixinsOf(Tcl_Command cmd, NsfCmdList *cmdList) {

  nonnull_assert(cmd != NULL);
  nonnull_assert(cmdList != NULL);

  do {
    const NsfClass    *class = NsfGetClassFromCmdPtr(cmdList->cmdPtr);
    NsfClassOpt *nclopt = (class != NULL) ? class->opt : NULL;
    if (nclopt != NULL) {
      NsfCmdList *del = CmdListFindCmdInList(cmd, nclopt->isClassMixinOf);
      if (del != NULL) {
        /* fprintf(stderr, "Removing class %s from isClassMixinOf of class %s\n",
           ClassName(cl), ObjStr(NsfGetClassFromCmdPtr(cmdList->cmdPtr)->object.cmdName)); */
        del = CmdListRemoveFromList(&nclopt->isClassMixinOf, del);
        CmdListDeleteCmdListEntry(del, GuardDel);
      }
    }
    cmdList = cmdList->nextPtr;
  } while (cmdList != NULL);
}

/*
 *----------------------------------------------------------------------
 * RemoveFromObjectMixinsOf --
 *
 *      Remove the class (provided as a cmd) from all isObjectMixinOf
 *      definitions from the provided classes (provided as cmdList).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletes potentially some entries in the isObjectMixinOf lists.
 *
 *----------------------------------------------------------------------
 */

static void RemoveFromObjectMixinsOf(Tcl_Command cmd, NsfCmdList *cmdList)
  nonnull(1) nonnull(2);

static void
RemoveFromObjectMixinsOf(Tcl_Command cmd, NsfCmdList *cmdList) {

  nonnull_assert(cmd != NULL);
  nonnull_assert(cmdList != NULL);

  do {
    const NsfClass *class = NsfGetClassFromCmdPtr(cmdList->cmdPtr);
    NsfClassOpt    *clopt = (class != NULL) ? class->opt : NULL;

    if (clopt != NULL) {
      NsfCmdList *del = CmdListFindCmdInList(cmd, clopt->isObjectMixinOf);

      if (del != NULL) {
        /* fprintf(stderr, "Removing object %s from isObjectMixinOf of Class %s\n",
           ObjectName(object), ObjStr(NsfGetClassFromCmdPtr(cmdList->cmdPtr)->object.cmdName)); */
        del = CmdListRemoveFromList(&clopt->isObjectMixinOf, del);
        CmdListDeleteCmdListEntry(del, GuardDel);
      }
    } /* else fprintf(stderr, "CleanupDestroyObject %s: NULL pointer in mixins!\n", ObjectName(object)); */
    cmdList = cmdList->nextPtr;
  } while(likely(cmdList != NULL));
}

/*
 *----------------------------------------------------------------------
 * RemoveFromClassmixins --
 *
 *      Remove the class (provided as a cmd) from all class mixins lists
 *      from the provided classes (provided as cmdList).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletes potentially some entries in the class mixins lists.
 *
 *----------------------------------------------------------------------
 */

static void RemoveFromClassmixins(Tcl_Command cmd, NsfCmdList *cmdList)
  nonnull(1) nonnull(2);

static void
RemoveFromClassmixins(Tcl_Command cmd, NsfCmdList *cmdList) {

  nonnull_assert(cmd != NULL);
  nonnull_assert(cmdList != NULL);

  do {
    NsfClass    *class = NsfGetClassFromCmdPtr(cmdList->cmdPtr);
    NsfClassOpt *clopt = (class != NULL) ? class->opt : NULL;

    if (clopt != NULL) {
      NsfCmdList *del = CmdListFindCmdInList(cmd, clopt->classMixins);

      if (del != NULL) {
        /* fprintf(stderr, "Removing class %s from mixins of object %s\n",
           ClassName(class), ObjStr(NsfGetObjectFromCmdPtr(cmdList->cmdPtr)->cmdName)); */
        del = CmdListRemoveFromList(&clopt->classMixins, del);
        CmdListDeleteCmdListEntry(del, GuardDel);
        if (class->object.mixinOrder != NULL) {
          MixinResetOrder(&class->object);
        }
      }
    }
    cmdList = cmdList->nextPtr;
  } while (likely(cmdList != NULL));
}

/*
 *----------------------------------------------------------------------
 * RemoveFromObjectMixins --
 *
 *      Remove the class (provided as a cmd) from all object mixin lists
 *      from the provided classes (provided as cmdList).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletes potentially some entries in the object mixins lists.
 *
 *----------------------------------------------------------------------
 */
static void RemoveFromObjectMixins(Tcl_Command cmd, NsfCmdList *cmdList)
  nonnull(1) nonnull(2);

static void
RemoveFromObjectMixins(Tcl_Command cmd, NsfCmdList *cmdList) {

  nonnull_assert(cmd != NULL);
  nonnull_assert(cmdList != NULL);

  do {
    NsfObject    *object = NsfGetObjectFromCmdPtr(cmdList->cmdPtr);
    NsfObjectOpt *objopt = (object != 0) ? object->opt : NULL;

    if (objopt != NULL) {
      NsfCmdList *del = CmdListFindCmdInList(cmd, objopt->objMixins);

      if (del != NULL) {
        /* fprintf(stderr, "Removing class %s from mixins of object %s\n",
           ClassName(del->clorobj), ObjStr(NsfGetObjectFromCmdPtr(cmdList->cmdPtr)->cmdName)); */
        del = CmdListRemoveFromList(&objopt->objMixins, del);
        CmdListDeleteCmdListEntry(del, GuardDel);
        if (object->mixinOrder != NULL) {
          MixinResetOrder(object);
        }
      }
    }
    cmdList = cmdList->nextPtr;
  } while (likely(cmdList != NULL));
}


/*
 *----------------------------------------------------------------------
 * ResetOrderOfObjectsUsingThisClassAsObjectMixin --
 *
 *      Reset the per-object mixin order for all objects having this
 *      class as per-object mixin.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletes potentially the mixin list for the objects.
 *
 *----------------------------------------------------------------------
 */
static void ResetOrderOfObjectsUsingThisClassAsObjectMixin(const NsfClass *class)
  nonnull(1);

static void
ResetOrderOfObjectsUsingThisClassAsObjectMixin(const NsfClass *class) {

  /*fprintf(stderr, "ResetOrderOfObjectsUsingThisClassAsObjectMixin %s - %p\n",
    ClassName(class), class->opt);*/

  nonnull_assert(class != NULL);

  if (class->opt != NULL) {
    const NsfCmdList *ml;

    for (ml = class->opt->isObjectMixinOf; ml != NULL; ml = ml->nextPtr) {
      NsfObject *object = NsfGetObjectFromCmdPtr(ml->cmdPtr);

      if (object != NULL) {
        if (object->mixinOrder != NULL) {
          MixinResetOrder(object);
        }
        object->flags &= ~NSF_MIXIN_ORDER_VALID;
      }
    }
  }
}

/*
 *----------------------------------------------------------------------
 * MixinInvalidateObjOrders --
 *
 *      Reset mixin order for all instances of the class and the
 *      instances of its dependent subclasses. This function is
 *      typically called, when the class hierarchy or the class
 *      mixins have changed and invalidate mixin entries in all
 *      dependent instances.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletes potentially the mixin list for the objects and classes.
 *
 *----------------------------------------------------------------------
 */

static void MixinInvalidateObjOrders(NsfClasses *subClasses)
  nonnull(1);

static void
MixinInvalidateObjOrders(NsfClasses *subClasses) {

  nonnull_assert(subClasses != NULL);

  /*
   * Iterate over the subclass hierarchy.
   */
  do {
    Tcl_HashSearch       hSrch;
    const Tcl_HashEntry *hPtr;
    Tcl_HashTable       *instanceTablePtr;

    /*
     * Reset mixin order for all objects having this class as per object mixin
     */
    ResetOrderOfObjectsUsingThisClassAsObjectMixin(subClasses->cl);

    if (subClasses->cl->parsedParamPtr != NULL) {
      ParsedParamFree(subClasses->cl->parsedParamPtr);
      subClasses->cl->parsedParamPtr = NULL;
    }

    instanceTablePtr = &subClasses->cl->instances;
    for (hPtr = Tcl_FirstHashEntry(instanceTablePtr, &hSrch);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&hSrch)) {
      NsfObject *object = (NsfObject *)Tcl_GetHashKey(instanceTablePtr, hPtr);

      assert(object != NULL);

      if (likely((object->flags & NSF_DURING_DELETE) == 0u)
          && ((object->flags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) != 0u)
          ) {
        MixinResetOrder(object);
        object->flags &= ~NSF_MIXIN_ORDER_VALID;
      }
    }
    subClasses = subClasses->nextPtr;
  } while (subClasses != NULL);

}

/*
 *----------------------------------------------------------------------
 * MixinComputeDefined --
 *
 *      This function computes the mixin order for the provided object
 *      and adjusts the mixin flags accordingly. The mixin order is
 *      either
 *
 *         DEFINED (there are mixins on the instance),
 *         NONE    (there are no mixins for the instance),
 *         or INVALID (a class restructuring has occurred.
 *                 It is not clear whether mixins are defined or not).
 *
 *      If the mixin order is INVALID, MixinComputeDefined can be used
 *      to compute the order and set the instance to DEFINED or NONE.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Might alter the mixin order.
 *
 *----------------------------------------------------------------------
 */
static void
MixinComputeDefined(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  MixinComputeOrder(interp, object);
  object->flags |= NSF_MIXIN_ORDER_VALID;
  if (object->mixinOrder != NULL) {
    object->flags |= NSF_MIXIN_ORDER_DEFINED;
  } else {
    object->flags &= ~NSF_MIXIN_ORDER_DEFINED;
  }
}

/*
 *----------------------------------------------------------------------
 * ComputePrecedenceList --
 *
 *      Returns the precedence list for the provided object.  The
 *      precedence list can optionally include the mixins and the
 *      root-class. If pattern is provided, this is used as well for
 *      filtering. The caller has to free the resulting list via
 *      NsfClassListFree();
 *
 * Results:
 *      Precedence list in form of a class list, potentially NULL due to
 *      filtering.
 *
 * Side effects:
 *      Allocated class list.
 *
 *----------------------------------------------------------------------
 */

static NsfClasses *ComputePrecedenceList(Tcl_Interp *interp, NsfObject *object,
                                         const char *pattern,
                                         bool withMixins, bool withRootClass)
  nonnull(1) nonnull(2);

static NsfClasses *
ComputePrecedenceList(Tcl_Interp *interp, NsfObject *object,
                      const char *pattern,
                      bool withMixins, bool withRootClass) {
  NsfClasses *precedenceList = NULL, *pcl, **npl = &precedenceList;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (withMixins) {
    if ((object->flags & NSF_MIXIN_ORDER_VALID) == 0u) {
      MixinComputeDefined(interp, object);
    }
    if ((object->flags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) != 0u) {
      NsfCmdList *ml;

      for (ml = object->mixinOrder; ml; ml = ml->nextPtr) {
        NsfClass *mixin = NsfGetClassFromCmdPtr(ml->cmdPtr);

        if ((pattern != NULL)
            && (mixin != NULL)
            && !Tcl_StringMatch(ClassName(mixin), pattern)) {
          continue;
        }
        npl = NsfClassListAdd(npl, mixin, NULL);
      }
    }
  }

  pcl = PrecedenceOrder(object->cl);
  for (; pcl != NULL; pcl = pcl->nextPtr) {
    if (!withRootClass && IsRootClass(pcl->cl)) {
      continue;
    }
    if (pattern != NULL && !Tcl_StringMatch(ClassName(pcl->cl), pattern)) {
      continue;
    }
    npl = NsfClassListAdd(npl, pcl->cl, NULL);
  }
  return precedenceList;
}

/*
 *----------------------------------------------------------------------
 * SeekCurrent --
 *
 *      Walk through the command list until the provided command is
 *      reached.  return the next entry. If the provided cmd is NULL,
 *      then return the first entry.
 *
 * Results:
 *      Command list pointer or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfCmdList *SeekCurrent(const Tcl_Command cmd, register NsfCmdList *cmdListPtr)
  nonnull(2) NSF_pure;

static NsfCmdList *
SeekCurrent(const Tcl_Command cmd, register NsfCmdList *cmdListPtr) {

  nonnull_assert(cmdListPtr != NULL);

  if (cmd != NULL) {
    do {
      if (cmdListPtr->cmdPtr == cmd) {
        return cmdListPtr->nextPtr;
      }
      cmdListPtr = cmdListPtr->nextPtr;
    } while  likely(cmdListPtr != NULL);

    return NULL;
  }
  return cmdListPtr;
}

/*
 *----------------------------------------------------------------------
 * CanInvokeMixinMethod --
 *
 *      Check, whether the provided cmd is allowed to be dispatch in a
 *      mixin.
 *
 * Results:
 *      A standard Tcl result or NSF_CHECK_FAILED in case, search should
 *      continue.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int CanInvokeMixinMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Command cmd, NsfCmdList *cmdList)
  nonnull(1) nonnull(2) nonnull(4);

static int
CanInvokeMixinMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Command cmd, NsfCmdList *cmdList) {
  int result = TCL_OK;
  unsigned int cmdFlags = (unsigned int)Tcl_Command_flags(cmd);

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(cmdList != NULL);

  if ((cmdFlags & NSF_CMD_CALL_PRIVATE_METHOD) != 0u ||
      ((cmdFlags & NSF_CMD_CLASS_ONLY_METHOD) != 0u && !NsfObjectIsClass(object))) {
    /*
     * The command is not applicable for objects (i.e. might crash,
     * since it expects a class record); therefore, skip it
     */
    return NSF_CHECK_FAILED;
  }

  if ((cmdList->clientData != NULL) && !RUNTIME_STATE(interp)->guardCount) {
    /*fprintf(stderr, "guard call\n");*/
    result = GuardCall(object, interp, (Tcl_Obj *)cmdList->clientData, NULL);
  }

  return result;
}


/*
 *----------------------------------------------------------------------
 * MixinSearchProc --
 *
 *      Search for a method name in the mixin list of the provided
 *      object. Depending on the state of the mixin stack, the search
 *      starts at the beginning or at the last dispatched, shadowed
 *      method on the mixin path.
 *
 * Results:
 *      A standard Tcl result.
 *      Returns as well always cmd (maybe NULL) in cmdPtr.
 *      Returns on success as well the class and the currentCmdPointer
 *      for continuation in next.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int MixinSearchProc(
    Tcl_Interp *interp, NsfObject *object,
    const char *methodName,
    NsfClass **classPtr, Tcl_Command *currentCmdPtr, Tcl_Command *cmdPtr
) nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5) nonnull(6);

static int
MixinSearchProc(
    Tcl_Interp *interp, NsfObject *object,
    const char *methodName,
    NsfClass **classPtr, Tcl_Command *currentCmdPtr, Tcl_Command *cmdPtr
) {
  Tcl_Command cmd = NULL;
  NsfCmdList *cmdList;
  NsfClass   *class = NULL;
  int         result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(classPtr != NULL);
  nonnull_assert(currentCmdPtr != NULL);
  nonnull_assert(cmdPtr != NULL);

  assert(object->mixinStack != NULL);

  /*
   * Ensure that the mixin order is valid.
   */
  assert((object->flags & NSF_MIXIN_ORDER_VALID) != 0u);

  if (object->mixinOrder == NULL) {
    return TCL_OK;
  }

  cmdList = SeekCurrent(object->mixinStack->currentCmdPtr, object->mixinOrder);
  RUNTIME_STATE(interp)->currentMixinCmdPtr = (cmdList != NULL) ? cmdList->cmdPtr : NULL;

  /*fprintf(stderr, "searching for '%s' in %p\n", methodName, cmdList);
  CmdListPrint(interp, "MixinSearch CL = \n", cmdList);*/

  if (unlikely((*classPtr != NULL) && (*cmdPtr != NULL))) {
    Tcl_Command lastCmdPtr = NULL;

    /*fprintf(stderr, "... new branch\n");*/

    for (; cmdList != NULL; cmdList = cmdList->nextPtr) {
      NsfClass *class1;

      /*
       * Ignore deleted commands
       */
      if (((unsigned int)Tcl_Command_flags(cmdList->cmdPtr) & CMD_IS_DELETED) != 0u) {
        continue;
      }

      class1 = NsfGetClassFromCmdPtr(cmdList->cmdPtr);
      assert(class1 != NULL);
      lastCmdPtr = cmdList->cmdPtr;

      if (class1 == *classPtr) {
        /*
         * The wanted class was found. Check guards and permissions to
         * determine whether we can invoke this method.
         */
        result = CanInvokeMixinMethod(interp, object, *cmdPtr, cmdList);

        if (likely(result == TCL_OK)) {
          class = class1;
        } else if (result == NSF_CHECK_FAILED) {
          result = TCL_OK;
        }
        /*
         * No matter, what the result is, stop the search through the mixin
         * classes here.
         */
        break;
      }
    }

    if (class != NULL) {
      assert(cmdList != NULL);
      /*
       * On success: return class and cmdList->cmdPtr;
       */
      *currentCmdPtr = cmdList->cmdPtr;
      /*fprintf(stderr, "... mixinsearch success returns %p (class %s)\n", cmd, ClassName(class));*/

    } else {
      /*
       * We did not find the absolute entry in the mixins.  Set the
       * currentCmdPtr (on the mixin stack) to the last entry to flag, that
       * the mixin list should not started again on a next.
       */
      *cmdPtr = NULL;
      *currentCmdPtr = lastCmdPtr;
      /*fprintf(stderr, "... mixinsearch success failure %p (class %s)\n", cmd, ClassName(class));*/
    }

    return result;

  } else {

    for (; cmdList; cmdList = cmdList->nextPtr) {
      /*
       * Ignore deleted commands
       */
      if (((unsigned int)Tcl_Command_flags(cmdList->cmdPtr) & CMD_IS_DELETED) != 0u) {
        continue;
      }
      class = NsfGetClassFromCmdPtr(cmdList->cmdPtr);
      assert(class != NULL);
      /*
        fprintf(stderr, "+++ MixinSearch %s->%s in %p cmdPtr %p clientData %p\n",
        ObjectName(object), methodName, cmdList,
        cmdList->cmdPtr, cmdList->clientData);
      */
      cmd = FindMethod(class->nsPtr, methodName);
      if (cmd == NULL) {
        continue;
      }

      result = CanInvokeMixinMethod(interp, object, cmd, cmdList);

      if (unlikely(result == TCL_ERROR)) {
        return result;
      } else if (result == NSF_CHECK_FAILED) {
        result = TCL_OK;
        cmd = NULL;
        continue;
      }

      /*
       * cmd was found and is applicable. We return class and cmdPtr.
       */
      *classPtr = class;
      *currentCmdPtr = cmdList->cmdPtr;
      /*fprintf(stderr, "mixinsearch returns %p (cl %s)\n", cmd, ClassName(class));*/
      break;
    }

  }
  *cmdPtr = cmd;
  return result;
}

/*
 * info option for mixins and class mixins
 */
static int MixinInfo(
    Tcl_Interp *interp, const NsfCmdList *m, const char *pattern,
    bool withGuards, const NsfObject *matchObject
) nonnull(1);

static int
MixinInfo(
    Tcl_Interp *interp, const NsfCmdList *m, const char *pattern,
    bool withGuards, const NsfObject *matchObject
) {
  Tcl_Obj *list = Tcl_NewListObj(0, NULL);

  nonnull_assert(interp != NULL);

  /*fprintf(stderr, "   mixin info m=%p, pattern %s, matchObject %p\n",
    m, pattern, matchObject);*/

  while (m != NULL) {
    const NsfClass *mixinClass = NsfGetClassFromCmdPtr(m->cmdPtr);

    /* fprintf(stderr, "   mixin info m=%p, next=%p, pattern %s, matchObject %p\n",
       m, m->next, pattern, matchObject);*/

    if (mixinClass != NULL &&
        (pattern == NULL
         || (matchObject != NULL && &(mixinClass->object) == matchObject)
         || (matchObject == NULL && Tcl_StringMatch(ObjStr(mixinClass->object.cmdName), pattern)))) {
      if (withGuards && (m->clientData != NULL)) {
        Tcl_Obj *l = Tcl_NewListObj(0, NULL);
        Tcl_Obj *g = (Tcl_Obj *) m->clientData;

        Tcl_ListObjAppendElement(interp, l, mixinClass->object.cmdName);
        Tcl_ListObjAppendElement(interp, l, NsfGlobalObjs[NSF_GUARD_OPTION]);
        Tcl_ListObjAppendElement(interp, l, g);
        Tcl_ListObjAppendElement(interp, list, l);
      } else {
        Tcl_ListObjAppendElement(interp, list, mixinClass->object.cmdName);
      }
      if (matchObject != NULL) {
        break;
      }
    }
    m = m->nextPtr;
  }

  Tcl_SetObjResult(interp, list);
  return TCL_OK;
}

/*
 * info option for mixinofs and isClassMixinOf
 */

static Tcl_Command MixinSearchMethodByName(NsfCmdList *mixinList, const char *name, NsfClass **classPtr)
  nonnull(1) nonnull(2) nonnull(3);

static Tcl_Command
MixinSearchMethodByName(NsfCmdList *mixinList, const char *name, NsfClass **classPtr) {
  Tcl_Command cmd;

  nonnull_assert(mixinList != NULL);
  nonnull_assert(name != NULL);
  nonnull_assert(classPtr != NULL);

  do {
    NsfClass *foundClass = NsfGetClassFromCmdPtr(mixinList->cmdPtr);

    if ((foundClass != NULL) && SearchCMethod(foundClass, name, &cmd)) {
      *classPtr = foundClass;
      return cmd;
    }
    mixinList = mixinList->nextPtr;
  } while (mixinList != NULL);

  return NULL;
}


/*
 *      Filter-Commands
 */

/*
 * The search method implements filter search order for object and
 * class filter: first a given name is interpreted as fully qualified
 * method name. If no method is found, a proc is searched with fully
 * name. Otherwise the simple name is searched on the heritage order:
 * object (only for per-object filters), class, metaclass
 */

static Tcl_Command FilterSearch(const char *name, NsfObject *startingObject,
             NsfClass *startingClass, NsfClass **classPtr)
  nonnull(1) nonnull(4);

static Tcl_Command
FilterSearch(const char *name, NsfObject *startingObject,
             NsfClass *startingClass, NsfClass **classPtr) {
  Tcl_Command cmd = NULL;

  nonnull_assert(name != NULL);
  nonnull_assert(classPtr != NULL);

  if (startingObject != NULL) {
    NsfObjectOpt *opt = startingObject->opt;
    /*
     * the object-specific filter can also be defined on the object's
     * class, its hierarchy, or the respective class mixins; thus use the
     * object's class as start point for the class-specific search then ...
     */
    startingClass = startingObject->cl;

    /*
     * search for filters on object mixins
     */
    if (opt != NULL
        && opt->objMixins != NULL
        && (cmd = MixinSearchMethodByName(opt->objMixins, name, classPtr))
       ) {
      return cmd;
    }
  }

  /*
   * Search for class filters on class mixins
   */
  if (startingClass != NULL) {
    NsfClassOpt *opt = startingClass->opt;
    if (opt != NULL && opt->classMixins != NULL) {
      if ((cmd = MixinSearchMethodByName(opt->classMixins, name, classPtr))) {
        return cmd;
      }
    }
  }

  /*
   * Search for object procs that are used as filters
   */
  if ((startingObject != NULL) && (startingObject->nsPtr != NULL)) {
    /*fprintf(stderr, "search filter %s as proc \n", name);*/
    if ((cmd = FindMethod(startingObject->nsPtr, name))) {
      *classPtr = (NsfClass *)startingObject;
      return cmd;
    }
  }

  /*
   * Ok, no filter on obj or mixins -> search class
   */
  if (startingClass != NULL) {
    *classPtr = SearchCMethod(startingClass, name, &cmd);
    if (*classPtr == NULL) {
      /*
       * If no filter is found yet -> search the metaclass
       */
      *classPtr = SearchCMethod(startingClass->object.cl, name, &cmd);
    }
  }
  return cmd;
}

/*
 * Filter Guards
 */

/*
 *----------------------------------------------------------------------
 * GuardCheck --
 *
 *      Check, a filter guard.
 *
 * Results:
 *      A standard Tcl result or NSF_CHECK_FAILED in case, search should
 *      continue.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int GuardCheck(Tcl_Interp *interp, Tcl_Obj *guardObj)
  nonnull(1) nonnull(2);

static int
GuardCheck(Tcl_Interp *interp, Tcl_Obj *guardObj) {
  NsfRuntimeState *rst;
  int              result;

  nonnull_assert(interp != NULL);
  nonnull_assert(guardObj != NULL);

  /*
   * if there are more than one filter guard for this filter
   * (i.e. they are inherited), then they are OR combined
   * -> if one check succeeds => return TCL_OK
   */

  /*fprintf(stderr, "checking guard **%s**\n", ObjStr(guardObj));*/
  rst = RUNTIME_STATE(interp);
  rst->guardCount++;
  result = CheckConditionInScope(interp, guardObj);
  rst->guardCount--;

  /*fprintf(stderr, "checking guard **%s** returned rc=%d\n", ObjStr(guardObj), rc);*/

  if (likely(result == TCL_OK)) {
    /* fprintf(stderr, " +++ OK\n"); */

  } else if (unlikely(result == TCL_ERROR)) {
    Tcl_Obj *sr = Tcl_GetObjResult(interp);

    INCR_REF_COUNT(sr);
    NsfPrintError(interp, "Guard error: '%s'\n%s", ObjStr(guardObj), ObjStr(sr));
    DECR_REF_COUNT(sr);

  } else {
    /*
      fprintf(stderr, " +++ FAILED\n");
    */
    result = NSF_CHECK_FAILED;
  }
  return result;
}

/*
  static void
  GuardPrint(Tcl_Interp *interp, ClientData clientData) {
  Tcl_Obj *guardObj = (Tcl_Obj *) clientData;
  fprintf(stderr, " +++ <GUARDS> \n");
  if (guardObj != NULL) {
  fprintf(stderr, "   *     %s \n", ObjStr(guardObj));
  }
  fprintf(stderr, " +++ </GUARDS>\n");
  }
*/

static void
GuardDel(NsfCmdList *guardList) {

  nonnull_assert(guardList != NULL);

  /*fprintf(stderr, "GuardDel %p clientData = %p\n",
    guardList, (guardList != NULL) ? guardList->clientData : NULL);*/

  if (guardList->clientData != NULL) {
    DECR_REF_COUNT2("guardObj", (Tcl_Obj *)guardList->clientData);
    guardList->clientData = NULL;
  }
}

NSF_INLINE static void
GuardAdd(NsfCmdList *guardList, Tcl_Obj *guardObj) {

  nonnull_assert(guardList != NULL);
  nonnull_assert(guardObj != NULL);

  GuardDel(guardList);
  if (strlen(ObjStr(guardObj)) > 0) {
    INCR_REF_COUNT2("guardObj", guardObj);
    guardList->clientData = guardObj;
    /*fprintf(stderr, "guard added to %p cmdPtr=%p, clientData= %p\n",
      guardList, guardList->cmdPtr, guardList->clientData);
    */
  }
}

static int
GuardCall(NsfObject *object, Tcl_Interp *interp, Tcl_Obj *guardObj, NsfCallStackContent *cscPtr) {
  int result = TCL_OK;
  Tcl_Obj *res = Tcl_GetObjResult(interp); /* save the result */
  CallFrame frame, *framePtr = &frame;

  nonnull_assert(object != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(guardObj != NULL);

  INCR_REF_COUNT(res);

  /*
   * For the guard push a fake call-frame on the Tcl stack so that
   * e.g. a "self calledproc" and other methods in the guard behave
   * like in the proc.
   */
  if (cscPtr != NULL) {
    Nsf_PushFrameCsc(interp, cscPtr, framePtr);
  } else {
    Nsf_PushFrameObj(interp, object, framePtr);
  }
  result = GuardCheck(interp, guardObj);

  if (cscPtr != NULL) {
    Nsf_PopFrameCsc(interp, framePtr);
  } else {
    Nsf_PopFrameObj(interp, framePtr);
  }

  if (result != TCL_ERROR) {
    Tcl_SetObjResult(interp, res);  /* restore the result */
  }

  DECR_REF_COUNT(res);
  return result;
}

/*
 *----------------------------------------------------------------------
 * GuardAddFromDefinitionList --
 *
 *      Add a guard to the specified destination list (first arg) from a
 *      list of definitions (last arg).  If the provided cmd is found in
 *      the list of definitions, it is added to the destination list if
 *      it has non-null client data.
 *
 * Results:
 *      Returns Boolean value depending on whether the cmd is part of the
 *      definition list.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool GuardAddFromDefinitionList(NsfCmdList *dest, Tcl_Command interceptorCmd,
                                      NsfCmdList *interceptorDefList)
  nonnull(1) nonnull(2) nonnull(3);

static bool
GuardAddFromDefinitionList(NsfCmdList *dest, Tcl_Command interceptorCmd,
                           NsfCmdList *interceptorDefList) {
  NsfCmdList *h;

  nonnull_assert(interceptorCmd != NULL);
  nonnull_assert(dest != NULL);
  nonnull_assert(interceptorDefList != NULL);

  h = CmdListFindCmdInList(interceptorCmd, interceptorDefList);
  if (h != NULL) {
    if (h->clientData != NULL) {
      GuardAdd(dest, (Tcl_Obj *) h->clientData);
    }
    return NSF_TRUE;
  }

  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * GuardAddInheritedGuards --
 *
 *      Add an inherited guards to the provided destination list.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Updates potentially destination list
 *
 *----------------------------------------------------------------------
 */
static void GuardAddInheritedGuards(Tcl_Interp *interp, NsfCmdList *dest,
                                    NsfObject *object, Tcl_Command filterCmd)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static void
GuardAddInheritedGuards(Tcl_Interp *interp, NsfCmdList *dest,
                        NsfObject *object, Tcl_Command filterCmd) {
  NsfClasses   *pl;
  bool          guardAdded = NSF_FALSE;
  NsfObjectOpt *opt;

  nonnull_assert(filterCmd != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(dest != NULL);
  nonnull_assert(object != NULL);

  /*
   * Search guards for class filters registered on mixins.
   */
  if (((object->flags & NSF_MIXIN_ORDER_VALID)) == 0u) {
    MixinComputeDefined(interp, object);
  }
  if ((object->flags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) != 0u) {
    NsfCmdList *ml;

    for (ml = object->mixinOrder; ml != NULL && !guardAdded; ml = ml->nextPtr) {
      NsfClass *mixin = NsfGetClassFromCmdPtr(ml->cmdPtr);

      if (mixin != NULL && mixin->opt != NULL && mixin->opt->classFilters != NULL) {
        guardAdded = GuardAddFromDefinitionList(dest, filterCmd, mixin->opt->classFilters);
      }
    }
  }

  /*
   * Search per-object filters.
   */
  opt = object->opt;
  if (!guardAdded && (opt != NULL) && (opt->objFilters != NULL)) {
    guardAdded = GuardAddFromDefinitionList(dest, filterCmd, opt->objFilters);
  }

  if (!guardAdded) {
    /*
     * Search per-class filters.
     */
    for (pl = PrecedenceOrder(object->cl); !guardAdded && (pl != NULL); pl = pl->nextPtr) {
      NsfClassOpt *clopt = pl->cl->opt;
      if (clopt != NULL && clopt->classFilters != NULL) {
        guardAdded = GuardAddFromDefinitionList(dest, filterCmd, clopt->classFilters);
      }
    }

    /*
     * if this is not a registered filter, it is an inherited filter, like:
     *   Class create A
     *   A method f ...
     *   Class create B -superclass A
     *   B method {{f {<guard>}}}
     *   B filter f
     * -> get the guard from the filter that inherits it (here B->f)
     */
    if (!guardAdded) {
      NsfCmdList *registeredFilter =
        CmdListFindNameInList(interp, (char *) Tcl_GetCommandName(interp, filterCmd),
                              object->filterOrder);
      if (registeredFilter && registeredFilter->clientData) {
        GuardAdd(dest, (Tcl_Obj *) registeredFilter->clientData);
      }
    }
  }
}

/*
 *----------------------------------------------------------------------
 * GuardList --
 *
 *      Set interp result to a named guard in the provided
 *      guardList. The variable "guardList" might be NULL.
 *
 * Results:
 *      Sets the interpreter's result object.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int GuardList(Tcl_Interp *interp, NsfCmdList *guardList, const char *interceptorName)
  nonnull(1) nonnull(3);

static int
GuardList(Tcl_Interp *interp, NsfCmdList *guardList, const char *interceptorName) {

  nonnull_assert(interp != NULL);
  nonnull_assert(interceptorName != NULL);

  if (guardList != NULL) {
    /*
     * Try to find simple name first.
     */
    NsfCmdList *h = CmdListFindNameInList(interp, interceptorName, guardList);
    if (h == NULL) {
      /*
       * Maybe it is a qualified name.
       */
      Tcl_Command cmd = NSFindCommand(interp, interceptorName);
      if (cmd != NULL) {
        h = CmdListFindCmdInList(cmd, guardList);
      }
    }
    if (h != NULL) {
      Tcl_ResetResult(interp);
      if (h->clientData != NULL) {
        Tcl_Obj *g = (Tcl_Obj *) h->clientData;
        Tcl_SetObjResult(interp, g);
      }
      return TCL_OK;
    }
  }
  return NsfPrintError(interp, "info guard: can't find filter/mixin %s", interceptorName);
}

/*
 *----------------------------------------------------------------------
 * FilterAddActive --
 *
 *      Add a method name to the set of methods, which were used as filters in
 *      the current interp.
 *
 *      TODO: let the set shrink, when filters are removed.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Adding or updating of a hash entry
 *
 *----------------------------------------------------------------------
 */
static void FilterAddActive(Tcl_Interp *interp, const char *methodName)
  nonnull(1) nonnull(2);

static void
FilterAddActive(Tcl_Interp *interp, const char *methodName) {
  Tcl_HashEntry *hPtr;
  int            newItem;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodName != NULL);

  hPtr = Tcl_CreateHashEntry(&RUNTIME_STATE(interp)->activeFilterTablePtr, methodName, &newItem);
  if (newItem != 0) {
    Tcl_SetHashValue(hPtr, INT2PTR(1));
  } else {
    long count = PTR2INT(Tcl_GetHashValue(hPtr));
    Tcl_SetHashValue(hPtr, INT2PTR(count+1));
  }
}

/*
 *----------------------------------------------------------------------
 * FilterIsActive --
 *
 *      Check, whether a method name is in the set of methods, which
 *      were used as filters in the current interp.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool FilterIsActive(Tcl_Interp *interp, const char *methodName)
  nonnull(1) nonnull(2);

static bool
FilterIsActive(Tcl_Interp *interp, const char *methodName) {
  const Tcl_HashEntry *hPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodName != NULL);

  hPtr = Tcl_CreateHashEntry(&RUNTIME_STATE(interp)->activeFilterTablePtr, methodName, NULL);
  return (hPtr != NULL);
}

/*
 *----------------------------------------------------------------------
 * FiltersDefined --
 *
 *      Return the number of defined distinct names of filters.
 *
 * Results:
 *      Positive number.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int FiltersDefined(Tcl_Interp *interp)
  nonnull(1) NSF_pure;

static int
FiltersDefined(Tcl_Interp *interp) {

  nonnull_assert(interp != NULL);

  return Tcl_HashSize(&RUNTIME_STATE(interp)->activeFilterTablePtr);
}


/*
 *----------------------------------------------------------------------
 * FilterAdd --
 *
 *      Append a filter command to the 'filterList' of an obj/class
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object in error cases.
 *
 *----------------------------------------------------------------------
 */
static int FilterAdd(Tcl_Interp *interp, NsfCmdList **filterList, Tcl_Obj *filterregObj,
                     NsfObject *startingObject, NsfClass *startingClass)
  nonnull(1) nonnull(2) nonnull(3);

static int
FilterAdd(Tcl_Interp *interp, NsfCmdList **filterList, Tcl_Obj *filterregObj,
          NsfObject *startingObject, NsfClass *startingClass) {
  Tcl_Obj     *filterObj = NULL;
  Tcl_Obj     *guardObj = NULL;
  Tcl_Command  cmd = NULL;
  NsfClass    *class = NULL;
  int          result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(filterList != NULL);
  nonnull_assert(filterregObj != NULL);

  /*
   * When the provided nameObj is of type NsfFilterregObjType, the nsf specific
   * converter was called already; otherwise call the converter here.
   */
  if (filterregObj->typePtr != &NsfFilterregObjType) {
    /*fprintf(stderr, "FilterAdd: convert %s in FilterAdd\n", ObjStr(filterregObj));*/
    if (Tcl_ConvertToType(interp, filterregObj, &NsfFilterregObjType) != TCL_OK) {
      result = TCL_ERROR;
    }
  } else {
    /*fprintf(stderr, "FilterAdd: %s already converted\n", ObjStr(filterregObj));*/
  }

  if (result == TCL_OK) {
    result = NsfFilterregGet(interp, filterregObj, &filterObj, &guardObj);

    if (result == TCL_OK) {
      const char *filterName = ObjStr(filterObj);

      cmd = FilterSearch(filterName, startingObject, startingClass, &class);
      if (cmd == NULL) {
        if (startingObject != NULL) {
          result = NsfPrintError(interp, "object filter: can't find filterproc '%s' on %s ",
                                 filterName, ObjectName(startingObject));
        } else {
          result = NsfPrintError(interp, "class filter: can't find filterproc '%s' on %s ",
                                 filterName, ClassName(startingClass));
        }
        assert(result == TCL_ERROR);
      }
    }
  }

  if (result == TCL_OK) {
    NsfCmdList *new;

    /*fprintf(stderr, " +++ adding filter %s cl %p\n", ObjStr(nameObj), class);*/

    new = CmdListAdd(filterList, cmd, class,
                     /*noDuplicates*/ NSF_TRUE, NSF_TRUE);
    FilterAddActive(interp, ObjStr(filterObj));

    if (guardObj != NULL) {
      GuardAdd(new, guardObj);
    } else if (new->clientData != NULL) {
      GuardDel(new);
    }
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * FilterResetOrder --
 *
 *      Reset the filter order cached in obj->filterOrder
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static void FilterResetOrder(NsfObject *object)
  nonnull(1);

static void
FilterResetOrder(NsfObject *object) {

  nonnull_assert(object != NULL);

  CmdListFree(&object->filterOrder, GuardDel);
  object->filterOrder = NULL;
}

/*
 *----------------------------------------------------------------------
 * FilterSearchAgain --
 *
 *      Search the filter in the hierarchy again with FilterSearch, e.g.
 *      upon changes in the class hierarchy or mixins that carry the
 *      filter command, so that we can be sure it is still reachable.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void FilterSearchAgain(Tcl_Interp *interp, NsfCmdList **filters,
                              NsfObject *startingObject, NsfClass *startingClass)
  nonnull(1) nonnull(2);

static void
FilterSearchAgain(Tcl_Interp *interp, NsfCmdList **filters,
                  NsfObject *startingObject, NsfClass *startingClass) {
  NsfCmdList *cmdList;

  nonnull_assert(interp != NULL);
  nonnull_assert(filters != NULL);

  CmdListRemoveDeleted(filters, GuardDel);
  cmdList = *filters;

  while (cmdList != NULL) {
    NsfCmdList *del = NULL;
    NsfClass   *class = NULL;
    const char *simpleName = Tcl_GetCommandName(interp, cmdList->cmdPtr);
    Tcl_Command cmd = FilterSearch(simpleName, startingObject, startingClass,
                                   &class);

    if (cmd == NULL) {
      del = CmdListRemoveFromList(filters, cmdList);
      /*
       * The actual deletion via CmdListDeleteCmdListEntry is deferred to the
       * end of the loop block, otherwise for del == cmdList, we risk running
       * into an invalid pointer access.
       */
    } else if (cmd != cmdList->cmdPtr) {
      CmdListReplaceCmd(cmdList, cmd, class);
    }

    cmdList = cmdList->nextPtr;

    if (del != NULL) {
      CmdListDeleteCmdListEntry(del, GuardDel);
    }
  }
}

/*
 *----------------------------------------------------------------------
 * FilterInvalidateObjOrders --
 *
 *      Invalidate filter entries in all dependent instances. This will
 *      be e.g. necessary, when the class hierarchy or the class filters
 *      have changed.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void FilterInvalidateObjOrders(Tcl_Interp *interp, NsfClasses *subClasses)
  nonnull(1) nonnull(2);

static void
FilterInvalidateObjOrders(Tcl_Interp *interp, NsfClasses *subClasses) {

  nonnull_assert(interp != NULL);
  nonnull_assert(subClasses != NULL);

  do {
    Tcl_HashSearch hSrch;
    const Tcl_HashEntry *hPtr;

    assert(subClasses->cl);

    hPtr = Tcl_FirstHashEntry(&subClasses->cl->instances, &hSrch);

    /*
     * Recalculate the commands of all class-filter registrations.
     */
    if (subClasses->cl->opt != NULL) {
      FilterSearchAgain(interp, &subClasses->cl->opt->classFilters, NULL, subClasses->cl);
    }

    for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSrch)) {
      NsfObject *object = (NsfObject *)Tcl_GetHashKey(&subClasses->cl->instances, hPtr);

      FilterResetOrder(object);
      object->flags &= ~NSF_FILTER_ORDER_VALID;

      /*
       * Recalculate the commands of all object filter registrations.
       */
      if (object->opt != NULL) {
        FilterSearchAgain(interp, &object->opt->objFilters, object, NULL);
      }
    }
    subClasses = subClasses->nextPtr;
  } while (likely(subClasses != NULL));
}

/*
 *----------------------------------------------------------------------
 * FilterRemoveDependentFilterCmds --
 *
 *
 *      Remove all filters from all subclasses that refer to
 *      "removeClass". This function is e.g. used to remove filters
 *      defined in superclass list from a dependent class.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
/*
 */
static void FilterRemoveDependentFilterCmds(NsfClass *removeClass, NsfClasses *subClasses)
  nonnull(1) nonnull(2);

static void
FilterRemoveDependentFilterCmds(NsfClass *removeClass, NsfClasses *subClasses) {

  nonnull_assert(removeClass != NULL);
  nonnull_assert(subClasses != NULL);

  /*fprintf(stderr, "FilterRemoveDependentFilterCmds removeClass %p %s\n",
    removeClass, ObjStr(removeClass->object.cmdName));*/

  do {
    Tcl_HashSearch hSrch;
    const Tcl_HashEntry *hPtr;
    NsfClassOpt   *opt;

    assert(subClasses->cl);
    hPtr = Tcl_FirstHashEntry(&subClasses->cl->instances, &hSrch);

    opt = subClasses->cl->opt;
    if (opt != NULL) {
      CmdListRemoveContextClassFromList(&opt->classFilters, removeClass, GuardDel);
    }
    for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSrch)) {
      NsfObject *object = (NsfObject *) Tcl_GetHashKey(&subClasses->cl->instances, hPtr);

      if (object->opt != NULL) {
        CmdListRemoveContextClassFromList(&object->opt->objFilters, removeClass, GuardDel);
      }
    }
    subClasses = subClasses->nextPtr;
  } while (subClasses != NULL);
}

/*
 *----------------------------------------------------------------------
 * MethodHandleObj --
 *
 *      Builds a methodHandle from a method name. We assume, the
 *      methodName is not fully qualified (i.e. it must not start with a
 *      colon).
 *
 * Results:
 *      fresh Tcl_Obj
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj * MethodHandleObj(NsfObject *object, int withPer_object, const char *methodName)
  nonnull(1) nonnull(3) returns_nonnull;

static Tcl_Obj *
MethodHandleObj(NsfObject *object, int withPer_object, const char *methodName) {
  Tcl_Obj *resultObj;

  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);
  assert(*methodName != ':');

  if (withPer_object == 1) {
    resultObj = Tcl_NewStringObj("", 0);
  } else {
    resultObj = Tcl_NewStringObj(nsfClassesPrefix, (int)nsfClassesPrefixLength);
  }
  Tcl_AppendObjToObj(resultObj, object->cmdName);
  Tcl_AppendStringsToObj(resultObj, "::", methodName, (char *) NULL);

  return resultObj;
}

/*
 *----------------------------------------------------------------------
 * FilterInfo --
 *
 *      Set the interp results with a Tcl list containing the content of
 *      the filter list. The options withGuards and withMethodHandles
 *      can be used for different output structures
 *
 * Results:
 *      Standard Tcl results
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static int FilterInfo(Tcl_Interp *interp, NsfCmdList *f, const char *pattern,
                      bool withGuards, bool withMethodHandles)
  nonnull(1);

static int
FilterInfo(Tcl_Interp *interp, NsfCmdList *f, const char *pattern,
           bool withGuards, bool withMethodHandles) {
  Tcl_Obj *list = Tcl_NewListObj(0, NULL);

  nonnull_assert(interp != NULL);

  /*
   * Guard lists should only have unqualified filter lists when "withGuards"
   * is activated. "withMethodHandles" has no effect when "withGuards" is
   * specified.
   */
  if (withGuards) {
    withMethodHandles = NSF_FALSE;
  }

  while (f != NULL) {
    const char *simpleName = Tcl_GetCommandName(interp, f->cmdPtr);

    if (pattern == NULL || Tcl_StringMatch(simpleName, pattern)) {
      if (withGuards && (f->clientData != NULL)) {
        Tcl_Obj *innerList = Tcl_NewListObj(0, NULL);
        Tcl_Obj *g = (Tcl_Obj *) f->clientData;

        Tcl_ListObjAppendElement(interp, innerList,
                                 Tcl_NewStringObj(simpleName, -1));
        Tcl_ListObjAppendElement(interp, innerList, NsfGlobalObjs[NSF_GUARD_OPTION]);
        Tcl_ListObjAppendElement(interp, innerList, g);
        Tcl_ListObjAppendElement(interp, list, innerList);
      } else {
        if (withMethodHandles) {
          NsfClass *filterClass = f->clorobj;

          Tcl_ListObjAppendElement(interp, list,
                                   MethodHandleObj((NsfObject *)filterClass,
                                                   !NsfObjectIsClass(&filterClass->object), simpleName));
        } else {
          Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(simpleName, -1));
        }
      }
    }
    f = f->nextPtr;
  }
  Tcl_SetObjResult(interp, list);
  return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 * FilterComputeOrderFullList --
 *
 *      Compute a fresh list of filters and append it to the filterList.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Updating filterList
 *
 *----------------------------------------------------------------------
 */
static void FilterComputeOrderFullList(
    Tcl_Interp *interp, NsfCmdList **filters,
    NsfCmdList **filterList
) nonnull(1) nonnull(2) nonnull(3);

static void
FilterComputeOrderFullList(
    Tcl_Interp *interp, NsfCmdList **filters,
    NsfCmdList **filterList
) {
  const NsfCmdList *f ;
  const NsfClasses *pl;
  NsfClass         *filterClass;

  nonnull_assert(interp != NULL);
  nonnull_assert(filters != NULL);
  nonnull_assert(filterList != NULL);

  /*
   * Ensure that no epoched command is in the filters list.
   */
  CmdListRemoveDeleted(filters, GuardDel);

  for (f = *filters; f != NULL; f = f->nextPtr) {
    const char *simpleName = Tcl_GetCommandName(interp, f->cmdPtr);

    filterClass = f->clorobj;
    CmdListAdd(filterList, f->cmdPtr, filterClass,
               /*noDuplicates*/ NSF_FALSE, NSF_TRUE);

    if (filterClass != NULL && !NsfObjectIsClass(&filterClass->object)) {
      /*
       * Get the class from the object for per-object filter.
       */
      filterClass = ((NsfObject *)filterClass)->cl;
    }

    /*
     * If we have a filter class -> search up the inheritance hierarchy.
     */
    if (filterClass != NULL) {
      pl = PrecedenceOrder(filterClass);
      if (pl != NULL && pl->nextPtr != NULL) {
        /*
         * Don't search on the start class again.
         */
        pl = pl->nextPtr;
        /*
         * Now go up the hierarchy.
         */
        for(; pl != NULL; pl = pl->nextPtr) {
          Tcl_Command pi = FindMethod(pl->cl->nsPtr, simpleName);

          if (pi != NULL) {
            CmdListAdd(filterList, pi, pl->cl,
                       /*noDuplicates*/ NSF_FALSE, NSF_TRUE);
            /*
              fprintf(stderr, " %s::%s, ", ClassName(pl->cl), simpleName);
            */
          }
        }
      }
    }
  }
  /*CmdListPrint(interp, "FilterComputeOrderFullList....\n", *filterList);*/
}

/*
 *----------------------------------------------------------------------
 * FilterComputeOrder --
 *
 *      Computes a linearized order of object and class filter. Then
 *      duplicates in the full list and with the class inheritance list
 *      of 'obj' are eliminated.  The precedence rule is that the last
 *      occurrence makes it into the final list (object->filterOrder).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static void FilterComputeOrder(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

static void
FilterComputeOrder(Tcl_Interp *interp, NsfObject *object) {
  NsfCmdList *filterList = NULL, *next, *checker, *newList;
  NsfClasses *pl;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (object->filterOrder != NULL) {
    FilterResetOrder(object);
  }
  /*
    fprintf(stderr, "<Filter Order obj=%s> List: ", ObjectName(object));
  */

  /*
   * Append class filters registered for mixins.
   */
  if ((object->flags & NSF_MIXIN_ORDER_VALID) == 0u) {
    MixinComputeDefined(interp, object);
  }
  if ((object->flags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) != 0u) {
    NsfCmdList *ml;

    for (ml = object->mixinOrder; ml != NULL; ml = ml->nextPtr) {
      NsfClass *mixin = NsfGetClassFromCmdPtr(ml->cmdPtr);

      if (mixin != NULL && mixin->opt != NULL && mixin->opt->classFilters != NULL) {
        FilterComputeOrderFullList(interp, &mixin->opt->classFilters, &filterList);
      }
    }
  }

  /*
   * Append per-obj filters.
   */
  if (object->opt != NULL) {
    FilterComputeOrderFullList(interp, &object->opt->objFilters, &filterList);
  }

  /*
   * Append per-class filters.
   */
  for (pl = PrecedenceOrder(object->cl); pl != NULL; pl = pl->nextPtr) {
    NsfClassOpt *clopt = pl->cl->opt;
    if (clopt != NULL && clopt->classFilters != NULL) {
      FilterComputeOrderFullList(interp, &clopt->classFilters, &filterList);
    }
  }

  /*
   * Use no duplicates & no classes of the precedence order
   * on the resulting list.
   */
  while (filterList != NULL) {
    /*
     * Search for filterList->cmdPtr
     */
    for (checker = next = filterList->nextPtr; checker != NULL; checker = checker->nextPtr) {
      if (checker->cmdPtr == filterList->cmdPtr) {
        break;
      }
    }

    if (checker == NULL) {
      /*
       * filterList->cmdPtr was found
       */
      newList = CmdListAdd(&object->filterOrder, filterList->cmdPtr, filterList->clorobj,
                           /*noDuplicates*/ NSF_FALSE, NSF_TRUE);
      GuardAddInheritedGuards(interp, newList, object, filterList->cmdPtr);
      /*
        GuardPrint(interp, newList->clientData);
      */
    }

    CmdListDeleteCmdListEntry(filterList, GuardDel);
    filterList = next;
  }
}

/*
 *----------------------------------------------------------------------
 * FilterComputeDefined --
 *
 *      Compute the state of the filter order. The filter order is either
 *
 *         DEFINED (there are filter on the instance),
 *         NONE    (there are no filter for the instance),
 *         or INVALID (a class restructuring has occurred, thus it is
                    not clear whether filters are defined or not).
 *
 *      If it is INVALID FilterComputeDefined can be used to compute the
 *      order and set the instance to DEFINE or NONE.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Updating object-flags
 *
 *----------------------------------------------------------------------
 */
static void
FilterComputeDefined(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  FilterComputeOrder(interp, object);
  object->flags |= NSF_FILTER_ORDER_VALID;
  if (object->filterOrder != NULL) {
    object->flags |= NSF_FILTER_ORDER_DEFINED;
  } else {
    object->flags &= ~NSF_FILTER_ORDER_DEFINED;
  }
}

/*
 *----------------------------------------------------------------------
 * FilterStackPush --
 *
 *      Push a filter stack information on this object and initialize it with
 *      calledProc.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Updating object->filterStack
 *
 *----------------------------------------------------------------------
 */
static void FilterStackPush(NsfObject *object, Tcl_Obj *calledProc)
  nonnull(1) nonnull(2);

static void
FilterStackPush(NsfObject *object, Tcl_Obj *calledProc) {
  register NsfFilterStack *h = NEW(NsfFilterStack);

  nonnull_assert(object != NULL);
  nonnull_assert(calledProc != NULL);

  h->currentCmdPtr = NULL;
  h->calledProc = calledProc;
  INCR_REF_COUNT(h->calledProc);
  h->nextPtr = object->filterStack;
  object->filterStack = h;
}

/*
 *----------------------------------------------------------------------
 * FilterStackPush --
 *
 *      Pop filter stack information from the specified object
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free filter stack info
 *
 *----------------------------------------------------------------------
 */
static void FilterStackPop(NsfObject *object)
  nonnull(1);

static void
FilterStackPop(NsfObject *object) {
  register NsfFilterStack *h;

  nonnull_assert(object != NULL);

  h = object->filterStack;
  object->filterStack = h->nextPtr;

  /*
   * Free stack entry.
   */
  DECR_REF_COUNT(h->calledProc);
  FREE(NsfFilterStack, h);
}

/*
 *----------------------------------------------------------------------
 * FilterFindReg --
 *
 *      Search through the filter list on obj and class hierarchy for
 *      registration of a cmdPtr as filter
 *
 * Results:
 *      Returns a Tcl list with the filter registration, like:
 *    "<obj> filter <filterName>, "<class> filter <filterName>,
 *      or an empty list, if not registered
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj * FilterFindReg(Tcl_Interp *interp, NsfObject *object, Tcl_Command cmd)
  nonnull(1) nonnull(2) nonnull(3) returns_nonnull;

static Tcl_Obj *
FilterFindReg(Tcl_Interp *interp, NsfObject *object, Tcl_Command cmd) {
  Tcl_Obj *list = Tcl_NewListObj(0, NULL);
  NsfClasses *pl;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(cmd != NULL);

  /*
   * Search per-object filters.
   */
  if (object->opt != NULL
      && object->opt->objFilters != NULL
      && CmdListFindCmdInList(cmd, object->opt->objFilters)) {
    Tcl_ListObjAppendElement(interp, list, object->cmdName);
    Tcl_ListObjAppendElement(interp, list, NsfGlobalObjs[NSF_OBJECT]);
    Tcl_ListObjAppendElement(interp, list, NsfGlobalObjs[NSF_FILTER]);
    Tcl_ListObjAppendElement(interp, list,
                             Tcl_NewStringObj(Tcl_GetCommandName(interp, cmd), -1));
    return list;
  }

  /*
   * Search per-class filters.
   */
  for (pl = PrecedenceOrder(object->cl); pl != NULL; pl = pl->nextPtr) {
    NsfClassOpt *opt = pl->cl->opt;
    if (opt != NULL && opt->classFilters != NULL) {
      if (CmdListFindCmdInList(cmd, opt->classFilters)) {
        Tcl_ListObjAppendElement(interp, list, pl->cl->object.cmdName);
        Tcl_ListObjAppendElement(interp, list, NsfGlobalObjs[NSF_FILTER]);
        Tcl_ListObjAppendElement(interp, list,
                                 Tcl_NewStringObj(Tcl_GetCommandName(interp, cmd), -1));
        return list;
      }
    }
  }
  return list;
}

/*
 *----------------------------------------------------------------------
 * FilterSearchProc --
 *
 *      FilterSearchProc seeks the current filter and the relevant calling
 *      information (class and currentCmd). The function assumes to be called
 *      with an existing filterStack.
 *
 * Results:
 *      Tcl_Command or NULL
 *
 * Side effects:
 *      Updates *currentCmd and **cl
 *
 *----------------------------------------------------------------------
 */
/*
 */
static Tcl_Command FilterSearchProc(Tcl_Interp *interp, NsfObject *object,
                 Tcl_Command *currentCmd, NsfClass **classPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static Tcl_Command
FilterSearchProc(Tcl_Interp *interp, NsfObject *object,
                 Tcl_Command *currentCmd, NsfClass **classPtr) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(currentCmd != NULL);
  nonnull_assert(classPtr != NULL);

  assert(object->filterStack != NULL);
  /*
   * Ensure that the filter order is not invalid, otherwise compute order
   * FilterComputeDefined(interp, object);
   */
  assert(object->flags & NSF_FILTER_ORDER_VALID);

  if (object->filterOrder != NULL) {
    NsfCmdList *cmdList;

    *currentCmd = NULL;
    cmdList = SeekCurrent(object->filterStack->currentCmdPtr, object->filterOrder);

    while (cmdList != NULL) {
      /*fprintf(stderr, "FilterSearchProc found %s\n",
        Tcl_GetCommandName(interp, (Tcl_Command)cmdList->cmdPtr));*/
      if (Tcl_Command_cmdEpoch(cmdList->cmdPtr) != 0) {
        cmdList = cmdList->nextPtr;
      } else if (FilterActiveOnObj(interp, object, cmdList->cmdPtr)) {
        /* fprintf(stderr, "Filter <%s> -- Active on: %s\n",
           Tcl_GetCommandName(interp, (Tcl_Command)cmdList->cmdPtr), ObjectName(object));
        */
        object->filterStack->currentCmdPtr = cmdList->cmdPtr;
        cmdList = SeekCurrent(object->filterStack->currentCmdPtr, object->filterOrder);
      } else {
        /*
         * Ok, ee found it
         */
        if (cmdList->clorobj && !NsfObjectIsClass(&cmdList->clorobj->object)) {
          *classPtr = NULL;
        } else {
          *classPtr = cmdList->clorobj;
        }
        *currentCmd = cmdList->cmdPtr;
        /* fprintf(stderr, "FilterSearchProc - found: %s, %p\n",
           Tcl_GetCommandName(interp, (Tcl_Command)cmdList->cmdPtr), cmdList->cmdPtr);
        */
        return cmdList->cmdPtr;
      }
    }
  }
  return NULL;
}

/*
 *----------------------------------------------------------------------
 * SuperclassAdd --
 *
 *      Add a list of superClasses (specified in the argument vector) to
 *      the specified class. On the first call, the class has no previous
 *      superClasses.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Rearranging the class relations, flushing previous precedence
 *      orders.
 *
 *----------------------------------------------------------------------
 */
static int SuperclassAdd(Tcl_Interp *interp, NsfClass *class, int oc, Tcl_Obj **ov, Tcl_Obj *arg)
  nonnull(1) nonnull(2) nonnull(4) nonnull(5);

static int
SuperclassAdd(Tcl_Interp *interp, NsfClass *class, int oc, Tcl_Obj **ov, Tcl_Obj *arg) {
  NsfClasses       *superClasses, *subClasses, *osl = NULL;
  NsfObjectSystem  *osPtr;
  NsfClass        **classPtr;
  int i, j;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(ov != NULL);
  nonnull_assert(arg != NULL);

  superClasses = PrecedenceOrder(class);
  subClasses = DependentSubClasses(class);

  /*
   * We have to remove all dependent superclass filter referenced
   * by class or one of its subclasses.
   *
   * Do not check the class "cl" itself (first entry in
   * filterCheck class list).
   */
  if (superClasses != NULL) {
    superClasses = superClasses->nextPtr;
  }
  for (; superClasses; superClasses = superClasses->nextPtr) {
    FilterRemoveDependentFilterCmds(superClasses->cl, subClasses);
  }

  /*
   * Invalidate all interceptors' orders of instances of this and of all
   * depended classes.
   */
  MixinInvalidateObjOrders(subClasses);
  if (FiltersDefined(interp) > 0) {
    FilterInvalidateObjOrders(interp, subClasses);
  }

  /*
   * Build an array of superClasses from the argument vector.
   */
  classPtr = NEW_ARRAY(NsfClass*, oc);
  for (i = 0; i < oc; i++) {
    if (GetClassFromObj(interp, ov[i], &classPtr[i], NSF_TRUE) != TCL_OK) {
      FREE(NsfClass**, classPtr);
      NsfClassListFree(subClasses);
      return NsfObjErrType(interp, "superclass", arg, "a list of classes", NULL);
    }
  }

  /*
   * Check that superClasses don't precede their classes.
   */
  for (i = 0; i < oc; i++) {
    for (j = i+1; j < oc; j++) {
      NsfClasses *dl = PrecedenceOrder(classPtr[j]);

      dl = NsfClassListFind(dl, classPtr[i]);
      if (dl != NULL) {
        FREE(NsfClass**, classPtr);
        NsfClassListFree(subClasses);
        return NsfObjErrType(interp, "superclass", arg, "classes in dependence order", NULL);
      }
    }
  }

  /*
   * Ensure that the current class and new superClasses are from the
   * same object system.
   */
  osPtr = GetObjectSystem(&class->object);
  for (i = 0; i < oc; i++) {
    if (osPtr != GetObjectSystem(&classPtr[i]->object)) {
      NsfPrintError(interp, "class \"%s\" has a different object system as class  \"%s\"",
                           ClassName_(class), ClassName(classPtr[i]));
      NsfClassListFree(subClasses);
      FREE(NsfClass**, classPtr);
      return TCL_ERROR;
    }
  }

  while (class->super != NULL) {
    /*
     * Build a backup of the old superclass list in case we need to revert.
     */
    NsfClass   *superClass = class->super->cl;
    NsfClasses *l = osl;

    osl = NEW(NsfClasses);
    osl->cl = superClass;
    osl->nextPtr = l;
    (void)RemoveSuper(class, class->super->cl);
  }

  for (i = 0; i < oc; i++) {
    AddSuper(class, classPtr[i]);
  }

  FlushPrecedences(subClasses);
  NsfClassListFree(subClasses);
  FREE(NsfClass**, classPtr);

  if (unlikely(!PrecedenceOrder(class))) {
    NsfClasses *l;
    /*
     * There is a cycle in the superclass graph, we have to revert and return
     * an error.
     */
    while (class->super != NULL) {
      (void)RemoveSuper(class, class->super->cl);
    }
    for (l = osl; l != NULL; l = l->nextPtr) {
      AddSuper(class, l->cl);
    }
    if (osl != NULL) {
      NsfClassListFree(osl);
    }

    return NsfObjErrType(interp, "superclass", arg, "a cycle-free graph", NULL);
  }

  if (osl != NULL) {
    NsfClassListFree(osl);
  }

  assert(class->super != NULL);

  Tcl_ResetResult(interp);
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * CheckVarName --
 *
 *      Check, whether the provided name is free of namespace markup.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int CheckVarName(Tcl_Interp *interp, const char *varNameString)
  nonnull(1) nonnull(2);

static int
CheckVarName(Tcl_Interp *interp, const char *varNameString) {

  nonnull_assert(interp != NULL);
  nonnull_assert(varNameString != NULL);

  /*
   * We want to have a plain variable name, since we do not want to
   * get interferences with namespace resolver and such.  In a first
   * attempt, we disallowed occurrences of "::", but we have to deal as
   * well with e.g. arrayName(::x::y)
   *
   * TODO: more general and efficient solution to disallow e.g. a::b
   * (check for :: until parens)
   */
  /*if (strstr(varNameString, "::") || *varNameString == ':') {*/
  if (*varNameString == ':') {
    return NsfPrintError(interp, "variable name \"%s\" must not contain "
                         "namespace separator or colon prefix",
                         varNameString);
  }
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * VarExists --
 *
 *      Check, whether the named variable exists on the specified object.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool VarExists(
    Tcl_Interp *interp, NsfObject *object,
    const char *name1, const char *name2, unsigned int flags
) nonnull(1) nonnull(2) nonnull(3);

static bool
VarExists(
    Tcl_Interp *interp, NsfObject *object,
    const char *name1, const char *name2,
    unsigned int flags
) {
  CallFrame frame, *framePtr = &frame;
  const Var *varPtr;
  Var *arrayPtr;
  bool result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(name1 != NULL);

  Nsf_PushFrameObj(interp, object, framePtr);

  if ((flags & NSF_VAR_TRIGGER_TRACE) != 0u) {
    varPtr = TclVarTraceExists(interp, name1);
  } else {
    varPtr = TclLookupVar(interp, name1, name2, 0, "access",
                          /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
  }
  /*
    fprintf(stderr, "VarExists %s varPtr %p flags %.4x isundef %d\n",
    name1,
    varPtr,
    flags, (varPtr != NULL) ? TclIsVarUndefined(varPtr) : NULL);
  */
  result = ((varPtr != NULL) && ((flags & NSF_VAR_REQUIRE_DEFINED) == 0u || !TclIsVarUndefined(varPtr)));
  if (result && ((flags & NSF_VAR_ISARRAY) != 0u) && !TclIsVarArray(varPtr)) {
    result = NSF_FALSE;
  }
  Nsf_PopFrameObj(interp, framePtr);

  return result;
}

#if defined(WITH_TCL_COMPILE)
# include <tclCompile.h>
#endif

/*
 *----------------------------------------------------------------------
 * MakeProcError --
 *
 *      Function called internally from Tcl in case the definition of
 *      the proc failed.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void
MakeProcError(
    Tcl_Interp *interp,        /* The interpreter in which the procedure was called. */
    Tcl_Obj *procNameObj       /* Name of the procedure. Used for error
                                * messages and trace information. */
) {
  int         overflow, limit = 60, nameLen;
  const char *procName;

  /*fprintf(stderr, "MakeProcError %p type %p refCount %d\n",
    procNameObj, procNameObj->typePtr, procNameObj->refCount);*/

  procName = Tcl_GetString(procNameObj);
  nameLen = procNameObj->length;
  overflow = (nameLen > limit);
  Tcl_AppendObjToErrorInfo(interp,
                           Tcl_ObjPrintf(
                               "\n    (procedure \"%.*s%s\" line %d)",
                               ((overflow != 0) ? limit : nameLen), procName,
                               ((overflow != 0) ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 *----------------------------------------------------------------------
 * ByteCompiled --
 *
 *      Function to determine whether a proc is already byte compiled or
 *      not.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int ByteCompiled(
    Tcl_Interp *interp, unsigned int *flagsPtr,
    Proc *procPtr, Namespace *nsPtr, const char *procName
) nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

static int
ByteCompiled(
    Tcl_Interp *interp, unsigned int *flagsPtr,
    Proc *procPtr, Namespace *nsPtr, const char *procName
) {
  Tcl_Obj *bodyObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(flagsPtr != NULL);
  nonnull_assert(procPtr != NULL);
  nonnull_assert(procName != NULL);
  nonnull_assert(nsPtr != NULL);

  bodyObj = procPtr->bodyPtr;

  if (likely(bodyObj->typePtr == Nsf_OT_byteCodeType)) {
#if defined(HAVE_TCL_COMPILE_H)
    ByteCode *codePtr;
    Interp   *iPtr = (Interp *) interp;

    /*
     * When we've got bytecode, this is the check for validity. That is,
     * the bytecode must be for the right interpreter (no cross-leaks!),
     * the code must be from the current epoch (so subcommand compilation
     * is up-to-date), the namespace must match (so variable handling
     * is right) and the resolverEpoch must match (so that new shadowed
     * commands and/or resolver changes are considered).
     */

    codePtr = bodyObj->internalRep.otherValuePtr;
    if (unlikely(((Interp *) *codePtr->interpHandle != iPtr)
                 || (codePtr->compileEpoch != iPtr->compileEpoch)
                 || (codePtr->nsPtr != nsPtr)
                 || (codePtr->nsEpoch != nsPtr->resolverEpoch))) {

# if defined(VAR_RESOLVER_TRACE)
      fprintf(stderr, "ByteCompiled bytecode not valid proc %p cmd %p method %s\n",
              (void *)procPtr, (void *)procPtr->cmdPtr,
              Tcl_GetCommandName(interp, (Tcl_Command)procPtr->cmdPtr));
      fprintf(stderr, "    %d %d %d %d\n",
              ((Interp *) *codePtr->interpHandle != iPtr),
               (codePtr->compileEpoch != iPtr->compileEpoch),
               (codePtr->nsPtr != nsPtr),
               (codePtr->nsEpoch != nsPtr->resolverEpoch));

      {
        CompiledLocal *localPtr = procPtr->firstLocalPtr;
        for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
          fprintf(stderr, "... local %p '%s' resolveInfo %p deleteProc %p\n",
                  (void *)localPtr, localPtr->name, (void *)localPtr->resolveInfo,
                  (localPtr->resolveInfo != NULL) ? (void *)localPtr->resolveInfo->deleteProc : NULL);
        }
      }
# endif
      /* dummy statement for coverage analysis */
      assert(1);
      goto doCompilation;
    }
#endif
    return TCL_OK;
  } else {
    int        result;
    Namespace *definitionNsPtr;

#if defined(HAVE_TCL_COMPILE_H)
  doCompilation:
#endif

    *flagsPtr |= NSF_CSC_CALL_IS_COMPILE;
    /*fprintf(stderr, "compiling '%s' with ns %s\n", procName, nsPtr->name);*/

    /*
     * Tcl's bytecode compiler (TclCompileScript & friends) will access the
     * proc command's namespace as resolution context for command lookups
     * (Tcl_FindCommand) when compiling the proc. We, therefore, have to patch
     * the proc command for the compilation step to point to the execution
     * namespace; and restore the definition namespace on leaving.
     */

    definitionNsPtr = procPtr->cmdPtr->nsPtr;
    procPtr->cmdPtr->nsPtr = nsPtr;

    result = TclProcCompileProc(interp, procPtr, bodyObj,
                                (Namespace *) nsPtr, "body of proc",
                                procName);
    procPtr->cmdPtr->nsPtr = definitionNsPtr;

    /*fprintf(stderr, "compiling '%s' with ns %s DONE\n", procName, nsPtr->name);*/
    *flagsPtr &= ~NSF_CSC_CALL_IS_COMPILE;

    return result;
  }
}

/*
 *----------------------------------------------------------------------
 * PushProcCallFrame --
 *
 *      Set up and push a new call frame for the procedure invocation.
 *      call-frame. The proc is passed via clientData.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      compiles body conditionally
 *
 *----------------------------------------------------------------------
 */
static int PushProcCallFrame(
    Proc *procPtr, Tcl_Interp *interp,
    int objc, Tcl_Obj *const objv[],
    Tcl_Namespace *execNsPtr,
    NsfCallStackContent *cscPtr
) nonnull(1) nonnull(2) nonnull(4) nonnull(6);

static int
PushProcCallFrame(
    Proc *procPtr, Tcl_Interp *interp,
    int objc, Tcl_Obj *const objv[],
    Tcl_Namespace *execNsPtr,
    NsfCallStackContent *cscPtr
) {
  Tcl_CallFrame *framePtr;
  int            result;

  nonnull_assert(procPtr != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(cscPtr != NULL);

  /*
   * Set up and push a new call frame for the new procedure invocation.
   * This call frame will execute either in the provided execNs or in
   * the proc's namespace, which might be different than the current
   * namespace. The proc's namespace is that of its command, which can
   * change when the command is renamed from one namespace to another.
   */

  if (execNsPtr == NULL) {
    execNsPtr = (Tcl_Namespace *) procPtr->cmdPtr->nsPtr;
  }

  /*
   * TODO: We could use Tcl_PushCallFrame(), if we would allocate the
   * Tcl stack frame earlier.
   */
  result = TclPushStackFrame(interp, (Tcl_CallFrame **)&framePtr,
                             execNsPtr,
                             (FRAME_IS_PROC|FRAME_IS_NSF_METHOD));

  if (likely(result == TCL_OK)) {

    Tcl_CallFrame_objc(framePtr) = objc;
    Tcl_CallFrame_objv(framePtr) = objv;
    Tcl_CallFrame_procPtr(framePtr) = procPtr;
    Tcl_CallFrame_clientData(framePtr) = cscPtr;

    /*fprintf(stderr, "Stack Frame %p procPtr %p compiledLocals %p firstLocal %p\n",
      (void *)framePtr, (void *)procPtr, (void *)Tcl_CallFrame_compiledLocals(framePtr),
      (void *)procPtr->firstLocalPtr);*/

    result = ByteCompiled(interp, &cscPtr->flags, procPtr, (Namespace *)execNsPtr, ObjStr(objv[0]));
  }

  return result;
}

#include "nsfAPI.h"

/*
 *----------------------------------------------------------------------
 * ObjectSystemsCheckSystemMethod --
 *
 *      Mark the specified method as (potentially) 'overloaded' in all object
 *      systems and declare it 'defined' in the specified object system.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Updates the object system structure(s).
 *
 *----------------------------------------------------------------------
 */
static int
ObjectSystemsCheckSystemMethod(
    Tcl_Interp *interp, const char *methodName, const NsfObject *object, unsigned int flags
) {
  NsfObjectSystem *osPtr, *defOsPtr;
  char             firstChar;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);

  firstChar = *methodName;
  defOsPtr = GetObjectSystem(object);

  for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr != NULL; osPtr = osPtr->nextPtr) {
    int           i, isRootClassMethod;
    unsigned int  flag = 0u;
    NsfObject    *defObject;
    const char  **methodStrings = osPtr->methodNames;

    for (i = 0; i <= NSF_s_set_idx; i++) {
      const char *methodString = *methodStrings ++;

      if (likely(methodString != NULL)
          && unlikely(*methodString == firstChar)
          && strcmp(methodName, methodString) == 0) {
        flag = 1u << i;
        break;
      }
    }
    if (flag == 0u) {
      continue;
    }

    isRootClassMethod = *(Nsf_SystemMethodOpts[i]+1) == 'o';
    defObject = (isRootClassMethod == 1)
      ? &osPtr->rootClass->object
      : &osPtr->rootMetaClass->object;

    if (osPtr->handles[i] && osPtr->protected[i]) {
      if (defObject == object && (flags & NSF_CMD_REDEFINE_PROTECTED_METHOD) == 0u) {
        return NsfPrintError(interp, "refuse to overwrite protected method %s on %s",
                             methodName, ObjectName(defObject));
      }
    }

    if ((osPtr->definedMethods & flag) != 0u) {
      /*
       *  If for some reason base methods become redefined (e.g. in a reload),
       *  do not count them as overloads.
       */
      if ((isRootClassMethod == 1
           && object == &defOsPtr->rootClass->object)
          || (isRootClassMethod == 0
              && object == &defOsPtr->rootMetaClass->object)
          ) {
        /*fprintf(stderr, "+++ %s %.6x NOT overloading %s.%s %s (is root %d, is meta %d)\n",
          ClassName(defOsPtr->rootClass),
          osPtr->overloadedMethods, ObjectName(object), methodName, Nsf_SystemMethodOpts[i],
          object == &defOsPtr->rootClass->object,
          object == &defOsPtr->rootMetaClass->object);*/
      } else {
        osPtr->overloadedMethods |= flag;
        /*fprintf(stderr, "+++ %s %.6x overloading %s.%s %s (is root %d, is meta %d)\n",
          ClassName(defOsPtr->rootClass),
          osPtr->overloadedMethods, ObjectName(object), methodName, Nsf_SystemMethodOpts[i],
          object == &defOsPtr->rootClass->object,
          object == &defOsPtr->rootMetaClass->object);*/
      }
    }
    if ((osPtr == defOsPtr)
        && ((osPtr->definedMethods & flag) == 0u)
        ) {
      /*
       * Mark the method as defined.
       */
      osPtr->definedMethods |= flag;

      /*fprintf(stderr, "+++ %s %.6x defining %s.%s %s osPtr %p defined %.8x flag %.8x handle %p\n",
              ClassName(defOsPtr->rootClass),  osPtr->definedMethods, ObjectName(object),
              methodName, Nsf_SystemMethodOpts[i], (void *)osPtr, osPtr->definedMethods, flag,
              (void *)osPtr->handles[i]);*/

      /*
       * If there is a method handle provided for this system method, register
       * it as a fallback; unless the method is to be defined at the root
       * class.
       */
      if (osPtr->handles[i]) {

        if (defObject != object) {
          int result;

          NsfLog(interp, NSF_LOG_DEBUG, "Define automatically alias %s for %s",
                 ObjStr(osPtr->handles[i]), Nsf_SystemMethodOpts[i]);

          result = NsfMethodAliasCmd(interp, defObject, 0, methodName, 0,
                                         ProtectionRedefine_protectedIdx, osPtr->handles[i]);

          if (unlikely(result != TCL_OK)) {
            /*
             * Alias definition failed.
             */
            NsfLog(interp, NSF_LOG_WARN, "Could not define alias %s for %s",
                   ObjStr(osPtr->handles[i]), Nsf_SystemMethodOpts[i]);
            return TCL_ERROR;
          } else {
            /*
             * Alias definition succeeded.
             */
            Tcl_Obj     *methodObj = Tcl_GetObjResult(interp);
            Tcl_Command  cmd       = Tcl_GetCommandFromObj(interp, methodObj);

            /*
             * Since the defObject is not equal to the overloaded method, the
             * definition above is effectively an overload of the alias.
             */
            osPtr->overloadedMethods |= flag;

            /*
             * Set method protection.
             */
            if (cmd != NULL) {
              Tcl_Command_flags(cmd) |= NSF_CMD_CALL_PROTECTED_METHOD;
              if (osPtr->protected[i]) {
                Tcl_Command_flags(cmd) |= NSF_CMD_REDEFINE_PROTECTED_METHOD;
              }
            }
            Tcl_ResetResult(interp);
          }
        }
      }
    }
  }

  return TCL_OK;
}


/*----------------------------------------------------------------------
 * ParamsNew --
 *
 *      Allocate an array of Nsf_Param structures
 *
 * Results:
 *      Pointer to allocated memory
 *
 * Side effects:
 *      Allocation of memory.
 *
 *----------------------------------------------------------------------
 */

static Nsf_Param *
ParamsNew(size_t nr) {
  Nsf_Param *paramsPtr = NEW_ARRAY(Nsf_Param, nr+1);

  memset(paramsPtr, 0, sizeof(Nsf_Param) * (nr+1));

  return paramsPtr;
}

/*----------------------------------------------------------------------
 * ParamFree --
 *
 *      Deallocate the contents of a single Nsf_Param*
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free the parameter definition.
 *
 *----------------------------------------------------------------------
 */
static void ParamFree(Nsf_Param *paramPtr)
  nonnull(1);

static void
ParamFree(Nsf_Param *paramPtr) {

  nonnull_assert(paramPtr != NULL);

  /*fprintf(stderr, "ParamFree %p\n", (void *)paramPtr);*/
  if (paramPtr->name != NULL) {STRING_FREE("paramPtr->name", paramPtr->name);}
  if (paramPtr->nameObj != NULL) {DECR_REF_COUNT(paramPtr->nameObj);}
  if (paramPtr->defaultValue != NULL) {DECR_REF_COUNT(paramPtr->defaultValue);}
  if (paramPtr->converterName != NULL) {DECR_REF_COUNT2("converterNameObj", paramPtr->converterName);}
  if (paramPtr->converterArg != NULL) {DECR_REF_COUNT(paramPtr->converterArg);}
  if (paramPtr->paramObj != NULL) {DECR_REF_COUNT(paramPtr->paramObj);}
  if (paramPtr->slotObj != NULL) {DECR_REF_COUNT(paramPtr->slotObj);}
  if (paramPtr->method != NULL) {DECR_REF_COUNT(paramPtr->method);}
}

/*----------------------------------------------------------------------
 * ParamsFree --
 *
 *      Deallocate a block of multiple Nsf_Param*
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free the parameter definition.
 *
 *----------------------------------------------------------------------
 */
static void ParamsFree(Nsf_Param *paramsPtr)
  nonnull(1);

static void
ParamsFree(Nsf_Param *paramsPtr) {
  Nsf_Param *paramPtr;

  nonnull_assert(paramsPtr != NULL);

  /*fprintf(stderr, "ParamsFree %p\n", (void *)paramsPtr);*/
  for (paramPtr = paramsPtr; paramPtr->name != NULL; paramPtr++) {
    ParamFree(paramPtr);
  }

  FREE(Nsf_Param*, paramsPtr);
}

/*----------------------------------------------------------------------
 * ParamDefsGet --
 *
 *      Obtain parameter definitions for a cmdPtr; Optionally, this command
 *      returns as well a flag for ProcessMethodArguments to indicate if the
 *      parameter have to checked always.
 *
 * Results:
 *      Parameter definitions or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static NsfParamDefs *
ParamDefsGet(
    const Tcl_Command cmdPtr,
    unsigned int *checkAlwaysFlagPtr,
    Tcl_Namespace **execNsPtrPtr
) {
  NsfParamDefs *result;

  nonnull_assert(cmdPtr != NULL);

  if (likely(Tcl_Command_deleteProc(cmdPtr) == NsfProcDeleteProc)) {
    NsfProcContext *ctx = (NsfProcContext *)Tcl_Command_deleteData(cmdPtr);

    if (checkAlwaysFlagPtr != NULL) {
      *checkAlwaysFlagPtr = ctx->checkAlwaysFlag;
    }
    if (execNsPtrPtr != NULL) {
      *execNsPtrPtr = ctx->execNsPtr;
    }
    result = ctx->paramDefs;
  } else {
    result = NULL;
  }

  return result;
}

/*----------------------------------------------------------------------
 * ParamDefsGetReturns --
 *
 *      Obtain the "returns" value from NsfProcContext.
 *
 * Results:
 *      Tcl_Obj or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static Tcl_Obj *ParamDefsGetReturns(
    const Tcl_Command cmdPtr
) nonnull(1) NSF_pure;

NSF_INLINE static Tcl_Obj *
ParamDefsGetReturns(const Tcl_Command cmdPtr) {
  const NsfProcContext *pCtx;
  Tcl_Obj              *resultObj;

  nonnull_assert(cmdPtr != NULL);

  pCtx = ProcContextGet(cmdPtr);
  if (pCtx != NULL) {
    resultObj = pCtx->returnsObj;
  } else {
    resultObj = NULL;
  }
  return resultObj;
}


/*----------------------------------------------------------------------
 * NsfParamDefsNonposLookup --
 *
 *      Process a list of ParamDefs look for a non-pos args. If there is no exact
 *      match, look for an abbreviated match having at least
 *      NSF_ABBREV_MIN_CHARS leading chars which are identical.
 *
 * Results:
 *      Standard Tcl result; might set paramPtrPtr;
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int NsfParamDefsNonposLookup(
    Tcl_Interp *interp, const char *nameString,
    const Nsf_Param *paramsPtr,  const Nsf_Param **paramPtrPtr
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static int
NsfParamDefsNonposLookup(
    Tcl_Interp *interp, const char *nameString,
    const Nsf_Param *paramsPtr, const Nsf_Param **paramPtrPtr
) {
  const Nsf_Param *paramPtr;
  char             ch1;
  size_t           length;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameString != NULL);
  nonnull_assert(paramsPtr != NULL);
  nonnull_assert(paramPtrPtr != NULL);

  /*
   * The provided paramsPtr must point to a block starting with a non-pos arg.
   */
  assert(paramsPtr->name != NULL);
  assert(*paramsPtr->name == '-');

  /*
   * The provided nameString starts as well with a leading dash.
   */
  assert(*nameString == '-');

  ch1 = nameString[2];
  for (paramPtr = paramsPtr; likely(paramPtr->name != NULL) && *paramPtr->name == '-'; paramPtr++) {
    if (unlikely((paramPtr->flags & NSF_ARG_NOCONFIG) != 0u)) {
      continue;
    }
    if (ch1 == paramPtr->name[2]
        && strcmp(nameString, paramPtr->name) == 0) {
        *paramPtrPtr = paramPtr;
        return TCL_OK;
    }
  }

  length = strlen(nameString);

  if (length >= NSF_ABBREV_MIN_CHARS) {

    for (paramPtr = paramsPtr; likely(paramPtr->name != NULL) && *paramPtr->name == '-'; paramPtr++) {
      if (unlikely((paramPtr->flags & NSF_ARG_NOCONFIG) != 0u)) {
        continue;
      }

      if (ch1 == paramPtr->name[2]
          && strncmp(nameString, paramPtr->name, length) == 0) {
        const Nsf_Param *pPtr;

        /* fprintf(stderr, "... <%s> is an abbrev of <%s>\n", nameString, paramPtr->name); */
        /*
         * Check whether the abbreviation is unique.
         */
        for (pPtr = paramPtr + 1; likely(pPtr->name != NULL) && *pPtr->name == '-'; pPtr++) {
          if (unlikely((pPtr->flags & NSF_ARG_NOCONFIG) != 0u)) {
            continue;
          }
          if (ch1 == pPtr->name[2]
              && strncmp(nameString, pPtr->name, length) == 0) {
            /*
             * The abbreviation is not unique
             */
            *paramPtrPtr = NULL;
            return NsfPrintError(interp, "the provided argument %s is an abbreviation for %s and %s",
                                 nameString, paramPtr->name, pPtr->name);
          }
        }
        /*
         * The abbreviation is unique
         */
        *paramPtrPtr = paramPtr;
        return TCL_OK;
      }
    }
  }
  *paramPtrPtr = NULL;
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * CGetParamLookup --
 *
 *      Obtain the parameter definition for a Tcl_Obj starting with a "-".  It
 *      can return an error, when the specified parameter is ambiguous.
 *
 * Results:
 *      A standard Tcl result, on success paramPtr in last argument
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int
CGetParamLookup(
    Tcl_Interp       *interp,
    Tcl_Obj          *nameObj,
    NsfParamDefs     *paramDefs,
    const Nsf_Param **paramPtrPtr
) nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static int
CGetParamLookup(Tcl_Interp *interp, Tcl_Obj *nameObj, NsfParamDefs *paramDefs, const Nsf_Param **paramPtrPtr)
{
  const char *nameString;
  int         result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(paramDefs != NULL);
  nonnull_assert(paramPtrPtr != NULL);

  /*
   * Does provided value start with a dash?
   */
  nameString = ObjStr(nameObj);
  if (unlikely(*nameString != '-')) {
    result = NsfPrintError(interp,
                           "cget: parameter must start with a '-': %s",
                           nameString);

  } else {
    NsfFlag *flagPtr = nameObj->internalRep.twoPtrValue.ptr1;

    if ((nameObj->typePtr == &NsfFlagObjType)
        && (flagPtr->signature == paramDefs->paramsPtr)
        && (flagPtr->serial == paramDefs->serial)
        ) {
      *paramPtrPtr = flagPtr->paramPtr;

    } else {
      Nsf_Param  *paramPtr;

      /*
       * Skip leading parameters from the definition, which are no non-pos args
       * (very unlikely).
       */
      for (paramPtr = paramDefs->paramsPtr;
           (paramPtr->name != NULL) && (*paramPtr->name != '-');
           paramPtr++) {
        ;
      }

      /*
       * Perform the lookup from the group starting with paramPtr.
       */
      result = NsfParamDefsNonposLookup(interp, nameString, paramPtr, paramPtrPtr);
      if (unlikely(result == TCL_OK)) {
        /*
         * Set the flag value. Probably, we should prohibit conversion on some
         * types.
         */
        NsfFlagObjSet(interp, nameObj, paramDefs->paramsPtr, paramDefs->serial,
                      *paramPtrPtr, NULL, 0u);
      }
    }
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * NsfProcDeleteProc --
 *
 *      FreeProc for procs with associated parameter definitions.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Freeing memory.
 *
 *----------------------------------------------------------------------
 */
static void
NsfProcDeleteProc(
    ClientData clientData
) {
  const NsfProcContext *ctxPtr;

  nonnull_assert(clientData != NULL);

  ctxPtr = (NsfProcContext *)clientData;
  if (ctxPtr->oldDeleteProc != NULL) {
    (*ctxPtr->oldDeleteProc)(ctxPtr->oldDeleteData);
  }
  if (ctxPtr->paramDefs != NULL) {
    /*fprintf(stderr, "free ParamDefs %p\n", (void*)ctxPtr->paramDefs);*/
    ParamDefsRefCountDecr(ctxPtr->paramDefs);
  }
  if (ctxPtr->colonLocalVarCache != NULL) {
    /*fprintf(stderr, "free colonLocalVarCache %p\n", (void*)ctxPtr->colonLocalVarCache);*/
    FREE(int*, ctxPtr->colonLocalVarCache);
  }
  if (ctxPtr->returnsObj != NULL) {
    DECR_REF_COUNT2("returnsObj", ctxPtr->returnsObj);
  }

  if (ctxPtr->execNsPtr != NULL) {
    /*
     * Balances increment in ParamDefsStore.
     */
    NSNamespaceRelease(ctxPtr->execNsPtr);
  }

  /*fprintf(stderr, "free %p\n", (void *)ctxPtr);*/
  FREE(NsfProcContext, ctxPtr);
}

/*
 *----------------------------------------------------------------------
 * ProcContextRequire --
 *
 *      Obtain an NsfProcContext for the given cmd. Create a new one, if it does
 *      not exist, or return the existing one.
 *
 * Results:
 *      NsfProcContext *
 *
 * Side effects:
 *      Might allocate memory
 *
 *----------------------------------------------------------------------
 */
static NsfProcContext *
ProcContextRequire(
    Tcl_Command cmd
) {
  NsfProcContext *ctxPtr;
  Command        *cmdPtr;

  nonnull_assert(cmd != NULL);

  cmdPtr = (Command *)cmd;

  if (cmdPtr->deleteProc != NsfProcDeleteProc) {
    ctxPtr = NEW(NsfProcContext);

    /*fprintf(stderr, "ParamDefsStore %p replace deleteProc %p by %p\n",
      (void *)paramDefs, (void *)cmdPtr->deleteProc, (void *)NsfProcDeleteProc);*/

    ctxPtr->oldDeleteData      = (Proc *)cmdPtr->deleteData;
    ctxPtr->oldDeleteProc      = cmdPtr->deleteProc;
    cmdPtr->deleteProc         = NsfProcDeleteProc;
    cmdPtr->deleteData         = ctxPtr;

    ctxPtr->paramDefs          = NULL;
    ctxPtr->checkAlwaysFlag    = 0;
    ctxPtr->execNsPtr          = NULL;
    ctxPtr->colonLocalVarCache = NULL;
    ctxPtr->returnsObj         = NULL;
  } else {
    ctxPtr = (NsfProcContext *)Tcl_Command_deleteData(cmdPtr);
  }
  return ctxPtr;
}

/*
 *----------------------------------------------------------------------
 * ProcContextGet --
 *
 *      Obtain an NsfProcContext for the given cmd when it is defined.
 *
 * Results:
 *      NsfProcContext * or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static NsfProcContext *
ProcContextGet(
    const Tcl_Command cmdPtr
) {
  NsfProcContext *result;

  nonnull_assert(cmdPtr != NULL);

  if (likely(Tcl_Command_deleteProc(cmdPtr) == NsfProcDeleteProc)) {
    result = (NsfProcContext *)Tcl_Command_deleteData(cmdPtr);
  } else {
    result = NULL;
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * ParamDefsStore --
 *
 *      Store the provided parameter definitions in the provided
 *      command. It stores a new deleteProc which will call the original
 *      delete proc automatically.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void ParamDefsStore(
    Tcl_Command cmd,
    NsfParamDefs *paramDefs,
    unsigned int checkAlwaysFlag,
    Tcl_Namespace *execNsPtr
) nonnull(1);

static void
ParamDefsStore(
    Tcl_Command cmd,
    NsfParamDefs *paramDefs,
    unsigned int checkAlwaysFlag,
    Tcl_Namespace *execNsPtr
) {
  NsfProcContext *ctxPtr;

  nonnull_assert(cmd != NULL);

  ctxPtr = ProcContextRequire(cmd);

  /*
   * We assume, that this never called for overwriting paramDefs
   */
  assert(ctxPtr->paramDefs == NULL);
  /* fprintf(stderr, "ParamDefsStore paramDefs %p called: NS %s\n",
     (void *)paramDefs, execNsPtr ? execNsPtr->fullName : "na");*/
  ctxPtr->paramDefs       = paramDefs;
  ctxPtr->checkAlwaysFlag = checkAlwaysFlag;
  ctxPtr->execNsPtr       = execNsPtr;

  if (ctxPtr->execNsPtr != NULL) {
    /*
     * Balanced by decrement in NsfProcDeleteProc.
     */
    NSNamespacePreserve(ctxPtr->execNsPtr);
  }
}

/*
 *----------------------------------------------------------------------
 * ParamDefsNew --
 *
 *      Allocate a new paramDefs structure and initialize it with zeros. The
 *      allocated structure should be freed with ParamDefsFree().
 *
 * Results:
 *      pointer to paramDefs structure
 *
 * Side effects:
 *      Allocating memory
 *
 *----------------------------------------------------------------------
 */
static NsfParamDefs *
ParamDefsNew(void) {
  NsfParamDefs    *paramDefs;
  static NsfMutex  serialMutex = 0;
  static int       serial = 0;

  paramDefs = NEW(NsfParamDefs);
  memset(paramDefs, 0, sizeof(NsfParamDefs));

  /*
   * We could keep the serial as well in thread local storage.
   */
  NsfMutexLock(&serialMutex);
  paramDefs->serial = serial++;
  NsfMutexUnlock(&serialMutex);

  /*fprintf(stderr, "ParamDefsNew %p\n", (void *)paramDefs);*/

  return paramDefs;
}


/*
 *----------------------------------------------------------------------
 * ParamDefsFree --
 *
 *      Free the parameter definitions. Since the parameter definitions are
 *      ref-counted, this function should be just called via
 *      ParamDefsRefCountDecr.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free the parameter definitions.
 *
 *----------------------------------------------------------------------
 */

static void ParamDefsFree(NsfParamDefs *paramDefs)
  nonnull(1);

static void
ParamDefsFree(NsfParamDefs *paramDefs) {
  /* fprintf(stderr, "ParamDefsFree %p \n",
     (void *)paramDefs, paramDefs);*/

  nonnull_assert(paramDefs != NULL);

  if (paramDefs->paramsPtr != NULL) {
    ParamsFree(paramDefs->paramsPtr);
  }

  FREE(NsfParamDefs, paramDefs);
}

/*
 *----------------------------------------------------------------------
 * ParamDefsRefCountIncr --
 * ParamDefsRefCountDecr --
 *
 *      Perform book keeping on the parameter definitions. RefCounting is
 *      necessary, since it might be possible that during the processing of the
 *      e.g. object parameters, these might be redefined (when an object
 *      parameter calls a method, redefining the structures).
 *      ParamDefsRefCountDecr() is responsible for actually freeing the
 *      structure.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      No direct.
 *
 *----------------------------------------------------------------------
 */


static void
ParamDefsRefCountIncr(NsfParamDefs *paramDefs) {

  nonnull_assert(paramDefs != NULL);

  paramDefs->refCount ++;
}

static void
ParamDefsRefCountDecr(NsfParamDefs *paramDefs) {

  nonnull_assert(paramDefs != NULL);

  paramDefs->refCount --;
  if (paramDefs->refCount < 1) {
    ParamDefsFree(paramDefs);
  }
}

/*
 *----------------------------------------------------------------------
 * ParamDefsFormatOption --
 *
 *      Append a parameter option to the nameStringObj representing the
 *      syntax of the parameter definition.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void ParamDefsFormatOption(
    Tcl_Obj *nameStringObj, const char *option, int optionLength,
    int *colonWritten, int *firstOption
) nonnull(1) nonnull(2) nonnull(4) nonnull(5);

static void
ParamDefsFormatOption(
    Tcl_Obj *nameStringObj, const char *option, int optionLength,
    int *colonWritten, int *firstOption
) {

  nonnull_assert(nameStringObj != NULL);
  nonnull_assert(option != NULL);
  nonnull_assert(colonWritten != NULL);
  nonnull_assert(firstOption != NULL);

  if (!*colonWritten) {
    Tcl_AppendLimitedToObj(nameStringObj, ":", 1, INT_MAX, NULL);
    *colonWritten = 1;
  }
  if (*firstOption) {
    *firstOption = 0;
  } else {
    Tcl_AppendLimitedToObj(nameStringObj, ",", 1, INT_MAX, NULL);
  }
  Tcl_AppendLimitedToObj(nameStringObj, option, optionLength, INT_MAX, NULL);
}

/*
 *----------------------------------------------------------------------
 * ParamDefsFormat --
 *
 *      Produce a Tcl_Obj representing a single parameter in the syntax
 *      of the parameter definition.
 *
 * Results:
 *      Tcl_Obj
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj *ParamDefsFormat(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr, NsfObject *contextObject, const char *pattern
) nonnull(1) nonnull(2) returns_nonnull;

static int ParamsDefMatchPattern(const Nsf_Param *paramsPtr, const char *pattern) {
  if (paramsPtr->nameObj != NULL) {
    return Tcl_StringMatch(ObjStr(paramsPtr->nameObj), pattern);
  } else {
    return Tcl_StringMatch(paramsPtr->name, pattern);
  }
}


static Tcl_Obj *
ParamDefsFormat(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr, NsfObject *contextObject, const char *pattern
) {
  int      first, colonWritten;
  Tcl_Obj *listObj = Tcl_NewListObj(0, NULL), *innerListObj, *nameStringObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(paramsPtr != NULL);

  INCR_REF_COUNT2("paramDefsObj", listObj);

  for (; likely(paramsPtr->name != NULL); paramsPtr++) {
    if ((paramsPtr->flags & NSF_ARG_NOCONFIG) != 0u) {
      continue;
    }
    if (paramsPtr->paramObj != NULL) {
      if (pattern != NULL && !ParamsDefMatchPattern(paramsPtr, pattern)) {
        continue;
      }
      innerListObj = paramsPtr->paramObj;
    } else {
      /*
       * We need this part only for C-defined parameter definitions,
       * defined via genTclAPI.
       *
       * TODO: we could streamline this by defining as well C-API via
       * the same syntax as for accepted for Tcl obj types "nsfParam"
       */
      int isNonpos = *paramsPtr->name == '-';
      int outputRequired = (isNonpos && ((paramsPtr->flags & NSF_ARG_REQUIRED) != 0u));
      int outputOptional = (!isNonpos && ((paramsPtr->flags & NSF_ARG_REQUIRED) == 0u)
                            && !paramsPtr->defaultValue &&
                            paramsPtr->converter != ConvertToNothing);
      first = 1;
      colonWritten = 0;

      if (NsfParamDefsAppendVirtual(interp, listObj, paramsPtr, contextObject, pattern, ParamDefsFormat)) {
        continue;
      }
      if (pattern != NULL && !ParamsDefMatchPattern(paramsPtr, pattern)) {
        continue;
      }

      nameStringObj = Tcl_NewStringObj(paramsPtr->name, -1);

      if (paramsPtr->type != NULL) {
        ParamDefsFormatOption(nameStringObj, paramsPtr->type, -1, &colonWritten, &first);
      } else if (isNonpos && paramsPtr->nrArgs == 0) {
        ParamDefsFormatOption(nameStringObj, "switch", 6, &colonWritten, &first);
      }
      if (outputRequired != 0) {
        ParamDefsFormatOption(nameStringObj, "required", 8, &colonWritten, &first);
      } else if (outputOptional != 0) {
        ParamDefsFormatOption(nameStringObj, "optional", 8, &colonWritten, &first);
      }
      if ((paramsPtr->flags & NSF_ARG_SUBST_DEFAULT) != 0u) {
        char buffer[30];
        int  len = 12;

        memcpy(buffer, "substdefault", (size_t)len);

        if ((paramsPtr->flags & NSF_ARG_SUBST_DEFAULT_ALL) != 0u) {
          memcpy(buffer + len + 1, "=0b", 3u);
          len += 4;
          buffer[len] = ((paramsPtr->flags & NSF_ARG_SUBST_DEFAULT_VARIABLES) != 0u) ? '1' : '0';
          len ++;
          buffer[len] = ((paramsPtr->flags & NSF_ARG_SUBST_DEFAULT_COMMANDS) != 0u) ? '1' : '0';
          len ++;
          buffer[len] = ((paramsPtr->flags & NSF_ARG_SUBST_DEFAULT_BACKSLASHES) != 0u) ? '1' : '0';
          len ++;
        } else {
          len ++;
        }
        buffer[len] = '\0';
        ParamDefsFormatOption(nameStringObj, buffer, len, &colonWritten, &first);

      }
      if ((paramsPtr->flags & NSF_ARG_ALLOW_EMPTY) != 0u || (paramsPtr->flags & NSF_ARG_MULTIVALUED) != 0u) {
        char option[10] = "....";

        option[0] = ((paramsPtr->flags & NSF_ARG_ALLOW_EMPTY) != 0u) ? '0' : '1';
        option[3] = ((paramsPtr->flags & NSF_ARG_MULTIVALUED) != 0u) ? '*' : '1';
        ParamDefsFormatOption(nameStringObj, option, 4, &colonWritten, &first);
      }
      if ((paramsPtr->flags & NSF_ARG_IS_CONVERTER) != 0u) {
        ParamDefsFormatOption(nameStringObj, "convert", 7, &colonWritten, &first);
      }
      if ((paramsPtr->flags & NSF_ARG_INITCMD) != 0u) {
        ParamDefsFormatOption(nameStringObj, "initcmd", 7, &colonWritten, &first);
      } else if ((paramsPtr->flags & NSF_ARG_CMD) != 0u) {
        ParamDefsFormatOption(nameStringObj, "cmd", 3, &colonWritten, &first);
      } else if ((paramsPtr->flags & NSF_ARG_ALIAS) != 0u) {
        ParamDefsFormatOption(nameStringObj, "alias", 5, &colonWritten, &first);
      } else if ((paramsPtr->flags & NSF_ARG_FORWARD) != 0u) {
        ParamDefsFormatOption(nameStringObj, "forward", 7, &colonWritten, &first);
      } else if ((paramsPtr->flags & NSF_ARG_NOARG) != 0u) {
        ParamDefsFormatOption(nameStringObj, "noarg", 5, &colonWritten, &first);
      } else if ((paramsPtr->flags & NSF_ARG_NOCONFIG) != 0u) {
        ParamDefsFormatOption(nameStringObj, "noconfig", 8, &colonWritten, &first);
      }

      innerListObj = Tcl_NewListObj(0, NULL);
      Tcl_ListObjAppendElement(interp, innerListObj, nameStringObj);
      if (paramsPtr->defaultValue != NULL) {
        Tcl_ListObjAppendElement(interp, innerListObj, paramsPtr->defaultValue);
      }
    }

    Tcl_ListObjAppendElement(interp, listObj, innerListObj);
  }

  return listObj;
}

/*
 *----------------------------------------------------------------------
 * ParamDefsList --
 *
 *      Produce a Tcl_ListObj containing the list of the parameters
 *      based on a parameter structure.
 *
 * Results:
 *      Tcl_Obj
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj *ParamDefsList(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr, NsfObject *contextObject, const char *pattern
) nonnull(1) nonnull(2) returns_nonnull;

static Tcl_Obj *
ParamDefsList(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr, NsfObject *contextObject, const char *pattern
) {
  Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);

  nonnull_assert(interp != NULL);
  nonnull_assert(paramsPtr != NULL);

  INCR_REF_COUNT2("paramDefsObj", listObj);

  for (; likely(paramsPtr->name != NULL); paramsPtr++) {
    if ((paramsPtr->flags & NSF_ARG_NOCONFIG) != 0u) {
      continue;
    }
    if (NsfParamDefsAppendVirtual(interp, listObj, paramsPtr, contextObject, pattern, ParamDefsList)) {
      continue;
    }

    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(paramsPtr->name, -1));
  }

  return listObj;
}


/*
 *----------------------------------------------------------------------
 * ParamDefsNames --
 *
 *      Produce a Tcl_ListObj containing the names of the parameters
 *      based on a parameter structure.
 *
 * Results:
 *      Tcl_Obj
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj * ParamDefsNames(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr, NsfObject *contextObject, const char *pattern
) nonnull(1) nonnull(2) returns_nonnull;

static Tcl_Obj *
ParamDefsNames(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr, NsfObject *contextObject, const char *pattern
) {
  Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);

  nonnull_assert(interp != NULL);
  nonnull_assert(paramsPtr != NULL);

  INCR_REF_COUNT2("paramDefsObj", listObj);

  for (; likely(paramsPtr->name != NULL); paramsPtr++) {
    const char* paramName;

    if ((paramsPtr->flags & NSF_ARG_NOCONFIG) != 0u) {
      continue;
    }
    if (NsfParamDefsAppendVirtual(interp, listObj, paramsPtr, contextObject, pattern, ParamDefsNames)) {
      continue;
    }

    paramName = *paramsPtr->name == '-' ? paramsPtr->name+1 : paramsPtr->name;
    if (pattern != NULL && !Tcl_StringMatch(paramName, pattern)) {
      continue;
    }
    Tcl_ListObjAppendElement(interp, listObj, (paramsPtr->nameObj != NULL) ?
                             paramsPtr->nameObj : Tcl_NewStringObj(paramsPtr->name, -1));
  }

  return listObj;
}

/*
 *----------------------------------------------------------------------
 * ParamGetType --
 *
 *      Obtain the type of a single parameter and return it as a string.
 *
 * Results:
 *      Type of the parameter in form of a string
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static const char *ParamGetType(Nsf_Param const *paramPtr)
  nonnull(1) returns_nonnull;

static const char *
ParamGetType(Nsf_Param const *paramPtr) {
  const char *result = "value";

  nonnull_assert(paramPtr != NULL);

  if (paramPtr->type != NULL) {
    if (paramPtr->converter == ConvertViaCmd) {
      result = paramPtr->type + 5;
    } else if (paramPtr->converter == Nsf_ConvertToClass &&
               ((paramPtr->flags & (NSF_ARG_BASECLASS|NSF_ARG_METACLASS)) != 0u) ) {
      if ((paramPtr->flags & NSF_ARG_BASECLASS) != 0u) {
        result = "baseclass";
      } else {
        result = "metaclass";
      }
    } else if (strcmp(paramPtr->type, "stringtype") == 0) {
      if (paramPtr->converterArg != NULL) {
        result = ObjStr(paramPtr->converterArg);
      }
    } else {
      result = paramPtr->type;
    }
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * ParamGetDomain --
 *
 *      Obtain the domain of a single parameter and return it as a
 *      string. The domain is an approximate type used in the parameter
 *      syntax.
 *
 * Results:
 *      Domain of the parameter in form of a string
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static const char * ParamGetDomain(Nsf_Param const *paramPtr)
  nonnull(1) returns_nonnull;

static const char *
ParamGetDomain(Nsf_Param const *paramPtr) {
  const char *result;

  nonnull_assert(paramPtr != NULL);

  if ((paramPtr->flags & NSF_ARG_IS_ENUMERATION) != 0u) {
    return Nsf_EnumerationTypeGetDomain(paramPtr->converter);
  } else {
    result = ParamGetType(paramPtr);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * NsfParamDefsSyntaxOne --
 *
 *      Appends the formatted parameter (provided as 2nd argument) to the
 *      content of the first argument.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Appending to first argument.
 *
 *----------------------------------------------------------------------
 */

static void NsfParamDefsSyntaxOne(Tcl_Obj *argStringObj, const Nsf_Param *pPtr)
  nonnull(1) nonnull(2);

static void
NsfParamDefsSyntaxOne(Tcl_Obj *argStringObj, const Nsf_Param *pPtr) {

  nonnull_assert(argStringObj != NULL);
  nonnull_assert(pPtr != NULL);

  if (pPtr->nrArgs > 0 && *pPtr->name == '-') {
    Tcl_AppendLimitedToObj(argStringObj, pPtr->name, -1, INT_MAX, NULL);
    Tcl_AppendLimitedToObj(argStringObj, " ", 1, INT_MAX, NULL);
    if ((pPtr->flags & NSF_ARG_IS_ENUMERATION) != 0u) {
      Tcl_AppendLimitedToObj(argStringObj, ParamGetDomain(pPtr), -1, INT_MAX, NULL);
      if ((pPtr->flags & NSF_ARG_MULTIVALUED) != 0u)  {
        Tcl_AppendLimitedToObj(argStringObj, " ...", 4, INT_MAX, NULL);
      }
    } else {
      Tcl_AppendLimitedToObj(argStringObj, "/", 1, INT_MAX, NULL);
      Tcl_AppendLimitedToObj(argStringObj, ParamGetDomain(pPtr), -1, INT_MAX, NULL);
      if ((pPtr->flags & NSF_ARG_MULTIVALUED) != 0u) {
        Tcl_AppendLimitedToObj(argStringObj, " ...", 4, INT_MAX, NULL);
      }
      Tcl_AppendLimitedToObj(argStringObj, "/", 1, INT_MAX, NULL);
    }
  } else if (*pPtr->name != '-') {
    Tcl_AppendLimitedToObj(argStringObj, "/", 1, INT_MAX, NULL);
    Tcl_AppendLimitedToObj(argStringObj, pPtr->name, -1, INT_MAX, NULL);
    Tcl_AppendLimitedToObj(argStringObj, "/", 1, INT_MAX, NULL);
  } else {
    Tcl_AppendLimitedToObj(argStringObj, pPtr->name, -1, INT_MAX, NULL);
  }
}

/*
 * NsfParamDefsVirtualFormat --
 *
 *      This function is called, when we know we can resolve a virtual argument
 *      against the context object. In such cases, obtain the resolved parsed
 *      params and call the formatter.
 *
 * Results:
 *      Standard Tcl result code.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
NsfParamDefsVirtualFormat(
    Tcl_Interp *interp, const Nsf_Param *pPtr,
    NsfObject *contextObject, const char *pattern,
    NsfFormatFunction formatFunction
) {
  NsfParsedParam parsedParam;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(contextObject != NULL);
  nonnull_assert(formatFunction != NULL);
  assert(pPtr->type != NULL);

  parsedParam.paramDefs = NULL;
  if (strcmp(pPtr->type, "virtualobjectargs") == 0) {
    result = GetObjectParameterDefinition(interp, NsfGlobalObjs[NSF_EMPTY], contextObject, NULL, &parsedParam);
  } else if (NsfObjectIsClass(contextObject)) {
    result = GetObjectParameterDefinition(interp, NsfGlobalObjs[NSF_EMPTY], NULL, (NsfClass *)contextObject, &parsedParam);
  } else {
    NsfLog(interp, NSF_LOG_WARN, "virtual args: provided context is not a class <%s>", ObjectName_(contextObject));
    result = TCL_ERROR;
  }

  if (result == TCL_OK && parsedParam.paramDefs != NULL) {
    return (*formatFunction)(interp, parsedParam.paramDefs->paramsPtr, contextObject, pattern);
  }

  return NULL;
}

/*
 *----------------------------------------------------------------------
 * NsfParamDefsAppendVirtual --
 *
 *      Check for the given paramsPtr whether this is a virtual parameter and if
 *      possible, resolve it and append the formatted content to the Tcl_Obj.
 *
 * Results:
 *      Boolean value for success
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool
NsfParamDefsAppendVirtual(
    Tcl_Interp *interp, Tcl_Obj *listObj,
    const Nsf_Param *paramsPtr, NsfObject *contextObject,
    const char *pattern, NsfFormatFunction formatFunction
) {
  nonnull_assert(interp != NULL);
  nonnull_assert(listObj != NULL);
  nonnull_assert(paramsPtr != NULL);
  nonnull_assert(formatFunction != NULL);

  assert(paramsPtr->name != NULL);

  if (paramsPtr->converter == ConvertToNothing && strcmp(paramsPtr->name, "args") == 0) {

    if ((contextObject != NULL)
        && (paramsPtr->type != NULL)
        && strncmp(paramsPtr->type, "virtual", 7) == 0
        ) {
      Tcl_Obj *formattedObj = NsfParamDefsVirtualFormat(interp, paramsPtr, contextObject, pattern, formatFunction);

      if (formattedObj != NULL) {
        Tcl_ListObjAppendList(interp, listObj, formattedObj);
        DECR_REF_COUNT2("paramDefsObj", formattedObj);

        return NSF_TRUE;
      }
    }
  }
  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * NsfParamDefsSyntax --
 *
 *      Return the parameter definitions of a sequence of parameters in
 *      the form of the "parametersyntax", inspired by the Tcl manual
 *      pages.
 *
 * Results:
 *      Tcl_Obj containing the parameter syntax
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *NsfParamDefsSyntax(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr, NsfObject *contextObject, const char *pattern
) nonnull(1) nonnull(2) returns_nonnull;

Tcl_Obj *
NsfParamDefsSyntax(
    Tcl_Interp *interp, const Nsf_Param *paramsPtr, NsfObject *contextObject, const char *pattern
) {
  Tcl_Obj         *argStringObj = Tcl_NewObj();
  const Nsf_Param *pPtr;
  int              needSpace = 0;

  nonnull_assert(interp != NULL);
  nonnull_assert(paramsPtr != NULL);

  INCR_REF_COUNT2("paramDefsObj", argStringObj);

  for (pPtr = paramsPtr; pPtr->name != NULL; pPtr++) {

    if ((pPtr->flags & NSF_ARG_NOCONFIG) != 0u) {
      /*
       * Don't output non-configurable parameters
       */
      continue;
    }

    if (pPtr != paramsPtr) {
      /*
       * Don't output non-consuming parameters (i.e. positional, and no args)
       */
      if (*pPtr->name != '-' && pPtr->nrArgs == 0) {
        continue;
      }
    }

    if (pPtr->converter == ConvertToNothing && strcmp(pPtr->name, "args") == 0) {
      int argsResolved = 0;

      if ((contextObject != NULL)
          && (pPtr->type != NULL)
          && strncmp(pPtr->type, "virtual", 7) == 0
          ) {
        Tcl_Obj *formattedObj = NsfParamDefsVirtualFormat(interp, pPtr, contextObject,
                                                          pattern, NsfParamDefsSyntax);

        if (formattedObj != NULL) {
          argsResolved = 1;
          if (needSpace != 0) {
            Tcl_AppendLimitedToObj(argStringObj, " ", 1, INT_MAX, NULL);
          }
          Tcl_AppendObjToObj(argStringObj, formattedObj);
          DECR_REF_COUNT2("paramDefsObj", formattedObj);
        }
      }
      if (argsResolved == 0) {
        if (pattern != NULL && !ParamsDefMatchPattern(pPtr, pattern)) {
          continue;
        }
        if (needSpace != 0) {
          Tcl_AppendLimitedToObj(argStringObj, " ", 1, INT_MAX, NULL);
        }
        Tcl_AppendLimitedToObj(argStringObj, "?/arg .../?", 11, INT_MAX, NULL);
      }

    } else if ((pPtr->flags & NSF_ARG_REQUIRED) != 0u) {
      if (pattern != NULL && !ParamsDefMatchPattern(pPtr, pattern)) {
        continue;
      }
      if (needSpace != 0) {
        Tcl_AppendLimitedToObj(argStringObj, " ", 1, INT_MAX, NULL);
      }

      if ((pPtr->flags & NSF_ARG_IS_ENUMERATION) != 0u) {
        Tcl_AppendLimitedToObj(argStringObj, Nsf_EnumerationTypeGetDomain(pPtr->converter), -1, INT_MAX, NULL);
      } else {
        NsfParamDefsSyntaxOne(argStringObj, pPtr);
      }

    } else {
      if (pattern != NULL && !ParamsDefMatchPattern(pPtr, pattern)) {
        continue;
      }
      if (needSpace != 0) Tcl_AppendLimitedToObj(argStringObj, " ", 1, INT_MAX, NULL);
      Tcl_AppendLimitedToObj(argStringObj, "?", 1, INT_MAX, NULL);
      NsfParamDefsSyntaxOne(argStringObj, pPtr);
      Tcl_AppendLimitedToObj(argStringObj, "?", 1, INT_MAX, NULL);
    }
    needSpace = 1;
  }

  /*
   * Caller has to decrement.
   */
  return argStringObj;
}

/*
 *----------------------------------------------------------------------
 * ParsedParamFree --
 *
 *      Free the provided information of the parsed parameters.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Freed Memory.
 *
 *----------------------------------------------------------------------
 */
static void
ParsedParamFree(NsfParsedParam *parsedParamPtr) {

  nonnull_assert(parsedParamPtr != NULL);

  /*fprintf(stderr, "ParsedParamFree %p, npargs %p\n",
    (void *)parsedParamPtr, (void *)parsedParamPtr->paramDefs);*/
  if (parsedParamPtr->paramDefs != NULL) {
    ParamDefsRefCountDecr(parsedParamPtr->paramDefs);
  }
  FREE(NsfParsedParam, parsedParamPtr);
}



/*
 * method dispatch
 */
/*
 *----------------------------------------------------------------------
 * ProcMethodDispatchFinalize --
 *
 *      Finalization function for ProcMethodDispatch which executes
 *      scripted methods. Essentially it handles post-assertions and
 *      frees per-invocation memory. The function was developed for NRE
 *      enabled Tcl versions but is used in the same way for non-NRE
 *      enabled versions.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      indirect effects by calling Tcl code
 *
 *----------------------------------------------------------------------
 */
static int ProcMethodDispatchFinalize(ClientData data[], Tcl_Interp *interp, int result)
  nonnull(1) nonnull(2);

static int
ProcMethodDispatchFinalize(ClientData data[], Tcl_Interp *interp, int result) {
  ParseContext       *pcPtr;
  /*const char *methodName = data[2];*/
#if defined(NSF_WITH_ASSERTIONS) || defined(NRE)
  NsfCallStackContent *cscPtr;
#endif
#if defined(NSF_WITH_ASSERTIONS)
  NsfObject           *object;
  NsfObjectOpt        *opt;
#endif

  nonnull_assert(data != NULL);
  nonnull_assert(interp != NULL);

  pcPtr = data[0];

#if defined(NSF_WITH_ASSERTIONS) || defined(NRE)
  cscPtr = data[1];
  assert(cscPtr != NULL);
#endif
#if defined(NSF_WITH_ASSERTIONS)
  object = cscPtr->self;
  opt = object->opt;
#endif

  /*fprintf(stderr, "ProcMethodDispatchFinalize %s %s flags %.6x isNRE %d pcPtr %p result %d\n",
          ObjectName(object), methodName,
          cscPtr->flags, (cscPtr->flags & NSF_CSC_CALL_IS_NRE), (void *)pcPtr, result);*/

#if defined(NSF_WITH_ASSERTIONS)
  if (unlikely(opt != NULL && object->teardown != NULL && (opt->checkoptions & CHECK_POST))
      && likely(result == TCL_OK)) {
    int rc = AssertionCheck(interp, object, cscPtr->cl, data[2], CHECK_POST);
    if (rc != TCL_OK) {
      result = rc;
    }
  }
#endif

#if defined(NRE)
  if (likely((cscPtr->flags & NSF_CSC_CALL_IS_NRE) != 0u)) {
    if (likely(pcPtr != NULL)) {
      ParseContextRelease(pcPtr);
      NsfTclStackFree(interp, pcPtr, "release parse context");
    }
    result = ObjectDispatchFinalize(interp, cscPtr, result /*, "NRE" , methodName*/);

    CscFinish(interp, cscPtr, result, "scripted finalize");
  }
#else
  if (unlikely(pcPtr != NULL)) {
    ParseContextRelease(pcPtr);
  }
#endif

  return result;
}

/*
 *----------------------------------------------------------------------
 * ProcDispatchFinalize --
 *
 *      Finalization function for nsf::proc. Simplified version of
 *      ProcMethodDispatchFinalize().
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      indirect effects by calling Tcl code
 *
 *----------------------------------------------------------------------
 */
static int ProcDispatchFinalize(ClientData data[], Tcl_Interp *interp, int result)
  nonnull(1) nonnull(2);

static int
ProcDispatchFinalize(ClientData data[], Tcl_Interp *interp, int result) {
  ParseContext *pcPtr;
  Tcl_Time     *ttPtr;

  nonnull_assert(data != NULL);
  nonnull_assert(interp != NULL);

  /*const char *methodName = data[0];
    fprintf(stderr, "ProcDispatchFinalize of method %s\n", methodName);*/

  pcPtr = data[1];
  ttPtr = data[2];

  if (ttPtr != NULL) {
    const char      *methodName = data[0];
    unsigned int     cmdFlags   = (unsigned int)PTR2UINT(data[3]);
#if defined(NSF_PROFILE)
    NsfRuntimeState *rst        = RUNTIME_STATE(interp);
#endif
    /*fprintf(stderr, "ProcDispatchFinalize methodName %s flags %.6lx\n",
      methodName, (cmdFlags & NSF_CMD_DEBUG_METHOD));*/
    if ((cmdFlags & NSF_CMD_DEBUG_METHOD) != 0u) {
      NsfProfileDebugExit(interp, NULL, NULL, methodName, ttPtr->sec, ttPtr->usec);
    }
#if defined(NSF_PROFILE)
    if (rst->doProfile != 0) {
      NsfProfileRecordProcData(interp, methodName, ttPtr->sec, ttPtr->usec);
    }
#endif
    ckfree((char *)ttPtr);
  }

  ParseContextRelease(pcPtr);
  NsfTclStackFree(interp, pcPtr, "nsf::proc dispatch finalize release parse context");
  return result;
}


/*
 *----------------------------------------------------------------------
 * ProcMethodDispatch --
 *
 *      Invoke a scripted method (with assertion checking and filters).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Indirect effects by calling Tcl code
 *
 *----------------------------------------------------------------------
 */
static int ProcMethodDispatch(
    ClientData cp, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    const char *methodName, NsfObject *object, NsfClass *class, Tcl_Command cmdPtr,
    NsfCallStackContent *cscPtr
) nonnull(1) nonnull(2) nonnull(4) nonnull(5) nonnull(6) nonnull(8) nonnull(9);

static int
ProcMethodDispatch(
    ClientData cp, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    const char *methodName, NsfObject *object, NsfClass *class, Tcl_Command cmdPtr,
    NsfCallStackContent *cscPtr
) {
  NsfParamDefs  *paramDefs;
  int            result;
  bool           releasePc = NSF_FALSE;
  Tcl_Namespace *execNsPtr = NULL;
  unsigned int   checkAlwaysFlag = 0u;
#if defined(NSF_WITH_ASSERTIONS)
  NsfObjectOpt  *opt;
#endif
#if defined(NRE)
  ParseContext  *pcPtr = NULL;
#else
  ParseContext   pc, *pcPtr = &pc;
#endif

  nonnull_assert(cp != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cmdPtr != NULL);
  nonnull_assert(cscPtr != NULL);
  nonnull_assert(object != NULL);

  assert(object->teardown != NULL);

#if defined(NRE)
  /*fprintf(stderr, "ProcMethodDispatch cmd %s\n", Tcl_GetCommandName(interp, cmdPtr));*/
  assert((cscPtr->flags & NSF_CSC_CALL_IS_NRE) != 0u);
#endif

  /*
   * If this is a filter, check whether its guard applies,
   * if not: just step forward to the next filter
   */

  if (unlikely(cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER)) {
    NsfCmdList *cmdList;
    /*
     * Seek cmd in obj's filterOrder.
     */
    assert((object->flags & NSF_FILTER_ORDER_VALID) != 0u);
    /* otherwise: FilterComputeDefined(interp, object);*/

    for (cmdList = object->filterOrder;
         (cmdList != NULL) && (cmdList->cmdPtr != cmdPtr);
         cmdList = cmdList->nextPtr) {
      ;
    }

    if (cmdList != NULL) {
      /*
       * A filter was found, check whether it has a guard.
       */
      if (cmdList->clientData != NULL) {
        result = GuardCall(object, interp, cmdList->clientData, cscPtr);
      } else {
        result = TCL_OK;
      }

      if (unlikely(result != TCL_OK)) {
        /*fprintf(stderr, "Filter GuardCall in invokeProc returned %d\n", result);*/

        if (likely(result != TCL_ERROR)) {
          /*
           * The guard failed (but no error), and we call "next".
           * Since we may not be in a method with already provided
           * arguments, we call next with the actual arguments and
           * perform no argument substitution.
           *
           * The call stack content is not jet pushed to the Tcl
           * stack, we pass it already to search-and-invoke.
           */

          /*fprintf(stderr, "... calling nextmethod cscPtr %p\n", (void *)cscPtr);*/
          result = NextSearchAndInvoke(interp, methodName, objc, objv, cscPtr, NSF_FALSE);
          /*fprintf(stderr, "... after nextmethod result %d\n", result);*/
        }

        /*
         * Next might have succeeded or not, but we are done. In the
         * NRE-case, we need a CscFinish for all return codes.
         */
#if defined(NRE)
        CscFinish(interp, cscPtr, result, "guard failed");
#endif
        return result;
      }
    }
  }

#if defined(NSF_WITH_ASSERTIONS)
  opt = object->opt;
  if (unlikely(opt != NULL && (opt->checkoptions & CHECK_PRE)) &&
      (result = AssertionCheck(interp, object, class, methodName, CHECK_PRE)) == TCL_ERROR) {
    goto prep_done;
  }
#endif

  /*
   *  If the method to be invoked has paramDefs, we have to call the
   *  argument parser with the argument definitions obtained from the
   *  proc context from the cmdPtr.
   */
  paramDefs = ParamDefsGet(cmdPtr, &checkAlwaysFlag, &execNsPtr);

  if (paramDefs != NULL && paramDefs->paramsPtr != NULL) {
#if defined(NRE)
    pcPtr = (ParseContext *) NsfTclStackAlloc(interp, sizeof(ParseContext), "parse context");
#endif
    result = ProcessMethodArguments(pcPtr, interp, object,
                                    checkAlwaysFlag|NSF_ARGPARSE_METHOD_PUSH|NSF_ARGPARSE_FORCE_REQUIRED,
                                    paramDefs, objv[0], objc, objv);
    cscPtr->objc = objc;
    cscPtr->objv = (Tcl_Obj **)objv;

    if (likely(result == TCL_OK)) {
      releasePc = NSF_TRUE;
      result = PushProcCallFrame(cp, interp, pcPtr->objc+1, pcPtr->full_objv, execNsPtr, cscPtr);
    } else {
      /*
       * some error occurred
       */
#if defined(NRE)
      ParseContextRelease(pcPtr);
      NsfTclStackFree(interp, pcPtr, "parse context (proc prep failed)");
      pcPtr = NULL;
#else
      ParseContextRelease(pcPtr);
#endif
    }
  } else {
    /*if (execNsPtr == NULL) {
      fprintf(stderr, "PushProcCallFrame for %s without method arguments and empty execNsPtr %p\n",
              methodName, (void*)execNsPtr);
              }*/
    result = PushProcCallFrame(cp, interp, objc, objv, execNsPtr, cscPtr);
  }

  /*
   * The stack frame is pushed, we could do something here before
   * running the byte code of the body.
   */

  /* We could consider to run here ARG_METHOD or ARG_INITCMD
  if (likely(result == TCL_OK)) {

  }
  */

#if defined(NSF_WITH_ASSERTIONS)
 prep_done:
#endif

  if (likely(result == TCL_OK)) {
#if defined(NRE)
    /*fprintf(stderr, "CALL TclNRInterpProcCore %s method '%s'\n",
      ObjectName(object), ObjStr(objv[0]));*/
    Tcl_NRAddCallback(interp, ProcMethodDispatchFinalize,
                      (releasePc ? pcPtr : NULL),
                      cscPtr,
                      (ClientData)methodName,
                      NULL);
    cscPtr->flags |= NSF_CSC_CALL_IS_NRE;
    result = TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
#else
    ClientData data[3] = {
      (releasePc ? pcPtr : NULL),
      cscPtr,
      (ClientData)methodName
    };

    result = TclObjInterpProcCore(interp, objv[0], 1, &MakeProcError);
    result = ProcMethodDispatchFinalize(data, interp, result);
#endif
  } else /* result != OK */ {
#if defined(NRE)
    CscFinish(interp, cscPtr, result, "nre, prep failed");
#endif
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * CmdMethodDispatch --
 *
 *      Invoke a method implemented as a cmd.  Essentially it stacks
 *      optionally a frame, calls the method, pops the frame and runs
 *      invariants.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Indirect effects by calling cmd
 *
 *----------------------------------------------------------------------
 */
static int CmdMethodDispatch(
    ClientData cp, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    NsfObject *object, Tcl_Command cmd, NsfCallStackContent *cscPtr
) nonnull(2) nonnull(4) nonnull(5) nonnull(6);

static int
CmdMethodDispatch(
    ClientData cp, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    NsfObject *object, Tcl_Command cmd, NsfCallStackContent *cscPtr
) {
  CallFrame frame, *framePtr = &frame;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(cmd != NULL);
  nonnull_assert(object != NULL);

  assert(object->teardown != NULL);

#if defined(NRE)
  assert(!cscPtr || (cscPtr->flags & NSF_CSC_CALL_IS_NRE) == 0u);
#endif

  if (cscPtr != NULL) {
    /*
     * We have a call-stack content, but the requested dispatch will not store
     * the call-stack content in a corresponding call-frame on its own. To get,
     * for example, self-introspection working for the requested dispatch, we
     * introduce a CMETHOD frame.
     */
    /*fprintf(stderr, "Nsf_PushFrameCsc %s %s\n", ObjectName(object), Tcl_GetCommandName(interp, cmd));*/
    Nsf_PushFrameCsc(interp, cscPtr, framePtr);
    result = Tcl_NRCallObjProc(interp, Tcl_Command_objProc(cmd), cp, objc, objv);
    Nsf_PopFrameCsc(interp, framePtr);
  } else {
    result = Tcl_NRCallObjProc(interp, Tcl_Command_objProc(cmd), cp, objc, objv);
  }

#if defined(NSF_WITH_ASSERTIONS)
  if (unlikely(object->opt != NULL) && likely(result == TCL_OK)) {
    CheckOptions co = object->opt->checkoptions;

    if ((co & CHECK_INVAR)) {
      int rc = AssertionCheckInvars(interp, object, Tcl_GetCommandName(interp, cmd), co);

      if (rc != TCL_OK) {
        result = rc;
      }
    }
  }
#endif

  /*
   * Reference counting in the calling ObjectDispatch() makes sure
   * that obj->opt is still accessible even after "dealloc"
   */
  return result;
}

/*
 *----------------------------------------------------------------------
 * ObjectCmdMethodDispatch --
 *
 *      Invoke a method implemented as an object. The referenced object is used
 *      as a source for methods to be executed.  Essentially this is currently
 *      primarily used to implement the dispatch of ensemble objects.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Indirect effects by calling cmd
 *
 *----------------------------------------------------------------------
 */

static int ObjectCmdMethodDispatch(
    NsfObject *invokedObject, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    const char *methodName, NsfObject *callerSelf, NsfCallStackContent *cscPtr
) nonnull(1) nonnull(2) nonnull(4) nonnull(5) nonnull(6) nonnull(7);

static int
ObjectCmdMethodDispatch(
    NsfObject *invokedObject, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    const char *methodName, NsfObject *callerSelf, NsfCallStackContent *cscPtr
) {
  CallFrame    frame, *framePtr = &frame;
  Tcl_Command  cmd, subMethodCmd;
  const char  *subMethodName;
  NsfObject   *actualSelf;
  NsfClass    *actualClass;
  int          result;

  nonnull_assert(invokedObject != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(callerSelf != NULL);
  nonnull_assert(cscPtr != NULL);

  cmd = cscPtr->cmdPtr;
  /*fprintf(stderr, "ObjectCmdMethodDispatch %p %s\n", (void *)cmd, Tcl_GetCommandName(interp, cmd));*/
  /*fprintf(stderr, "ObjectCmdMethodDispatch method %s invokedObject %p %s callerSelf %p %s\n",
          methodName, (void *)invokedObject, ObjectName(invokedObject),
          (void *)callerSelf, ObjectName(callerSelf));*/

  if (unlikely((invokedObject->flags & NSF_DELETED) != 0u)) {
    /*
     * When we try to invoke a deleted object, the cmd (alias) is
     * automatically removed. Note that the cmd might be still referenced
     * in various entries in the call-stack. The reference counting on
     * these elements takes care that the cmdPtr is deleted on a pop
     * operation (although we do a Tcl_DeleteCommandFromToken() below.
     */

    /*fprintf(stderr, "methodName %s found DELETED object with cmd %p my cscPtr %p\n",
      methodName, (void *)cmd, (void *)cscPtr);*/

    Tcl_DeleteCommandFromToken(interp, cmd);
    if (cscPtr->cl != NULL) {
      NsfInstanceMethodEpochIncr("DeleteObjectAlias");
    } else {
      NsfObjectMethodEpochIncr("DeleteObjectAlias");
    }

    NsfCleanupObject(invokedObject, "alias-delete1");
    return NsfPrintError(interp, "trying to dispatch deleted object via method '%s'",
                         methodName);
  }

  /*
   * Check whether the object cmd was called without a reference to a
   * method. If so, perform the standard dispatch of default methods.
   */
  if (unlikely(objc < 2)) {

    if ((invokedObject->flags & NSF_PER_OBJECT_DISPATCH) != 0u) {
      cscPtr->flags |= NSF_CSC_CALL_IS_ENSEMBLE;
    }
    Nsf_PushFrameCsc(interp, cscPtr, framePtr);
    result = DispatchDefaultMethod(interp, invokedObject, objv[0], NSF_CSC_IMMEDIATE);
    Nsf_PopFrameCsc(interp, framePtr);
    return result;
  }

  /*
   * Check whether we want NSF_KEEP_CALLER_SELF. The setting of this flag
   * determines the values of actualSelf and actualClass.
   */
  if ((invokedObject->flags & NSF_KEEP_CALLER_SELF) != 0u) {
    actualSelf = callerSelf;
    actualClass = cscPtr->cl;
  } else {
    actualSelf = invokedObject;
    actualClass = NULL;
  }
  subMethodName = ObjStr(objv[1]);

  if ((invokedObject->flags & NSF_PER_OBJECT_DISPATCH) == 0u) {
    /*fprintf(stderr, "invokedObject %p %s methodName %s: no perobjectdispatch\n",
      (void*)invokedObject, ObjectName(invokedObject), methodName);*/
#if 0
    /*
     * We should have either an approach
     *  - to obtain from an object to methodname the cmd, and
     *    call e.g. MethodDispatch(), or pass a fully qualified
     *     method name, or
     *  - to pass the actualSelf and invokedObject both
     *    to MethodDispatch/MethodDispatch
     *  TODO: maybe remove NSF_CM_KEEP_CALLER_SELF when done.
     */
    result = MethodDispatch(interp, nobjc+1, nobjv-1, cmd, object,
                            NULL /*NsfClass *cl*/,
                            Tcl_GetCommandName(interp, cmd),
                            NSF_CSC_TYPE_PLAIN, flags);
#endif
#if 1
    /*
     * Simple and brutal.
     */
    if (likely(invokedObject->nsPtr != NULL)) {
      subMethodCmd = FindMethod(invokedObject->nsPtr, subMethodName);
    } else {
      subMethodCmd = NULL;
    }

    if (subMethodCmd == NULL) {
      /*
       * no -system handling.
       */
      actualClass = SearchPLMethod(invokedObject->cl->order, subMethodName, &subMethodCmd,
                                   NSF_CMD_CALL_PRIVATE_METHOD);
    }
    if (likely(subMethodCmd != NULL)) {
      cscPtr->objc = objc;
      cscPtr->objv = objv;
      Nsf_PushFrameCsc(interp, cscPtr, framePtr);
      result = MethodDispatch(interp, objc-1, objv+1,
                              subMethodCmd, actualSelf, actualClass, subMethodName,
                              cscPtr->frameType|NSF_CSC_TYPE_ENSEMBLE,
                              (cscPtr->flags & 0xFF)|NSF_CSC_IMMEDIATE);
      Nsf_PopFrameCsc(interp, framePtr);
      return result;
    }

  /*fprintf(stderr, "... objv[0] %s cmd %p %s csc %p\n",
    ObjStr(objv[0]), (void *)subMethodCmd, subMethodName, (void *)cscPtr); */

#endif
    return ObjectDispatch(actualSelf, interp, objc, objv, NSF_CM_KEEP_CALLER_SELF);
  }

  /*
   * NSF_PER_OBJECT_DISPATCH is set
   */

  if (likely(invokedObject->nsPtr != NULL)) {
    subMethodCmd = FindMethod(invokedObject->nsPtr, subMethodName);
  } else {
    subMethodCmd = NULL;
  }

#if 1
  if (subMethodCmd != NULL) {
    unsigned int cmdFlags = (unsigned int)Tcl_Command_flags(subMethodCmd);

    if ((cscPtr->flags & (NSF_CM_LOCAL_METHOD|NSF_CM_IGNORE_PERMISSIONS)) == 0u &&
        (cmdFlags & NSF_CMD_CALL_PRIVATE_METHOD) != 0u) {
      subMethodCmd = NULL;
    } else if (unlikely((cmdFlags & NSF_CMD_CALL_PROTECTED_METHOD) != 0u)) {
      const NsfObject *lastSelf;
      Tcl_CallFrame   *framePtr0;
      bool             withinEnsemble = ((cscPtr->frameType & NSF_CSC_TYPE_ENSEMBLE) != 0u);

      if (withinEnsemble) {
        Tcl_CallFrame *framePtr1;

        /* Alternatively: (void)NsfCallStackFindLastInvocation(interp, 0, &framePtr1); */
        (void)CallStackGetTopFrame(interp, &framePtr0);
        (void)CallStackFindEnsembleCsc(framePtr0, &framePtr1);
        /* NsfShowStack(interp);
           fprintf(stderr, "framePtr %p\n", (void *)framePtr1);*/
        if (framePtr1 != NULL) {
          lastSelf = GetSelfObj2(interp, framePtr1);
        } else {
          lastSelf = NULL;
        }
      } else {
        lastSelf = GetSelfObj(interp);
      }


      /* fprintf(stderr, "'%s (%s) == %s == %s? for %s\n", lastSelf != NULL ? ObjectName(lastSelf): "n/a",
              ObjectName(GetSelfObj(interp)), ObjectName(actualSelf), ObjectName(invokedObject), subMethodName); */

      if (actualSelf != lastSelf) {
        const char *path;
        Tcl_Obj *pathObj = NULL;

        if (withinEnsemble) {
          pathObj = NsfMethodNamePath(interp, framePtr0, methodName);
          INCR_REF_COUNT(pathObj);
          path = ObjStr(pathObj);
        } else {
          path = methodName;
        }

        NsfLog(interp, NSF_LOG_WARN, "'%s %s %s' fails since method %s.%s %s is protected",
               ObjectName(actualSelf), path, subMethodName, (actualClass != NULL) ?
               ClassName(actualClass) : ObjectName(actualSelf), path, subMethodName);

        subMethodCmd = NULL;
        if (pathObj != NULL) {
          DECR_REF_COUNT(pathObj);
        }
      }
    }
  }
#endif


  /*
   * Make sure that the current call is marked as an ensemble call, both
   * for dispatching to the default-method and for dispatching the method
   * interface of the given object. Otherwise, current introspection
   * specific to sub-methods fails (e.g., a [current method-path] in the
   * default-method).
   */
  cscPtr->flags |= NSF_CSC_CALL_IS_ENSEMBLE;

  /* fprintf(stderr, "ensemble dispatch cp %s %s objc %d\n",
     ObjectName((NsfObject*)cp), methodName, objc);*/

  cscPtr->objc = objc;
  cscPtr->objv = objv;
  Nsf_PushFrameCsc(interp, cscPtr, framePtr);

  /*fprintf(stderr, "... objv[0] %s cmd %p %s csc %p\n",
    ObjStr(objv[0]), (void *)subMethodCmd, subMethodName, (void *)cscPtr); */

  if (likely(subMethodCmd != NULL)) {
    /*
     * In order to allow [next] to be called in an ensemble method,
     * an extra call-frame is needed. This CSC frame is typed as
     * NSF_CSC_TYPE_ENSEMBLE. Note that the associated call is flagged
     * additionally (NSF_CSC_CALL_IS_ENSEMBLE; see above) to be able
     * to identify ensemble-specific frames during [next] execution.
     *
     * The dispatch requires NSF_CSC_IMMEDIATE to be set, ensuring
     * that scripted methods are executed before the ensemble ends. If
     * they were executed later, they would find their parent frame
     * (CMETHOD) being popped from the stack already.
     */

    /*fprintf(stderr, ".... ensemble dispatch object %s self %s pass %s\n",
      ObjectName(invokedObject), ObjectName(actualSelf), (actualSelf->flags & NSF_KEEP_CALLER_SELF) ? "callerSelf" : "invokedObject");
      fprintf(stderr, ".... ensemble dispatch on %s.%s objflags %.8x cscPtr %p base flags %.6x flags %.6x cl %s\n",
      ObjectName(actualSelf), subMethodName, actualSelf->flags,
      (void *)cscPtr, (0xFF & cscPtr->flags), (cscPtr->flags & 0xFF)|NSF_CSC_IMMEDIATE,
      (actualClass != NULL) ? ClassName(actualClass) : "NONE");*/
    result = MethodDispatch(interp, objc-1, objv+1,
                            subMethodCmd, actualSelf, actualClass, subMethodName,
                            cscPtr->frameType|NSF_CSC_TYPE_ENSEMBLE,
                            (cscPtr->flags & 0xFF)|NSF_CSC_IMMEDIATE);
    /*if (unlikely(result != TCL_OK)) {
      fprintf(stderr, "ERROR: cmd %p %s subMethodName %s -- %s -- %s\n",
      (void *)subMethodCmd, Tcl_GetCommandName(interp, subMethodCmd), subMethodName,
      Tcl_GetCommandName(interp, cscPtr->cmdPtr), ObjStr(Tcl_GetObjResult(interp)));
      }*/

  } else {
    /*
     * The method to be called was not part of this ensemble. Call
     * next to try to call such methods along the next path.
     */
    Tcl_CallFrame       *framePtr1;
    NsfCallStackContent *cscPtr1 = CallStackGetTopFrame(interp, &framePtr1);

    /*fprintf(stderr, "call next instead of unknown %s.%s \n",
      ObjectName(cscPtr->self), methodName);*/

    assert(cscPtr1 != NULL);
    if ((cscPtr1->frameType & NSF_CSC_TYPE_ENSEMBLE)) {
      /*
       * We are in an ensemble method. The next works here not on the
       * actual methodName + frame, but on the ensemble above it. We
       * locate the appropriate call-stack content and continue next on
       * that.
       */
      cscPtr1 = CallStackFindEnsembleCsc(framePtr1, &framePtr1);
      assert(cscPtr1 != NULL);
    }

    /*
     * We mark in the flags that we are in an ensemble but failed so far to
     * resolve the cmd. Now we try to resolve the unknown subcmd via next and
     * we record this in the flags. The method name for next might be
     * colon-prefixed. In these cases, we have to skip the single colon with
     * the MethodName() function.
     */
    cscPtr1->flags |= NSF_CM_ENSEMBLE_UNKNOWN;
    /*fprintf(stderr, "==> trying to find <%s> in ensemble <%s> via next\n",
      subMethodName, MethodName(cscPtr1->objv[0]));*/
    result = NextSearchAndInvoke(interp, MethodName(cscPtr1->objv[0]),
                                 cscPtr1->objc, cscPtr1->objv, cscPtr1, NSF_FALSE);

    /*fprintf(stderr, "==> next %s.%s subMethodName %s (obj %s) cscPtr %p (flags %.8x)) cscPtr1 %p (flags %.8x) result %d unknown %d\n",
            ObjectName(callerSelf), methodName, subMethodName, ObjectName(invokedObject),
            (void*)cscPtr, cscPtr->flags, (void*)cscPtr1, (cscPtr1 != NULL) ? cscPtr1->flags : 0,
            result, RUNTIME_STATE(interp)->unknown);*/

    if (RUNTIME_STATE(interp)->unknown) {
      Tcl_Obj       *callInfoObj = Tcl_NewListObj(1, &callerSelf->cmdName);
      Tcl_CallFrame *varFramePtr, *tclFramePtr = CallStackGetTclFrame(interp, (Tcl_CallFrame *)framePtr, 1);
      int            pathLength, pathLength0 = 0, unknownIndex;
      Tcl_Obj       *pathObj = NsfMethodNamePath(interp, tclFramePtr, MethodName(objv[0]));
      bool           getPath = NSF_TRUE;

      INCR_REF_COUNT(pathObj);

      /*
       * The "next" call could not resolve the unknown subcommand. At this
       * point, potentially serval different ensembles were tried, which can
       * be found on the stack.
       *
       * Example1:  call: foo a b d
       *    mixin:  foo a b c
       *    object: foo a x
       *
       * We want to return the longest, most precise prefix (here "foo a b")
       * and flag "d" as unknown (here the mixin frame). Another (inferior)
       * solution would be to report "foo a" as know prefix and "b d" as
       * unknown (when the error is generated from the point of view of the
       * object method frame).
       *
       * In the general case, we traverse the stack for all ensembles and pick
       * the longest known ensemble for reporting. This path is passed to the
       * unknown-handler of the ensemble.
       */

      Tcl_ListObjLength(interp, pathObj, &pathLength0);
      pathLength = pathLength0;

      for (varFramePtr = (Tcl_CallFrame *)framePtr; likely(varFramePtr != NULL);
           varFramePtr = Tcl_CallFrame_callerVarPtr(varFramePtr)) {
        const NsfCallStackContent *stackCscPtr;

        /*
         * If we reach a non-nsf frame, or it is not an ensemble, we are done.
         */
        stackCscPtr =
          (((unsigned int)Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) != 0u) ?
          ((NsfCallStackContent *)Tcl_CallFrame_clientData(varFramePtr)) : NULL;
        if (stackCscPtr == NULL || (stackCscPtr->flags & NSF_CSC_CALL_IS_ENSEMBLE) == 0u) {
          break;
        }
        /*
         * Every ensemble block starts with a frame of
         * NSF_CSC_TYPE_ENSEMBLE. If we find one, then we compute a new
         * path in the next iteration.
         */
        if ((stackCscPtr->frameType & (NSF_CSC_TYPE_ENSEMBLE)) == 0) {
          /*
           * Get method path the next round.
           */
          getPath = NSF_TRUE;
        } else if (getPath) {
          int      pathLength1;
          Tcl_Obj *pathObj1 = CallStackMethodPath(interp, varFramePtr);

          INCR_REF_COUNT(pathObj1);
          getPath = NSF_FALSE;
          Tcl_ListObjLength(interp, pathObj1, &pathLength1);
          if (pathLength1 > pathLength) {
            if (pathObj != NULL) {
              DECR_REF_COUNT(pathObj);
            }
            pathObj    = pathObj1;
            pathLength = pathLength1;
          } else {
            DECR_REF_COUNT(pathObj1);
          }
        }
      }

      unknownIndex = pathLength <= pathLength0 ? 1 : 1 + pathLength - pathLength0;
      assert(objc > unknownIndex);

      INCR_REF_COUNT(callInfoObj);
      Tcl_ListObjAppendList(interp, callInfoObj, pathObj);
      Tcl_ListObjAppendElement(interp, callInfoObj, objv[unknownIndex]);

      /* fprintf(stderr, "DispatchUnknownMethod is called with callinfo <%s> (callerSelf <%s>, methodName '%s', methodPath '%s')\n",
              ObjStr(callInfoObj), ObjStr(callerSelf->cmdName), MethodName(objv[0]),
              ObjStr(callInfoObj)); */
      result = DispatchUnknownMethod(interp, invokedObject, objc-1, objv+1, callInfoObj,
                                     objv[1], NSF_CM_NO_OBJECT_METHOD|NSF_CSC_IMMEDIATE);
      DECR_REF_COUNT(callInfoObj);
      DECR_REF_COUNT(pathObj);
    }
  }
  Nsf_PopFrameCsc(interp, framePtr);

  return result;
}

#if !defined(NSF_ASSEMBLE)
static int NsfAsmProc(ClientData UNUSED(clientData), Tcl_Interp *UNUSED(interp),
                      int UNUSED(objc), Tcl_Obj *const UNUSED(objv[])) {
  return TCL_OK;
}
#endif


/*
 *----------------------------------------------------------------------
 * CheckCStack --
 *
 *      Monitor the growth of the C Stack when complied with
 *      NSF_STACKCHECK.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      update of rst->bottomOfStack
 *
 *----------------------------------------------------------------------
 */
#if defined(NSF_STACKCHECK) && defined(PRE86)
NSF_INLINE static void CheckCStack(Tcl_Interp *interp, const char *prefix, const char *fullMethodName)
  nonnull(1) nonnull(2) nonnull(3);

NSF_INLINE static void
CheckCStack(Tcl_Interp *interp, const char *prefix, const char *fullMethodName) {
  int somevar;
  NsfRuntimeState *rst = RUNTIME_STATE(interp);

  nonnull_assert(interp != NULL);
  nonnull_assert(prefix != NULL);
  nonnull_assert(fullMethodName != NULL);

  if (rst->exitHandlerDestroyRound == NSF_EXITHANDLER_OFF) {
# if TCL_STACK_GROWS_UP
    if ((void *)&somevar < rst->bottomOfStack) {
      NsfLog(interp, NSF_LOG_WARN, "Stack adjust bottom %ld - %s %s",
             (void *)&somevar - rst->bottomOfStack, prefix, fullMethodName);
      rst->bottomOfStack = (void *)&somevar;
    } else if ((void *)&somevar > rst->maxStack) {
      NsfLog(interp, NSF_LOG_WARN, "Stack adjust top %ld - %s %s",
             (void *)&somevar - rst->bottomOfStack, prefix, fullMethodName);
      rst->maxStack = (void *)&somevar;
    }
# else
    if ((void *)&somevar > rst->bottomOfStack) {
      NsfLog(interp, NSF_LOG_WARN, "Stack adjust bottom %ld - %s %s",
             rst->bottomOfStack - (void *)&somevar, prefix, fullMethodName);
      rst->bottomOfStack = (void *)&somevar;
    } else if ((void *)&somevar < rst->maxStack) {
      NsfLog(interp, NSF_LOG_WARN, "Stack adjust top %ld - %s %s",
             rst->bottomOfStack - (void *)&somevar, prefix, fullMethodName);
      rst->maxStack = (void *)&somevar;
    }
# endif
  }
}
#else
# define CheckCStack(interp, prefix, methodName)
#endif

/*
 *----------------------------------------------------------------------
 * MethodDispatchCsc --
 *
 *      Dispatch a method (scripted or cmd) with an already allocated
 *      call stack content. The method calls either ProcMethodDispatch()
 *    (for scripted methods) or CmdMethodDispatch() (otherwise).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Indirect effects by calling methods
 *
 *----------------------------------------------------------------------
 */
static int MethodDispatchCsc(
    ClientData clientData, Tcl_Interp *interp,
    int objc, Tcl_Obj *const objv[],
    Tcl_Command cmd,
    NsfCallStackContent *cscPtr,
    const char *methodName,
    bool *validCscPtr
) nonnull(1) nonnull(2) nonnull(4) nonnull(5) nonnull(6) nonnull(7) nonnull(8);

static int
MethodDispatchCsc(
    ClientData clientData, Tcl_Interp *interp,
    int objc, Tcl_Obj *const objv[],
    Tcl_Command cmd,
    NsfCallStackContent *cscPtr,
    const char *methodName,
    bool *validCscPtr
) {
  NsfObject           *object;
  ClientData           cp;
  Tcl_ObjCmdProc      *proc;
  NsfCallStackContent *cscPtr1;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(cmd != NULL);
  nonnull_assert(cscPtr != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(validCscPtr != NULL);

  cp = Tcl_Command_objClientData(cmd);
  proc = Tcl_Command_objProc(cmd);
  object = cscPtr->self;

  /*
   * Provide DTrace with calling info
   */
  if (NSF_DTRACE_METHOD_ENTRY_ENABLED()) {
    NSF_DTRACE_METHOD_ENTRY(ObjectName(object), (cscPtr->cl != NULL) ? ClassName(cscPtr->cl) : ObjectName(object),
                            (char *)methodName,
                            objc-1, (Tcl_Obj **)objv+1);
  }
  if (unlikely(((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_DEPRECATED_METHOD) != 0u)) {
    NsfProfileDeprecatedCall(interp, object, cscPtr->cl, methodName, "");
  }
  if (unlikely(((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_DEBUG_METHOD) != 0u)) {
    NsfProfileDebugCall(interp, object, cscPtr->cl, methodName, objc-1, (Tcl_Obj **)objv+1);
  }

  /*fprintf(stderr, "MethodDispatch method '%s' cmd %p %s clientData %p cp=%p objc=%d cscPtr %p csc->flags %.6x \n",
          methodName, (void *)cmd, Tcl_GetCommandName(interp, cmd), (void *)clientData,
          (void *)cp, objc, cscPtr, cscPtr->flags);*/
  /*fprintf(stderr, "MethodDispatch method '%s' cmd %p cp=%p objc=%d cscPtr %p csc->flags %.6x "
          "obj->flags %.6x teardown %p\n",
          methodName, (void *)cmd, (void *)cp, objc, (void *)cscPtr, cscPtr->flags,
          object->flags, object->teardown);*/
  assert(object->teardown != NULL);

  /*
   * The default assumption is that the CscPtr is valid after this function
   * finishes.
   */

  if (likely(proc == TclObjInterpProc)) {
    int           result;
#if defined(NRE)
    NRE_callback *rootPtr = TOP_CB(interp);
    int           isImmediate = (cscPtr->flags & NSF_CSC_IMMEDIATE);
# if defined(NRE_CALLBACK_TRACE)
    NsfClass     *class = cscPtr->cl;
# endif
#endif
    /*
     * The cmd is a scripted method
     */
    //assert(((Proc *)cp)->refCount > 0);
    result = ProcMethodDispatch(cp, interp, objc, objv, methodName,
                                object, cscPtr->cl, cmd, cscPtr);
#if defined(NRE)
    /*
     * In the NRE case, there is no trust in the cscPtr anymore, it might be already gone.
     */
    *validCscPtr = NSF_FALSE;

    if (unlikely(isImmediate)) {
# if defined(NRE_CALLBACK_TRACE)
      fprintf(stderr, ".... manual run callbacks rootPtr = %p, result %d methodName %s.%s\n",
              (void *)rootPtr, result, ClassName(class), methodName);
# endif
      result = NsfNRRunCallbacks(interp, result, rootPtr);
    } else {
# if defined(NRE_CALLBACK_TRACE)
      fprintf(stderr, ".... don't run callbacks rootPtr = %p, result %d methodName %s.%s\n",
              (void *)rootPtr, result, ClassName(class), methodName);
# endif
    }
#endif
    /*
     * scripted method done
     */
    return result;

  } else if (proc == NsfObjDispatch) {

    assert(cp != NULL);
    return ObjectCmdMethodDispatch((NsfObject *)cp, interp, objc, objv,
                                   methodName, object, cscPtr);

  } else if (cp != NULL) {

    cscPtr1 = cscPtr;

    /*fprintf(stderr, "cscPtr %p cmd %p %s want to stack cmd %p %s cp %p no-leaf %d force frame %d\n",
            (void *)cscPtr, (void *)cmd, Tcl_GetCommandName(interp, cmd),
            (void *)cmd, Tcl_GetCommandName(interp, cmd),
            (void *)cp,
            (Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD),
            (cscPtr->flags & NSF_CSC_FORCE_FRAME));*/
    /*
     * The cmd has client data, we check for required updates in this
     * structure.
     */

    if (proc == NsfForwardMethod ||
        proc == NsfObjscopedMethod ||
        proc == NsfSetterMethod ||
        proc == NsfAsmProc
        ) {
      TclCmdClientData *tcd = (TclCmdClientData *)cp;

      assert(tcd != NULL);
      tcd->object = object;
      assert(!CmdIsProc(cmd));

    } else if (cp == (ClientData)NSF_CMD_NONLEAF_METHOD) {
      cp = clientData;
      assert(!CmdIsProc(cmd));

    }
#if !defined(NDEBUG)
    else if (proc == NsfProcAliasMethod) {
      /*
       * This should never happen!
       */
      Tcl_Panic("Alias invoked in unexpected way");
    }
#endif


  } else if (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD) != 0u
             || ((cscPtr->flags & NSF_CSC_FORCE_FRAME) != 0u)) {
    /*
     * Technically, we would not need a frame to execute the cmd, but maybe,
     * the user wants it (to be able to call next, or the keep proc-level
     * variables. The clientData cp is in such cases typically NULL.
     */
    /*fprintf(stderr, "FORCE_FRAME\n");*/
    cscPtr1 = cscPtr;

  } else {
    /*
     * There is no need to pass a frame. Use the original clientData.
     */
    cscPtr1 = NULL;
  }

  if (cscPtr1 != NULL) {
    /*
     * Call with a stack frame.
     */

    /*fprintf(stderr, "cmdMethodDispatch %s.%s, cscPtr %p objflags %.6x\n",
      ObjectName(object), methodName, (void *)cscPtr, object->flags); */

    return CmdMethodDispatch(cp, interp, objc, objv, object, cmd, cscPtr1);
  } else {
    /*
     * Call without a stack frame.
     */
    CscListAdd(interp, cscPtr);

    /*fprintf(stderr, "cmdMethodDispatch %p %s.%s, nothing stacked, objflags %.6x\n",
      cmd, ObjectName(object), methodName, object->flags); */

    return CmdMethodDispatch(clientData, interp, objc, objv, object, cmd, NULL);
  }
}

/*
 *----------------------------------------------------------------------
 * MethodDispatch --
 *
 *      Convenience wrapper for MethodDispatchCsc(). It allocates a call
 *      stack content and invokes MethodDispatchCsc.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Indirect effects by calling methods
 *
 *----------------------------------------------------------------------
 */
static int
MethodDispatch(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
               Tcl_Command cmd, NsfObject *object, NsfClass *class,
               const char *methodName, unsigned short frameType, unsigned int flags) {
  NsfCallStackContent csc, *cscPtr;
  bool                isValidCsc = NSF_TRUE;
  Tcl_Command         resolvedCmd;
  int                 result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(cmd != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);

  assert(object->teardown != NULL);

  CheckCStack(interp, "method", methodName);

  /*fprintf(stderr, "MethodDispatch method '%s.%s' objc %d flags %.6x\n",
    ObjectName(object), methodName, objc, flags); */

  resolvedCmd = AliasDereference(interp, object, methodName, cmd);
  if (unlikely(resolvedCmd == NULL)) {
    return TCL_ERROR;
  }

  /*
   * cscAlloc uses for resolvedCmd for allocating the call stack content and
   * sets the IS_NRE flag based on it. We use the original cmd in the
   * call-stack content structure for introspection.
   */
  cscPtr = CscAlloc(interp, &csc, resolvedCmd);

  /*
   * We would not need CscInit when cp (clientData) == NULL &&
   * !(Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD) TODO: We could
   * pass cmd == NULL, but is this worth it?
   */
  CscInit(cscPtr, object, class, cmd, frameType, flags, methodName);

  result = MethodDispatchCsc(object, interp, objc, objv,
                             resolvedCmd, cscPtr, methodName, &isValidCsc);

#if defined(NRE)
  if (isValidCsc) {
    CscListRemove(interp, cscPtr, NULL);
    CscFinish(interp, cscPtr, result, "csc cleanup");
  }
#else
  CscListRemove(interp, cscPtr, NULL);
  CscFinish(interp, cscPtr, result, "csc cleanup");
#endif

  return result;
}

/*
 *----------------------------------------------------------------------
 * ObjectDispatchFinalize --
 *
 *      Finalization function for ObjectDispatch() which performs method
 *      lookup and call all kind of methods. The function runs after
 *      ObjectDispatch() and calls the unknown handler if necessary and
 *      resets the filter and mixin stacks.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Maybe side effects by the cmd called by ParameterCheck()
 *      or DispatchUnknownMethod()
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static int ObjectDispatchFinalize(Tcl_Interp *interp, NsfCallStackContent *cscPtr,
                                             int result /*, char *msg, const char *methodName*/)
  nonnull(1) nonnull(2);

NSF_INLINE static int
ObjectDispatchFinalize(Tcl_Interp *interp, NsfCallStackContent *cscPtr,
                       int result /*, char *msg, const char *methodName*/) {
  const NsfRuntimeState *rst;
  NsfObject             *object;
  unsigned int           flags;

  nonnull_assert(interp != NULL);
  nonnull_assert(cscPtr != NULL);

  object = cscPtr->self;
  assert(object != NULL);
  assert(object->id != NULL);

  flags = cscPtr->flags;
  rst = RUNTIME_STATE(interp);

  /*fprintf(stderr, "ObjectDispatchFinalize %p %s flags %.6x (%d) frame %.6x unk %d m %s\n",
          (void*)cscPtr, ObjectName(object), flags,
          result, cscPtr->frameType, RUNTIME_STATE(interp)->unknown,
          (cscPtr->cmdPtr != NULL) ? Tcl_GetCommandName(interp, cscPtr->cmdPtr) : "");*/

  /*
   * Check the return value if wanted
   */
  if (likely((result == TCL_OK)
             && (cscPtr->cmdPtr != NULL)
             && (Tcl_Command_cmdEpoch(cscPtr->cmdPtr) == 0))) {
    Tcl_Obj *returnsObj = ParamDefsGetReturns(cscPtr->cmdPtr);

    if (returnsObj != NULL) {
      NsfObject     *ctxObject = (cscPtr->cl != NULL) ? (NsfObject *)cscPtr->cl : object;
      Tcl_Namespace *nsPtr = Tcl_Command_nsPtr(ctxObject->id);
      Tcl_Obj       *valueObj = Tcl_GetObjResult(interp);

      result = ParameterCheck(interp, returnsObj, valueObj, "return-value:",
                              rst->doCheckResults, NSF_FALSE, NSF_FALSE, NULL,
                              nsPtr != NULL ? nsPtr->fullName : NULL);
    }
  } else {
    /*fprintf(stderr, "We have no cmdPtr in cscPtr %p %s",  cscPtr, ObjectName(object));
    fprintf(stderr, "... cannot check return values!\n");*/
  }


  /*
   * On success (no error occurred) check for unknown cases.
   */
  if (likely(result == TCL_OK)) {

    /*
     * When triggered via filter, we might have cases with NRE, where the
     * filter is called from a filter, leading to an unknown cscPtr->objv);
     * however, there is no need to dispatch in such a case the unknown method.
     */
    if (unlikely(((flags & NSF_CSC_METHOD_IS_UNKNOWN) != 0u)
                 || ((cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER) && rst->unknown && (cscPtr->objv != NULL))
                 )) {
      result = DispatchUnknownMethod(interp, object,
                                     cscPtr->objc, cscPtr->objv, NULL, cscPtr->objv[0],
                                     (cscPtr->flags & NSF_CSC_CALL_NO_UNKNOWN)|NSF_CSC_IMMEDIATE);
    }
  }

  /*
   * Resetting mixin and filter stacks
   */

  if (unlikely((flags & NSF_CSC_MIXIN_STACK_PUSHED) && object->mixinStack != NULL) != 0u) {
    /* fprintf(stderr, "MixinStackPop %s.%s %p %s\n",
       ObjectName(object), methodName, object->mixinStack, msg);*/
    MixinStackPop(object);
  }
  if (unlikely((flags & NSF_CSC_FILTER_STACK_PUSHED) && object->filterStack) != 0u) {
    /* fprintf(stderr, "FilterStackPop %s.%s %p %s\n",
       ObjectName(object), methodName, object->filterStack, msg);*/
    FilterStackPop(object);
  }

  return result;
}

/*#define INHERIT_CLASS_METHODS 1*/

#if defined(INHERIT_CLASS_METHODS)
static Tcl_Command NsfFindClassMethod(Tcl_Interp *interp, NsfClass *class, const char *methodName)
  nonnull(1) nonnull(2) nonnull(3);

static Tcl_Command
NsfFindClassMethod(Tcl_Interp *interp, NsfClass *class, const char *methodName) {
  Tcl_Command  cmd;
  NsfClasses  *p;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(methodName != NULL);

  /*fprintf(stderr, "NsfFindClassMethod %s %s\n", ClassName(class), methodName);*/
  for(p = PrecedenceOrder(class); p != NULL; p = p->nextPtr) {
    NsfClass      *currentClass = p->cl;
    Tcl_Namespace *nsPtr = currentClass->object.nsPtr;

    /*fprintf(stderr, "1 check for obj ns in class %s => %p\n",
      ClassName(currentClass), nsPtr);*/
    if (nsPtr != NULL) {
      cmd = FindMethod(nsPtr, methodName);
      /*fprintf(stderr, "1 lookup for method %s in class %s => %p\n",
        methodName, ClassName(currentClass), cmd);*/
      if (cmd != NULL) {
        return cmd;
      }
    }
  }
  return NULL;
}
#endif


/*
 *----------------------------------------------------------------------
 * CmdObjProcName --
 *
 *      Try to find a symbolic name for the objCmdProc of a Tcl_command.
 *
 * Results:
 *      String name, potentially "other"
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static const char *CmdObjProcName(
    Tcl_Command cmd
) nonnull(1) NSF_pure;

static const char *
CmdObjProcName(
    Tcl_Command cmd
) {
  const char     *result;
  Tcl_ObjCmdProc *proc;

  nonnull_assert(cmd != NULL);

  proc = Tcl_Command_objProc(cmd);
  if (CmdIsNsfObject(cmd)) {
    result = "object";
  } else if (CmdIsProc(cmd)) {
    result = "proc";
  } else if (proc == NsfForwardMethod) {
    result = "forward";
  } else if (proc == NsfProcAliasMethod) {
    result = "alias";
  } else if (proc == NsfODestroyMethodStub) {
    result = "destroy";
  } else if (proc == NsfCCreateMethodStub) {
    result = "create";
  } else if (proc == NsfCNewMethodStub) {
    result = "new";
  } else if (proc == NsfOConfigureMethodStub) {
    result = "configure";
  } else if (proc == NsfOVolatileMethodStub) {
    result = "volatile";
  } else if (proc == NsfOVolatile1MethodStub) {
    result = "volatile";
  } else if (proc == NsfOAutonameMethodStub) {
    result = "autoname";
  } else if (proc == NsfOUplevelMethodStub) {
    result = "uplevel";
  } else if (proc == NsfOUpvarMethodStub) {
    result = "upvar";
  } else if (proc == NsfObjscopedMethod) {
    result = "objscoped";
  } else if (proc == NsfProcStub) {
    result = "nsfproc";
  } else if (proc == NsfSetterMethod) {
    result = "setter";
  } else if (proc == NsfAsmProc) {
    result = "asm";
  } else if (proc == TclObjInterpProc) {
    result = "alt proc";
#if 0
  } else if (proc == Tcl_ApplyObjCmd) {
    result = "apply";
  } else if (proc == Tcl_EvalObjCmd) {
    result = "eval";
#endif
  } else {
    result = "unknown";
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * ColonCmdCacheSet --
 *
 *      Fill out an ColonCmdCacheSet entry
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

NSF_INLINE static void
ColonCmdCacheSet(
    NsfColonCmdContext *ccCtxPtr,
    NsfClass           *currentClass,
    unsigned int        methodEpoch,
    Tcl_Command         cmd,
    NsfClass           *class,
    unsigned int        flags
) {
  ccCtxPtr->context = currentClass;
  ccCtxPtr->methodEpoch = methodEpoch;
  ccCtxPtr->cmd = cmd;
  ccCtxPtr->class = class;
  ccCtxPtr->flags = flags;
}

#if defined(COLON_CMD_STATS)
static void ColonCmdCacheNew(NsfColonCmdContext *ccCtxPtr, Tcl_Obj *obj) {
  ccCtxPtr->hits = 0u;
  ccCtxPtr->invalidates = 0u;
  ccCtxPtr->requiredRefetches = 0u;
  ccCtxPtr->obj = obj;
  INCR_REF_COUNT(obj);
}
static void ColonCmdCacheInvalidate(NsfColonCmdContext *ccCtxPtr) {
  ccCtxPtr->invalidates ++;
}
static void ColonCmdCacheRequiredRefetch(NsfColonCmdContext *ccCtxPtr) {
  ccCtxPtr->requiredRefetches ++;
}
static void ColonCmdCacheHit(NsfColonCmdContext *ccCtxPtr) {
  ccCtxPtr->hits ++;
}
#else
#define ColonCmdCacheNew(ccCtxPtr, obj)
#define ColonCmdCacheInvalidate(ccCtxPtr)
#define ColonCmdCacheRequiredRefetch(ccCtxPtr)
#define ColonCmdCacheHit(ccCtxPtr)
#endif


#ifdef DO_CLEANUP
/*
 *----------------------------------------------------------------------
 * NsfColonCmdContextFree --
 *
 *      FreeProc for NsfColonCmdContext
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Freeing memory.
 *
 *----------------------------------------------------------------------
 */
static void
NsfColonCmdContextFree(void *clientData) {
#if defined(COLON_CMD_STATS)
  NsfColonCmdContext *ccCtxPtr = clientData;

  fprintf(stderr, "### free colonCmdContext for %s: hits %lu invalidates %lu required-refetches %lu\n",
          ObjStr(ccCtxPtr->obj), (unsigned long)ccCtxPtr->hits,
          (unsigned long)ccCtxPtr->invalidates, (unsigned long)ccCtxPtr->requiredRefetches);
  DECR_REF_COUNT(ccCtxPtr->obj);
#endif
  FREE(NsfColonCmdContext, clientData);
}
#endif

/*
 *----------------------------------------------------------------------
 * CacheCmd --
 *
 *      Cache a Tcl_Command element in a Tcl_Obj, using either the NSF
 *      specific object types, or the colon cmd cache for Tcl cmd types.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Add cache entry
 *
 *----------------------------------------------------------------------
 */
static void
CacheCmd(
    Tcl_Interp        *interp,
    Tcl_Command        cmd,
    Tcl_Obj           *methodObj,
    const Tcl_ObjType *nsfObjTypePtr,
    void              *context,
    unsigned int       methodEpoch,
    NsfClass          *class,
    unsigned int       flags,
    bool               isColonCmd
) {
  const Tcl_ObjType *methodObjTypePtr = methodObj->typePtr;

  if (((methodObjTypePtr != Nsf_OT_tclCmdNameType))
      && (methodObjTypePtr != Nsf_OT_parsedVarNameType)
     ) {
    /*fprintf(stderr, "==== SET OBJ TYPE for %s.%s to NsfInstanceMethodObjType cmd %p\n",
      ObjectName(object), calledName, (void*)cmd);*/
    NsfMethodObjSet(interp, methodObj, nsfObjTypePtr,
                    context, methodEpoch, cmd, class, flags);

  } else if (isColonCmd && (methodObj->refCount > 1)) {
    /*
     * When the refCount <= 1, the object is a temporary object, for which
     * caching is not useful. We could also cache the following types, but the
     * benefit is not clear.
     *
     *     (methodObjTypePtr != Nsf_OT_tclCmdNameType)
     *     || (Tcl_Command_objProc(cmd) == NsfProcAliasMethod)
     *
     */
    NsfColonCmdContext *ccCtxPtr = methodObj->internalRep.twoPtrValue.ptr2;

    if (ccCtxPtr != NULL) {
      /*
       * We had already a ccCtxPtr, so the values was invalidated before.
       */
      ColonCmdCacheInvalidate(ccCtxPtr);

      if (ccCtxPtr->cmd != cmd) {
        /*
         * The cached cmd differs from actual one, so this was a required
         * refetch operation, where the invalidation was truly necessary.
         */
        ColonCmdCacheRequiredRefetch(ccCtxPtr);
      }
      ColonCmdCacheSet(ccCtxPtr, context, methodEpoch, cmd, class, flags);

    } else {
      NsfRuntimeState *rst = RUNTIME_STATE(interp);

      /*fprintf(stderr, "======== new entry for %p %s type %s refCount %d ccCtxPtr %p flags %.6x context %s\n",
              (void*)methodObj, ObjStr(methodObj), ObjTypeStr(methodObj),
              methodObj->refCount, (void*)ccCtxPtr, flags, ObjectName((NsfObject*)context));*/

      /*
       * Create an NsfColonCmdContext and supply it with data (primarily the
       * cmd, the other data is for validation).
       */
      ccCtxPtr = NEW(NsfColonCmdContext);
      ColonCmdCacheNew(ccCtxPtr, methodObj);
      ColonCmdCacheSet(ccCtxPtr, context, methodEpoch, cmd, class, flags);

      /*
       * Save the NsfColonCmdContext in the proc context for memory management
       * and as well for reuse in twoPtrValue.ptr2.
       */
      /* rst->freeListPtr = NsfListCons(ccCtxPtr, rst->freeListPtr); */
      NsfDListAppend(&rst->freeDList, ccCtxPtr);
      methodObj->internalRep.twoPtrValue.ptr2 = ccCtxPtr;

      /*fprintf(stderr, "==== ptr2 of %s empty, is set %p for obj %p %p %s target proc ctx %p ccCtx %p\n",
        ObjStr(methodObj),
        (void*)cmd, (void*)object, (void*)methodObj, ObjStr(methodObj),
        (void*)pCtxPtr, (void*)pCtxPtr->freeListObj);*/
    }
  } else {
    /*
     * We found a command, but we do not cache it...
     */
    /* fprintf(stderr, "... found cmd '%s' type of methodObj '%s' type %s, procType %s but we do not cache\n",
       Tcl_GetCommandName(NULL, cmd), ObjStr(methodObj),
       methodObjTypePtr ? methodObjTypePtr->name : "NONE",
       CmdObjProcName(cmd));*/
  }
}

/*
 *----------------------------------------------------------------------
 * ObjectDispatch --
 *
 *      This function performs the method lookup and call all kind of
 *      methods. It checks, whether a filter or mixin has to be
 *      applied. In these cases, the effective method lookup is
 *      performed by "next".
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Maybe side effects by the cmd called by ParameterCheck()
 *      or DispatchUnknownMethod()
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static int ObjectDispatch(ClientData clientData, Tcl_Interp *interp,
                                     int objc, Tcl_Obj *const objv[],
                                     unsigned int flags)
  nonnull(1) nonnull(2) nonnull(4);

NSF_INLINE static int
ObjectDispatch(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[],
    unsigned int flags
) {
  int                    result = TCL_OK, shift;
  bool                   isValidCsc = NSF_TRUE;
  unsigned int           objflags;
  unsigned short         frameType = NSF_CSC_TYPE_PLAIN;
  register NsfObject    *object;
  const char            *methodName, *calledName;
  NsfObject             *calledObject;
  NsfClass              *class = NULL;
  Tcl_Obj               *cmdName, *methodObj;
  const Tcl_ObjType     *methodObjTypePtr;
  NsfColonCmdContext    *ccCtxPtr;
  const NsfRuntimeState *rst;
  NsfCallStackContent    csc, *cscPtr = NULL;
  Tcl_Command            cmd = NULL;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  object = (NsfObject *)clientData;
  cmdName = object->cmdName;
  rst = RUNTIME_STATE(interp);

  /*
   * None of the higher copy-flags must be passed
   */
  assert((flags & (NSF_CSC_COPY_FLAGS & 0x000FFF000U)) == 0u);

  /*
   * Do we have to shift the argument vector?
   */
  if (unlikely((flags & NSF_CM_NO_SHIFT) != 0u)) {
    shift = 0;
    methodObj = objv[0];
    methodName = MethodName(methodObj);
    calledName =  ObjStr(methodObj);;

  } else {
    assert(objc > 1);
    shift = 1;
    methodObj = objv[1];
    methodName = ObjStr(methodObj);
    calledName = methodName;
    if (unlikely(FOR_COLON_RESOLVER(methodName))) {
      return NsfPrintError(interp, "%s: method name '%s' must not start with a colon",
                           ObjectName_(object), methodName);
    }
  }
  methodObjTypePtr = methodObj->typePtr;
  ccCtxPtr = methodObj->internalRep.twoPtrValue.ptr2;


#if 1
  /*
   * This code block is purely for debugging erroneous behavior with broken
   * cached Tcl Command, where the command itself looks perfectly fine, but
   * the procPtr behind this contains invalid data. This seems to happen only
   * for scripted commands. In such cases, we do not trust the data obtained
   * from the Tcl_Obj.
   */
  if (ccCtxPtr != NULL
      && (
          methodObjTypePtr == Nsf_OT_tclCmdNameType
          || methodObjTypePtr == &NsfInstanceMethodObjType
          || methodObjTypePtr == &NsfObjectMethodObjType
      )
      && Tcl_Command_objProc(ccCtxPtr->cmd) == TclObjInterpProc) {
    //fprintf(stderr, "cached scipted call %s (object %s class %s) \n",
    //        methodName, ObjectName(object), ClassName(object->cl));
    Proc *procPtr = Tcl_Command_objClientData(ccCtxPtr->cmd);

    if ((Tcl_Interp *)procPtr->iPtr != interp
        || procPtr->bodyPtr == NULL
        || procPtr->refCount < 1
        || procPtr->numArgs < 0
        || procPtr->numArgs > 10000
        || procPtr->numCompiledLocals < 0
        || procPtr->numCompiledLocals > 10000
       ) {
      fprintf(stderr, "################### do NOT trust cached procPtr %p of %s "
              "(object %s class %s) bodyPtr %p "
              "iPtr %p interp %p refCount %d numArgs %d numCompiledLocals %d\n",
              (void*)procPtr, methodName,
              ObjectName(object), ClassName(object->cl),
              (void*)procPtr->bodyPtr, (void*)procPtr->iPtr, (void*)interp,
              procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals);
      ccCtxPtr = NULL;
    }
  }
#endif

  assert(object->teardown != NULL);

#if defined(METHOD_OBJECT_TRACE)
  fprintf(stderr, "method %p/%d '%s' type %p <%s>\n",
          (void*)methodObj, methodObj->refCount, methodName, (void*)methodObjTypePtr,
          (methodObjTypePtr != NULL) ? methodObjTypePtr->name : "");
#endif
  /*fprintf(stderr, "==== ObjectDispatch obj = %s objc = %d 0=%s methodName=%s method-obj-type %s cmd %p shift %d\n",
          (object != NULL) ? ObjectName(object) : NULL,
          objc, objv[0] ? ObjStr(objv[0]) : NULL,
          methodName, methodObjTypePtr ? methodObjTypePtr->name : "NONE",
          (void*)cmd, shift);*/

  objflags = object->flags; /* avoid stalling */

  /*
   * Make sure, cmdName and obj survive this method until the end of
   * this function.
   */
  INCR_REF_COUNT(cmdName);
  NsfObjectRefCountIncr(object);

  /*fprintf(stderr, "obj refCount of %p after incr %d (ObjectDispatch) %s\n",
    object, object->refCount, methodName);*/

  if (unlikely((objflags & NSF_FILTER_ORDER_VALID) == 0u)) {
    FilterComputeDefined(interp, object);
    objflags = object->flags;
  }

  if (unlikely((objflags & NSF_MIXIN_ORDER_VALID) == 0u)) {
    MixinComputeDefined(interp, object);
    objflags = object->flags;
  }

  /*
   * Only start new filter chain, if
   *   (a) filters are defined and
   *   (b) the top-level csc entry is not a filter on self
   */

  /*fprintf(stderr, "call %s, objflags %.6x, defined and valid %.6x doFilters %d guard count %d\n",
          methodName, objflags, NSF_FILTER_ORDER_DEFINED_AND_VALID,
          rst->doFilters, rst->guardCount);*/

  assert((flags & (NSF_CSC_MIXIN_STACK_PUSHED|NSF_CSC_FILTER_STACK_PUSHED)) == 0u);

  if (unlikely((objflags & NSF_FILTER_ORDER_DEFINED_AND_VALID) == NSF_FILTER_ORDER_DEFINED_AND_VALID)) {
    if (rst->doFilters && !rst->guardCount) {
      const NsfCallStackContent *cscPtr1 = CallStackGetTopFrame0(interp);

      if ((cscPtr1 == NULL)
          || (object != cscPtr1->self)
          || (cscPtr1->frameType != NSF_CSC_TYPE_ACTIVE_FILTER)
         ) {
        FilterStackPush(object, methodObj);
        flags |= NSF_CSC_FILTER_STACK_PUSHED;

        cmd = FilterSearchProc(interp, object, &object->filterStack->currentCmdPtr, &class);
        if (cmd != NULL) {
          /*fprintf(stderr, "*** filterSearchProc returned cmd %p\n", cmd);*/
          frameType = NSF_CSC_TYPE_ACTIVE_FILTER;
          methodName = (char *)Tcl_GetCommandName(interp, cmd);
          flags |= NSF_CM_IGNORE_PERMISSIONS;
        }
      }
    }
  }

  if (unlikely(cmd == NULL && ((flags & NSF_CM_LOCAL_METHOD) != 0u))) {
    /*
     * We require a local method. If the local method is found, we set always
     * the cmd and sometimes the class (if it is a class specific method).
     */
    const NsfCallStackContent *cscPtr1 = CallStackGetTopFrame0(interp);

    if (unlikely(cscPtr1 == NULL)) {
      return NsfPrintError(interp, "flag '-local' only allowed when called from a method body");
    }
    if (cscPtr1->cl != NULL) {
      cmd = FindMethod(cscPtr1->cl->nsPtr, methodName);
      if (cmd != NULL) {
        class = cscPtr1->cl;
      }
    } else if (object->nsPtr != NULL) {
      cmd = FindMethod(object->nsPtr, methodName);
    }

    /*fprintf(stderr, "ObjectDispatch NSF_CM_LOCAL_METHOD obj %s methodName %s => cl %p %s cmd %p \n",
            (object != NULL) ? ObjectName(object) : NULL,
            methodName, (void*)class, (class != NULL) ? ClassName(class) : "NONE", (void*)cmd);*/

  } else if (unlikely(*methodName == ':')) {
    NsfObject *regObject;
    bool       fromClassNS = NSF_FALSE;

    /*
     * We have fully qualified name provided. Determine the class and/or
     * object on which the method was registered.
     */

    INCR_REF_COUNT(methodObj);
    cmd = ResolveMethodName(interp, NULL, methodObj,
                            NULL, &regObject, NULL, NULL, &fromClassNS);
    DECR_REF_COUNT(methodObj);

    if (likely(cmd != NULL)) {
      if (CmdIsNsfObject(cmd)) {
        /*
         * Don't allow for calling objects as methods via fully qualified
         * names. Otherwise, in line [2] below, ::State (or any children of
         * it, e.g., ::Slot::child) is interpreted as a method candidate. As a
         * result, dispatch chaining occurs with ::State or ::State::child
         * being the receiver (instead of Class) of the method call
         * "-parameter". In such a dispatch chaining, the method "unknown"
         * won't be called on Class (in the XOTcl tradition), effectively
         * bypassing any unknown-based indirection mechanism (e.g., XOTcl's short-cutting
         * of object/class creations).
         *
         *  [1] Class ::State; Class ::State::child
         *  [2] Class ::State -parameter x; Class ::State::child -parameter x
         */
        NsfLog(interp, NSF_LOG_NOTICE,
               "Don't invoke object %s this way. Register object via alias ...",
               methodName);
        cmd = NULL;
      } else {
        if (regObject != NULL) {
          if (NsfObjectIsClass(regObject)) {
            class = (NsfClass *)regObject;
          }
        }
        /* fprintf(stderr, "fully qualified lookup of %s returned %p\n", ObjStr(methodObj), cmd); */
        /*
         * Ignore permissions for fully qualified method names.
         */
        flags |= NSF_CM_IGNORE_PERMISSIONS;
      }
      /*fprintf(stderr, "ObjectDispatch fully qualified obj %s methodName %s => cl %p cmd %p \n",
              (object != NULL) ? ObjectName(object) : NULL,
              methodName, (void*)cl, (void*)cmd);*/
    }
  }

  /*fprintf(stderr, "MixinStackPush check for %p %s.%s objflags %.6x == %d\n",
    object, ObjectName(object), methodName, objflags & NSF_MIXIN_ORDER_DEFINED_AND_VALID,
    (objflags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) == NSF_MIXIN_ORDER_DEFINED_AND_VALID);*/
  /*
   * Check whether a mixed in method has to be called. This is necessary, even when
   * cmd is already determined.
   */
  if (unlikely((objflags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) == NSF_MIXIN_ORDER_DEFINED_AND_VALID
               && (flags & (NSF_CM_SYSTEM_METHOD|NSF_CM_INTRINSIC_METHOD)) == 0u
               && ((flags & NSF_CM_LOCAL_METHOD) == 0u || class != NULL))
     ) {
    /*
     * The current logic allocates first an entry on the per-object
     * stack and searches then for a mixin. This could be improved by
     * allocating a stack entry just when a mixin is found. The same
     * holds for the filters above, but there, the hit-rate is much
     * larger.
     */

    MixinStackPush(object);
    flags |= NSF_CSC_MIXIN_STACK_PUSHED;

    if (frameType != NSF_CSC_TYPE_ACTIVE_FILTER) {
      Tcl_Command cmd1 = cmd;
      /*
       * The entry is just searched and pushed on the stack when we
       * have no filter; in the filter case, the search happens in
       * next.
       */
      result = MixinSearchProc(interp, object, methodName, &class,
                               &object->mixinStack->currentCmdPtr, &cmd1);
      if (unlikely(result != TCL_OK)) {
        /*fprintf(stderr, "mixinsearch returned an error for %p %s.%s\n",
          object, ObjectName(object), methodName);*/
        isValidCsc = NSF_FALSE;
        goto exit_object_dispatch;
      }
      if (cmd1 != NULL) {
        frameType = NSF_CSC_TYPE_ACTIVE_MIXIN;
        cmd = cmd1;
      }
    }
  }

  /*fprintf(stderr, "ObjectDispatch ordinary lookup %s.%s cmd %p\n",
    ObjectName(object), ObjStr(methodObj), (void*)cmd);*/

  /*
   * If no fully qualified method name/filter/mixin was found then perform
   * ordinary method lookup. First, try to resolve the method name as a
   * per-object method.
   */

  if (likely(cmd == NULL)) {
    NsfMethodContext *mcPtr = methodObj->internalRep.twoPtrValue.ptr1;
    unsigned int      nsfObjectMethodEpoch = rst->objectMethodEpoch;

    if (methodObjTypePtr == &NsfObjectMethodObjType
        && mcPtr->context == object
        && mcPtr->methodEpoch == nsfObjectMethodEpoch
        && mcPtr->flags == flags
        ) {
      cmd = mcPtr->cmd;

#if defined(METHOD_OBJECT_TRACE)
      fprintf(stderr, "... use internal rep method %p %s cmd %p (objProc %p) cl %p %s\n",
              (void*)methodObj, ObjStr(methodObj),
              (void*)cmd, (cmd != NULL) ? (void*)((Command *)cmd)->objProc : 0,
              (void*)class, (class != NULL) ? ClassName(class) : ObjectName(object));
#endif

      assert((cmd != NULL) ? ((Command *)cmd)->objProc != NULL : 1);

    } else if (methodObjTypePtr == Nsf_OT_tclCmdNameType
               && ccCtxPtr != NULL
               && ccCtxPtr->context == object
               && ccCtxPtr->methodEpoch == nsfObjectMethodEpoch
               && ccCtxPtr->flags == flags
               ) {
      cmd = ccCtxPtr->cmd;
      class = ccCtxPtr ->class;
      ColonCmdCacheHit(ccCtxPtr);

    } else {
      /*
       * Check whether the call can be resolved against an object-specific method.
       */
      if (unlikely((object->nsPtr != NULL)
                   && (flags & (NSF_CM_NO_OBJECT_METHOD|NSF_CM_SYSTEM_METHOD)) == 0u)) {
        cmd = FindMethod(object->nsPtr, methodName);
        /*fprintf(stderr, "ObjectDispatch lookup for per-object method in obj %p method %s nsPtr %p"
                " => %p objProc %p\n",
                (void*)object, methodName, (void*)object->nsPtr, (void*)cmd,
                (cmd != NULL) ? (void*)((Command *)cmd)->objProc : NULL);*/

        if (cmd != NULL) {
          /*
           * Reject resolved cmd when
           * a) trying to call a private method without the local flag or ignore permissions, or
           * b) trying to call an object with no method interface
           */
          if (((flags & (NSF_CM_LOCAL_METHOD|NSF_CM_IGNORE_PERMISSIONS)) == 0u
               && ((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_CALL_PRIVATE_METHOD) != 0u)
              ) {
            cmd = NULL;
          } else {
            CacheCmd(interp,
                     cmd, methodObj, &NsfObjectMethodObjType,
                     object, nsfObjectMethodEpoch, NULL, flags,
                     (*calledName == ':'));
          }
        }
      }
    }
#if defined(INHERIT_CLASS_METHODS)
    /*
     * This is not optimized yet, since current class might be checked twice,
     * but easier to maintain.
     */
    if ((flags & NSF_CM_NO_OBJECT_METHOD) == 0u && cmd == NULL && NsfObjectIsClass(object)) {
      cmd = NsfFindClassMethod(interp, (NsfClass *)object, methodName);
    }
#endif

    if (likely(cmd == NULL)) {
      /*
       * Check whether the call can be resolved against an instance method.
       */
      NsfClass           *currentClass = object->cl;
      NsfMethodContext   *mcPtr0 = methodObj->internalRep.twoPtrValue.ptr1;
      unsigned int        nsfInstanceMethodEpoch = rst->instanceMethodEpoch;

#if defined(METHOD_OBJECT_TRACE)
      fprintf(stderr, "... method %p/%d '%s' type %p %s type? %d context? %d nsfMethodEpoch %d => %d\n",
              (void*)methodObj, methodObj->refCount, ObjStr(methodObj),
              (void*)methodObjTypePtr, (methodObjTypePtr != NULL) ? methodObjTypePtr->name : "NONE",
              methodObjTypePtr == &NsfInstanceMethodObjType,
              methodObjTypePtr == &NsfInstanceMethodObjType ? mcPtr0->context == currentClass : 0,
              methodObjTypePtr == &NsfInstanceMethodObjType ? mcPtr0->methodEpoch : 0,
              nsfInstanceMethodEpoch );
#endif

      if (methodObjTypePtr == &NsfInstanceMethodObjType
          && mcPtr0->context == currentClass
          && mcPtr0->methodEpoch == nsfInstanceMethodEpoch
          && mcPtr0->flags == flags
          ) {
        cmd = mcPtr0->cmd;
        class = mcPtr0->cl;

#if defined(METHOD_OBJECT_TRACE)
        fprintf(stderr, "... use internal rep method %p %s cmd %p (objProc %p) cl %p %s\n",
                (void*)methodObj, ObjStr(methodObj),
                (void*)cmd, (cmd != NULL) ? (void*)((Command *)cmd)->objProc : NULL,
                (void*)class, (class != NULL) ? ClassName(class) : ObjectName(object));
#endif
        assert((cmd != NULL) ? ((Command *)cmd)->objProc != NULL : 1);

      } else if (methodObjTypePtr == Nsf_OT_tclCmdNameType
                 && ccCtxPtr != NULL
                 && ccCtxPtr->context == currentClass
                 && ccCtxPtr->methodEpoch == nsfInstanceMethodEpoch
                 && ccCtxPtr->flags == flags
          ) {
        cmd = ccCtxPtr->cmd;
        class = ccCtxPtr ->class;
        ColonCmdCacheHit(ccCtxPtr);

#if defined(METHOD_OBJECT_TRACE)
        fprintf(stderr, "... use internal rep ptr2 method %p %s cmd %p (objProc %p) cl %p %s\n",
                (void*)methodObj, ObjStr(methodObj),
                (void*)cmd, (cmd != NULL) ? (void*)((Command *)cmd)->objProc : NULL,
                (void*)class, (class != NULL) ? ClassName(class) : ObjectName(object));
#endif
      } else {

        /*
         * We could call PrecedenceOrder(currentClass) to recompute
         * currentClass->order on demand, but by construction this is already
         * set here.
         */
        assert(currentClass->order);

        if (unlikely((flags & NSF_CM_SYSTEM_METHOD) != 0u)) {
          NsfClasses *classListPtr = currentClass->order;

          /*
           * Skip entries until the (first) base class.
           */
          do {
            if (IsBaseClass(&classListPtr->cl->object)) {
              break;
            }
            classListPtr = classListPtr->nextPtr;
          } while (classListPtr->nextPtr != NULL);

          class = SearchPLMethod(classListPtr, methodName, &cmd, NSF_CMD_CALL_PRIVATE_METHOD);
        } else {
          class = SearchPLMethod(currentClass->order, methodName, &cmd, NSF_CMD_CALL_PRIVATE_METHOD);
        }

        /*fprintf(stderr, "... check type of methodObj %s type %s check %d\n",
                calledName, methodObjTypePtr ? methodObjTypePtr->name : "NONE",
                (((methodObjTypePtr != Nsf_OT_tclCmdNameType) || *calledName == ':')
                 && methodObjTypePtr != Nsf_OT_parsedVarNameType
                 && likely(cmd != NULL)  )
                 );*/
        if (likely(cmd != NULL)) {
          CacheCmd(interp,
                   cmd, methodObj, &NsfInstanceMethodObjType,
                   currentClass, nsfInstanceMethodEpoch, class, flags,
                   (*calledName == ':'));
        }
      }
    }
  }
  calledObject = object;

  /*
   * If we have a command, check the permissions, unless
   * NSF_CM_IGNORE_PERMISSIONS is set. Note that NSF_CM_IGNORE_PERMISSIONS is
   * set currently for fully qualified cmd names and in nsf::object::dispatch.
   */

  if (likely((cmd != NULL) && (flags & NSF_CM_IGNORE_PERMISSIONS) == 0u)) {
    const unsigned int cmdFlags = (unsigned int)Tcl_Command_flags(cmd);

#if !defined(NDEBUG)
    if (unlikely(((cmdFlags & NSF_CMD_CALL_PRIVATE_METHOD) != 0u)
                 && ((flags & NSF_CM_LOCAL_METHOD) == 0u))
        ) {
      /*
       * Private methods can be only called with the "-local" flag. All cases
       * handling private methods should be covered above (e.g. by setting
       * NSF_CM_IGNORE_PERMISSIONS, or by filtering private methods in method
       * search. So, this branch should never by executed.
       */

      Tcl_Panic("Unexpected handling of private method; most likely a caching bug");
      cmd = NULL;

    } else
#endif
    if (unlikely((cmdFlags & NSF_CMD_CALL_PROTECTED_METHOD) != 0u)) {
      const NsfObject *lastSelf = GetSelfObj(interp);

      /*
       * Protected methods can be called, when calling object == called object.
       */

      if (unlikely(object != lastSelf)) {
        NsfLog(interp, NSF_LOG_WARN, "'%s %s' fails since method %s.%s is protected",
               ObjectName(object), methodName,
               (class != NULL) ? ClassName(class) : ObjectName(object),
               methodName);
        /*
         * Reset cmd, since it is still unknown.
         */
        cmd = NULL;
      }
    }
  }

  assert(result == TCL_OK);

  if (likely(cmd != NULL)) {
    /*
     * We found the method to dispatch.
     */
    const Tcl_Command resolvedCmd = AliasDereference(interp, object, methodName, cmd);
    if (unlikely(resolvedCmd == NULL)) {
      isValidCsc = NSF_FALSE;
      goto exit_object_dispatch;
    }

    /*
     * cscAlloc uses resolvedCmd for allocating the call stack content and
     * sets the IS_NRE flag based on it. We use the original cmd in the
     * call-stack content structure for introspection.
     */

    cscPtr = CscAlloc(interp, &csc, resolvedCmd);
    CscInit(cscPtr, calledObject, class, cmd, frameType, flags, methodName);

    if (unlikely(cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER)) {
      /*
       * Run filters is not NRE enabled.
       */
      cscPtr->flags |= NSF_CSC_IMMEDIATE;
      /*
       * Setting cscPtr->objc and cscPtr->objv is needed for invoking UNKNOWN
       * from ProcMethodDispatchFinalize()
       */
      cscPtr->objc = objc - shift;
      cscPtr->objv = objv + shift;
    }

    /* fprintf(stderr, "MethodDispatchCsc %s.%s %p flags %.6x cscPtr %p method-obj-type %s\n",
            ObjectName(object), methodName, (void*)object->mixinStack, cscPtr->flags,
            (void*)cscPtr, methodObj->typePtr ? methodObj->typePtr->name : "NONE");*/

    result = MethodDispatchCsc(clientData, interp, objc - shift, objv + shift,
                               resolvedCmd, cscPtr, methodName, &isValidCsc);
    /* fprintf(stderr, "MethodDispatchCsc %s.%s %p flags %.6x cscPtr %p method-obj-type %s DONE\n",
            ObjectName(object), methodName, (void*)object->mixinStack, cscPtr->flags,
            (void*)cscPtr, methodObj->typePtr ? methodObj->typePtr->name : "NONE"); */

    if (unlikely(result == TCL_ERROR)) {
      /*fprintf(stderr, "Call ErrInProc cl = %p, cmd %p, methodName %s flags %.6x\n",
              class, (class != NULL) ? class->object.id : NULL, methodName, (class != NULL) ? class->object.flags : 0);*/

      result = NsfErrInProc(interp, cmdName,
                            (class != NULL && class->object.teardown) ? class->object.cmdName : NULL,
                            methodName);
    }
  } else {
    /*
     * The method to be dispatched is unknown
     */
    cscPtr = CscAlloc(interp, &csc, cmd);
    CscInit(cscPtr, object, class, cmd, frameType, flags, methodName);
    cscPtr->flags |= NSF_CSC_METHOD_IS_UNKNOWN;
    if ((flags & NSF_CM_NO_UNKNOWN) != 0u) {
      cscPtr->flags |= NSF_CSC_CALL_NO_UNKNOWN;
    }
    cscPtr->objc = objc - shift;
    cscPtr->objv = objv + shift;
  }

 exit_object_dispatch:
  if (likely(isValidCsc)) {
    /*
     * In every situation, we have a cscPtr containing all context information
     */
    assert(cscPtr != NULL);

    result = ObjectDispatchFinalize(interp, cscPtr, result /*, "immediate" , methodName*/);
    CscListRemove(interp, cscPtr, NULL);
    CscFinish(interp, cscPtr, result, "non-scripted finalize");
  }

  /*fprintf(stderr, "ObjectDispatch %s.%s returns %d\n",
    ObjectName(object), methodName, result);*/

  NsfCleanupObject(object, "ObjectDispatch");
  /*fprintf(stderr, "ObjectDispatch call NsfCleanupObject %p DONE\n", object);*/
  DECR_REF_COUNT(cmdName); /* must be after last dereferencing of obj */

  return result;
}

/*
 *----------------------------------------------------------------------
 * DispatchDefaultMethod --
 *
 *      Dispatch the default method (when object is called without arguments)
 *      in case the object system has it defined.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      indirect effects by calling Tcl code
 *
 *----------------------------------------------------------------------
 */
static int
DispatchDefaultMethod(Tcl_Interp *interp, NsfObject *object,
                      Tcl_Obj *obj, unsigned int flags) {
  int result;
  Tcl_Obj *methodObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(obj != NULL);

  if (CallDirectly(interp, object, NSF_o_defaultmethod_idx, &methodObj)) {

    Tcl_SetObjResult(interp, object->cmdName);
    result = TCL_OK;

  } else {
    Tcl_Obj *tov[2];

    tov[0] = obj;
    tov[1] = methodObj;
    result = ObjectDispatch(object, interp, 2, tov,
                            flags|NSF_CM_NO_UNKNOWN|NSF_CM_IGNORE_PERMISSIONS);
  }

  return result;
}


/*
 *----------------------------------------------------------------------
 * DispatchDestroyMethod --
 *
 *      Dispatch the method "destroy" in case the object system has it
 *      defined. During the final cleanup of the object system, the
 *      destroy is called separately from deallocation. Normally,
 *      Object.destroy() calls dealloc, which is responsible for the
 *      physical deallocation.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      indirect effects by calling Tcl code
 *
 *----------------------------------------------------------------------
 */

static int
DispatchDestroyMethod(Tcl_Interp *interp, NsfObject *object, unsigned int flags) {
  int              result;
  NsfRuntimeState *rst;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  rst = RUNTIME_STATE(interp);
  if (unlikely(rst == NULL)) {

    /*
     * There is no run time state in this interpreter.
     */
    if ((Tcl_Interp_flags(interp) & DELETED)) {

      /*
       * The interpreter is already deleted, just ignore this call.
       */
      result = TCL_OK;
    } else {
      /*
       * In all other cases we expect a run time state. If this is violated,
       * something substantial must be wrong, so panic.
       */

      Tcl_Panic("Runtime state is lost");
      result = TCL_OK;
    }

  } else {

    /*
     * Don't call destroy after exit handler started physical
     * destruction, or when it was called already before
     */
    if (rst->exitHandlerDestroyRound == NSF_EXITHANDLER_ON_PHYSICAL_DESTROY
        || (object->flags & NSF_DESTROY_CALLED) != 0u
       ) {
      result = TCL_OK;

    } else {
      Tcl_Obj *methodObj;

      /*
       * We can call destroy.
       */

      /*fprintf(stderr, "    DispatchDestroyMethod obj %p flags %.6x active %d\n",
        object, object->flags,  object->activationCount); */

      PRINTOBJ("DispatchDestroyMethod", object);

      /*
       * Flag that destroy was called and invoke the method.
       */
      object->flags |= NSF_DESTROY_CALLED;

      if (CallDirectly(interp, object, NSF_o_destroy_idx, &methodObj)) {
        NSF_PROFILE_TIME_DATA;
        NSF_PROFILE_CALL(interp, object, Nsf_SystemMethodOpts[NSF_o_destroy_idx]);
        result = NsfODestroyMethod(interp, object);
        NSF_PROFILE_EXIT(interp, object, Nsf_SystemMethodOpts[NSF_o_destroy_idx]);

      } else {
        result = CallMethod(object, interp, methodObj, 2, NULL,
                            NSF_CM_IGNORE_PERMISSIONS|NSF_CSC_IMMEDIATE|flags);
      }
      if (unlikely(result != TCL_OK)) {
        /*
         * The object might be already gone here, since we have no stack frame.
         * Therefore, we can't even use nsf::current object safely.
         */
        NsfErrorContext(interp, "method destroy");

        if (++rst->errorCount > 20) {
          Tcl_Panic("too many destroy errors occurred. Endless loop?");
        }
      } else if (rst->errorCount > 0) {
        rst->errorCount--;
      }

#ifdef OBJDELETION_TRACE
      fprintf(stderr, "DispatchDestroyMethod for %p exit\n", (void *)object);
#endif
    }
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * DispatchInitMethod --
 *
in case the object system has it
 *      defined and it was not already called on the object,
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Indirect effects by calling Tcl code
 *
 *----------------------------------------------------------------------
 */
static int DispatchInitMethod(Tcl_Interp *interp, NsfObject *object,
                   int objc, Tcl_Obj *const objv[], unsigned int flags)
  nonnull(1) nonnull(2);

static int
DispatchInitMethod(Tcl_Interp *interp, NsfObject *object,
                   int objc, Tcl_Obj *const objv[], unsigned int flags) {
  int result;
  Tcl_Obj *methodObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  /*
   * check, whether init was called already
   */
  if ((object->flags & (NSF_INIT_CALLED|NSF_DESTROY_CALLED)) == 0u) {

    /*
     * Flag the call to "init" before the dispatch, such that a call to
     * "configure" within init does not clear the already set instance
     * variables.
     */

    object->flags |= NSF_INIT_CALLED;

    if (CallDirectly(interp, object, NSF_o_init_idx, &methodObj)) {
      /*fprintf(stderr, "%s init directly\n", ObjectName(object));*/
      /*
       * Actually, nothing to do.
       */
      result = TCL_OK;
    } else {
      result = CallMethod(object, interp, methodObj, objc+2, objv,
                          flags|NSF_CM_IGNORE_PERMISSIONS|NSF_CSC_IMMEDIATE);
    }

  } else {
    result = TCL_OK;
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * DispatchUnknownMethod --
 *
 *      Dispatch the method "unknown" in case the object system has it
 *      defined and the application program contains an unknown handler.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      There might be indirect effects by calling Tcl code; also,
 *      the interp's unknown-state is reset.
 *
 *----------------------------------------------------------------------
 */

static int
DispatchUnknownMethod(Tcl_Interp *interp, NsfObject *object,
                      int objc, Tcl_Obj *const objv[],
                      Tcl_Obj *callInfoObj, Tcl_Obj *methodObj, unsigned int flags) {
  int result;
  Tcl_Obj         *unknownObj;
  const char      *methodName;
  NsfRuntimeState *rst;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(methodObj != NULL);

  rst = RUNTIME_STATE(interp);
  methodName = MethodName(methodObj);
  unknownObj = NsfMethodObj(object, NSF_o_unknown_idx);

  /*fprintf(stderr, "compare unknownObj %p with methodObj %p '%s' %p %p %s -- %s\n",
    unknownObj, methodObj, ObjStr(methodObj), callInfoObj, (callInfoObj != NULL) ?objv[1]:NULL, (callInfoObj != NULL) ?ObjStr(objv[1]) : NULL,
    methodName);*/

  if ((unknownObj != NULL)
      && (methodObj != unknownObj)
      && (flags & NSF_CSC_CALL_NO_UNKNOWN) == 0u
     ) {
    /*
     * Back off and try unknown.
     */
    bool mustCopy = (*(ObjStr(methodObj)) == ':');
    ALLOC_ON_STACK(Tcl_Obj*, objc+3, tov);

    if (callInfoObj == NULL) {
      callInfoObj = (mustCopy ? Tcl_NewStringObj(methodName, -1) : methodObj);
    }
    INCR_REF_COUNT(callInfoObj);

    /*fprintf(stderr, "calling unknown for %s %s, flags=%.6x,%.6x/%.6x isClass=%d %p %s objc %d\n",
      ObjectName(object), ObjStr(methodObj), flags, NSF_CM_NO_UNKNOWN, NSF_CSC_CALL_NO_UNKNOWN,
      NsfObjectIsClass(object), object, ObjectName(object), objc);*/

    tov[0] = object->cmdName;
    tov[1] = unknownObj;
    tov[2] = callInfoObj;
    if (objc > 1) {
      memcpy(tov + 3, objv + 1, sizeof(Tcl_Obj *) * ((size_t)objc - 1u));
    }

    flags &= ~NSF_CM_NO_SHIFT;

    /*fprintf(stderr, "call unknown via dispatch mustCopy %d delegator %p method %s (%s)\n",
      mustCopy, delegator, ObjStr(tov[offset]), ObjStr(methodObj));*/

    result = ObjectDispatch(object, interp, objc+2, tov,
                            flags|NSF_CM_NO_UNKNOWN|NSF_CM_IGNORE_PERMISSIONS);

    DECR_REF_COUNT(callInfoObj);
    FREE_ON_STACK(Tcl_Obj*, tov);

  } else {
    Tcl_Obj *tailMethodObj = NULL;

    /*
     * No unknown called. This is the built-in unknown handler.
     */

    if (objc > 1 && ((*methodName) == '-' || (unknownObj && objv[0] == unknownObj))) {
      int length;

      tailMethodObj = objv[1];
      if ((((object->flags & NSF_KEEP_CALLER_SELF) != 0u) ||
           ((object->flags & NSF_PER_OBJECT_DISPATCH) != 0u)) &&
          Tcl_ListObjLength(interp, objv[1], &length) == TCL_OK) {
        if (length > 1) {
          Tcl_ListObjIndex(interp, objv[1], length - 1, &tailMethodObj);
        }
      }
    }
    result = NsfPrintError(interp, "%s: unable to dispatch method '%s'",
                           ObjectName_(object),
                           (tailMethodObj != NULL) ? MethodName(tailMethodObj) : methodName);
  }

  /*
   * Reset interp state, unknown has been fired.
   */
  rst->unknown = 0;

  return result;
}

/*
 *----------------------------------------------------------------------
 * NsfObjDispatch --
 *
 *      This function is called on every object dispatch (when an object
 *      is invoked). It calls either the passed method, or dispatches
 *      some default method.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Maybe side effects by the cmd called by ParameterCheck()
 *      or DispatchUnknownMethod()
 *
 *----------------------------------------------------------------------
 */
#if defined(NRE)
Tcl_ObjCmdProc NsfObjDispatchNRE;
int
NsfObjDispatch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  return Tcl_NRCallObjProc(interp, NsfObjDispatchNRE, clientData, objc, objv);
}
int NsfObjDispatchNRE(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(4);

int
NsfObjDispatchNRE(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])

#else

EXTERN int
NsfObjDispatch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])

#endif
{
  int result;
#ifdef STACK_TRACE
  NsfStackDump(interp);
#endif

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  if (likely(objc > 1)) {
    /*
     * Normal dispatch; we must not use NSF_CSC_IMMEDIATE here,
     * otherwise coroutines won't work.
     */
    result = ObjectDispatch(clientData, interp, objc, objv, 0u);
  } else {
    result = DispatchDefaultMethod(interp, (NsfObject *)clientData, objv[0], NSF_CSC_IMMEDIATE);
  }
  return result;
}

/*
 *      Proc-Creation
 */

/*
 *----------------------------------------------------------------------
 * AddPrefixToBody --
 *
 *      Create a fresh TclObj* containing the body with a potential prefix.
 *      The caller has to decrement the ref-count on this Tcl_Obj*.
 *
 * Results:
 *      Tcl_Obj
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj * AddPrefixToBody(Tcl_Obj *body, bool useParamDefs, NsfParsedParam *paramPtr)
  nonnull(1) nonnull(3);

static Tcl_Obj *
AddPrefixToBody(Tcl_Obj *body, bool useParamDefs, NsfParsedParam *paramPtr) {
  Tcl_Obj *resultBody = Tcl_NewObj();

  nonnull_assert(body != NULL);
  nonnull_assert(paramPtr != NULL);

  INCR_REF_COUNT2("resultBody", resultBody);

  if (useParamDefs && paramPtr->possibleUnknowns > 0) {
    Tcl_AppendStringsToObj(resultBody, "::nsf::__unset_unknown_args\n", (char *) NULL);
  }

  Tcl_AppendStringsToObj(resultBody, ObjStr(body), (char *) NULL);
  return resultBody;
}

/*
 *----------------------------------------------------------------------
 * NoMetaChars --
 *
 *      Check, of the provided string contains meta characters
 *    (i.e. "*", "?", or "[")
 *
 * Results:
 *      Boolean value
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static bool NoMetaChars(const char *pattern)
  nonnull(1) NSF_pure;

NSF_INLINE static bool
NoMetaChars(const char *pattern) {
  register char c;
  bool          result = NSF_TRUE;

  nonnull_assert(pattern != NULL);

  for (c = *pattern; c; c = *++pattern) {
    if (c == '*' || c == '?' || c == '[') {
      result = NSF_FALSE;
      break;
    }
  }
  return result;
}

/***********************************************************************
 * Nsf_TypeConverter
 ***********************************************************************/

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToString --
 *
 *      Minimal Nsf_TypeConverter setting the client data (passed to C
 *      functions) to the ObjStr of the object.
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int Nsf_ConvertToString(Tcl_Interp *UNUSED(interp), Tcl_Obj *objPtr, const Nsf_Param *UNUSED(pPtr),
                        ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(2) nonnull(4);

int
Nsf_ConvertToString(Tcl_Interp *UNUSED(interp), Tcl_Obj *objPtr, const Nsf_Param *UNUSED(pPtr),
                    ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {

  nonnull_assert(objPtr != NULL);
  nonnull_assert(clientData != NULL);

  *clientData = (char *)ObjStr(objPtr);

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * ConvertToNothing --
 *
 *      Minimalistic Nsf_TypeConverter, even setting the client data (passed to
 *      C functions).
 *
 * Results:
 *      Tcl result code, **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int ConvertToNothing(Tcl_Interp *UNUSED(interp), Tcl_Obj *objPtr,  const Nsf_Param *UNUSED(pPtr),
                            ClientData *UNUSED(clientData), Tcl_Obj **outObjPtr)
  nonnull(2) nonnull(5) NSF_pure;

static int
ConvertToNothing(Tcl_Interp *UNUSED(interp), Tcl_Obj *objPtr,  const Nsf_Param *UNUSED(pPtr),
                 ClientData *UNUSED(clientData), Tcl_Obj **outObjPtr) {

  nonnull_assert(objPtr != NULL);
  nonnull_assert(outObjPtr != NULL);
  assert(*outObjPtr == objPtr);

  *outObjPtr = objPtr;
  return TCL_OK;
}

#ifdef NSF_WITH_TCL_OBJ_TYPES_AS_CONVERTER
int Nsf_ConvertToTclObjType(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                        ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

int
Nsf_ConvertToTclObjType(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                    ClientData *clientData, Tcl_Obj **outObjPtr) {
  int result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  fprintf(stderr, "Nsf_ConvertToTclObjType: converterArg %p\n", (void*)pPtr->converterArg);
  if (unlikely(pPtr->converterArg != NULL)) {
    const Tcl_ObjType *tclObjType = pPtr->converterArg->internalRep.twoPtrValue.ptr1;

    if (tclObjType != NULL) {
      result = Tcl_ConvertToType(interp, objPtr, tclObjType);
      fprintf(stderr, "Nsf_ConvertToTclObjType:type  %p -> %d\n", (void*)tclObjType, result);

      if (result != TCL_OK) {
        Tcl_ResetResult(interp);
        result = NsfObjErrType(interp, NULL, objPtr, tclObjType->name, (Nsf_Param *)pPtr);
      }
    }
  }
  *outObjPtr = objPtr;
  /*
    nsf::proc foo {a:ns:mem_unit} {return $a}
    nsf::proc bar {a:ns:mem_unit} {return [expr {$a + 1}]}
    foo 1kB
    foo xxx
    bar 1kB
   */
  return result;
}
#endif

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToTclobj --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      passed Tcl_Obj. Optionally this converter checks if the Tcl_Obj has
 *      permissible content via the Tcl "string is" checkers.
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
enum stringTypeIdx {StringTypeAlnum, StringTypeAlpha, StringTypeAscii, StringTypeBoolean, StringTypeControl,
                    StringTypeDigit, StringTypeDouble, StringTypeFalse, StringTypeGraph, StringTypeInteger,
                    StringTypeLower, StringTypePrint, StringTypePunct, StringTypeSpace, StringTypeTrue,
                    StringTypeUpper, StringTypeWideinteger, StringTypeWordchar, StringTypeXdigit };
static const char *stringTypeOpts[] = {"alnum", "alpha", "ascii", "boolean", "control",
                                       "digit", "double", "false", "graph", "integer",
                                       "lower", "print", "punct", "space",  "true",
                                       "upper", "wideinteger", "wordchar", "xdigit",
                                       NULL};

int Nsf_ConvertToTclobj(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                        ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

int
Nsf_ConvertToTclobj(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                    ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  if (unlikely(pPtr->converterArg != NULL)) {
    Tcl_Obj *objv[4];
    /*fprintf(stderr, "ConvertToTclobj %s (must be %s)\n", ObjStr(objPtr), ObjStr(pPtr->converterArg));*/

    objv[0] = NULL;
    objv[1] = pPtr->converterArg;
    objv[2] = NsfGlobalObjs[NSF_OPTION_STRICT];
    objv[3] = objPtr;

    result = NsfCallCommand(interp, NSF_STRING_IS, 4, objv);
    if (likely(result == TCL_OK)) {
      int success;
      Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &success);
      if (success == 1) {
        *clientData = objPtr;
      } else {
        Tcl_ResetResult(interp);
        result = NsfObjErrType(interp, NULL, objPtr, ObjStr(pPtr->converterArg), (Nsf_Param *)pPtr);
      }
    }
  } else {
    result = TCL_OK;

#if defined(NSF_WITH_VALUE_WARNINGS)
    if (RUNTIME_STATE(interp)->logSeverity == NSF_LOG_DEBUG) {
      const char *value = ObjStr(objPtr);

      if (unlikely(*value == '-'
                   && (pPtr->flags & NSF_ARG_CHECK_NONPOS) != 0u
                   && isalpha(*(value+1))
                   && strchr(value+1, ' ') == NULL)
          ) {
        /*
         * In order to flag a warning, we set the error message and
         * return TCL_CONTINUE
         */
        (void)NsfPrintError(interp, "value '%s' of parameter '%s' could be a non-positional argument",
                      value, pPtr->name);
        result = TCL_CONTINUE;
      }
    }
#endif
    *clientData = objPtr;
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToBoolean --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      internal representation of a boolean. This converter checks the passed
 *      value via Tcl_GetBooleanFromObj().
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int Nsf_ConvertToBoolean(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                         ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

int
Nsf_ConvertToBoolean(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                     ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  int result, boolVal;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  result = Tcl_GetBooleanFromObj(interp, objPtr, &boolVal);
  if (likely(result == TCL_OK)) {
    *clientData = (ClientData)INT2PTR(boolVal);
  } else {
    Tcl_ResetResult(interp);
    NsfObjErrType(interp, NULL, objPtr, "boolean", pPtr);
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToInt32 --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      internal representation of an integer. This converter checks the passed
 *      value via Tcl_GetIntFromObj().
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
int Nsf_ConvertToInt32(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                       ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

int
Nsf_ConvertToInt32(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                   ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  int result, i;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  result = Tcl_GetIntFromObj(interp, objPtr, &i);

  if (likely(result == TCL_OK)) {
    *clientData = (ClientData)INT2PTR(i);
  } else {
    Tcl_ResetResult(interp);
    NsfObjErrType(interp, NULL, objPtr, "int32", (Nsf_Param *)pPtr);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToInteger --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      Tcl_Obj containing the bignum value. This converter checks the passed
 *      value via Tcl_GetBignumFromObj().
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

#if TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
/*
 * Starting with Tcl 8.7a4 and TIP 538, NSF might end up built against Tcl
 * linking against a system-wide/ external libtommath, rather than with an
 * embedded libtommath. In both cases, even the embedded one, Tcl does not
 * ship tommat.h anymore. This leaves NSF without the necessary build-time
 * definitions for mp_int and mp_clear (see below). For the time being, we
 * rely on a hot fix by the TIP 538 author, providing compat definitions when
 * setting the TCL_NO_TOMMATH_H macro before including tclTomMath.h.
 *
 * See https://core.tcl-lang.org/tcl/tktview?name=4663e0636f (also for other
 * mid-term options)
 */
//#define TCL_NO_TOMMATH_H 1
# ifndef MP_INT_DECLARED
typedef size_t mp_int[4];
# endif
#else
# include <tclTomMath.h>
#endif


int Nsf_ConvertToInteger(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                     ClientData *clientData, Tcl_Obj **outObjPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

int
Nsf_ConvertToInteger(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                     ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  /*
   * Try to short_cut common cases to avoid conversion to bignums, since
   * Tcl_GetBignumFromObj returns a value, which has to be freed.
   */
  if (objPtr->typePtr == Nsf_OT_intType || objPtr->typePtr == Nsf_OT_bignumType) {
    /*
     * We know already that the value is an int
     */
    result = TCL_OK;
  } else if (objPtr->typePtr == Nsf_OT_doubleType) {
    /*
     * We know already that the value is not an int
     */
    result = TCL_ERROR;
  } else {
    long         longValue;
    Tcl_WideInt  wideIntValue;
    mp_int       bignumValue;

    /*
     * We have to figure out, whether the value is an int. We perform this
     * test via Tcl_GetBignumFromObj(), which tries to keep the type small if
     * possible (e.g. it might return type "int" or "float" when appropriate.
     */

    /*if (objPtr->typePtr != NULL) {
      fprintf(stderr, "### type is on call %p %s value %s \n",
              objPtr->typePtr, ObjTypeStr(objPtr), ObjStr(objPtr));
              }*/

    if ((result = Tcl_GetLongFromObj(interp, objPtr, &longValue)) == TCL_OK) {

    } else if ((result = Tcl_GetWideIntFromObj(interp, objPtr, &wideIntValue)) == TCL_OK) {

    } else if ((result = Tcl_GetBignumFromObj(interp, objPtr, &bignumValue)) == TCL_OK) {
      Tcl_Obj *bigNumObj = Tcl_NewBignumObj(&bignumValue);

      Tcl_DecrRefCount(bigNumObj);
      /* fprintf(stderr, "### IS BIG %s\n", objPtr->typePtr->name); */
    }
  }

  if (likely(result == TCL_OK)) {
    *clientData = (ClientData)objPtr;
  } else {
    Tcl_ResetResult(interp);
    NsfObjErrType(interp, NULL, objPtr, "integer", (Nsf_Param *)pPtr);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToSwitch --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      internal representation of an Boolean. This converter simply calls
 *      Tcl_ConvertToBoolean(). The distinction between "switch" and boolean is
 *      made on the semantics of which arguments/defaults are passed to the real
 *      converter.
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int Nsf_ConvertToSwitch(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *pPtr,
                        ClientData *clientData, Tcl_Obj **outObjPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

int
Nsf_ConvertToSwitch(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *pPtr,
                    ClientData *clientData, Tcl_Obj **outObjPtr) {
  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);
  nonnull_assert(outObjPtr != NULL);

  return Nsf_ConvertToBoolean(interp, objPtr, pPtr, clientData, outObjPtr);
}

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToObject --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      internal representation of an object. This converter checks the passed
 *      value via IsObjectOfType().
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int Nsf_ConvertToObject(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *pPtr,
                        ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

int
Nsf_ConvertToObject(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *pPtr,
                    ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  if (likely(GetObjectFromObj(interp, objPtr, (NsfObject **)clientData) == TCL_OK)) {
    result = IsObjectOfType(interp, (NsfObject *)*clientData, "object", objPtr, pPtr);
  } else {
    result = NsfObjErrType(interp, NULL, objPtr, "object", (Nsf_Param *)pPtr);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToClass --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      internal representation of a class. This converter checks the passed
 *      value via IsObjectOfType().
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int Nsf_ConvertToClass(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                       ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

int
Nsf_ConvertToClass(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                   ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  bool withUnknown;
  int  result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  withUnknown = (RUNTIME_STATE(interp)->doClassConverterOmitUnknown == 0);

  if (likely(GetClassFromObj(interp, objPtr, (NsfClass **)clientData, withUnknown) == TCL_OK)) {
    result = IsObjectOfType(interp, (NsfObject *)*clientData, "class", objPtr, pPtr);
  } else {
    result = NsfObjErrType(interp, NULL, objPtr, "class", (Nsf_Param *)pPtr);
  }
  return result;
}



/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToFilterreg --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      Tcl_Obj. This nsf type converter checks the passed value via the
 *      NsfFilterregObjType tcl_obj converter, which provides an internal
 *      representation for the client function.
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int Nsf_ConvertToFilterreg(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                           ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

int
Nsf_ConvertToFilterreg(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                       ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  result = Tcl_ConvertToType(interp, objPtr, &NsfFilterregObjType);
  if (likely(result == TCL_OK)) {
    *clientData = objPtr;
  } else {
    result = NsfObjErrType(interp, NULL, objPtr, "filterreg", (Nsf_Param *)pPtr);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToMixinreg --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      Tcl_Obj. This nsf type converter checks the passed value via the
 *      NsfMixinregObjType tcl_obj converter, which provides an internal
 *      representation for the client function.
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int Nsf_ConvertToMixinreg(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                          ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

int
Nsf_ConvertToMixinreg(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
                      ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  result = Tcl_ConvertToType(interp, objPtr, &NsfMixinregObjType);
  if (likely(result == TCL_OK)) {
    *clientData = objPtr;
  } else {
    result = NsfObjErrType(interp, NULL, objPtr, "mixinreg", (Nsf_Param *)pPtr);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * Nsf_ConvertToParameter --
 *
 *      Nsf_TypeConverter setting the client data (passed to C functions) to the
 *      Tcl_Obj. This nsf type converter checks if the provided value could be a
 *      valid parameter spec (i.e. start with no ":", is not an unnamed spec
 *    "-:int"). This converter performs just a rough syntactic check.
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int Nsf_ConvertToParameter(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *pPtr,
                           ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr))
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

int
Nsf_ConvertToParameter(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *pPtr,
                       ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) {
  const char *value;
  int         result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);

  value = ObjStr(objPtr);
  /*fprintf(stderr, "convert to parameter '%s' t '%s'\n", value, pPtr->type);*/
  if (*value == ':' ||  (*value == '-' && *(value + 1) == ':')) {
    result = NsfPrintError(interp, "leading colon in '%s' not allowed in parameter specification '%s'",
                           ObjStr(objPtr), pPtr->name);
  } else {
    *clientData = (char *)ObjStr(objPtr);
    result = TCL_OK;
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * ConvertViaCmd --
 *
 *      Nsf_TypeConverter calling a used-defined checking/conversion
 *      function. It sets the client data (passed to C functions) to the
 *      Tcl_Obj.
 *
 * Results:
 *      Tcl result code, *clientData and **outObjPtr
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int ConvertViaCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
              ClientData *clientData, Tcl_Obj **outObjPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5);

static int
ConvertViaCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,  const Nsf_Param *pPtr,
              ClientData *clientData, Tcl_Obj **outObjPtr) {
  Tcl_Obj *ov[5], *savedResult;
  NsfObject *object;
  int result, oc;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(clientData != NULL);
  nonnull_assert(outObjPtr != NULL);

  /*
   * In general, when the converter is used e.g. for result checking,
   * we do not want to alter the result just when the converter sets a
   * result. So, for non-converter, we save the old result and restore
   * it before the return in case of success. Strictly speaking,
   * result-overwriting just harms for result-converters, but saving is
   * always semantically correct.
   */
  if (unlikely((pPtr->flags & NSF_ARG_IS_CONVERTER) == 0u)) {
    savedResult = Tcl_GetObjResult(interp); /* save the result */
    INCR_REF_COUNT(savedResult);
  } else {
    savedResult = NULL;
  }

  ov[0] = (pPtr->slotObj != NULL) ? pPtr->slotObj : NsfGlobalObjs[NSF_METHOD_PARAMETER_SLOT_OBJ];
  ov[1] = pPtr->converterName;
  ov[2] = pPtr->nameObj;
  ov[3] = objPtr;

  oc = 4;
  if (pPtr->converterArg != NULL) {
    ov[4] = pPtr->converterArg;
    oc++;
  }

  /*fprintf(stderr, "ConvertViaCmd call converter %s (refCount %d) on %s paramPtr %p arg %p oc %d\n",
          ObjStr(pPtr->converterName), pPtr->converterName->refCount, ObjStr(ov[0]),
          pPtr, pPtr->converterArg, oc);*/

  INCR_REF_COUNT(ov[1]);
  INCR_REF_COUNT(ov[2]);

  /* result = Tcl_EvalObjv(interp, oc, ov, 0); */
  result = GetObjectFromObj(interp, ov[0], &object);
  if(likely(result == TCL_OK)) {
    result = ObjectDispatch(object, interp, oc, ov, NSF_CSC_IMMEDIATE|NSF_CM_IGNORE_PERMISSIONS);
  }

  DECR_REF_COUNT(ov[1]);
  DECR_REF_COUNT(ov[2]);

  /*
   * Per default, the input arg is the output arg.
   */
  assert(*outObjPtr == objPtr);

  if (likely(result == TCL_OK)) {
    /*fprintf(stderr, "ConvertViaCmd could convert %s to '%s' paramPtr %p, is_converter %d\n",
            ObjStr(objPtr), ObjStr(Tcl_GetObjResult(interp)), pPtr,
            pPtr->flags & NSF_ARG_IS_CONVERTER);*/
    if ((pPtr->flags & NSF_ARG_IS_CONVERTER) != 0u) {
      Tcl_Obj *resultObj;

      /*
       * If we want to convert, the resulting obj is the result of the
       * converter. The increment of the refCount is necessary e.g. for
       *
       *     return [expr {$value + 1}]
       *
       * The conversion is just needed, when resultObj differs from the actual
       * value in the output vector. Otherwise the conversion and the value
       * increment happened already before (and is already recorded in the
       * parse context).
       */
      resultObj = Tcl_GetObjResult(interp);

      if (*outObjPtr != resultObj) {
        INCR_REF_COUNT2("valueObj", resultObj);
        *outObjPtr = resultObj;
      }
      /*fprintf(stderr, "**** NSF_ARG_IS_CONVERTER %p\n", *outObjPtr);*/
    }
    *clientData = (ClientData) *outObjPtr;

    if (savedResult != NULL) {
      /*fprintf(stderr, "restore savedResult %p\n", savedResult);*/
      Tcl_SetObjResult(interp, savedResult);  /* restore the result */
    }
  }

  if (savedResult != NULL) {
    DECR_REF_COUNT(savedResult);
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * ConvertToObjpattern --
 *
 *      This function obtains a Tcl_Obj *, which contains the pattern if a Next
 *      Scripting Object. When this pattern contains no meta characters, we
 *      check whether the object exists. If it exists, the Tcl_Obj is converted to
 *      the cmd-type. If it does not exit, the function using this pattern will
 *      fail. If the pattern contains meta characters, we prepend to the pattern
 *    "::" if necessary to avoid errors, if one specifies a pattern object
 *      without the prefix. In this case, the patternObj is of plain type.
 *      The resulting patternObj has always the refCount incremented, which has
 *      to be decremented by the caller.x
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Incremented refCount for the patternObj.
 *
 *----------------------------------------------------------------------
 */
static int ConvertToObjpattern(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *UNUSED(pPtr),
                    ClientData *clientData, Tcl_Obj **outObjPtr)
  nonnull(1) nonnull(2) nonnull(4) nonnull(5);

static int
ConvertToObjpattern(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *UNUSED(pPtr),
                    ClientData *clientData, Tcl_Obj **outObjPtr) {
  Tcl_Obj    *patternObj;
  const char *pattern;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(clientData != NULL);
  nonnull_assert(outObjPtr != NULL);

  patternObj = objPtr;
  pattern = ObjStr(objPtr);
  if (NoMetaChars(pattern)) {
    /*
     * We have no meta characters, we try to check for an existing object
     */
    NsfObject *object = NULL;

    if (GetObjectFromObj(interp, objPtr, &object) == TCL_OK && object != NULL) {
      patternObj = object->cmdName;
    }
  } else {
    /*
     * We have a pattern and meta characters, we might have
     * to prefix it to ovoid obvious errors: since all object
     * names are prefixed with ::, we add this prefix automatically
     * to the match pattern, if it does not exist.
     */
    if (*pattern != ':' && *pattern+1 != ':') {
      patternObj = Tcl_NewStringObj("::", 2);
      Tcl_AppendLimitedToObj(patternObj, pattern, -1, INT_MAX, NULL);
    }
  }
  if (patternObj != NULL) {
    INCR_REF_COUNT2("patternObj", patternObj);
  }
  *clientData = (ClientData)patternObj;
  /* The following assert does not hold here, since we
     have a direct call to the converter
     assert(*outObjPtr == objPtr); */

  *outObjPtr = objPtr;
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * ParamCheckObj --
 *
 *      This function returns a fresh Tcl_Obj in the form of a method name for a
 *      checker method.
 *
 * Results:
 *      Tcl_Obj
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *ParamCheckObj(const char *start, size_t len)
  nonnull(1) returns_nonnull;

static Tcl_Obj *
ParamCheckObj(const char *start, size_t len) {
  Tcl_Obj *checker = Tcl_NewStringObj("type=", 5);

  nonnull_assert(start != NULL);

  Tcl_AppendLimitedToObj(checker, start, (int)len, INT_MAX, NULL);
  return checker;
}

/*
 *----------------------------------------------------------------------
 * ParamOptionSetConverter --
 *
 *      Fill in the fields int to the specified paramPtr structure
 *      checker method and perform sanity checking.
 *
 * Results:
 *      Standard result code
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int ParamOptionSetConverter(Tcl_Interp *interp, Nsf_Param *paramPtr,
                        const char *typeName, Nsf_TypeConverter *converter)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static int
ParamOptionSetConverter(Tcl_Interp *interp, Nsf_Param *paramPtr,
                        const char *typeName, Nsf_TypeConverter *converter) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(paramPtr != NULL);
  nonnull_assert(typeName != NULL);
  nonnull_assert(converter != NULL);

  if (paramPtr->converter != NULL) {
    result = NsfPrintError(interp, "refuse to redefine parameter type of '%s' from type '%s' to type '%s'",
                           paramPtr->name, paramPtr->type, typeName);
  } else {
    paramPtr->converter = converter;
    paramPtr->nrArgs = 1;
    paramPtr->type = typeName;
    result = TCL_OK;
  }
  return result;
}


/*
 *----------------------------------------------------------------------
 * Unescape --
 *
 *      Unescape double commas in the provided Tcl_Obj.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Potentially shortened string content
 *
 *----------------------------------------------------------------------
 */

static void Unescape(Tcl_Obj *objPtr)
  nonnull(1);

static void
Unescape(Tcl_Obj *objPtr) {
  int i, j, l;
  char *string;

  nonnull_assert(objPtr != NULL);

  l = Tcl_GetCharLength(objPtr);
  string = ObjStr(objPtr);

  for (i = 0; i < l; i++) {
    if (string[i] == ',' && string[i+1] == ',') {
      for (j = i+1; j < l; j++) {
        string[j] = string[j+1];
      }
      l--;
      i++;
    }
  }
  Tcl_SetObjLength(objPtr, l);
}

/*
 *----------------------------------------------------------------------
 * ParamOptionParse --
 *
 *      Parse a single parameter option of a parameter. The parameter option
 *      string is passed in as second argument, the sizes start and remainder
 *      flag the offsets in the string follow. As a result, the fields of the
 *      parameter structure are updated.
 *
 * Results:
 *      Tcl result code, updated fields in the Nsf_Param structure.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int ParamOptionParse(Tcl_Interp *interp, const char *argString,
                            size_t start, size_t optionLength,
                            unsigned int disallowedOptions, Nsf_Param *paramPtr,
                            bool unescape, const char *qualifier)
  nonnull(1) nonnull(2) nonnull(6);

static int
ParamOptionParse(Tcl_Interp *interp, const char *argString,
                 size_t start, size_t optionLength,
                 unsigned int disallowedOptions, Nsf_Param *paramPtr,
                 bool unescape, const char *qualifier) {
  const char *dotdot, *option;
  char        firstChar;
  int         result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(argString != NULL);
  nonnull_assert(paramPtr != NULL);

  option = argString + start;
  firstChar = *option;

  /*fprintf(stderr, "ParamOptionParse name %s, option '%s' (%ld) disallowed %.6x\n",
    paramPtr->name, option, start, disallowedOptions);*/

  if (firstChar == 'r' && strncmp(option, "required", NsfMax(3, optionLength)) == 0) {
    paramPtr->flags |= NSF_ARG_REQUIRED;

  } else if (firstChar == 'o' && strncmp(option, "optional",  NsfMax(3, optionLength)) == 0) {
    paramPtr->flags &= ~NSF_ARG_REQUIRED;

  } else if (firstChar == 's'
             && strncmp(option, "substdefault", 12) == 0
             ) {
    int  substDefaultFlags = 0;
    char trailingChar = *(option+12);

    if (trailingChar == '=') {
      Tcl_Obj *ov[2];

      ov[0] = NULL;
      ov[1] = Tcl_NewStringObj(option + 13, (int)optionLength - 13);
      INCR_REF_COUNT(ov[1]);
      result = Nsf_ExprObjCmd(NULL, interp, 2, ov);
      DECR_REF_COUNT(ov[1]);

      if (result == TCL_OK) {
        Tcl_Obj *resultObj = Tcl_GetObjResult(interp);

        if ((Tcl_GetIntFromObj(interp, resultObj, &substDefaultFlags) != TCL_OK)
            || (substDefaultFlags < 0) || (substDefaultFlags > 7)
            ) {
          return NsfPrintError(interp,
                               "parameter option 'substdefault=' must be a value between 0b000 and 0b111: %s",
                               option);
        }
      } else {
        return NsfPrintError(interp, "substdefault expression failed: %s", ObjStr(Tcl_GetObjResult(interp)));
      }
    } else if (trailingChar == '\0' || trailingChar == ',') {
      substDefaultFlags = 7;
    } else {
      return NsfPrintError(interp, "unexpected character %c (%d) after 'substdefault'", trailingChar, trailingChar);
    }
    paramPtr->flags |= NSF_ARG_SUBST_DEFAULT;
    paramPtr->flags |= ((unsigned int)substDefaultFlags << 28);

  } else if (firstChar == 'c' && strncmp(option, "convert", 7) == 0) {
    paramPtr->flags |= NSF_ARG_IS_CONVERTER;

  } else if (firstChar == 'i' && strncmp(option, "initcmd", 7) == 0) {
    if (unlikely((paramPtr->flags & (NSF_ARG_CMD|NSF_ARG_ALIAS|NSF_ARG_FORWARD)) != 0u)) {
      return NsfPrintError(interp, "parameter option 'initcmd' not valid in this option combination");
    }
    paramPtr->flags |= NSF_ARG_INITCMD;

  } else if (firstChar == 'c' && strncmp(option, "cmd", 3) == 0) {
    if (unlikely((paramPtr->flags & (NSF_ARG_INITCMD|NSF_ARG_ALIAS|NSF_ARG_FORWARD)) != 0u)) {
      return NsfPrintError(interp, "parameter option 'cmd' not valid in this option combination");
    }
    paramPtr->flags |= NSF_ARG_CMD;

  } else if (firstChar == 'a' && strncmp(option, "alias", 5) == 0) {
    if (unlikely((paramPtr->flags & (NSF_ARG_INITCMD|NSF_ARG_CMD|NSF_ARG_FORWARD)) != 0u)) {
      return NsfPrintError(interp, "parameter option 'alias' not valid in this option combination");
    }
    paramPtr->flags |= NSF_ARG_ALIAS;

  } else if (firstChar == 'f' && strncmp(option, "forward", 7) == 0) {
    if (unlikely((paramPtr->flags & (NSF_ARG_INITCMD|NSF_ARG_CMD|NSF_ARG_ALIAS)) != 0u)) {
      return NsfPrintError(interp, "parameter option 'forward' not valid in this option combination");
    }
    paramPtr->flags |= NSF_ARG_FORWARD;

  } else if (firstChar == 's' && strncmp(option, "slotset", 7) == 0) {
    if (unlikely(paramPtr->slotObj == NULL)) {
      return NsfPrintError(interp, "parameter option 'slotset' must follow 'slot='");
    }
    paramPtr->flags |= NSF_ARG_SLOTSET;

  } else if (firstChar == 's' && strncmp(option, "slotinitialize", 14) == 0) {
    if (unlikely(paramPtr->slotObj == NULL)) {
      return NsfPrintError(interp, "parameter option 'slotinit' must follow 'slot='");
    }
    paramPtr->flags |= NSF_ARG_SLOTINITIALIZE;

  } else if ((dotdot = strnstr(option, "..", optionLength-1))) {
    /*
     * Check lower bound.
     */
    if (*option == '0') {
      paramPtr->flags |= NSF_ARG_ALLOW_EMPTY;
    } else if (unlikely(*option != '1')) {
      return NsfPrintError(interp, "lower bound of multiplicity in %s not supported", argString);
    }
    /*
     * Check upper bound.
     */
    option = dotdot + 2;
    if (*option == '*' || *option == 'n') {
      if (unlikely((paramPtr->flags & (NSF_ARG_SWITCH)) != 0u)) {
        return NsfPrintError(interp,
                             "upper bound of multiplicity of '%c' not allowed for \"switch\"\n", *option);
      }
      paramPtr->flags |= NSF_ARG_MULTIVALUED;
    } else if (*option != '1') {
      return NsfPrintError(interp, "upper bound of multiplicity in %s not supported", argString);
    }

  } else if (firstChar == 'n' && strncmp(option, "noarg", 5) == 0) {
    if ((paramPtr->flags & NSF_ARG_ALIAS) == 0u) {
      return NsfPrintError(interp, "parameter option \"noarg\" only allowed for parameter type \"alias\"");
    }
    paramPtr->flags |= NSF_ARG_NOARG;
    paramPtr->nrArgs = 0;

  } else if (firstChar == 'n' && strncmp(option, "nodashalnum", 11) == 0) {
    if (*paramPtr->name == '-') {
      return NsfPrintError(interp, "parameter option 'nodashalnum' only allowed for positional parameters");
    }
    paramPtr->flags |= NSF_ARG_NODASHALNUM;

  } else if (firstChar == 'n' && strncmp(option, "noconfig", 8) == 0) {
    if (disallowedOptions != NSF_DISALLOWED_ARG_OBJECT_PARAMETER) {
      return NsfPrintError(interp, "parameter option 'noconfig' only allowed for object parameters");
    }
    paramPtr->flags |= NSF_ARG_NOCONFIG;

  } else if (firstChar == 'a' && strncmp(option, "args", 4) == 0) {
    if ((paramPtr->flags & NSF_ARG_ALIAS) == 0u) {
      return NsfPrintError(interp, "parameter option \"args\" only allowed for parameter type \"alias\"");
    }
    result = ParamOptionSetConverter(interp, paramPtr, "args", ConvertToNothing);

  } else if (firstChar == 'a' && optionLength >= 4 && strncmp(option, "arg=", 4) == 0) {
    if (paramPtr->converter != ConvertViaCmd) {
      return NsfPrintError(interp,
                           "parameter option 'arg=' only allowed for user-defined converter");
    }
    if (paramPtr->converterArg != NULL) {
      DECR_REF_COUNT(paramPtr->converterArg);
    }
    paramPtr->converterArg = Tcl_NewStringObj(option + 4, (int)optionLength - 4);
    /*
     * In case, we know that we have to unescape double commas, do it here...
     */
    if (unlikely(unescape)) {
      Unescape(paramPtr->converterArg);
    }
    INCR_REF_COUNT(paramPtr->converterArg);

  } else if (firstChar == 's' && strncmp(option, "switch", 6) == 0) {
    if (*paramPtr->name != '-') {
      return NsfPrintError(interp,
                           "invalid parameter type \"switch\" for argument \"%s\"; "
                           "type \"switch\" only allowed for non-positional arguments",
                           paramPtr->name);
    } else if ((paramPtr->flags & NSF_ARG_METHOD_INVOCATION) != 0u) {
      return NsfPrintError(interp, "parameter invocation types cannot be used with option 'switch'");
    }
    result = ParamOptionSetConverter(interp, paramPtr, "switch", Nsf_ConvertToSwitch);
    paramPtr->flags |= NSF_ARG_SWITCH;
    paramPtr->nrArgs = 0;
    assert(paramPtr->defaultValue == NULL);
    paramPtr->defaultValue = Tcl_NewBooleanObj(0);
    INCR_REF_COUNT(paramPtr->defaultValue);

  } else if (firstChar == 'i' && strncmp(option, "integer", NsfMax(3, optionLength)) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "integer", Nsf_ConvertToInteger);

  } else if (firstChar == 'i' && strncmp(option, "int32", 5) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "int32", Nsf_ConvertToInt32);

  } else if (firstChar == 'b' && strncmp(option, "boolean", 7) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "boolean", Nsf_ConvertToBoolean);

  } else if (firstChar == 'o' && strncmp(option, "object", 6) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "object", Nsf_ConvertToObject);

  } else if (firstChar == 'c' && strncmp(option, "class", 5) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "class", Nsf_ConvertToClass);

  } else if (firstChar == 'm' && strncmp(option, "metaclass", 9) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "class", Nsf_ConvertToClass);
    paramPtr->flags |= NSF_ARG_METACLASS;

  } else if (firstChar == 'b' && strncmp(option, "baseclass", 9) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "class", Nsf_ConvertToClass);
    paramPtr->flags |= NSF_ARG_BASECLASS;

  } else if (firstChar == 'm' && strncmp(option, "mixinreg", 8) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "mixinreg", Nsf_ConvertToMixinreg);

  } else if (firstChar == 'f' && strncmp(option, "filterreg", 9) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "filterreg", Nsf_ConvertToFilterreg);

  } else if (firstChar == 'p' && strncmp(option, "parameter", 9) == 0) {
    result = ParamOptionSetConverter(interp, paramPtr, "parameter", Nsf_ConvertToParameter);

  } else if (firstChar == 't' && optionLength >= 6 && strncmp(option, "type=", 5) == 0) {
    const char* typeValue = option + 5;
    int         typeValueLength = (int)optionLength - 5;

    if (paramPtr->converter != Nsf_ConvertToObject
        && paramPtr->converter != Nsf_ConvertToClass ) {
      return NsfPrintError(interp, "parameter option 'type=' only allowed for parameter types 'object' and 'class'");
    }
    if (paramPtr->converterArg != NULL) {
      DECR_REF_COUNT(paramPtr->converterArg);
    }

    if (qualifier != NULL && !isAbsolutePath(typeValue) &&
        isAbsolutePath(qualifier)) {
      Tcl_DString ds, *dsPtr = &ds;
      Tcl_DStringInit(dsPtr);
      Tcl_DStringAppend(dsPtr, qualifier, -1);
      if (Tcl_DStringLength(dsPtr) > 2) {
        Tcl_DStringAppend(dsPtr, "::", 2);
      }
      Tcl_DStringAppend(dsPtr, typeValue, typeValueLength);
      paramPtr->converterArg = Tcl_NewStringObj(Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr));
      Tcl_DStringFree(dsPtr);
    } else {
      paramPtr->converterArg = Tcl_NewStringObj(typeValue, typeValueLength);
    }

    if (unlikely(unescape)) {
      Unescape(paramPtr->converterArg);
    }
    INCR_REF_COUNT(paramPtr->converterArg);

  } else if (firstChar == 's' && optionLength >= 6 && strncmp(option, "slot=", 5) == 0) {
    if (paramPtr->slotObj != NULL) {
      DECR_REF_COUNT(paramPtr->slotObj);
    }
    paramPtr->slotObj = Tcl_NewStringObj(option + 5,  (int)optionLength - 5);
    if (unlikely(unescape)) {
      Unescape(paramPtr->slotObj);
    }
    INCR_REF_COUNT(paramPtr->slotObj);

  } else if (firstChar == 'm' && optionLength >= 6 && strncmp(option, "method=", 7) == 0) {
    if ((paramPtr->flags & (NSF_ARG_ALIAS|NSF_ARG_FORWARD|NSF_ARG_SLOTSET)) == 0u) {
      return NsfPrintError(interp, "parameter option 'method=' only allowed for parameter "
                           "types 'alias', 'forward' and 'slotset'");
    }
    if (paramPtr->method != NULL) {
      DECR_REF_COUNT(paramPtr->method);
    }
    paramPtr->method = Tcl_NewStringObj(option + 7,  (int)optionLength - 7);
    if (unlikely(unescape)) {
      Unescape(paramPtr->method);
    }
    INCR_REF_COUNT(paramPtr->method);

  } else if ((firstChar == 'v') &&
             ((strncmp(option, "virtualobjectargs", 17) == 0) ||
              (strncmp(option, "virtualclassargs", 16) == 0))) {
    result = ParamOptionSetConverter(interp, paramPtr, option, ConvertToNothing);
  } else {
    Tcl_DString ds, *dsPtr = &ds;
#ifdef  NSF_WITH_TCL_OBJ_TYPES_AS_CONVERTER
    const Tcl_ObjType *tclObjType;
#endif

    if (option[0] == '\0') {
      NsfLog(interp, NSF_LOG_WARN, "empty parameter option ignored");
      return TCL_OK;
    }

    Tcl_DStringInit(dsPtr);
    Tcl_DStringAppend(dsPtr, option,  (int)optionLength);

    if (unlikely(paramPtr->converter != NULL)) {
      NsfPrintError(interp, "parameter option '%s' unknown for parameter type '%s'",
                    Tcl_DStringValue(dsPtr), paramPtr->type);
      Tcl_DStringFree(dsPtr);
      return TCL_ERROR;
    }

    /*fprintf(stderr, "HAV TYPE converter for <%s> ?\n", option);*/

    if (Nsf_PointerTypeLookup(Tcl_DStringValue(dsPtr))) {
      /*
       * Check whether the option refers to a pointer converter.
       */
      ParamOptionSetConverter(interp, paramPtr,  Tcl_DStringValue(dsPtr), Nsf_ConvertToPointer);
      Tcl_DStringFree(dsPtr);

#ifdef NSF_WITH_TCL_OBJ_TYPES_AS_CONVERTER
    } else if ((tclObjType = Tcl_GetObjType(option)) != NULL) {
      /*fprintf(stderr, "SET TYPE converter for <%s>\n", option);*/
      result = ParamOptionSetConverter(interp, paramPtr,  Tcl_DStringValue(dsPtr), Nsf_ConvertToTclObjType);
      if (paramPtr->converterArg != NULL) {
          DECR_REF_COUNT(paramPtr->converterArg);
        }
        paramPtr->converterArg = Tcl_NewObj();
        paramPtr->converterArg->internalRep.twoPtrValue.ptr1 = (void *)tclObjType;
        INCR_REF_COUNT(paramPtr->converterArg);
#endif
    } else {
      int i, found = -1;

      /*
       * The option is still unknown, check the Tcl string-is checkers
       */
      Tcl_DStringFree(dsPtr);

      for (i = 0; stringTypeOpts[i]; i++) {
        /*
         * Do not allow abbreviations, so the additional strlen() checks
         * for a full match.
         */
        if (strncmp(option, stringTypeOpts[i], optionLength) == 0
            && strlen(stringTypeOpts[i]) == optionLength) {
          found = i;
          break;
        }
      }

      if (found > -1) {
        /*
         * Converter is stringType.
         */
        result = ParamOptionSetConverter(interp, paramPtr, "stringtype", Nsf_ConvertToTclobj);
        if (paramPtr->converterArg != NULL) {
          DECR_REF_COUNT(paramPtr->converterArg);
        }
        paramPtr->converterArg = Tcl_NewStringObj(stringTypeOpts[i], -1);
        INCR_REF_COUNT(paramPtr->converterArg);
      } else {

        /*
         * The parameter option is still unknown. We assume that the parameter
         * option identifies a user-defined argument checker, implemented as a
         * method.
         */
        if (paramPtr->converterName != NULL) {
          DECR_REF_COUNT2("converterNameObj", paramPtr->converterName);
        }
        paramPtr->converterName = ParamCheckObj(option, optionLength);
        INCR_REF_COUNT2("converterNameObj", paramPtr->converterName);
        result = ParamOptionSetConverter(interp, paramPtr, ObjStr(paramPtr->converterName), ConvertViaCmd);
      }
    }
  }

  if ((paramPtr->flags & disallowedOptions) != 0u) {
    return NsfPrintError(interp, "parameter option '%s' not allowed", option);
  }

  if (unlikely(((paramPtr->flags & NSF_ARG_METHOD_INVOCATION) != 0u)
               && ((paramPtr->flags & NSF_ARG_NOCONFIG)) != 0u)) {
    return NsfPrintError(interp, "parameter option 'noconfig' cannot used together with this type of object parameter");
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * ParamDefinitionParse --
 *
 *      Parse a single parameter definition with a possible default provided in
 *      the form of a Tcl_Obj.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int ParamDefinitionParse(Tcl_Interp *interp, Tcl_Obj *procNameObj, Tcl_Obj *arg,
                                unsigned int disallowedFlags,
                                Nsf_Param *paramPtr, int *possibleUnknowns, int *plainParams,
                                int *nrNonposArgs, const char *qualifier)
  nonnull(1) nonnull(3) nonnull(5) nonnull(6) nonnull(7) nonnull(8);

static int
ParamDefinitionParse(Tcl_Interp *interp, Tcl_Obj *procNameObj, Tcl_Obj *arg, unsigned int disallowedFlags,
                     Nsf_Param *paramPtr, int *possibleUnknowns, int *plainParams, int *nrNonposArgs,
                     const char *qualifier) {
  const char  *argString, *argName;
  int          result, npac, isNonposArgument, parensCount;
  size_t       length, j;
  Tcl_Obj    **npav;

  nonnull_assert(interp != NULL);
  nonnull_assert(arg != NULL);
  nonnull_assert(paramPtr != NULL);
  nonnull_assert(possibleUnknowns != NULL);
  nonnull_assert(plainParams != NULL);
  nonnull_assert(nrNonposArgs != NULL);

  paramPtr->paramObj = arg;
  INCR_REF_COUNT(paramPtr->paramObj);

  result = Tcl_ListObjGetElements(interp, paramPtr->paramObj, &npac, &npav);
  if (unlikely(result != TCL_OK || npac < 1 || npac > 2)) {
    if (procNameObj != NULL) {
      result = NsfPrintError(interp,
                             "wrong # of elements in parameter definition "
                             "of method '%s'. "
                             "Should be a list of 1 or 2 elements, but got: '$s'",
                             ObjStr(procNameObj), ObjStr(paramPtr->paramObj));
    } else {
      result = NsfPrintError(interp,
                             "wrong # of elements in parameter definition. "
                             "Should be a list of 1 or 2 elements, but got: '%s'",
                             ObjStr(paramPtr->paramObj));
    }
    DECR_REF_COUNT(paramPtr->paramObj);
    return result;
  }

  argString = ObjStr(npav[0]);
  length = strlen(argString);
  /*
     For whatever reason, the snippet above seems to be faster than:

     argString = TclGetStringFromObj(npav[0], &result);
     length    = (size_t) result;
  */

  /*
   * Per default parameter have exactly one argument; types without arguments
   * (like "switch") have to set their nrArgs explicitly.
   */
  paramPtr->nrArgs = 1;

  isNonposArgument = *argString == '-';
  if (isNonposArgument != 0) {
    argName = argString+1;
    (*nrNonposArgs) ++;
  } else {
    argName = argString;
    paramPtr->flags |= NSF_ARG_REQUIRED; /* positional arguments are required unless we have a default */
  }

  /*fprintf(stderr, "... parsing '%s', name '%s' argString '%s' \n",
    ObjStr(arg), argName, argString);*/

  /*
   * Find the first ':' outside of parens; the name of the parameter might be
   * in array syntax, the array index might contain ":", "," etc.
   */
  parensCount = 0;
  for (j = 0; j < length; j++) {
    if (parensCount > 0 && argString[j] == ')') {
      parensCount --;
      continue;
    }
    if (argString[j] == '(') {
      parensCount ++;
      continue;
    }
    if (parensCount == 0 && argString[j] == ':') {
      break;
    }
  }

  if (argString[j] == ':') {
    /*
     * We found a ':'
     */
    size_t l, start, end;
    bool   unescape = NSF_FALSE;

    /*
     * Get parameter name
     */
    STRING_NEW(paramPtr->name, argString, j);
    paramPtr->nameObj = Tcl_NewStringObj(argName, (isNonposArgument != 0) ? (int)j-1 : (int)j);
    INCR_REF_COUNT(paramPtr->nameObj);

    /*
     * Skip space at begin
     */
    for (start = j+1; start<length && isspace((int)argString[start]); start++) {
      ;
    }

    /*
     * Search for unescaped ','
     */
    for (l = start; l < length; l++) {
      if (unlikely(argString[l] == ',')) {
        if (likely(argString[l+1]) == ',') {
          l++;
          unescape = NSF_TRUE;
          continue;
        }
        /*
         * Skip space from end.
         */
        for (end = l; end > 0 && isspace((int)argString[end-1]); end--);
        result = ParamOptionParse(interp, argString, start, end-start, disallowedFlags, paramPtr, unescape,
                                  qualifier);
        unescape = NSF_FALSE;
        if (unlikely(result != TCL_OK)) {
          goto param_error;
        }
        l++;
        /*
         * Skip space from begin.
         */
        for (start = l; start<length && isspace((int)argString[start]); start++) {
          ;
        }
      }
    }
    /*
     * skip space from end
     */
    for (end = l; end > 0 && isspace((int)argString[end-1]); end--);

    /*
     * process last option
     */
    if (end-start > 0) {
      result = ParamOptionParse(interp, argString, start, end-start, disallowedFlags, paramPtr, unescape,
                                qualifier);
      if (unlikely(result != TCL_OK)) {
        goto param_error;
      }
    }

  } else {
    /*
     * No ':', the whole arg is the name, we have no options
     */
    STRING_NEW(paramPtr->name, argString, length);
    if (isNonposArgument != 0) {
      paramPtr->nameObj = Tcl_NewStringObj(argName, (int)length-1);
    } else {
      (*plainParams) ++;
      paramPtr->nameObj = Tcl_NewStringObj(argName, (int)length);
    }
    INCR_REF_COUNT(paramPtr->nameObj);
  }

  /*
   * If we have two arguments in the list, the second one is a default value
   */
  if (npac == 2) {

    if ((disallowedFlags & NSF_ARG_HAS_DEFAULT) != 0u) {
      NsfPrintError(interp, "parameter specification for \"%s\" is not allowed to have default \"%s\"",
                    argString, ObjStr(npav[1]));
      goto param_error;
    }

    /*
     * If we have for some reason already a default value, free it
     */
    if (paramPtr->defaultValue != NULL) {
      DECR_REF_COUNT(paramPtr->defaultValue);
    }
    paramPtr->defaultValue = Tcl_DuplicateObj(npav[1]);
    INCR_REF_COUNT(paramPtr->defaultValue);
    /*
     * The argument will be not required for an invocation, since we
     * have a default.
     */
    paramPtr->flags &= ~NSF_ARG_REQUIRED;
  } else if ((paramPtr->flags & NSF_ARG_SUBST_DEFAULT) != 0u) {
    NsfPrintError(interp,
                  "parameter option substdefault specified for parameter \"%s\""
                  " without default value", paramPtr->name);
    goto param_error;
  }

  /*
   * Postprocessing the parameter options
   */

  if (paramPtr->converter == NULL) {
    /*
     * If no converter is set, use the default converter
     */
    paramPtr->converter = Nsf_ConvertToTclobj;
  } else if (
      paramPtr->converter == ConvertToNothing
      && (paramPtr->flags & (NSF_ARG_ALLOW_EMPTY|NSF_ARG_MULTIVALUED)) != 0u
  ) {
      NsfPrintError(interp,
                    "multiplicity settings for variable argument parameter \"%s\" not allowed",
                    paramPtr->name);
      goto param_error;
  }

  /*
   * Check for application specific value checkers and converters
   */
  /*fprintf(stderr, "parm %s: slotObj %p viaCmd? %d\n",
          paramPtr->name, paramPtr->slotObj, paramPtr->converter == ConvertViaCmd);*/

  if ((paramPtr->slotObj || paramPtr->converter == ConvertViaCmd) && paramPtr->type) {
    const char *converterNameString;
    Tcl_Obj    *converterNameObj, *slotObj;
    NsfObject  *paramObject;
    Tcl_Command cmd;
    NsfClass   *paramClass = NULL;

    slotObj = (paramPtr->slotObj != NULL) ? paramPtr->slotObj : NsfGlobalObjs[NSF_METHOD_PARAMETER_SLOT_OBJ];
    result = GetObjectFromObj(interp, slotObj, &paramObject);
    if (unlikely(result != TCL_OK)) {
      NsfPrintError(interp, "non-existing slot object \"%s\"", ObjStr(slotObj));
      goto param_error;
    }
    if (paramPtr->converterName == NULL) {
      converterNameObj = ParamCheckObj(paramPtr->type, strlen(paramPtr->type));
      INCR_REF_COUNT2("converterNameObj", converterNameObj);
    } else {
      converterNameObj = paramPtr->converterName;
    }
    converterNameString = ObjStr(converterNameObj);

    cmd = ObjectFindMethod(interp, paramObject, converterNameObj, &paramClass);
    /*fprintf(stderr, "locating %s on %s returns %p (%s)\n",
      ObjStr(converterNameObj), ObjectName(paramObject), cmd, ClassName(paramClass));*/
    if (cmd == NULL) {
      if (paramPtr->converter == ConvertViaCmd) {

        NsfLog(interp, NSF_LOG_WARN, "Could not find value checker %s defined on %s",
               converterNameString, ObjectName(paramObject));

        paramPtr->flags |= NSF_ARG_CURRENTLY_UNKNOWN;
        /* TODO: for the time being, we do not return an error here */
      }
    } else if (paramPtr->converter != ConvertViaCmd &&
               paramPtr->slotObj &&
               strcmp(ObjStr(paramPtr->slotObj),
                      NsfGlobalStrings[NSF_METHOD_PARAMETER_SLOT_OBJ]) != 0) {

      NsfLog(interp, NSF_LOG_WARN, "Checker method %s defined on %s shadows built-in converter",
             converterNameString, ObjectName(paramObject));

      if (paramPtr->converterName == NULL) {
        paramPtr->converterName = converterNameObj;
        paramPtr->converter = NULL;
        result = ParamOptionSetConverter(interp, paramPtr, converterNameString, ConvertViaCmd);
        if (unlikely(result != TCL_OK)) {
          if (converterNameObj != paramPtr->converterName) {
            DECR_REF_COUNT2("converterNameObj", converterNameObj);
          }
          goto param_error;
        }
      }
    }
    if (((paramPtr->flags & NSF_ARG_IS_CONVERTER) != 0u)
        && paramPtr->converter != ConvertViaCmd) {
      NsfPrintError(interp, "option 'convert' only allowed for application-defined converters");
      if (converterNameObj != paramPtr->converterName) {
        DECR_REF_COUNT2("converterNameObj", converterNameObj);
      }
      goto param_error;
    }

    if (converterNameObj != paramPtr->converterName) {
      DECR_REF_COUNT2("converterNameObj", converterNameObj);
    }
  }

  /*
   * If the argument has no arguments and it is positional, it can't be
   * required.
   */
  if (paramPtr->nrArgs == 0
      && *paramPtr->name != '-'
      && (paramPtr->flags & NSF_ARG_REQUIRED) != 0u
      ) {
    paramPtr->flags &= ~NSF_ARG_REQUIRED;
  }

  /*
   * If the argument is not required and no default value is specified, we
   * have to handle in the client code (e.g. in the canonical arg handlers for
   * scripted methods) the unknown value (e.g. don't set/unset a variable)
   */
  if ((paramPtr->flags & NSF_ARG_REQUIRED) == 0u && paramPtr->defaultValue == NULL) {
    (*possibleUnknowns)++;
  }
  return TCL_OK;

 param_error:
  ParamFree(paramPtr);
  paramPtr->name = NULL;

#if !defined(NDEBUG)
  /*
   * Whenever we return a TCL_ERROR, we expect that the interp result contains
   * an error message.
   */
  {
    const char *errStr = ObjStr(Tcl_GetObjResult(interp));
    assert(*errStr != '\0');
  }
#endif

  return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 * ParamDefsParse --
 *
 *      Parse a list of parameters in the form of Tcl_Objs into a
 *      parsedParamPtr structure (last argument). The argument
 *      allowedOptions is used to flag, what parameter options are
 *      generally allowed (typically different for method and object
 *      parameters). Unless forceParamdefs is set, the parsed parameter
 *      structure is only returned when needed (i.e. when not all
 *      parameters are plain parameters).
 *
 * Results:
 *      A standard Tcl result, parsedParameter structure in last
 *      argument (allocated by the caller).
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int ParamDefsParse(Tcl_Interp *interp, Tcl_Obj *procNameObj, Tcl_Obj *paramSpecObjs,
                          unsigned int allowedOptions, bool forceParamdefs,
                          NsfParsedParam *parsedParamPtr, const char *qualifier)
  nonnull(1) nonnull(3) nonnull(6);

static int
ParamDefsParse(Tcl_Interp *interp, Tcl_Obj *procNameObj, Tcl_Obj *paramSpecObjs,
               unsigned int allowedOptions, bool forceParamdefs, NsfParsedParam *parsedParamPtr,
               const char *qualifier) {
  Tcl_Obj **argsv;
  int result, argsc;

  nonnull_assert(interp != NULL);
  nonnull_assert(paramSpecObjs != NULL);
  nonnull_assert(parsedParamPtr != NULL);

  parsedParamPtr->paramDefs = NULL;
  parsedParamPtr->possibleUnknowns = 0;

  result = Tcl_ListObjGetElements(interp, paramSpecObjs, &argsc, &argsv);
  if (unlikely(result != TCL_OK)) {
    return NsfPrintError(interp, "cannot break down non-positional args: %s", ObjStr(paramSpecObjs));
  }

  if (argsc > 0) {
    Nsf_Param *paramsPtr, *paramPtr, *lastParamPtr;
    int i, possibleUnknowns = 0, plainParams = 0, nrNonposArgs = 0;
    NsfParamDefs *paramDefs;

    paramPtr = paramsPtr = ParamsNew((size_t)argsc);

    for (i = 0; i < argsc; i++, paramPtr++) {
      result = ParamDefinitionParse(interp, procNameObj, argsv[i], allowedOptions,
                                    paramPtr, &possibleUnknowns, &plainParams, &nrNonposArgs,
                                    qualifier);

      if (result == TCL_OK) {
        if (paramPtr->converter == ConvertToNothing && i < argsc-1) {
          result = NsfPrintError(interp,
                                 "parameter option \"args\" invalid for parameter \"%s\"; only allowed for last parameter",
                                 paramPtr->name);
        }

        /* fprintf(stderr, "qual %s\n", qualifier);
           if (qualifier != NULL &&
           (paramPtr->converter == Nsf_ConvertToObject ||
           paramPtr->converter == Nsf_ConvertToClass) &&
           paramPtr->converterArg != NULL) {
           fprintf(stderr, "qual %s\n", qualifier);
           const char *carg = ObjStr(paramPtr->converterArg);
           if (*carg != ':') {
           Tcl_Obj *qualifiedConverterArg = Tcl_NewStringObj(qualifier, -1);
           Tcl_AppendToObj(qualifiedConverterArg, "::", 2);
           Tcl_AppendObjToObj(qualifiedConverterArg, paramPtr->converterArg);
           DECR_REF_COUNT(paramPtr->converterArg);
           paramPtr->converterArg = qualifiedConverterArg;
           INCR_REF_COUNT(qualifiedConverterArg);
           fprintf(stderr, ">>> converterArg %s qualifier %s\n", ObjStr(paramPtr->converterArg), qualifier);
           }
           }*/
      }
      if (unlikely(result != TCL_OK)) {
        ParamsFree(paramsPtr);
        return result;
      }
      /*
       * Every parameter must have at least a name set.
       */
      assert(paramPtr->name);
    }
#if defined(NSF_WITH_VALUE_WARNINGS)
    if (nrNonposArgs > 0 && argsc > 1) {
      for (i = 0; i < argsc; i++) {
        (paramsPtr + i)->flags |= NSF_ARG_CHECK_NONPOS;
      }
    }
#endif

    /*
     * If all arguments are good old Tcl arguments, there is no need
     * to use the parameter definition structure, unless we force it.
     */
    if (plainParams == argsc && !forceParamdefs) {
      ParamsFree(paramsPtr);
      return TCL_OK;
    }

    /*fprintf(stderr, "we need param definition structure for {%s}, argsc %d plain %d\n",
      ObjStr(paramSpecObjs), argsc, plainParams);*/

    /*
     * Check the last argument. If the last argument is named 'args',
     * force converter and make it non-required.
     */
    lastParamPtr = paramPtr - 1;
    if (isArgsString(lastParamPtr->name)) {
      lastParamPtr->converter = ConvertToNothing;
      lastParamPtr->flags &= ~NSF_ARG_REQUIRED;
    }

    paramDefs = ParamDefsNew();
    paramDefs->paramsPtr = paramsPtr;
    paramDefs->nrParams = (int)(paramPtr - paramsPtr);
    /*fprintf(stderr, "method %s serial %d paramDefs %p ifsize %ld, possible unknowns = %d,\n",
      ObjStr(procNameObj), paramDefs->serial,
      paramDefs, paramPtr-paramsPtr, possibleUnknowns);*/
    parsedParamPtr->paramDefs = paramDefs;
    parsedParamPtr->possibleUnknowns = possibleUnknowns;
  }
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * ParameterMethodForwardDispatch --
 *
 *      Dispatch a forwarding method provided via parameter definition.
 *
 *      The current implementation performs for every object
 *      parameter forward the full cycle of
 *
 *     (a) splitting the spec,
 *     (b) convert it to the client data structure,
 *     (c) invoke forward,
 *     (d) free client data structure
 *
 *      In the future, it should convert to the client data
 *      structure just once and free it with the disposal of the
 *      parameter. This could be achieved
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      The called function might side-effect.
 *
 *----------------------------------------------------------------------
 */
static int ParameterMethodForwardDispatch(Tcl_Interp *interp, NsfObject *object,
                                          const Nsf_Param *paramPtr, Tcl_Obj *newValue,
                                          NsfCallStackContent *cscPtr)
  nonnull(1) nonnull(2) nonnull(3);

static int
ParameterMethodForwardDispatch(Tcl_Interp *interp, NsfObject *object,
                               const Nsf_Param *paramPtr, Tcl_Obj *newValue,
                               NsfCallStackContent *cscPtr) {
  Tcl_Obj **nobjv, *ov[3], *methodObj, *forwardSpec;
  ForwardCmdClientData *tcd = NULL;
  int result, oc, nobjc;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(paramPtr != NULL);
  assert((paramPtr->flags & NSF_ARG_FORWARD) != 0u);

  forwardSpec = (paramPtr->method != NULL) ? paramPtr->method : NULL; /* different default? */
  if (forwardSpec == NULL) {
    return NsfPrintError(interp, "forward: no spec available\n");
  }

  result = Tcl_ListObjGetElements(interp, forwardSpec, &nobjc, &nobjv);
  if (unlikely(result != TCL_OK)) {
    return result;
  }

  methodObj = paramPtr->nameObj;
  result = ForwardProcessOptions(interp, methodObj,
                                 NULL /*withDefault*/,
                                 0 /*withEarlybinding*/,
                                 NULL /*withOnerror*/,
                                 NULL /*withMethodprefix*/,
                                 0 /*withFrame*/,
                                 NSF_FALSE /*withVerbose*/,
                                 nobjv[0], nobjc-1, nobjv+1, &tcd);
  if (unlikely(result != TCL_OK)) {
    if (tcd != NULL) {
      ForwardCmdDeleteProc(tcd);
    }
    return result;
  }

  /*fprintf(stderr, "parameter %s forward spec <%s> After Options obj %s method %s\n",
          ObjStr(paramPtr->nameObj), ObjStr(forwardSpec),
          ObjectName(object), ObjStr(methodObj));*/

  tcd->object = object;
  oc = 1;
  ov[0] = methodObj;
  if (paramPtr->nrArgs == 1 && newValue) {
    ov[oc] = newValue;
    oc ++;
  }

  /*
   * Mark the intermittent CSC frame as INACTIVE, so that, e.g.,
   * call-stack traversals seeking active frames ignore it.
   */
  if (cscPtr != NULL) {
    cscPtr->frameType = NSF_CSC_TYPE_INACTIVE;
  }

  result = NsfForwardMethod(tcd, interp, oc, ov);
  ForwardCmdDeleteProc(tcd);

  return result;
}


/*
 *----------------------------------------------------------------------
 * ParameterMethodDispatch --
 *
 *      Dispatch a method provided via parameter definition. The function checks
 *      the parameter definition, builds an argument list for the function call
 *      and invokes finally the configured cmd.  This function is typically
 *      called from configure.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      The called function might side-effect.
 *
 *----------------------------------------------------------------------
 */
static int ParameterMethodDispatch(
    Tcl_Interp *interp, NsfObject *object,
    Nsf_Param *paramPtr, Tcl_Obj *newValue,
    CallFrame *uplevelVarFramePtr,
    const char *initString,
    Tcl_Obj **nextObjPtr,
    int nrRemainingArgs
) nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(6) nonnull(7);

static int
ParameterMethodDispatch(
    Tcl_Interp *interp, NsfObject *object,
    Nsf_Param *paramPtr, Tcl_Obj *newValue,
    CallFrame *uplevelVarFramePtr,
    const char *initString,
    Tcl_Obj **nextObjPtr,
    int nrRemainingArgs
) {
  CallFrame           *varFramePtr;
  NsfCallStackContent  csc, *cscPtr = &csc;
  CallFrame            frame2, *framePtr2 = &frame2;
  int                  result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(paramPtr != NULL);
  nonnull_assert(newValue != NULL);
  nonnull_assert(initString != NULL);
  nonnull_assert(nextObjPtr != NULL);

#if 0
  {int i;
  fprintf(stderr, "ParameterMethodDispatch %s flags %06x nrRemainingArgs %d ",
          paramPtr->name, paramPtr->flags, nrRemainingArgs);
  for(i = 0; i < nrRemainingArgs; i++) {
    fprintf(stderr, " [%d]=%p %s,", i, &nextObjPtr[i], ObjStr(nextObjPtr[i]));
  }
  fprintf(stderr, "\n");
  }
#endif

  /*
   * The current call-frame of configure uses an obj-frame, such
   * that setvar etc.  are able to access variables like "a" as a
   * local variable.  However, in the init block, we do not like
   * that behavior, since this should look like a proc body.
   * So we push yet another call-frame without providing the
   * var-frame.
   *
   * The new frame will have the namespace of the caller to avoid
   * the current obj-frame. Nsf_PushFrameCsc() will establish a
   * CMETHOD frame.
   */
  varFramePtr = Tcl_Interp_varFramePtr(interp);
  Tcl_Interp_varFramePtr(interp) = varFramePtr->callerVarPtr;

  cscPtr->flags = 0;
  CscInit(cscPtr, object, object->cl /*cl*/, NULL /*cmd*/,
          NSF_CSC_TYPE_PLAIN, 0, NsfGlobalStrings[NSF_CONFIGURE]);
  Nsf_PushFrameCsc(interp, cscPtr, framePtr2);

  if ((paramPtr->flags & (NSF_ARG_INITCMD|NSF_ARG_CMD)) != 0u) {
    /* cscPtr->cmdPtr = NSFindCommand(interp, "::eval"); */
    result = Tcl_EvalObjEx(interp, newValue, TCL_EVAL_DIRECT);

  } else if ((paramPtr->flags & NSF_ARG_ALIAS) != 0u) {
    Tcl_Obj *methodObj, **ovPtr, *ov0;
    static Tcl_Obj *constantObj = NULL;
    const char *methodString;
    int oc = 0;

    /*
     * Restore the variable frame context as found at the original call
     * site of configure(). Note that we do not have to revert this
     * context change when leaving this configure() context because a
     * surrounding [uplevel] will correct the call-stack context for us ...
     */
    if (uplevelVarFramePtr != NULL) {
      Tcl_Interp_varFramePtr(interp) = uplevelVarFramePtr;
    }

    /*
     * Mark the intermittent CSC frame as INACTIVE, so that, e.g.,
     * call-stack traversals seeking active frames ignore it.
     */
    cscPtr->frameType = NSF_CSC_TYPE_INACTIVE;

    /*
     * If parameter option "method=" was given, use it as method name
     */
    methodObj = (paramPtr->method != NULL) ? paramPtr->method : paramPtr->nameObj;
    methodString = ObjStr(methodObj);

    /*fprintf(stderr, "ALIAS %s, nrargs %d converter %p ConvertToNothing %d oc %d\n",
            paramPtr->name, paramPtr->nrArgs, paramPtr->converter,
            paramPtr->converter == ConvertToNothing,
            oc);*/

    if (paramPtr->converter == ConvertToNothing) {
      /*
       * We are using the varargs interface; pass all remaining args into
       * the called method.
       */
      if (newValue == paramPtr->defaultValue) {
        /*
         * Use the default.
         */
        if (Tcl_ListObjGetElements(interp, paramPtr->defaultValue, &oc, &ovPtr) != TCL_OK) {
          goto method_arg_done;
        }
        ov0 = *ovPtr;
        ovPtr ++;
      } else {
        /*
         * Use actual args.
         */
        ov0 = *nextObjPtr;
        /*fprintf(stderr, "ALIAS use actual args oc %d ov0 <%s> nextObjPtr %p %p\n",
          nrRemainingArgs, ObjStr(ov0), nextObjPtr, nextObjPtr+1);*/
        ovPtr = nextObjPtr+1;
        oc = nrRemainingArgs;
      }
    } else {
      /*
       * A simple alias, receives no arg (when noarg was specified) or a
       * single argument (which might be the default value).
       */
      int       moc = 1;
      Tcl_Obj **movPtr = NULL;

      ov0 = NULL;
      ovPtr = &constantObj;

      if (Tcl_ListObjGetElements(interp, methodObj, &moc, &movPtr) == TCL_OK) {
        if (moc != 2) {
          oc = 0;
          if (unlikely(moc > 2)) {
            NsfLog(interp, NSF_LOG_WARN, "max 2 words are currently allowed in methodName <%s>", methodString);
          }
        } else {
          oc = 1;
          methodObj = movPtr[0];
          ov0 = movPtr[1];
        }
      }
      if (paramPtr->nrArgs == 1) {
        oc++;
        if (oc == 1) {
          ov0 = newValue;
        } else {
          ovPtr = &newValue;
        }
      }
    }

    /*
     * Check whether we have an object parameter alias for the constructor.
     * Since we require the object system for the current object to determine
     * its object system configuration, we can't do this at parameter compile
     * time.
     */
    if (*initString == *methodString && strcmp(initString, methodString) == 0) {
      result = DispatchInitMethod(interp, object, oc, &ov0, 0u);
    } else {

      /*fprintf(stderr, "... call alias %s with methodObj %s.%s oc %d, nrArgs %d '%s'\n",
              paramPtr->name, ObjectName(object), ObjStr(methodObj), oc,
              paramPtr->nrArgs, ObjStr(newValue));*/
#if !defined(NDEBUG)
      if (oc > 2) {
        assert(ovPtr != NULL);
        assert(ovPtr != &constantObj);
        assert(ISOBJ(ovPtr[oc-2]));
      }
#endif
      Tcl_ResetResult(interp);
      result = NsfCallMethodWithArgs(interp, (Nsf_Object*)object, methodObj,
                                     ov0, oc, ovPtr,
                                     NSF_CSC_IMMEDIATE|NSF_CM_IGNORE_PERMISSIONS);
    }
  } else {
    /*
     * must be NSF_ARG_FORWARD
     */
    assert((paramPtr->flags & NSF_ARG_FORWARD) != 0u);

    result = ParameterMethodForwardDispatch(interp, object,
                                            paramPtr, newValue, cscPtr);
  }
 method_arg_done:
  /*
   * Pop previously stacked frame for eval context and set the
   * varFramePtr to the previous value.
   */
  Nsf_PopFrameCsc(interp, framePtr2);
  CscListRemove(interp, cscPtr, NULL);
  CscFinish(interp, cscPtr, result, "converter object frame");
  Tcl_Interp_varFramePtr(interp) = varFramePtr;

  /* fprintf(stderr, "NsfOConfigureMethod_ attribute %s evaluated %s => (%d)\n",
     ObjStr(paramPtr->nameObj), ObjStr(newValue), result);*/

  if (likely(result == TCL_OK)) {
    if ((paramPtr->flags & NSF_ARG_CMD) != 0u
        && RUNTIME_STATE(interp)->doKeepcmds
        ) {
      Tcl_Obj *resultObj;

      resultObj = Tcl_ObjSetVar2(interp, NsfGlobalObjs[NSF_ARRAY_CMD], paramPtr->nameObj, newValue, TCL_LEAVE_ERR_MSG);
      if (unlikely(resultObj == NULL)) {
        result = TCL_ERROR;
      }
    }
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * MakeProc --
 *
 *      Define a scripted function via the ObjCmd "proc".
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Defined function or exception.
 *
 *----------------------------------------------------------------------
 */
static int MakeProc(Tcl_Namespace *nsPtr, NsfAssertionStore *aStore, Tcl_Interp *interp,
    Tcl_Obj *nameObj, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition,
    Tcl_Obj *postcondition, NsfObject *defObject, NsfObject *regObject,
    int withPer_object, int withInner_namespace, unsigned int checkAlwaysFlag
) nonnull(1) nonnull(3) nonnull(4) nonnull(5) nonnull(6) nonnull(9);

static int
MakeProc(
    Tcl_Namespace *nsPtr, NsfAssertionStore *aStore, Tcl_Interp *interp,
    Tcl_Obj *nameObj, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition,
    Tcl_Obj *postcondition, NsfObject *defObject, NsfObject *regObject,
    int withPer_object, int withInner_namespace, unsigned int checkAlwaysFlag
) {
  const char     *methodName;
  NsfParsedParam  parsedParam;
  Tcl_Obj        *ov[4], *fullyQualifiedNameObj;
  int             result;

  nonnull_assert(nsPtr != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(args != NULL);
  nonnull_assert(body != NULL);
  nonnull_assert(defObject != NULL);

  methodName = ObjStr(nameObj);

  /*
   * Tcl (at least in newer versions) will raise an error in cases, where
   * the methodName starts with a colon.
   */
  if (regObject == NULL) {
    regObject = defObject;
  }

  /*
   * Check whether we are allowed to redefine the method.
   */
  result = CanRedefineCmd(interp, nsPtr, defObject, methodName, 0u);
  if (likely(result == TCL_OK)) {
    /*
     * Yes, we can! ...so obtain the method parameter definition.
     */
    Tcl_Namespace *nsPtr1 = Tcl_Command_nsPtr(defObject->id);

    result = ParamDefsParse(interp, nameObj, args,
                            NSF_DISALLOWED_ARG_METHOD_PARAMETER, NSF_FALSE,
                            &parsedParam,
                            nsPtr1 != NULL ? nsPtr1->fullName : NULL);
  }

  if (unlikely(result != TCL_OK)) {
    return result;
  }

  if (isAbsolutePath(methodName)) {
    fullyQualifiedNameObj = nameObj;
  } else {
    fullyQualifiedNameObj = NameInNamespaceObj(methodName, nsPtr);
    INCR_REF_COUNT2("fullyQualifiedName", fullyQualifiedNameObj);
  }

  ov[0] = NULL;
  ov[1] = fullyQualifiedNameObj;

  if (parsedParam.paramDefs != NULL) {
    Nsf_Param *pPtr;
    Tcl_Obj *argList = Tcl_NewListObj(0, NULL);

    for (pPtr = parsedParam.paramDefs->paramsPtr; pPtr->name != NULL; pPtr++) {
      if (*pPtr->name == '-') {
        Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(pPtr->name+1, -1));
      } else {
        Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(pPtr->name, -1));
      }
    }
    ov[2] = argList;
    INCR_REF_COUNT(ov[2]);
    /*fprintf(stderr, "final arglist = <%s>\n", ObjStr(argList)); */
    ov[3] = AddPrefixToBody(body, NSF_TRUE, &parsedParam);
  } else { /* no parameter handling needed */
    ov[2] = args;
    ov[3] = AddPrefixToBody(body, NSF_FALSE, &parsedParam);
  }

  /*
   * Check whether the cmd exists already in the namespace. If so, delete it
   * from there.
   */
  {
    Tcl_Command cmdPtr = FindMethod(nsPtr, methodName);
    if (cmdPtr != NULL) {
      Tcl_DeleteCommandFromToken(interp, cmdPtr);
    }
  }

  /*
   * Create the method in the provided namespace.
   */

  result = Tcl_ProcObjCmd(NULL, interp, 4, ov);

  if (likely(result == TCL_OK)) {
    /*
     * Retrieve the newly defined proc
     */
    Proc *procPtr = FindProcMethod(nsPtr, methodName);

    if (procPtr != NULL) {
      Namespace *execNsPtr;

      if (withInner_namespace == 1) {
        /*
         * Set the execution namespace to the registration object (e.g. same
         * as the class).
         */
        if (regObject->nsPtr == NULL) {
          MakeObjNamespace(interp, regObject);
        }
        /*fprintf(stderr, "obj %s\n", ObjectName(defObject));
        fprintf(stderr, "ns %p defObject->ns %p\n", nsPtr, defObject->nsPtr);
        fprintf(stderr, "ns %s defObject->ns %s\n", nsPtr->fullName, defObject->nsPtr->fullName);
        fprintf(stderr, "old %s\n", procPtr->cmdPtr->nsPtr->fullName);*/
        execNsPtr =  (Namespace *)regObject->nsPtr;
      } else {
        /*
         * Set the execution namespace of the method to the same namespace the
         * cmd of the defObject has.
         */
        execNsPtr = ((Command *)regObject->id)->nsPtr;
      }

      ParamDefsStore((Tcl_Command)procPtr->cmdPtr, parsedParam.paramDefs, checkAlwaysFlag,
                     (Tcl_Namespace *)execNsPtr);
      Tcl_SetObjResult(interp, MethodHandleObj(defObject, withPer_object, methodName));
      result = TCL_OK;

    } else {
      result = TCL_ERROR;
      NsfLog(interp, NSF_LOG_WARN,
             "cannot retrieve newly defined method %s from namespace %s",
             methodName, nsPtr->fullName);
      if (*methodName == ':') {
        NsfPrintError(interp, "can't create procedure \"%s\" in non-global namespace"
                      " with name starting with \":\"",
                      methodName);
      } else {
        NsfPrintError(interp, "can't create procedure \"%s\" in non-global namespace",
                      methodName);
      }
    }
  }

#if defined(NSF_WITH_ASSERTIONS)
  if (result == TCL_OK && aStore != NULL /* (precondition || postcondition)*/) {
    AssertionAddProc(interp, methodName, aStore, precondition, postcondition);
  }
#endif

  if (parsedParam.paramDefs != NULL) {
    DECR_REF_COUNT(ov[2]);
  }
  DECR_REF_COUNT2("resultBody", ov[3]);
  if (fullyQualifiedNameObj != nameObj) {
    DECR_REF_COUNT2("fullyQualifiedName", fullyQualifiedNameObj);
  }


  return result;
}

/*
 *----------------------------------------------------------------------
 * MakeMethod --
 *
 *      Define a scripted method to be defined on defObject and registered on
 *      regObject (if specified). This function handles as well assertions.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Defined method or exception.
 *
 *----------------------------------------------------------------------
 */
static int MakeMethod(Tcl_Interp *interp, NsfObject *defObject, NsfObject *regObject,
                      NsfClass *class, Tcl_Obj *nameObj, Tcl_Obj *args, Tcl_Obj *body,
                      Tcl_Obj *precondition, Tcl_Obj *postcondition,
                      int withInner_namespace, unsigned int checkAlwaysFlag)
  nonnull(1) nonnull(2) nonnull(5) nonnull(6) nonnull(7);

static int
MakeMethod(Tcl_Interp *interp, NsfObject *defObject, NsfObject *regObject,
           NsfClass *class, Tcl_Obj *nameObj, Tcl_Obj *args, Tcl_Obj *body,
           Tcl_Obj *precondition, Tcl_Obj *postcondition,
           int withInner_namespace, unsigned int checkAlwaysFlag) {
  const char *argsStr, *bodyStr, *nameStr;
  int   result;

  nonnull_assert(interp != NULL);
  nonnull_assert(defObject != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(args != NULL);
  nonnull_assert(body != NULL);

  nameStr = ObjStr(nameObj);

  if (*nameStr == '\0' || NsfHasTclSpace(nameStr)) {
    return NsfPrintError(interp, "invalid method name '%s'", nameStr);
  }

  if (precondition != NULL && postcondition == NULL) {
    return NsfPrintError(interp, "%s method '%s'; when specifying a precondition (%s)"
                         " a postcondition must be specified as well",
                         ClassName(class), nameStr, ObjStr(precondition));
  }

  argsStr = ObjStr(args);
  bodyStr = ObjStr(body);
  if (*argsStr == 0 && *bodyStr == 0) {
    /*
     * Both, args and body are empty strings. This means we should delete the
     * method.
     */
    if (RUNTIME_STATE(interp)->exitHandlerDestroyRound == NSF_EXITHANDLER_OFF) {
      /*
       * Don't delete methods via scripting during shutdown
       */
      result = (class != NULL) ?
        NsfRemoveClassMethod(interp, (Nsf_Class *)class, nameStr) :
        NsfRemoveObjectMethod(interp, (Nsf_Object *)defObject, nameStr);
    } else {
      /* fprintf(stderr, "don't delete method %s during shutdown\n", nameStr); */
      result = TCL_OK;
    }

  } else {
#if defined(NSF_WITH_ASSERTIONS)
    NsfAssertionStore *aStore = NULL;

    if (precondition != NULL || postcondition != NULL) {
      if (class != NULL) {
        NsfClassOpt *opt = NsfRequireClassOpt(class);

        if (opt->assertions == NULL) {
          opt->assertions = AssertionCreateStore();
        }
        aStore = opt->assertions;
      } else {
        NsfObjectOpt *opt = NsfRequireObjectOpt(defObject);

        if (opt->assertions == NULL) {
          opt->assertions = AssertionCreateStore();
        }
        aStore = opt->assertions;
      }
    }
    result = MakeProc((class != NULL) ? class->nsPtr : defObject->nsPtr, aStore,
                      interp, nameObj, args, body, precondition, postcondition,
                      defObject, regObject, class == NULL, withInner_namespace,
                      checkAlwaysFlag);
#else
    if (precondition != NULL) {
      NsfLog(interp, NSF_LOG_WARN, "Precondition %s provided, but not compiled with assertion enabled",
             ObjStr(precondition));
    } else if (postcondition != NULL) {
      NsfLog(interp, NSF_LOG_WARN, "Postcondition %s provided, but not compiled with assertion enabled",
             ObjStr(postcondition));
    }
    result = MakeProc((class != NULL) ? class->nsPtr : defObject->nsPtr, NULL,
                      interp, nameObj, args, body, NULL, NULL,
                      defObject, regObject, class == NULL, withInner_namespace,
                      checkAlwaysFlag);
#endif
  }

  if (class != NULL) {
    NsfInstanceMethodEpochIncr("MakeMethod");
    /*
     * Could be a filter or filter inheritance ... update filter orders.
     */
    if (FilterIsActive(interp, nameStr)) {
      NsfClasses *subClasses = TransitiveSubClasses(class);
      if (subClasses != NULL) {
        FilterInvalidateObjOrders(interp, subClasses);
        NsfClassListFree(subClasses);
      }
    }
  } else {
    NsfObjectMethodEpochIncr("MakeMethod");
    /*
     * Could be a filter => recompute filter order.
     */
    FilterComputeDefined(interp, defObject);
  }

  return result;
}

/**************************************************************************
 * Begin Definition of nsf::proc (Tcl Procs with Parameter handling)
 **************************************************************************/
/*
 *----------------------------------------------------------------------
 * NsfProcStubDeleteProc --
 *
 *      Tcl_CmdDeleteProc for NsfProcStubs. Is called, whenever a
 *      NsfProcStub is deleted and frees the associated client data.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees client-data
 *
 *----------------------------------------------------------------------
 */
static void
NsfProcStubDeleteProc(ClientData clientData) {
  NsfProcClientData *tcd = clientData;

  /* fprintf(stderr, "NsfProcStubDeleteProc received %p\n", clientData);
  fprintf(stderr, "... procName %s paramDefs %p\n", ObjStr(tcd->procName), tcd->paramDefs);*/

  DECR_REF_COUNT2("procNameObj", tcd->procName);
  if (tcd->cmd != NULL) {
    Tcl_DeleteCommandFromToken(tcd->interp, tcd->cmd);
    NsfCommandRelease(tcd->cmd);
  }
  /* tcd->paramDefs is freed by NsfProcDeleteProc() */
  FREE(NsfProcClientData, tcd);
}

/*
 *----------------------------------------------------------------------
 * InvokeShadowedProc --
 *
 *      Call the proc specified in objc/objv; procNameObj should be used
 *      for error messages.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int InvokeShadowedProc(Tcl_Interp *interp, Tcl_Obj *procNameObj,
                              Tcl_Command cmd, ParseContext *pcPtr,
                              struct Tcl_Time *trtPtr, unsigned int cmdFlags,
                              Tcl_Namespace *execNsPtr)
  nonnull(1) nonnull(2) nonnull(4) nonnull(3) nonnull(4) nonnull(5);

static int
InvokeShadowedProc(Tcl_Interp *interp, Tcl_Obj *procNameObj,
                   Tcl_Command cmd, ParseContext *pcPtr,
                   struct Tcl_Time  *trtPtr, unsigned int cmdFlags,
                   Tcl_Namespace *execNsPtr) {
  Tcl_Obj       *const *objv;
  int            objc, result, includeTiming;
  const char    *fullMethodName;
  Tcl_CallFrame *framePtr;
  Proc          *procPtr;
  Tcl_Time      *ttPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(procNameObj != NULL);
  nonnull_assert(cmd != NULL);
  nonnull_assert(pcPtr != NULL);
  nonnull_assert(trtPtr != NULL);

  objv = pcPtr->full_objv;
  objc = pcPtr->objc+1;

  fullMethodName = ObjStr(procNameObj);
  CheckCStack(interp, "nsfProc", fullMethodName);
  /* fprintf(stderr, "=== InvokeShadowedProc %s objc %d\n", fullMethodName, objc); */

  /*
   * The code below is derived from the scripted method dispatch and just
   * slightly adapted to remove object dependencies.
   */

  procPtr = (Proc *)Tcl_Command_objClientData(cmd);
  result = TclPushStackFrame(interp, &framePtr,
                             execNsPtr /* procPtr->cmdPtr->nsPtr */,
                             (FRAME_IS_PROC));

  if (likely(result == TCL_OK)) {
    unsigned int dummy = 0;
    result = ByteCompiled(interp, &dummy, procPtr,  (Namespace *)execNsPtr,
                          fullMethodName);
  }
  if (unlikely(result != TCL_OK)) {
    /* todo: really? error msg? */
    return result;
  }

  includeTiming = ((cmdFlags & NSF_CMD_DEBUG_METHOD) != 0u);

#if defined(NSF_PROFILE)
  if (includeTiming == 0) {
    NsfRuntimeState *rst = RUNTIME_STATE(interp);

    /*fprintf(stderr, "InvokeShadowedProc %s cmdFlags %.6lx\n", fullMethodName, cmdFlags);*/
    includeTiming = rst->doProfile;
  }
#endif

  Tcl_CallFrame_objc(framePtr) = objc;
  Tcl_CallFrame_objv(framePtr) = objv;
  Tcl_CallFrame_procPtr(framePtr) = procPtr;

  if (includeTiming) {
    ttPtr = (Tcl_Time *) ckalloc(sizeof(Tcl_Time));
    memcpy(ttPtr, trtPtr, sizeof(Tcl_Time));
  } else {
    ttPtr = NULL;
  }

#if defined(NRE)
  /* fprintf(stderr, "CALL TclNRInterpProcCore proc '%s' %s nameObj %p %s\n",
     ObjStr(objv[0]), fullMethodName, procNameObj, ObjStr(procNameObj)); */

  Tcl_NRAddCallback(interp, ProcDispatchFinalize,
                    (ClientData)fullMethodName, pcPtr,
                    (ClientData)ttPtr,
                    (ClientData)UINT2PTR(cmdFlags)
                    );
  result = TclNRInterpProcCore(interp, procNameObj, 1, &MakeProcError);
#else
  {
  ClientData data[4] = {
    (ClientData)fullMethodName,
    pcPtr,
    (ClientData)ttPtr,
    (ClientData)UINT2PTR(cmdFlags)
  };
  result = TclObjInterpProcCore(interp, procNameObj, 1, &MakeProcError);
  result = ProcDispatchFinalize(data, interp, result);
  }
#endif
  return result;
}

/*
 *----------------------------------------------------------------------
 * NsfProcStub --
 *
 *      Tcl_ObjCmdProc implementing Proc Stubs. This function processes
 *      the argument list in accordance with the parameter definitions
 *      and calls in case of success the shadowed proc.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
NsfProcStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
  NsfProcClientData *tcd;
  int result;
  ParseContext *pcPtr;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  tcd = clientData;
  assert(tcd->cmd != NULL);

  /*fprintf(stderr, "NsfProcStub %s is called, tcd %p, paramDefs %p\n", ObjStr(objv[0]), tcd, tcd ? tcd->paramDefs : NULL);*/

  if ((((unsigned int)Tcl_Command_flags(tcd->cmd) & CMD_IS_DELETED) == 0u) ||
      Tcl_Command_cmdEpoch(tcd->cmd) != 0) {
    /*
     * It seems as if the (cached) command was deleted (e.g., rename), or
     * someone messed around with the shadowed proc.
     *
     * We must refetch the command ...
     */

    Tcl_Command newCmdPtr = Tcl_GetCommandFromObj(interp, tcd->procName);

    if (unlikely(newCmdPtr == NULL)) {
      return NsfPrintError(interp, "cannot lookup command '%s'",
                             ObjStr(tcd->procName));

    } else if (unlikely(!CmdIsProc(newCmdPtr))) {
      return NsfPrintError(interp, "command '%s' is not a proc",
                             ObjStr(tcd->procName));
    }

    /*
     * ... and update the refCounts and cmd in ClientData
     */
    NsfCommandRelease(tcd->cmd);
    tcd->cmd = newCmdPtr;
    NsfCommandPreserve(tcd->cmd);
  }

  pcPtr = (ParseContext *) NsfTclStackAlloc(interp, sizeof(ParseContext),
                                            "parse context");

  if (likely(tcd->paramDefs != NULL && tcd->paramDefs->paramsPtr)) {
    /*
     * We have a parameter definition, parse the provided objv against the
     * parameter definition.
     */
    result = ProcessMethodArguments(pcPtr, interp, NULL,
                                    (((tcd->flags & NSF_PROC_FLAG_CHECK_ALWAYS) != 0u) ?
                                     NSF_ARGPARSE_CHECK : 0u)
                                    |NSF_ARGPARSE_FORCE_REQUIRED,
                                    tcd->paramDefs, objv[0],
                                    objc, objv);
  } else {
    /*
     * In case we have no parameter definition (e.g. no arguments, or no
     * arguments), just pass the objv along.
     */
    pcPtr->full_objv = (Tcl_Obj**)objv;
    pcPtr->objc = objc-1;
    pcPtr->status = 0;
    result = TCL_OK;
  }

  /*
   * Check whether the argument parsing was ok.
   */
  if (likely(result == TCL_OK)) {
    Tcl_Command     cmd = tcd->wrapperCmd;
    unsigned int    cmdFlags;
    struct Tcl_Time trt;

    assert(cmd != NULL);

    cmdFlags = (unsigned int)Tcl_Command_flags(cmd);

#if defined(NSF_PROFILE)
    Tcl_GetTime(&trt);

    if (RUNTIME_STATE(interp)->doTrace) {
      NsfProfileTraceCallAppend(interp, ObjStr(objv[0]));
    }
    if ((cmdFlags & NSF_CMD_DEBUG_METHOD) != 0u) {
      NsfProfileDebugCall(interp, NULL, NULL, ObjStr(objv[0]), objc-1, (Tcl_Obj **)objv+1);
    }
#else
    if ((cmdFlags & NSF_CMD_DEBUG_METHOD) != 0u) {
      Tcl_GetTime(&trt);

      NsfProfileDebugCall(interp, NULL, NULL, ObjStr(objv[0]), objc-1, (Tcl_Obj **)objv+1);
    } else {
      trt.sec = 0;
      trt.usec = 0;
    }
#endif

    if ((cmdFlags & NSF_CMD_DEPRECATED_METHOD) != 0u) {
      NsfDeprecatedCmd(interp, "proc", ObjStr(objv[0]), "");
    }

    result = InvokeShadowedProc(interp, tcd->procName, tcd->cmd, pcPtr, &trt,
                                cmdFlags, Tcl_Command_nsPtr(cmd));

  } else {
    /*
     * Result is already set to TCL_ERROR, the error message should be already
     * provided.
     */
    ParseContextRelease(pcPtr);
    NsfTclStackFree(interp, pcPtr, "release parse context");
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * NsfProcAdd --
 *
 *      Add a command for implementing a Tcl proc with next scripting
 *      parameter handling.
 *
 *      For the time being, this function adds two things, (a) a Tcl cmd
 *      functioning as a stub for the argument processing (in accordance
 *      with the parameter definitions) and (b) the shadowed Tcl proc
 *      with a mutated name.
 *
 *      TODO: the current 1 cmd + 1 proc implementation is not robust
 *      against renaming and partial deletions (deletion of the
 *      stub).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Adding one Tcl command and one Tcl proc
 *
 *----------------------------------------------------------------------
 */
static int NsfProcAdd(Tcl_Interp *interp, NsfParsedParam *parsedParamPtr,
                      const char *procName, Tcl_Obj *body,
                      int with_ad, int with_checkAlways, int with_Debug, int with_Deprecated)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static int
NsfProcAdd(Tcl_Interp *interp, NsfParsedParam *parsedParamPtr,
           const char *procName, Tcl_Obj *body,
           int with_ad, int with_checkAlways, int with_Debug, int with_Deprecated) {
  NsfParamDefs      *paramDefs;
  NsfProcClientData *tcd;
  Tcl_Namespace     *cmdNsPtr;
  Tcl_Obj           *argList, *procNameObj, *ov[4];
  Tcl_DString        ds, *dsPtr = &ds;
  int                result;
  unsigned int       checkAlwaysFlag;
  Tcl_Command        cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(parsedParamPtr != NULL);
  nonnull_assert(procName != NULL);
  nonnull_assert(body != NULL);

  Tcl_DStringInit(dsPtr);

  /*
   * Create a fully qualified procName
   */
  if (*procName != ':') {
    DStringAppendQualName(dsPtr, Tcl_GetCurrentNamespace(interp), procName);
    procName = Tcl_DStringValue(dsPtr);
  }
  /*
   * Create first the ProcStub to obtain later its namespace, which is
   * needed as the inner namespace of the shadowed proc.
   */
  tcd = NEW(NsfProcClientData);
  cmd = Tcl_CreateObjCommand(interp, procName, NsfProcStub,
                             tcd, NsfProcStubDeleteProc);
  if (unlikely(cmd == NULL)) {
    /*
     * For some reason, the command could not be created. Let us hope,
     * we have a useful error message.
     */
    Tcl_DStringFree(dsPtr);
    FREE(NsfProcClientData, tcd);
    return TCL_ERROR;
  }

  checkAlwaysFlag = (with_checkAlways != 0) ? NSF_ARGPARSE_CHECK : 0u;
  cmdNsPtr = Tcl_Command_nsPtr(cmd);

  /*
   * Storing param definitions is not needed for running the proc, since the
   * stub receives parameters + flag via client data... but it is needed for
   * introspection.
   *
   * TODO: For now, we provide no means to set the execNsPtr via interface.
   */
  paramDefs = parsedParamPtr->paramDefs;
  ParamDefsStore(cmd, paramDefs, checkAlwaysFlag, NULL);

  /*fprintf(stderr, "NsfProcAdd procName '%s' define cmd '%s' %p in namespace %s\n",
    procName, Tcl_GetCommandName(interp, cmd), cmd, cmdNsPtr->fullName);*/

  /*
   * Let us create the shadowed Tcl proc, which is stored under
   * ::nsf::procs::*. First build the fully qualified name procNameObj.
   */
  Tcl_DStringSetLength(dsPtr, 0);
  Tcl_DStringAppend(dsPtr, "::nsf::procs", -1);
  DStringAppendQualName(dsPtr, cmdNsPtr, Tcl_GetCommandName(interp, cmd));
  procNameObj = Tcl_NewStringObj(Tcl_DStringValue(dsPtr),
                                 Tcl_DStringLength(dsPtr));

  INCR_REF_COUNT2("procNameObj", procNameObj); /* will be freed, when NsfProcStub is deleted */

  /*
   * Make sure to create the target namespace under "::nsf::procs::", if
   * it does not exist.
   */
  {
    Namespace  *nsPtr, *dummy1Ptr, *dummy2Ptr;
    const char *dummy;

    /*
     * Create the target namespace, if it does not exist.
     */
    TclGetNamespaceForQualName(interp, ObjStr(procNameObj), NULL, TCL_CREATE_NS_IF_UNKNOWN,
                               &nsPtr, &dummy1Ptr,
                               &dummy2Ptr, &dummy);
  }

  /*
   * Create the client data, which links the stub cmd with the proc.
   */
  tcd->procName = procNameObj;
  tcd->paramDefs = paramDefs;
  tcd->flags = (checkAlwaysFlag != 0u ? NSF_PROC_FLAG_CHECK_ALWAYS : 0u) | (with_ad != 0 ? NSF_PROC_FLAG_AD : 0u);
  tcd->cmd = NULL;
  tcd->wrapperCmd = cmd;  /* TODO should we preserve? */
  tcd->interp = interp; /* for deleting the shadowed proc */

  /*fprintf(stderr, "NsfProcAdd %s tcd %p paramdefs %p\n",
    ObjStr(procNameObj), tcd, tcd->paramDefs);*/

  /*
   * Build an argument list for the shadowed proc.
   */
  argList = Tcl_NewListObj(0, NULL);
  INCR_REF_COUNT(argList);

  if (paramDefs != NULL) {
    Nsf_Param *paramPtr;

    for (paramPtr = paramDefs->paramsPtr; paramPtr->name != NULL; paramPtr++) {
      if (*paramPtr->name == '-') {
        Tcl_Obj *varNameObj = Tcl_NewStringObj(paramPtr->name+1, -1);

        /*
         * If we have the -ad (for ars digita) flag set, we provide the
         * OpenACS semantics. This is (a) to use the name "boolean" for
         * a switch and (b) to name the automatic variable with the
         * prefix "_p".
         */
        if (with_ad && paramPtr->converter == Nsf_ConvertToBoolean && paramPtr->nrArgs == 1) {
          /*fprintf(stderr, "... ad handling: proc %s param %s type %s nrargs %d default %p\n",
            procName, paramPtr->name, paramPtr->type, paramPtr->nrArgs, paramPtr->defaultValue);*/
          paramPtr->nrArgs = 0;
          /*paramPtr->converter = Nsf_ConvertToSwitch;*/
          Tcl_AppendToObj(varNameObj, "_p", 2);
          if (paramPtr->defaultValue == NULL) {
            paramPtr->defaultValue = Tcl_NewBooleanObj(0);
            INCR_REF_COUNT(paramPtr->defaultValue);
          }
        }
        Tcl_ListObjAppendElement(interp, argList, varNameObj);
      } else {
        Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(paramPtr->name, -1));
      }
    }
  }

  ov[0] = NULL;
  ov[1] = procNameObj;
  ov[2] = argList;
  ov[3] = AddPrefixToBody(body, NSF_TRUE, parsedParamPtr);

  /*fprintf(stderr, "NsfProcAdd define proc %s arglist '%s'\n",
    ObjStr(ov[1]), ObjStr(ov[2])); */

  result = Tcl_ProcObjCmd(0, interp, 4, ov);
  DECR_REF_COUNT(argList);
  DECR_REF_COUNT2("resultBody", ov[3]);

  if (likely(result == TCL_OK)) {
    /*
     * The shadowed proc was created successfully. Retrieve the defined proc
     * and set its namespace to the namespace of the stub cmd.
     */
    Tcl_Command procCmd = Tcl_GetCommandFromObj(interp, procNameObj);

    assert(procCmd != NULL);

    tcd->cmd = procCmd;
    NsfCommandPreserve(tcd->cmd);

    if (with_Debug) {
      Tcl_Command_flags(cmd) |= NSF_CMD_DEBUG_METHOD;
    }
    if (with_Deprecated) {
      Tcl_Command_flags(cmd) |= NSF_CMD_DEPRECATED_METHOD;
    }


  } else {
    /*
     * We could not define the shadowed proc. In this case, cleanup by
     * removing the stub cmd.
     */
    Tcl_DeleteCommandFromToken(interp, cmd);
  }

  Tcl_DStringFree(dsPtr);
  return result;
}

/*
 *----------------------------------------------------------------------
 * ProcessMethodArguments --
 *
 *      Process the arguments provided to a method call. It parses the argument
 *      vector objv, disallows certain parameter types and updates the parse
 *      context.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Updates parameter context
 *
 *----------------------------------------------------------------------
 */
static int
ProcessMethodArguments(ParseContext *pcPtr, Tcl_Interp *interp,
                       NsfObject *object, unsigned int processFlags, NsfParamDefs *paramDefs,
                       Tcl_Obj *methodNameObj, int objc, Tcl_Obj *const objv[]) {
  int result;
  CallFrame frame, *framePtr = &frame;

  nonnull_assert(pcPtr != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(paramDefs != NULL);
  nonnull_assert(methodNameObj != NULL);
  nonnull_assert(objv != NULL);

  if (object != NULL && (processFlags & NSF_ARGPARSE_METHOD_PUSH) != 0u ) {
    Nsf_PushFrameObj(interp, object, framePtr);
  }

#if 0
  {int i;
    fprintf(stderr, "ProcessMethodArguments before ArgumentParse %s (flags %.6x objc %d): ", ObjStr(methodNameObj), processFlags, objc);
    for(i = 0; i < objc; i++) {fprintf(stderr, " [%d]=%s,", i, ObjStr(objv[i]));}
    fprintf(stderr, "\n");

    Tcl_Obj *listObj = ParamDefsList(interp, paramDefs->paramsPtr, NULL, NULL);
    fprintf(stderr, "... got params <%s>\n", ObjStr(listObj));
  }
#endif

  result = ArgumentParse(interp, objc, objv, object, methodNameObj,
                         paramDefs->paramsPtr, paramDefs->nrParams, paramDefs->serial,
                         processFlags|RUNTIME_STATE(interp)->doCheckArguments,
                         pcPtr);
#if 0
  {
    int i, fromArg, toArg;
    fprintf(stderr, "ProcessMethodArguments after ArgumentParse %s pcPtr->objc %d result %d\n",
            ObjStr(methodNameObj), pcPtr->objc, result);
    if (result == TCL_OK) {
      if ((processFlags & NSF_ARGPARSE_START_ZERO) != 0u) {
        fromArg = 0;
        toArg = pcPtr->objc;
      } else {
        fromArg = 1;
        toArg = pcPtr->objc;
      }
      for (i = fromArg; i < toArg; i++) {
        fprintf(stderr, "... pcPtr %p [%d] obj %p refCount %d (%s) flags %.6x & %p\n",
                (void*)pcPtr, i,
                pcPtr->objv[i] ? (void*)pcPtr->objv[i] : NULL,
                pcPtr->objv[i] ? pcPtr->objv[i]->refCount : -1,
                pcPtr->objv[i] ? ObjStr(pcPtr->objv[i]) : "(null)", pcPtr->flags[i],
                (void*)&(pcPtr->flags[i]));
      }
    }
  }
#endif

  if (object != NULL && ((processFlags & NSF_ARGPARSE_METHOD_PUSH) != 0u)) {
    Nsf_PopFrameObj(interp, framePtr);
  }

  /*
   * Set objc of the parse context to the number of defined parameters.
   * pcPtr->objc and paramDefs->nrParams will be equivalent in cases
   * where argument values are passed to the call in absence of var
   * args ('args'). Treating "args is more involved (see below).
   */

  if (unlikely(result != TCL_OK)) {
    return result;
  }

  if (pcPtr->varArgs) {
    /*
     * The last argument was "args".
     */
    int elts = objc - pcPtr->lastObjc;

    if (elts == 0) {
      /*
       * No arguments were passed to "args".  We simply decrement objc.
       */
      pcPtr->objc--;
    } else if (elts > 1) {
      /*
       * Multiple arguments were passed to "args". The array pcPtr->objv is
       * pointing to the first of the var args. We have to copy the remaining
       * actual argument vector objv to the parse context.
       */

      /*NsfPrintObjv("actual:  ", objc, objv);*/
      ParseContextExtendObjv(pcPtr, (unsigned)paramDefs->nrParams, (unsigned)elts-1u, objv + 1u + pcPtr->lastObjc);
    } else {
      /*
       * A single argument was passed to "args". There is no need to
       * mutate the pcPtr->objv, because this has been achieved in
       * ArgumentParse (i.e., pcPtr->objv[i] contains this element).
       */
    }
  }

  return TCL_OK;
}
/**************************************************************************
 * End Definition of nsf::proc  (Tcl Procs with Parameter handling)
 **************************************************************************/

/*
 *----------------------------------------------------------------------
 * ForwardCmdDeleteProc --
 *
 *      This Tcl_CmdDeleteProc is called, when a forward method is deleted
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees client data of the setter command.
 *
 *----------------------------------------------------------------------
 */

static void
ForwardCmdDeleteProc(ClientData clientData) {
  ForwardCmdClientData *tcd;

  nonnull_assert(clientData != NULL);

  tcd = (ForwardCmdClientData *)clientData;
  if (tcd->cmdName != NULL)     {DECR_REF_COUNT(tcd->cmdName);}
  if (tcd->subcommands != NULL) {DECR_REF_COUNT(tcd->subcommands);}
#if defined(NSF_FORWARD_WITH_ONERROR)
  if (tcd->onerror != NULL)     {DECR_REF_COUNT(tcd->onerror);}
#endif
  if (tcd->prefix != NULL)      {DECR_REF_COUNT(tcd->prefix);}
  if (tcd->args != NULL)        {DECR_REF_COUNT(tcd->args);}
  FREE(ForwardCmdClientData, tcd);
}


/*
 *----------------------------------------------------------------------
 * SetterCmdDeleteProc --
 *
 *      This Tcl_CmdDeleteProc is called, when a setter method is deleted
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees client data of the setter command.
 *
 *----------------------------------------------------------------------
 */
static void SetterCmdDeleteProc(ClientData clientData)
  nonnull(1);

static void
SetterCmdDeleteProc(ClientData clientData) {
  SetterCmdClientData *setterClientData;

  nonnull_assert(clientData != NULL);

  setterClientData = (SetterCmdClientData *)clientData;
  if (setterClientData->paramsPtr != NULL) {
    ParamsFree(setterClientData->paramsPtr);
  }
  FREE(SetterCmdClientData, setterClientData);
}


/*
 *----------------------------------------------------------------------
 * AliasCmdDeleteProc --
 *
 *      This Tcl_CmdDeleteProc is called, when an alias method is deleted
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees client data of the setter command.
 *
 *----------------------------------------------------------------------
 */
static void AliasCmdDeleteProc(ClientData clientData)
  nonnull(1);

static void
AliasCmdDeleteProc(ClientData clientData) {
  AliasCmdClientData *tcd;

  nonnull_assert(clientData != NULL);

  /*
   * Since we just get the clientData, we have to obtain interp,
   * object, methodName and per-object from tcd; the obj might be
   * deleted already. We need as well at least still the global
   * namespace.
   */
  tcd = (AliasCmdClientData *)clientData;
  if ((tcd->interp != NULL)
      && (((Interp *)(tcd->interp))->globalNsPtr != NULL)
      && RUNTIME_STATE(tcd->interp)->exitHandlerDestroyRound != NSF_EXITHANDLER_ON_PHYSICAL_DESTROY
     ) {
    const char *methodName = Tcl_GetCommandName(tcd->interp, tcd->aliasCmd);

    AliasDelete(tcd->interp, tcd->cmdName, methodName, tcd->class == NULL);
  }

  /*fprintf(stderr, "AliasCmdDeleteProc aliasedCmd %p\n", tcd->aliasedCmd);*/
  if (tcd->cmdName != NULL) {
    DECR_REF_COUNT(tcd->cmdName);
  }
  if (tcd->aliasedCmd != NULL) {

#if defined(WITH_IMPORT_REFS)
    ImportRef *refPtr, *prevPtr = NULL;
    Command *aliasedCmd = (Command *)(tcd->aliasedCmd);

    /*fprintf(stderr, "AliasCmdDeleteProc aliasedCmd %p epoch %d refCount %d\n",
      aliasedCmd, Tcl_Command_cmdEpoch(tcd->aliasedCmd), aliasedCmd->refCount);*/
    /*
     * Clear the aliasCmd from the imported-ref chain of the aliased
     * (or real) cmd.  This widely resembles what happens in the
     * DeleteImportedCmd() (see tclNamesp.c), however, as we do not
     * provide for ImportedCmdData client data etc., we cannot
     * directly use it.
     */
    for (refPtr = aliasedCmd->importRefPtr; refPtr != NULL; refPtr = refPtr->nextPtr) {
      if (refPtr->importedCmdPtr == (Command *) tcd->aliasCmd) {
        if (prevPtr == NULL) {
          aliasedCmd->importRefPtr = refPtr->nextPtr;
        } else {
          prevPtr->nextPtr = refPtr->nextPtr;
        }
        ckfree((char *) refPtr);
        break;
      }
      prevPtr = refPtr;
    }
#endif
    NsfCommandRelease(tcd->aliasedCmd);
  }
  FREE(AliasCmdClientData, tcd);
}

/*
 *----------------------------------------------------------------------
 * GetMatchObject --
 *
 *      Helper method used by nsfAPI.h and the info methods to check whether the
 *      Tcl_Obj patternObj was provided and can be looked up. If this is the
 *      case, wild card matching etc. does not have to be performed, but just
 *      the properties of the object have to be tested.
 *
 * Results:
 *      0 or 1 or -1, potentially the matchObject (when 0 is returned)
 *      0: we have wild-card characters, iterate to get matches
 *      1: we have an existing object
 *   -1: we no wild-card characters and a non-existing object
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int
GetMatchObject(Tcl_Interp *interp, Tcl_Obj *patternObj, Tcl_Obj *origObj,
                NsfObject **matchObjectPtr, const char **patternPtr) {

  nonnull_assert(interp != NULL);
  nonnull_assert(matchObjectPtr != NULL);
  nonnull_assert(patternPtr != NULL);

  if (patternObj != NULL) {
    *patternPtr = ObjStr(patternObj);
    if (TclObjIsNsfObject(interp, patternObj, matchObjectPtr)) {
      return 1;
    }
    if (patternObj == origObj && **patternPtr != ':') {
      return -1;
    }
  }

  return 0;
}


/*
 *----------------------------------------------------------------------
 * ForwardProcessOptions --
 *
 *      Process the options provided by the forward method and turn these into
 *      the ForwardCmdClientData structure.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Allocated and initialized ForwardCmdClientData
 *
 *----------------------------------------------------------------------
 */

static int
ForwardProcessOptions(Tcl_Interp *interp, Tcl_Obj *nameObj,
                      Tcl_Obj *withDefault,
                      int withEarlybinding,
                      Tcl_Obj *withOnerror,
                      Tcl_Obj *withMethodprefix,
                      int withFrame,
                      bool withVerbose,
                      Tcl_Obj *target, int objc, Tcl_Obj * const objv[],
                       ForwardCmdClientData **tcdPtr) {
  ForwardCmdClientData *tcd;
  int i, result = 0;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(objv != NULL);

  tcd = NEW(ForwardCmdClientData);
  memset(tcd, 0, sizeof(ForwardCmdClientData));

  if (withDefault != 0) {
    Tcl_DString ds, *dsPtr = &ds;
    DSTRING_INIT(dsPtr);
    Tcl_DStringAppend(dsPtr, "%1 {", 4);
    Tcl_DStringAppend(dsPtr, ObjStr(withDefault), -1);
    Tcl_DStringAppend(dsPtr, "}", 1);
    NsfDeprecatedCmd(interp, "forward option", "-default ...", Tcl_DStringValue(dsPtr));
    DSTRING_FREE(dsPtr);

    tcd->subcommands = withDefault;
    result = Tcl_ListObjLength(interp, withDefault, &tcd->nr_subcommands);
    INCR_REF_COUNT(tcd->subcommands);
  }
  if (withMethodprefix != 0) {
    tcd->prefix = withMethodprefix;
    INCR_REF_COUNT(tcd->prefix);
  }
#if defined(NSF_FORWARD_WITH_ONERROR)
  if (withOnerror != 0) {
    tcd->onerror = withOnerror;
    INCR_REF_COUNT(tcd->onerror);
  }
#endif
  tcd->frame = withFrame;
  tcd->verbose = withVerbose;
  tcd->needobjmap = NSF_FALSE;
  tcd->cmdName = target;
  /*fprintf(stderr, "...forwardprocess objc %d, cmdName %p %s\n", objc, target, ObjStr(target));*/

  for (i = 0; i < objc; i++) {
    const char *element = ObjStr(objv[i]);
    /*fprintf(stderr, "... [%d] forwardprocess element '%s'\n", i, element);*/
    tcd->needobjmap = (tcd->needobjmap || (*element == '%' && *(element+1) == '@'));
    tcd->hasNonposArgs = (tcd->hasNonposArgs || (*element == '%' && *(element+1) == '-'));
    if (tcd->args == NULL) {
      tcd->args = Tcl_NewListObj(1, &objv[i]);
      tcd->nr_args++;
      INCR_REF_COUNT(tcd->args);
    } else {
      Tcl_ListObjAppendElement(interp, tcd->args, objv[i]);
      tcd->nr_args++;
    }
  }

  if (tcd->cmdName == NULL) {
    tcd->cmdName = nameObj;
  }

  /*fprintf(stderr, "+++ cmdName = %s, args = %s, # = %d\n",
    ObjStr(tcd->cmdName), (tcd->args != NULL) ?ObjStr(tcd->args):"NULL", tcd->nr_args);*/

  if (tcd->frame == FrameObjectIdx) {
    /*
     * When we evaluating objscope, and define ...
     *     o forward append -frame object append
     *  a call to
     *     o append ...
     *  would lead to a recursive call; so we add the appropriate namespace.
     */
    const char *nameString = ObjStr(tcd->cmdName);

    if (!isAbsolutePath(nameString)) {
      tcd->cmdName = NameInNamespaceObj(nameString, CallingNameSpace(interp));
      /*fprintf(stderr, "+++ name %s not absolute, therefore, qualifying %s\n", nameString,
        ObjStr(tcd->cmdName));*/
    }
  }
  INCR_REF_COUNT(tcd->cmdName);

  if (withEarlybinding != 0) {
    Tcl_Command cmd = Tcl_GetCommandFromObj(interp, tcd->cmdName);
    if (cmd == NULL) {
      result = NsfPrintError(interp, "cannot lookup command '%s'", ObjStr(tcd->cmdName));
      goto forward_process_options_exit;
    }
    if (CmdIsNsfObject(cmd)     /* don't do direct invoke on nsf objects */
        || Tcl_Command_objProc(cmd) == TclObjInterpProc  /* don't do direct invoke on Tcl procs */
        ) {
      /*
       * Silently ignore earlybinding flag
       */
      tcd->objProc = NULL;
    } else {
      tcd->objProc = Tcl_Command_objProc(cmd);
      tcd->clientData = Tcl_Command_objClientData(cmd);
    }
  }

  tcd->passthrough = (tcd->args == NULL && *(ObjStr(tcd->cmdName)) != '%' && tcd->objProc);

 forward_process_options_exit:
  /*fprintf(stderr, "forward args = %p, name = '%s'\n", tcd->args, ObjStr(tcd->cmdName));*/
  if (likely(result == TCL_OK)) {
    *tcdPtr = tcd;
  } else {
    ForwardCmdDeleteProc(tcd);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * StripBodyPrefix --
 *
 *      Strip the prefix of the body, which might have been added by nsf.
 *
 * Results:
 *      The string of the body without the prefix.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static const char * StripBodyPrefix(const char *body)
  nonnull(1) NSF_pure;

static const char *
StripBodyPrefix(const char *body) {

  nonnull_assert(body != NULL);

  if (strncmp(body, "::nsf::__unset_unknown_args\n", 28) == 0) {
    body += 28;
  }
  return body;
}


/*
 *----------------------------------------------------------------------
 * AddSlotObjects --
 *
 *      Compute the slot objects (children of the slot container) for a provided
 *      object. The objects can be filtered via a pattern.
 *
 * Results:
 *      The function appends results to the provide listObj
 *
 * Side effects:
 *      Might add as well to the hash-table to avoid duplicates.
 *
 *----------------------------------------------------------------------
 */
static void AddSlotObjects(Tcl_Interp *interp, NsfObject *parent, const char *prefix,
                           Tcl_HashTable *slotTablePtr, NsfClass *typeClass,
                           const char *pattern, Tcl_Obj *listObj)
  nonnull(1) nonnull(2) nonnull(3) nonnull(7);

static void
AddSlotObjects(Tcl_Interp *interp, NsfObject *parent, const char *prefix,
               Tcl_HashTable *slotTablePtr,
               NsfClass *typeClass, const char *pattern,
               Tcl_Obj *listObj) {
  NsfObject   *slotContainerObject;
  Tcl_DString  ds, *dsPtr = &ds;
  bool         isFullQualPattern = ((pattern != NULL) && *pattern == ':' && *(pattern+1) == ':');

  nonnull_assert(interp != NULL);
  nonnull_assert(parent != NULL);
  nonnull_assert(prefix != NULL);
  nonnull_assert(listObj != NULL);

  /*fprintf(stderr, "AddSlotObjects parent %s prefix %s type %p %s\n",
    ObjectName(parent), prefix, type, (type != NULL) ? ClassName(type) : "");*/

  DSTRING_INIT(dsPtr);
  Tcl_DStringAppend(dsPtr, ObjectName_(parent), -1);
  Tcl_DStringAppend(dsPtr, prefix, -1);
  slotContainerObject = GetObjectFromString(interp, Tcl_DStringValue(dsPtr));

  if (slotContainerObject != NULL && slotContainerObject->nsPtr
      && ((slotContainerObject->flags & NSF_IS_SLOT_CONTAINER) != 0u)) {
    Tcl_HashSearch       hSrch;
    const Tcl_HashEntry *hPtr;
    Tcl_HashTable       *cmdTablePtr = Tcl_Namespace_cmdTablePtr(slotContainerObject->nsPtr);
    Tcl_Command          cmd;

    hPtr = Tcl_FirstHashEntry(cmdTablePtr, &hSrch);
    for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSrch)) {
      const char *key = Tcl_GetHashKey(cmdTablePtr, hPtr);
      NsfObject *childObject;

      if (slotTablePtr != NULL) {
        int new;
        /*
         * Check whether we have and entry with this key already processed. We
         * never want to report shadowed entries.
         */
        Tcl_CreateHashEntry(slotTablePtr, key, &new);
        if (new == 0) {
          continue;
        }
      }

      /*
       * Obtain the childObject
       */
      cmd = (Tcl_Command) Tcl_GetHashValue(hPtr);
      childObject = NsfGetObjectFromCmdPtr(cmd);

      /*
       * Report just the already fully initialized slot objects, not the one
       * being right now created.
       */
      if (childObject == NULL || (childObject->flags & NSF_INIT_CALLED) == 0u) {
        /* fprintf(stderr, "....... key %s unfinished\n", key);*/
        continue;
      }

      /*
       * Check the pattern.
       */
      if (pattern != NULL) {
        int isMatch;
        /*
         * If the pattern looks like fully qualified, we match against the
         * fully qualified name.
         */

        if (isFullQualPattern) {
          isMatch = Tcl_StringMatch(ObjectName(childObject), pattern);
        } else {
          /*
           * do we have a mangled name of a private property/variable?
           */
          if (*key == '_' && *(key+1) == '_' && *(key+2) == '_' && *(key+3) == '_') {
            Tcl_Obj *value = Nsf_ObjGetVar2((Nsf_Object *)childObject, interp,
                                            NsfGlobalObjs[NSF_SETTERNAME], NULL, 0);

            isMatch = (value != NULL) ? Tcl_StringMatch(ObjStr(value), pattern) : 0;

            /*fprintf(stderr, "pattern <%s> isFullQualPattern %d child %s key %s %p <%s> match %d\n",
              pattern, isFullQualPattern, ObjectName(childObject), key,
              value, (value != NULL) ? ObjStr(value) : "", match);*/
          } else {
            isMatch = Tcl_StringMatch(key, pattern);
          }
        }
        if (isMatch == 0) {
          continue;
        }
      }

      /*
       * Check whether the entry is from the right type.
       */
      if (typeClass != NULL && !IsSubType(childObject->cl, typeClass)) {
        continue;
      }

      /*
       * Add finally the entry to the returned list.
       */
      Tcl_ListObjAppendElement(interp, listObj, childObject->cmdName);
    }
  }
  DSTRING_FREE(dsPtr);
}

/*
 *----------------------------------------------------------------------
 * FindCalledClass --
 *
 *      Find the called class of the called proc on the call-stack.
 *
 * Results:
 *      NsfClass * or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClass *FindCalledClass(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

static NsfClass *
FindCalledClass(Tcl_Interp *interp, NsfObject *object) {
  NsfCallStackContent *cscPtr;
  NsfClass            *result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  cscPtr = CallStackGetTopFrame0(interp);
  if (unlikely(cscPtr == NULL)) {
    result = NULL;

  } else {
    if (cscPtr->frameType == NSF_CSC_TYPE_PLAIN) {
      result = cscPtr->cl;
    } else {
      const char *methodName;

      if (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER) {
        methodName = MethodName(cscPtr->filterStackEntry->calledProc);
      } else if (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_MIXIN && object->mixinStack != NULL) {
        methodName = Tcl_GetCommandName(interp, cscPtr->cmdPtr);
      } else {
        methodName = NULL;
      }

      if (unlikely(methodName == NULL)) {
        result = NULL;

      } else if (object->nsPtr != NULL && FindMethod(object->nsPtr, methodName) != NULL) {
        /*
         * An object specific method was called.
         */
        result = NULL;
      } else {
        Tcl_Command  cmd;

        result = SearchCMethod(object->cl, methodName, &cmd);
      }
    }
  }
  return result;
}

/*
 * Next Primitive Handling
 */
/*
 *----------------------------------------------------------------------
 * NextSearchMethod --
 *
 *      Determine the method to be called via "next". The function returns on
 *      success the found cmd and information like method name, was it from a
 *      mixin, filter, or was the end of the filter chain reached.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static int NextSearchMethod(
    NsfObject *object, Tcl_Interp *interp, const NsfCallStackContent *cscPtr,
    NsfClass **classPtr, const char **methodNamePtr, Tcl_Command *cmdPtr,
    bool *isMixinEntry, bool *isFilterEntry,
    bool *endOfFilterChain, Tcl_Command *currentCmdPtr
) nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5) nonnull(6) nonnull(7) nonnull(8) nonnull(9) nonnull(10);

NSF_INLINE static int
NextSearchMethod(
    NsfObject *object, Tcl_Interp *interp, const NsfCallStackContent *cscPtr,
    NsfClass **classPtr, const char **methodNamePtr, Tcl_Command *cmdPtr,
    bool *isMixinEntry, bool *isFilterEntry,
    bool *endOfFilterChain, Tcl_Command *currentCmdPtr
) {
  bool         endOfChain = NSF_FALSE;
  unsigned int objflags;

  nonnull_assert(object != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(cscPtr != NULL);
  nonnull_assert(classPtr != NULL);
  nonnull_assert(methodNamePtr != NULL);
  nonnull_assert(cmdPtr != NULL);
  nonnull_assert(isMixinEntry != NULL);
  nonnull_assert(isFilterEntry != NULL);
  nonnull_assert(endOfFilterChain != NULL);
  nonnull_assert(currentCmdPtr != NULL);

  /*fprintf(stderr, "NextSearchMethod for %s called with cl %p\n", *methodNamePtr, *classPtr);*/

  /*
   *  Next in filters
   */

  objflags = object->flags; /* avoid stalling */
  if ((objflags & NSF_MIXIN_ORDER_VALID) == 0u) {
    MixinComputeDefined(interp, object);
    objflags = object->flags; /* avoid stalling */
  }

  if ((objflags & NSF_FILTER_ORDER_VALID) != 0u
      && (object->filterStack != NULL)
      && object->filterStack->currentCmdPtr) {
    *cmdPtr = FilterSearchProc(interp, object, currentCmdPtr, classPtr);

    /*fprintf(stderr, "FilterSearchProc returned cmd %p\n", *cmdPtr);
      NsfShowStack(interp);*/

    if (*cmdPtr == NULL) {
      if (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER) {
        /*
         * Reset the information to the values of method, classPtr
         * to the values they had before calling the filters.
         */
        *methodNamePtr = MethodName(object->filterStack->calledProc);
        endOfChain = NSF_TRUE;
        *endOfFilterChain = NSF_TRUE;
        *classPtr = NULL;
        /*fprintf(stderr, "EndOfChain resetting cl\n");*/
      }
    } else {
      *methodNamePtr = (char *) Tcl_GetCommandName(interp, *cmdPtr);
      *endOfFilterChain = NSF_FALSE;
      *isFilterEntry = NSF_TRUE;
      return TCL_OK;
    }
  }

  /*
   *  Next in Mixins requires that we have already a mixinStack, and the
   *  current frame is not a plain frame.
   */
  assert((objflags & NSF_MIXIN_ORDER_VALID) != 0u);

  if ((object->mixinStack != NULL) && cscPtr->frameType) {
    int result = MixinSearchProc(interp, object, *methodNamePtr,
                                 classPtr, currentCmdPtr, cmdPtr);

    /* fprintf(stderr, "next in mixins %s frameType %.6x\n", *methodNamePtr, cscPtr->frameType); */

    if (unlikely(result != TCL_OK)) {
      return result;
    }

    if (*cmdPtr == NULL) {
      if (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_MIXIN) {
        endOfChain = NSF_TRUE;
        *classPtr = NULL;
      }
    } else {
      *isMixinEntry = NSF_TRUE;
      return TCL_OK;
    }
  }

  /*fprintf(stderr, "nextsearch: object %s nsPtr %p endOfChain %d\n",
    ObjectName(object), object->nsPtr, endOfChain);*/

  /*
   * Otherwise: normal method dispatch
   *
   * If we are already in the precedence ordering, then advance
   * past our last point; otherwise (if classPtr == NULL) begin from the start.
   *
   * When a mixin or filter chain reached its end, we have to check for
   * fully qualified method names and search the obj-specific methods as well.
   */
  if (endOfChain) {
    if (**methodNamePtr == ':') {
      *cmdPtr = Tcl_FindCommand(interp, *methodNamePtr, NULL, TCL_GLOBAL_ONLY);
      /* fprintf(stderr, "NEXT found absolute cmd %s => %p\n", *methodNamePtr, *cmdPtr); */
    } else if (object->nsPtr != NULL) {
      *cmdPtr = FindMethod(object->nsPtr, *methodNamePtr);
      if ((*cmdPtr != NULL)
          && ((unsigned int)Tcl_Command_flags(*cmdPtr) & NSF_CMD_CALL_PRIVATE_METHOD) != 0u
          ) {
        /*fprintf(stderr, "NEXT found private cmd %s => %p\n", *methodNamePtr, *cmdPtr);*/
        *cmdPtr = NULL;
      }
    } else {
      *cmdPtr = NULL;
    }
  } else {
    *cmdPtr = NULL;
  }

  /*fprintf(stderr, "NEXT methodName %s *classPtr %p %s *cmd %p cscPtr->flags %.6x\n",
   *methodNamePtr, *classPtr, ClassName((*classPtr)), *cmdPtr, cscPtr->flags); */

  if (*cmdPtr == NULL) {
    const NsfClasses *pl = PrecedenceOrder(object->cl);
    const NsfClass   *class = *classPtr;

    if (class != NULL) {
      /*
       * Skip until actual class
       */
      for ( ; pl != NULL; pl = pl->nextPtr) {
        if (pl->cl == class) {
          pl = pl->nextPtr;
          break;
        }
      }
    }

    if (pl != NULL) {
      /*
       * Search for a further class method. When we are called from an active
       * filter and the call had the "-local" flag set, then allow one to call
       * private methods.
       */
      *classPtr = SearchPLMethod(pl, *methodNamePtr, cmdPtr,
                                 ((cscPtr->flags & NSF_CM_LOCAL_METHOD) != 0u &&
                                  (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER) != 0u)
                                 ? 0 : NSF_CMD_CALL_PRIVATE_METHOD);
    } else {
    *classPtr = NULL;
    }

  } else {
    *classPtr = NULL;
  }

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * NextGetArguments --
 *
 *      Obtain arguments for a method invoked via next either from the argument
 *      vector or from the stack (call stack content or Tcl stack). In case of
 *      ensemble calls the stack entries of the ensemble invocation are
 *      used. The function returns the arguments 4 to 8.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int NextGetArguments(
    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    NsfCallStackContent **cscPtrPtr, const char **methodNamePtr,
    int *outObjc, Tcl_Obj ***outObjv, bool *freeArgumentVector
) nonnull(1) nonnull(4) nonnull(5) nonnull(6) nonnull(7) nonnull(8);

static int
NextGetArguments(
    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    NsfCallStackContent **cscPtrPtr, const char **methodNamePtr,
    int *outObjc, Tcl_Obj ***outObjv, bool *freeArgumentVector
) {
  Tcl_Obj            **nobjv;
  int                  nobjc, oc;
  bool                 inEnsemble;
  Tcl_CallFrame       *framePtr;
  NsfCallStackContent *cscPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(cscPtrPtr != NULL);
  nonnull_assert(methodNamePtr != NULL);
  nonnull_assert(outObjc != NULL);
  nonnull_assert(outObjv != NULL);
  nonnull_assert(freeArgumentVector != NULL);

  /*
   * Initialize to zero to make sure, we only decrement when necessary.
   */
  *freeArgumentVector = NSF_FALSE;

  cscPtr = CallStackGetTopFrame(interp, &framePtr);
  if (cscPtr == NULL) {
    return NsfPrintError(interp, "next: can't find self");
  }

  if (cscPtr->cmdPtr == NULL) {
    return NsfPrintError(interp, "next: no executing proc");
  }

  oc = Tcl_CallFrame_objc(framePtr);

  if ((cscPtr->frameType & NSF_CSC_TYPE_ENSEMBLE)) {
    /*
     * We are in an ensemble method. The next works here not on the
     * actual methodName + frame, but on the ensemble above it. We
     * locate the appropriate call-stack content and continue next on
     * that.
     */
    cscPtr = CallStackFindEnsembleCsc(framePtr, &framePtr);
    assert(cscPtr != NULL);
    inEnsemble = NSF_TRUE;
    *methodNamePtr = MethodName(cscPtr->objv[0]);
  } else {
    inEnsemble = NSF_FALSE;
    *methodNamePtr = Tcl_GetCommandName(interp, cscPtr->cmdPtr);
  }

  /*fprintf(stderr, "NextGetArguments oc %d objc %d inEnsemble %d objv %p\n",
    oc, objc, inEnsemble, cscPtr->objv); */

  if (objc > -1) {
    int methodNameLength;
    /*
     * Arguments were provided. We have to construct an argument
     * vector with the first argument(s) as the method name. In an
     * ensemble, we have to insert the objs of the full ensemble name.
     */
    if (inEnsemble) {
      methodNameLength = 1 + cscPtr->objc - oc;
      nobjc = objc + methodNameLength;
      nobjv = (Tcl_Obj **)ckalloc((unsigned)sizeof(Tcl_Obj *) * (unsigned)nobjc);
      MEM_COUNT_ALLOC("nextArgumentVector", nobjv);
      /*
       * Copy the ensemble pathname
       */
      memcpy((char *)nobjv, cscPtr->objv, sizeof(Tcl_Obj *) * (size_t)methodNameLength);

     } else {
      methodNameLength = 1;
      nobjc = objc + methodNameLength;
      nobjv = (Tcl_Obj **)ckalloc((unsigned)sizeof(Tcl_Obj *) * (unsigned)nobjc);
      MEM_COUNT_ALLOC("nextArgumentVector", nobjv);
      /*
       * Copy the method name
       */
      if (cscPtr->objv != NULL) {
        nobjv[0] = cscPtr->objv[0];
      } else if (Tcl_CallFrame_objv(framePtr)) {
        nobjv[0] = Tcl_CallFrame_objv(framePtr)[0];
      }
    }

    if (objc > 0 && (objv != NULL || cscPtr->objv != NULL)) {
      /*
       * Copy the remaining argument vector
       */
      memcpy(nobjv + methodNameLength, objv == NULL ? cscPtr->objv : objv, sizeof(Tcl_Obj *) * (size_t)objc);
    }

    INCR_REF_COUNT(nobjv[0]); /* we seem to need this here */
    *freeArgumentVector = NSF_TRUE;
  } else {
    /*
     * No arguments were provided
     */
    if (cscPtr->objv != NULL) {
      nobjv = (Tcl_Obj **)cscPtr->objv;
      nobjc = cscPtr->objc;
    } else {
      nobjc = Tcl_CallFrame_objc(framePtr);
      nobjv = (Tcl_Obj **)Tcl_CallFrame_objv(framePtr);
    }
  }

  *cscPtrPtr = cscPtr;
  *outObjc = nobjc;
  *outObjv = nobjv;

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * NextInvokeFinalize --
 *
 *      This finalize function is either called via NRE callback or
 *      directly (from NextSearchAndInvoke). It resets after a successful
 *      lookup and invocation the continuation context (filter flags etc)
 *      and cleans up optionally the argument vector (inverse operation
 *      of NextGetArguments).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      freeing memory
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static int NextInvokeFinalize(ClientData data[], Tcl_Interp *interp, int result)
  nonnull(1) nonnull(2);

NSF_INLINE static int
NextInvokeFinalize(ClientData data[], Tcl_Interp *interp, int result) {
  Tcl_Obj             **nobjv;
  NsfCallStackContent  *cscPtr;

  nonnull_assert(data != NULL);
  nonnull_assert(interp != NULL);

  nobjv = data[0];
  cscPtr = data[1];

  /*fprintf(stderr, "***** NextInvokeFinalize cscPtr %p flags %.6x is next %d result %d unk %d\n",
          cscPtr, cscPtr->flags, cscPtr->flags & NSF_CSC_CALL_IS_NEXT, result,
          RUNTIME_STATE(interp)->unknown);*/

  if ((cscPtr->flags & NSF_CSC_CALL_IS_NEXT) != 0u) {
    /* fprintf(stderr, "..... it was a successful next\n"); */
    cscPtr->flags &= ~NSF_CSC_CALL_IS_NEXT;

    if (cscPtr->frameType == NSF_CSC_TYPE_INACTIVE_FILTER) {
      cscPtr->frameType = NSF_CSC_TYPE_ACTIVE_FILTER;
    } else if (cscPtr->frameType == NSF_CSC_TYPE_INACTIVE_MIXIN) {
      cscPtr->frameType = NSF_CSC_TYPE_ACTIVE_MIXIN;
    }
  }

  if (nobjv != NULL) {
    DECR_REF_COUNT(nobjv[0]);
    MEM_COUNT_FREE("nextArgumentVector", nobjv);
    ckfree((char *)nobjv);
  }

  if (result == TCL_ERROR && RUNTIME_STATE(interp)->unknown) {
    /* fprintf(stderr, "don't report unknown error\n"); */
    /*
     * Don't report "unknown" errors via next.
     */
    result = TCL_OK;
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * NextSearchAndInvoke --
 *
 *      The function is called with a final argument vector and searches for a
 *      possibly shadowed method. If a target method is found, this dispatcher
 *      function updates the continuation context (filter flags etc.), invokes
 *      upon the target method, and performs a cleanup.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      The invoked method might produce side effects. Also, the interp's unknown
 *      state may be modified.
 *
 *----------------------------------------------------------------------
 */
static int
NextSearchAndInvoke(
    Tcl_Interp *interp, const char *methodName,
    int objc, Tcl_Obj *const objv[],
    NsfCallStackContent *cscPtr,
    bool freeArgumentVector
) {
  Tcl_Command      cmd = NULL, currentCmd = NULL;
  int              result;
  bool             endOfFilterChain = NSF_FALSE,
                   isMixinEntry = NSF_FALSE,
                   isFilterEntry = NSF_FALSE;
  NsfRuntimeState *rst;
  NsfObject       *object;
  NsfClass        *class;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cscPtr != NULL);

  rst = RUNTIME_STATE(interp);
  /*
   * Search the next method & compute its method data
   */
  class = cscPtr->cl;
  object = cscPtr->self;
  result = NextSearchMethod(object, interp, cscPtr, &class, &methodName, &cmd,
                            &isMixinEntry, &isFilterEntry, &endOfFilterChain, &currentCmd);

  /*fprintf(stderr, "NEXT search on %s.%s cl %p cmd %p endOfFilterChain %d result %d IS OK %d\n",
          ObjectName(object), methodName, (void*)class, (void*)cmd, endOfFilterChain,
          result, (result == TCL_OK));*/

  if (unlikely(result != TCL_OK)) {
    goto next_search_and_invoke_cleanup;
  }

#if 0
  Tcl_ResetResult(interp); /* needed for bytecode support */
#endif
  if (cmd != NULL) {
    unsigned short frameType = NSF_CSC_TYPE_PLAIN;

    /*
     * Change mixin state.
     */
    if (object->mixinStack != NULL) {
      if (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_MIXIN) {
        cscPtr->frameType = NSF_CSC_TYPE_INACTIVE_MIXIN;
      }
      /*
       * Otherwise move the command pointer forward.
       */
      if (isMixinEntry) {
        frameType = NSF_CSC_TYPE_ACTIVE_MIXIN;
        object->mixinStack->currentCmdPtr = currentCmd;
      }
    }

    /*
     * Change filter state
     */
    if (object->filterStack != NULL) {
      if (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER) {
        /*fprintf(stderr, "next changes filter state\n");*/
        cscPtr->frameType = NSF_CSC_TYPE_INACTIVE_FILTER;
      }

      /*
       * Otherwise move the command pointer forward.
       */
      if (isFilterEntry) {
        /*fprintf(stderr, "next moves filter forward\n");*/
        frameType = NSF_CSC_TYPE_ACTIVE_FILTER;
        object->filterStack->currentCmdPtr = currentCmd;
      }
    }

    /*
     * Now actually call the "next" method.
     */
    cscPtr->flags |= NSF_CSC_CALL_IS_NEXT;
    rst->unknown = 0;
#if defined(NRE)
    { unsigned int flags;
      /*
       * Allow call only without immediate flag, when caller has NRE without
       * immediate.
       */
      flags = NsfImmediateFromCallerFlags(cscPtr->flags);

      /*fprintf(stderr, "MethodDispatch in next flags %.6x NRE %d immediate %d next-flags %.6x\n",
        cscPtr->flags,
        (cscPtr->flags & NSF_CSC_CALL_IS_NRE) != 0,
        (cscPtr->flags & NSF_CSC_IMMEDIATE) != 0,
        flags);*/

      if (flags == 0) {
        /*
         * The call is NRE-enabled. We register the callback and return
         * here immediately.  All other forms of this function have
         * to call NextInvokeFinalize() manually on return.
         */
        Tcl_NRAddCallback(interp, NextInvokeFinalize,
                          freeArgumentVector ? (ClientData)objv : NULL,
                          cscPtr, NULL, NULL);
        return MethodDispatch(interp, objc, objv, cmd,
                              object, class, methodName, frameType, flags);
      } else {
        result = MethodDispatch(interp, objc, objv, cmd,
                                object, class, methodName, frameType, flags);
      }
    }
#else
    /*fprintf(stderr, "NextSearchAndWinvoke calls cmd %p methodName %s cscPtr->flags %.8x\n",
      cmd, methodName, cscPtr->flags);*/
    result = MethodDispatch(interp, objc, objv, cmd,
                            object, class, methodName, frameType, cscPtr->flags);
#endif
  } else if (likely(result == TCL_OK)) {
    NsfCallStackContent *topCscPtr;
    Tcl_CallFrame       *varFramePtr = NULL;
    int                  isLeafNext;

    /*
     * We could not find a cmd, yet the dispatch attempt did not result
     * in an error. This means that we find ourselves in either of three
     * situations at this point:
     *
     * 1) An explicit "next" cmd (NsfNextCmd()) at the end of a filter chain:
     * Dispatch to unknown as there is no implementation for the requested
     * call available.
     *
     * 2) An explicit "next" cmd from within a leaf sub-method (a "leaf
     * next"): Remain silent, do not dispatch to unknown.

     * 3) An implicit "next" triggered for unresolved sub-methods that might be
     * resolved along the next path: Dispatch to unknown, the requested
     * sub-cmd is not resolvable to a cmd.
     *
     * For the cases 1) and 3), set the interp's unknown flag signaling to
     * higher levels (e.g., in MethodDispatchCsc(), in NsfNextCmd()) the need
     * for dispatching to unknown.
     */

    /* NsfShowStack(interp);*/

    topCscPtr = CallStackGetTopFrame(interp, &varFramePtr);
    assert(topCscPtr != NULL);
    assert(varFramePtr != NULL);

    /*
     * Find the appropriate frame pointing to the start of the ensemble, in
     * case we are in the middle of an ensemble.
     */
    /*fprintf(stderr, "######## cscPtr %p topCscPtr %p\n", cscPtr, topCscPtr);*/
    if ( cscPtr != topCscPtr
         && (cscPtr->flags & NSF_CSC_CALL_IS_ENSEMBLE) != 0u
         && (topCscPtr->flags & NSF_CSC_CALL_IS_ENSEMBLE) != 0u) {

      for (; varFramePtr != NULL; varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr)) {
        topCscPtr = (NsfCallStackContent *)Tcl_CallFrame_clientData(varFramePtr);
        assert(topCscPtr != NULL);
        /*fprintf(stderr, "######## cscPtr %p topCscPtr %p topCscPtr->flags %8x\n",
          cscPtr, topCscPtr, (topCscPtr != NULL) ? topCscPtr->flags : 0);*/
        if ((topCscPtr->flags & NSF_CM_ENSEMBLE_UNKNOWN) != 0u) {
          break;
        }
      }

      if (varFramePtr != NULL) {
        varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr);
        if (((unsigned int)Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) != 0u) {
          topCscPtr = (NsfCallStackContent *)Tcl_CallFrame_clientData(varFramePtr);
          assert(topCscPtr != NULL);
        }
      }
    }

    /* case 2 */
    isLeafNext = (cscPtr != topCscPtr)
      && (topCscPtr->frameType & NSF_CSC_TYPE_ENSEMBLE) != 0u
      && (topCscPtr->flags & NSF_CSC_CALL_IS_ENSEMBLE) == 0u;

    /*fprintf(stderr, "******** isleavenext %d based on %d && %d && %d <%s>\n",
            isLeafNext,
            (cscPtr != topCscPtr),
            (topCscPtr->frameType & NSF_CSC_TYPE_ENSEMBLE) != 0u,
            (topCscPtr->flags & NSF_CSC_CALL_IS_ENSEMBLE) == 0u);*/

    /*
     * If we are in an ENSEMBLE_UNKNOWN we have to identify a special variant
     * of case 2: When "next" is called from an ensemble method (e.g. from a
     * method "i s") the call of "next" has to start over from "i" to search
     * for the next method (the next "i s") of the shadowed methods. If there
     * is none, we reach the ENSEMBLE_UNKNOWN state. But we reach the state
     * not immediately after the "next" call, the other checks for handling
     * this case fails, and we would run into the unknown handler, although
     * being called from "next".
     *
     * Therefore, we check in the call-stack whether we are were called inside
     * an ensemble setup on a path leading to an invocation of "next".
     *
     * Such a situation is e.g. (simplified stack view, then with flag names)
     *
     *        varFrame  flags lvl csc          frameType flags
     *  0x7ffeeb7b1698 040001  5  0x7ffeeb7b1870    0000 8000104 (::b.0x7fa756821490 i)
     *  0x7fa75480eda0 020001  4  0x7fa75480ed40    0020 002100 (::b.0x7fa756821e10 s)
     *  0x7ffeeb7b2028 040001  3  0x7ffeeb7b2370    0000 000005 (::b.0x7fa756821c10 i)
     *
     * topcsc 0x7ffeeb7b1870
     * 0x7ffeeb7b1698   flags NSF_CSC_CALL_IS_ENSEMBLE|NSF_CSC_IMMEDIATE|NSF_CM_ENSEMBLE_UNKNOWN
     * 0x7fa75480eda0   flags NSF_CSC_IMMEDIATE|NSF_CSC_CALL_IS_NRE frametype NSF_CSC_TYPE_ENSEMBLE
     * 0x7ffeeb7b2028   flags NSF_CSC_CALL_IS_NEXT|NSF_CSC_CALL_IS_ENSEMBLE
     *
     */
    if (!isLeafNext && (topCscPtr->flags & NSF_CM_ENSEMBLE_UNKNOWN) != 0u) {

      for (;;) {
        varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr);
        if (unlikely(varFramePtr == NULL)) {
          break;
        }
        if (((unsigned int)Tcl_CallFrame_isProcCallFrame(varFramePtr)
             & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) == 0) {
          /*
           * Parent frame is not an NSF frame.
           */
          /*fprintf(stderr, "******** parent frame ptr is not an NSF frame %p\n", (void*)varFramePtr);*/
          break;
        }
        topCscPtr = (NsfCallStackContent *)Tcl_CallFrame_clientData(varFramePtr);
        if ((topCscPtr->frameType & NSF_CSC_TYPE_ENSEMBLE) == 0u) {
          /*
           * Call stack content not of type ensemble.
           */
          /*fprintf(stderr, "******** topCscPtr not type ensemble %p\n", (void*)topCscPtr);*/
          break;
        }
      }

      isLeafNext = (
          (topCscPtr->flags & (NSF_CSC_CALL_IS_NEXT|NSF_CSC_CALL_IS_ENSEMBLE)) == (NSF_CSC_CALL_IS_NEXT|NSF_CSC_CALL_IS_ENSEMBLE) &&
          (topCscPtr->flags & NSF_CM_ENSEMBLE_UNKNOWN) == 0u
      );
      /*fprintf(stderr, "******** alternate isleavenext %d based on topcscptr %p flags %.6x\n",
        isLeafNext,
        (void*)topCscPtr,
        (topCscPtr != NULL ? topCscPtr->flags : 0));*/
    }

    rst->unknown =
      /* case 1 */ endOfFilterChain ||
      /* case 3 */ (!isLeafNext && ((cscPtr->flags & NSF_CSC_CALL_IS_ENSEMBLE) != 0u));

    /*NsfShowStack(interp);*/

    /*fprintf(stderr, "******** setting unknown to %d isLeafNext %d topCscPtr %p endOfFilterChain %d\n",
      rst->unknown, isLeafNext, (void *)topCscPtr, endOfFilterChain);*/
  }

 next_search_and_invoke_cleanup:
  /*
   * We come here, whenever the NRE callback is NOT registered
   */
  {ClientData data[2] = {
      freeArgumentVector ? (ClientData)objv : NULL,
      cscPtr
    };

    return NextInvokeFinalize(data, interp, result);
  }
}

/*
 *----------------------------------------------------------------------
 * NsfNextObjCmd --
 *
 *      nsf::xotclnext is for backwards compatibility to the next
 *      implementation in XOTcl.  It receives an argument vector which
 *      is used for the invocation. If no argument vector is provided,
 *      the argument vector of the last invocation is used. If the
 *      argument vector starts with "--noArgs", then no arguments are
 *      passed to the shadowed method.
 *
 *      TODO: On the longer range, this function should go into an external
 *      library (e.g. XOTcl compatibility library)
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      The invoked method might produce side effects
 *
 *----------------------------------------------------------------------
 */
static int
NsfNextObjCmd(ClientData UNUSED(clientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  nonnull(2) nonnull(4);

static int
NsfNextObjCmd(ClientData UNUSED(clientData), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
  int                  result, nobjc = 0;
  bool                 freeArgumentVector;
  const char          *methodName = NULL;
  NsfCallStackContent *cscPtr;
  Tcl_Obj            **nobjv;

  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  if (likely(objc < 2)) {
    /*
     * No arguments were provided.
     */
    objc = 0;
  } else {
    /*
     * In case "--noArgs" is used, remove the flag and provide an empty
     * argument list.
     */
    const char *arg1String = ObjStr(objv[1]);

    if (*arg1String == '-' && !strcmp(arg1String, "--noArgs")) {
      objc = 1;
    }
  }

  result = NextGetArguments(interp, objc-1, &objv[1], &cscPtr, &methodName,
                            &nobjc, &nobjv, &freeArgumentVector);
  if (likely(result == TCL_OK)) {
    assert(nobjc > 0);
    result = NextSearchAndInvoke(interp, methodName, nobjc, nobjv, cscPtr, freeArgumentVector);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * FindNextMethod --
 *
 *      This function is called via [current nextmethod] to resolve the
 *      method to be invoked by [next]. If there is a next method found
 *      on the precedence path, a method handle (Tcl_Obj) will be
 *      returned. The caller is responsible for managing the resulting
 *      Tcl_Obj, if any.
 *
 * Results:
 *      A Tcl_Obj; The result is NULL when no next method or called from
 *      outside of NSF.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *FindNextMethod(Tcl_Interp *interp, Tcl_CallFrame *framePtr)
  nonnull(1) nonnull(2);

static Tcl_Obj *
FindNextMethod(Tcl_Interp *interp, Tcl_CallFrame *framePtr) {
  Tcl_Obj             *result;
  NsfCallStackContent *cscPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(framePtr != NULL);

  cscPtr = Tcl_CallFrame_clientData(framePtr);
  if (unlikely(cscPtr == NULL)) {
    result = NULL;

  } else {
    bool         isEnsemble,
                 isMixinEntry = NSF_FALSE,
                 isFilterEntry = NSF_FALSE,
                 endOfFilterChain = NSF_FALSE;
    Tcl_Command  cmd = NULL, currentCmd = NULL;
    const char  *lookupMethodName, *methodName;
    NsfClass    *class;
    NsfObject   *object;

    isEnsemble = ((cscPtr->frameType & NSF_CSC_TYPE_ENSEMBLE) != 0u);

    methodName = Tcl_GetCommandName(interp, cscPtr->cmdPtr);
    if (isEnsemble) {
      NsfCallStackContent *cscPtr1 = CallStackFindEnsembleCsc(framePtr, &framePtr);

      lookupMethodName = MethodName(cscPtr1->objv[0]);
    } else {
      lookupMethodName = methodName;
    }

    class = cscPtr->cl;
    object = cscPtr->self;

    if (NextSearchMethod(object, interp, cscPtr,
                         &class, &lookupMethodName, &cmd, &isMixinEntry, &isFilterEntry,
                         &endOfFilterChain, &currentCmd) == TCL_OK
        && cmd != NULL) {
      Tcl_Obj *pathObj = NsfMethodNamePath(interp, framePtr, methodName);
      INCR_REF_COUNT(pathObj);

      methodName = isEnsemble ? ObjStr(pathObj) : lookupMethodName;
      result = MethodHandleObj((class != NULL) ? (NsfObject *)class : object, (class == NULL), methodName);
      DECR_REF_COUNT(pathObj);
    } else {
      result = NULL;
    }
  }
  return result;
}


/*
 *----------------------------------------------------------------------
 * ComputeLevelObj --
 *
 *      This function computes a fresh Tcl_Obj referring to the interp level. The
 *      caller has to care about freeing the returned Tcl_Obj.
 *
 * Results:
 *      Tcl_Obj *
 *
 * Side effects:
 *      Allocates a new Tcl_Obj
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj * ComputeLevelObj(Tcl_Interp *interp, CallStackLevel level)
  nonnull(1) returns_nonnull;

static Tcl_Obj *
ComputeLevelObj(Tcl_Interp *interp, CallStackLevel level) {
  Tcl_CallFrame *framePtr = NULL;
  Tcl_Obj       *resultObj;

  nonnull_assert(interp != NULL);

  switch (level) {
  case CALLING_LEVEL: {
    Tcl_CallFrame *callingFramePtr = NULL;

    /*
     * NsfCallStackFindCallingContext() sets always the framePtr, but
     * initialize framePtr explicitly to silence static checkers, since
     * ComputeLevelObj() is not performance critical.
     */
    framePtr = NULL;
    NsfCallStackFindCallingContext(interp, 1, &framePtr, &callingFramePtr);
    if (framePtr == NULL) {
      framePtr = callingFramePtr;
    }
    break;
  }
  case ACTIVE_LEVEL:
    NsfCallStackFindActiveFrame(interp,    1, &framePtr);
    break;
  }

  if (framePtr != NULL) {
    /*
     * The call was from an NSF frame, return absolute frame number.
     */
    char buffer[LONG_AS_STRING];
    int  l;

    buffer[0] = '#';
    Nsf_ltoa(buffer+1, (long)Tcl_CallFrame_level(framePtr), &l);
    resultObj = Tcl_NewStringObj(buffer, l+1);
  } else {
    /*
     * If not called from an NSF frame, return #0 as default.
     *
     * TODO: With NsfCallStackFindCallingContext in place, this cannot (should
     * not) be reachable. Need to check NsfCallStackFindActiveFrame. When in
     * the "clear", provide for a warning here?
     *
     */
    resultObj = Tcl_NewStringObj("#0", 2);
  }

  return resultObj;
}

/*
  int
  NsfKObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
  if (objc < 2) {
    return NsfPrintError(interp, "wrong # of args for K");
  }

  Tcl_SetObjResult(interp, objv[1]);
  return TCL_OK;
  }
*/

/*
 * object creation & destruction
 */

/*
 *----------------------------------------------------------------------
 * UnsetInAllNamespaces --
 *
 *      Try to unset a variable, searching for the variable in all
 *      name-spaces. This function is used by volatile to unset the automatic
 *      variable used for the destroy trace.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Might unset variable
 *
 *----------------------------------------------------------------------
 */

static int UnsetInAllNamespaces(
    Tcl_Interp *interp, const Tcl_Namespace *nsPtr, const char *name
) nonnull(1) nonnull(2) nonnull(3);

static int
UnsetInAllNamespaces(
    Tcl_Interp *interp, const Tcl_Namespace *nsPtr, const char *name
) {
  int            rc = 0;
  Tcl_HashSearch search;
  Tcl_HashEntry *entryPtr;
  const Tcl_Var *varPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(nsPtr != NULL);
  nonnull_assert(name != NULL);

  /*fprintf(stderr, "### UnsetInAllNamespaces variable '%s', current namespace '%s'\n",
          name, (nsPtr != NULL) ? nsPtr->fullName : "NULL");*/

  entryPtr = Tcl_FirstHashEntry(Tcl_Namespace_childTablePtr(nsPtr), &search);
  varPtr = (Tcl_Var *) Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *)nsPtr, 0);
  /*fprintf(stderr, "found %s in %s -> %p\n", name, nsPtr->fullName, varPtr);*/
  if (varPtr != NULL) {
    Tcl_DString dFullname, *dsPtr = &dFullname;
    int         result;

    Tcl_DStringInit(dsPtr);
    Tcl_DStringAppend(dsPtr, "unset ", -1);
    DStringAppendQualName(dsPtr, nsPtr, name);

    result = Tcl_Eval(interp, Tcl_DStringValue(dsPtr));
    /* fprintf(stderr, "fqName = '%s' unset => %d %d\n", Tcl_DStringValue(dsPtr), rc, TCL_OK);*/
    if (likely(result == TCL_OK)) {
      rc = 1;
    } else {
      Tcl_Obj *resultObj = Tcl_GetObjResult(interp);
      fprintf(stderr, "   err = '%s'\n", ObjStr(resultObj));
    }
    Tcl_DStringFree(dsPtr);
  }

  while ((rc == 0) && (entryPtr != NULL)) {
    Tcl_Namespace *childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
    /*fprintf(stderr, "child = %s\n", childNsPtr->fullName);*/
    entryPtr = Tcl_NextHashEntry(&search);
    rc |= UnsetInAllNamespaces(interp, childNsPtr, name);
  }

  return rc;
}

/*
 *----------------------------------------------------------------------
 * FreeUnsetTraceVariable --
 *
 *      Unset trace variable.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Might unset variable
 *
 *----------------------------------------------------------------------
 */

static int FreeUnsetTraceVariable(Tcl_Interp *interp, const NsfObject *object)
  nonnull(1) nonnull(2);

static int
FreeUnsetTraceVariable(Tcl_Interp *interp, const NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (object->opt != NULL && (object->opt->volatileVarName != NULL)) {
    int result = Tcl_UnsetVar2(interp, object->opt->volatileVarName, NULL, 0);

    /*
     * Somebody destroys a volatile object manually while the var-trace is
     * still active. Destroying the object will be a problem in case the
     * variable is deleted later and fires the trace. So, we unset the
     * variable here which will cause a destroy via var-trace, which in turn
     * clears the volatileVarName flag.
     */
    /* fprintf(stderr, "### FreeUnsetTraceVariable %s\n", object->opt->volatileVarName);*/

    if (unlikely(result != TCL_OK)) {
      result = Tcl_UnsetVar2(interp, object->opt->volatileVarName, NULL, TCL_GLOBAL_ONLY);

      if (unlikely(result != TCL_OK)) {
        Tcl_Namespace *nsPtr = Tcl_GetCurrentNamespace(interp);
        if (UnsetInAllNamespaces(interp, nsPtr, object->opt->volatileVarName) == 0) {
          fprintf(stderr, "### don't know how to delete variable '%s' of volatile object\n",
                  object->opt->volatileVarName);
          /*
           * Return always success, since an error during destroy does not
           * help at all
           */
        }
      }
    }
    /*fprintf(stderr, "### FreeUnsetTraceVariable returns %d OK %d\n", result, TCL_OK);*/
  }

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * NsfUnsetTrace --
 *
 *      Function to be triggered whenever the trigger variable is
 *      deleted. Typically, this function deletes the associated object.
 *
 * Results:
 *      Result msg or null.
 *
 * Side effects:
 *      Might delete associated object.
 *
 *----------------------------------------------------------------------
 */

static const char *NsfUnsetTrace(
    ClientData clientData, Tcl_Interp *interp,
    const char *UNUSED(name), const char *UNUSED(name2), unsigned int UNUSED(flags)
) nonnull(1) nonnull(2);

static const char *
NsfUnsetTrace(
    ClientData clientData, Tcl_Interp *interp,
    const char *UNUSED(name), const char *UNUSED(name2), unsigned int UNUSED(flags)
) {
  Tcl_Obj    *objPtr = (Tcl_Obj *)clientData;
  NsfObject  *object;
  const char *resultMsg = NULL;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);

  /*fprintf(stderr, "NsfUnsetTrace %s flags %.4x deleted %d\n", name, flags,
    Tcl_InterpDeleted(interp));*/

  if (Tcl_InterpDeleted(interp) == 0) {
    if (GetObjectFromObj(interp, objPtr, &object) == TCL_OK) {
      Tcl_Obj *savedResultObj = Tcl_GetObjResult(interp); /* save the result */

      INCR_REF_COUNT(savedResultObj);

      /*
       * Clear variable, destroy is called from trace.
       */
      if (object->opt != NULL && object->opt->volatileVarName) {
        object->opt->volatileVarName = NULL;
      }

      if (DispatchDestroyMethod(interp, object, 0u) != TCL_OK) {
        resultMsg = "Destroy for volatile object failed";
      } else {
        resultMsg = "No NSF Object passed";
      }

      Tcl_SetObjResult(interp, savedResultObj);  /* restore the result */
      DECR_REF_COUNT(savedResultObj);
    }
    DECR_REF_COUNT(objPtr);
  } else {
    /*fprintf(stderr, "omitting destroy on %s %p\n", name);*/
  }
  return resultMsg;
}

/*
 *----------------------------------------------------------------------
 * CleanupDestroyObject --
 *
 *      Perform cleanup of object; after the function is executed, the object is
 *      in the same fresh state as after initialization.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Possibly freeing memory.
 *
 *----------------------------------------------------------------------
 */
static void CleanupDestroyObject(Tcl_Interp *interp, NsfObject *object, bool softrecreate)
  nonnull(1) nonnull(2);

static void
CleanupDestroyObject(Tcl_Interp *interp, NsfObject *object, bool softrecreate) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  /*fprintf(stderr, "CleanupDestroyObject obj %p softrecreate %d nsPtr %p\n",
    object, softrecreate, object->nsPtr);*/

  /*
   * The object pointer is guaranteed to point to the same object, so it is
   * not sufficient for methodObj validation. Therefore, for objects
   * containing per-object methods, we increment the objectMethodEpoch.
   */
  if (object->nsPtr != NULL) {
    NsfObjectMethodEpochIncr("CleanupDestroyObject");
  }

  /*
   * Remove the instance, but not for ::Class/::Object
   */
  if (!IsBaseClass(object)) {

    if (!softrecreate) {
      RemoveInstance(object, object->cl);
    }
  }

  /*
   * Unset object variables with unset traces preemptively.
   */
  UnsetTracedVars(interp, object);

  if (object->nsPtr != NULL) {
    NSCleanupNamespace(interp, object->nsPtr);
    NSDeleteChildren(interp, object->nsPtr);
  }

  if (object->varTablePtr != NULL) {
    /*
     * Any unset-traced variable has been deleted before (UnsetTracedVars).
     */
    TclDeleteVars(((Interp *)interp), object->varTablePtr);

    ckfree((char *)object->varTablePtr);
    /*FREE(obj->varTablePtr, obj->varTablePtr);*/
    object->varTablePtr = 0;
  }

  if (object->opt != NULL) {
    NsfObjectOpt *opt = object->opt;
#if defined(NSF_WITH_ASSERTIONS)
    if (opt->assertions != NULL) {
      AssertionRemoveStore(opt->assertions);
      opt->assertions = NULL;
    }
#endif

#if defined(PER_OBJECT_PARAMETER_CACHING)
    if (object->opt->parsedParamPtr != NULL) {
      NsfParameterCacheObjectInvalidateCmd(interp, object);
    }
#endif

    if (!softrecreate) {
      /*
       * Remove this object from all per object mixin lists and clear the
       * mixin list.
       */
      if (opt->objMixins != NULL) {
        RemoveFromObjectMixinsOf(object->id, opt->objMixins);
      }

      CmdListFree(&opt->objMixins, GuardDel);
      CmdListFree(&opt->objFilters, GuardDel);
      FREE(NsfObjectOpt, opt);
      object->opt = NULL;
    }
  }

  object->flags &= ~NSF_MIXIN_ORDER_VALID;
  if (object->mixinOrder != NULL) {
    MixinResetOrder(object);
  }
  object->flags &= ~NSF_FILTER_ORDER_VALID;
  if (object->filterOrder != NULL) {
    FilterResetOrder(object);
  }
}

/*
 * obj initialization & namespace creation
 */

/*
 *----------------------------------------------------------------------
 * CleanupInitObject --
 *
 *      Perform the initialization of an object in a virgin state.
 *      During bootstrap, cl might be NULL.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Updating the object structure
 *
 *----------------------------------------------------------------------
 */
static void CleanupInitObject(
    Tcl_Interp *interp, NsfObject *object,
    NsfClass *class, Tcl_Namespace *nsPtr, bool softrecreate
) nonnull(1) nonnull(2);

static void
CleanupInitObject(
    Tcl_Interp *interp, NsfObject *object,
    NsfClass *class, Tcl_Namespace *nsPtr, bool softrecreate
) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

#ifdef OBJDELETION_TRACE
  fprintf(stderr, "+++ CleanupInitObject\n");
#endif
  object->teardown = interp;
  object->nsPtr = nsPtr;

  if (!softrecreate && class != NULL) {
    AddInstance(object, class);
  }
  if ((object->flags & NSF_RECREATE) != 0u) {
    object->opt = NULL;
    object->varTablePtr = NULL;
    object->mixinOrder = NULL;
    object->filterOrder = NULL;
    object->flags = 0;
  }
  /*
    fprintf(stderr, "cleanupInitObject %s: %p cl = %p\n", (obj->cmdName != NULL) ? ObjectName(object) : "", object, object->cl);*/
}

/*
 *----------------------------------------------------------------------
 * PrimitiveDestroy --
 *
 *      Dispatch either PrimitiveCDestroy or PrimitiveODestroy
 *      depending on whether the object is a class
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void
PrimitiveDestroy(ClientData clientData) {

  nonnull_assert(clientData != NULL);

  if (NsfObjectIsClass((NsfObject *)clientData)) {
    PrimitiveCDestroy(clientData);
  } else {
    PrimitiveODestroy(clientData);
  }
}

/*
 *----------------------------------------------------------------------
 * TclDeletesObject --
 *
 *      Function to be called, when Tcl deletes the command which has an
 *      object/class associated. This happens, when e.g. a namespace is deleted.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void TclDeletesObject(ClientData clientData)
  nonnull(1);

static void
TclDeletesObject(ClientData clientData) {
  NsfObject *object;

  nonnull_assert(clientData != NULL);

  object = (NsfObject *)clientData;

  /*
   * TODO: Actually, it seems like a good idea to flag a deletion from Tcl by
   * setting object->id to NULL. However, we seem to have some dependencies
   * avoiding this currently, so we use the flag.
   */
  object->flags |= NSF_TCL_DELETE;

  /*fprintf(stderr, "cmd dealloc %p TclDeletesObject (%d)\n",
    object->id,  Tcl_Command_refCount(object->id));*/

#ifdef OBJDELETION_TRACE
  fprintf(stderr, "TclDeletesObject %p obj->id %p flags %.6x\n",
          (void *)object, (void *)object->id, object->flags);
#endif
  if (unlikely((object->flags & NSF_DURING_DELETE) == 0u)
      && (object->teardown != NULL)
      ) {

# ifdef OBJDELETION_TRACE
    fprintf(stderr, "... %p %s\n", (void *)object, ObjectName(object));
# endif

    CallStackDestroyObject(object->teardown, object);
  }
}


/*
 *----------------------------------------------------------------------
 * PrimitiveODestroy --
 *
 *      Delete an object with its namespace and associated data structures
 *    (mixin stack, filter stack). The physical deallocation is handled by
 *      NsfCleanupObject() which performs reference counting.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free object contents.
 *
 *----------------------------------------------------------------------
 */
static void
PrimitiveODestroy(ClientData clientData) {
  NsfObject  *object;
  Tcl_Interp *interp;

  nonnull_assert(clientData != NULL);

  object = (NsfObject *)clientData;
  assert(object->teardown != NULL);

  /*fprintf(stderr, "****** PrimitiveODestroy %p cmd %p flags %.6x\n",
    (void *)object, (void *)object->id, object->flags);*/

  /*
   * We assume, the object was not yet deleted, but destroy was called
   * already.
   */
  assert((object->flags & NSF_DELETED) == 0u);
  assert((object->flags & NSF_DESTROY_CALLED) != 0u);

  /*
   * Check and latch against recurrent calls with object->teardown.
   */
  PRINTOBJ("PrimitiveODestroy", object);
  interp = object->teardown;

  /*
   * Don't destroy, if the interpreter is destroyed already
   * e.g. TK calls Tcl_DeleteInterp directly, if the window is killed
   */
  if (!Tcl_InterpDeleted(interp)) {

#ifdef OBJDELETION_TRACE
    {Command *cmdPtr = (Command*)object->id;
      fprintf(stderr, "  physical delete of %p id=%p (cmd->refCount %d) destroyCalled=%d '%s'\n",
              (void *)object, (void *)object->id, cmdPtr->refCount,
              (object->flags & NSF_DESTROY_CALLED), ObjectName(object));
    }
#endif
    CleanupDestroyObject(interp, object, NSF_FALSE);

    while (object->mixinStack != NULL) {
      MixinStackPop(object);
    }

    while (object->filterStack != NULL) {
      FilterStackPop(object);
    }

    /*
     * Object is now mostly dead, but still allocated. However, since
     * Nsf_DeleteNamespace might delegate to the parent (e.g. slots) we clear
     * teardown after the deletion of the children.
     */
    if (object->nsPtr != NULL) {
      /*fprintf(stderr, "PrimitiveODestroy calls deleteNamespace for object %p nsPtr %p\n", (void*)object, object->nsPtr);*/
      Nsf_DeleteNamespace(interp, object->nsPtr);
      object->nsPtr = NULL;
    }
    object->teardown = NULL;

    /*fprintf(stderr, " +++ OBJ/CLS free: %p %s\n", (void *)object, ObjectName(object));*/

    object->flags |= NSF_DELETED;
    ObjTrace("ODestroy", object);

    DECR_REF_COUNT(object->cmdName);
    NsfCleanupObject(object, "PrimitiveODestroy");
  }
}

/*
 *----------------------------------------------------------------------
 * DoDealloc --
 *
 *      Perform deallocation of an object/class. This function is called
 *      from the dealloc method and internally to get rid of an
 *      abject. It cares about volatile and frees/triggers free
 *      operation depending on the stack references.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      freed object or object is marked to be freed.
 *
 *----------------------------------------------------------------------
 */
static int DoDealloc(Tcl_Interp *interp, NsfObject *object)
  nonnull(1) nonnull(2);

static int
DoDealloc(Tcl_Interp *interp, NsfObject *object) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  /*fprintf(stderr, "DoDealloc obj= %s %p flags %.6x activation %d cmd %p opt=%p\n",
          ObjectName(object), object, object->flags, object->activationCount,
          object->id, object->opt);*/

  result = FreeUnsetTraceVariable(interp, object);
  if (unlikely(result == TCL_OK)) {

    /*
     * Latch, and call delete command if not already in progress.
     */
    if (RUNTIME_STATE(interp)->exitHandlerDestroyRound !=
        NSF_EXITHANDLER_ON_SOFT_DESTROY) {
      CallStackDestroyObject(interp, object);
    }
  }

  return result;
}


/*
 *----------------------------------------------------------------------
 * MarkUndestroyed --
 *
 *      Mark an object as if destroy was not called. This function is e.g. used
 *      from recreate.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Setting object flag.
 *
 *----------------------------------------------------------------------
 */
static void MarkUndestroyed(NsfObject *object)
  nonnull(1);

static void
MarkUndestroyed(NsfObject *object) {

  nonnull_assert(object != NULL);

  object->flags &= ~NSF_DESTROY_CALLED;
}

/*
 *----------------------------------------------------------------------
 * PrimitiveOInit --
 *
 *      Set/reset the object to a fresh, un-destroyed state
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      initializing object structure
 *
 *----------------------------------------------------------------------
 */
static void PrimitiveOInit(NsfObject *object, Tcl_Interp *interp, const char *name,
                           Tcl_Namespace *nsPtr, NsfClass *class)
  nonnull(1) nonnull(2) nonnull(3);

static void
PrimitiveOInit(NsfObject *object, Tcl_Interp *interp, const char *name,
               Tcl_Namespace *nsPtr, NsfClass *class) {

  nonnull_assert(object != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);

#ifdef OBJDELETION_TRACE
  fprintf(stderr, "+++ PrimitiveOInit\n");
#endif

#ifdef NSFOBJ_TRACE
  fprintf(stderr, "OINIT %s = %p\n", name, (void *)object);
#endif
  NsfObjectRefCountIncr(object);
  MarkUndestroyed(object);

  /*
   * There might be already a namespace with the provided name; if this is the
   * case, use this namespace as object namespace. The preexisting namespace
   * might contain Next Scripting objects. If we would not use the namespace
   * as child namespace, we would not recognize the objects as child objects,
   * deletions of the object might lead to a crash.
   *
   * We can use here the provided nsPtr, except in cases, where this
   * namespaces is being destroyed (e.g. recreate a new object from a
   * different object system).
   */

  if (nsPtr != NULL && (((Namespace *)nsPtr)->flags & NS_DYING) != 0u) {
    Namespace  *dummy1Ptr, *dummy2Ptr, *nsPtr1 = (Namespace *)nsPtr;
    const char *dummy;
    TclGetNamespaceForQualName(interp, name,
                               NULL, TCL_GLOBAL_ONLY|TCL_FIND_ONLY_NS,
                               &nsPtr1, &dummy1Ptr, &dummy2Ptr, &dummy);
    nsPtr = (Tcl_Namespace *)nsPtr1;
    /*fprintf(stderr, "PrimitiveOInit %p calls TclGetNamespaceForQualName with %s => %p given %p object->nsPtr %p\n",
            object, name,
            nsPtr, nsPtr, object->nsPtr);*/
  }

  if (nsPtr != NULL) {
    NsfNamespaceInit(nsPtr);
  }

  /* fprintf(stderr, "PrimitiveOInit %p %s, ns %p\n", object, name, nsPtr); */
  CleanupInitObject(interp, object, class, nsPtr, NSF_FALSE);

  /*
   * TODO: would be nice, if we could init object flags.
   */
  /* object->flags = NSF_MIXIN_ORDER_VALID | NSF_FILTER_ORDER_VALID;*/
  object->mixinStack = NULL;
  object->filterStack = NULL;
}

/*
 *----------------------------------------------------------------------
 * PrimitiveOCreate --
 *
 *      Allocate memory for an object, create the object name and the associated
 *      Tcl command and call the initialization functions.
 *
 * Results:
 *      NsfObject*
 *
 * Side effects:
 *      Allocating memory
 *
 *----------------------------------------------------------------------
 */
static NsfObject * PrimitiveOCreate(Tcl_Interp *interp, Tcl_Obj *nameObj, Tcl_Namespace *parentNsPtr, NsfClass *class)
  nonnull(1) nonnull(2) nonnull(4) returns_nonnull;

static NsfObject *
PrimitiveOCreate(Tcl_Interp *interp, Tcl_Obj *nameObj, Tcl_Namespace *parentNsPtr, NsfClass *class) {
  const char    *nameString;
  Tcl_Namespace *nsPtr;
  NsfObject     *object;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(class != NULL);

  object = (NsfObject *)ckalloc((int)sizeof(NsfObject));
  MEM_COUNT_ALLOC("NsfObject/NsfClass", object);
  assert(object != NULL); /* ckalloc panics, if malloc fails */

  memset(object, 0, sizeof(NsfObject));

  nameString = ObjStr(nameObj);
  assert(isAbsolutePath(nameString));

#if defined(NSFOBJ_TRACE)
  fprintf(stderr, "CKALLOC Object %p %s\n", (void *)object, nameString);
#endif
#ifdef OBJDELETION_TRACE
  fprintf(stderr, "+++ PrimitiveOCreate\n");
#endif

  nsPtr = NSCheckNamespace(interp, nameString, parentNsPtr);
  if (nsPtr != NULL) {
    NSNamespacePreserve(nsPtr);
  }
#if defined(NRE)
  object->id = Tcl_NRCreateCommand(interp, nameString,
                                   NsfObjDispatch,
                                   NsfObjDispatchNRE,
                                   object, TclDeletesObject);
#else
  object->id = Tcl_CreateObjCommand(interp, nameString, NsfObjDispatch,
                                    object, TclDeletesObject);
#endif

  /*fprintf(stderr, "cmd alloc %p %d (%s)\n", object->id,
    Tcl_Command_refCount(object->id), nameString);*/

  PrimitiveOInit(object, interp, nameString, nsPtr, class);
  if (nsPtr != NULL) {
    NSNamespaceRelease(nsPtr);
  }

  object->cmdName = nameObj;
  INCR_REF_COUNT(object->cmdName);

  ObjTrace("PrimitiveOCreate", object);

  return object;
}

/*
 *----------------------------------------------------------------------
 * DefaultSuperClass --
 *
 *      Determine the default superclass of the class (specified as
 *      second argument) and metaclass (third argument). The function
 *      searches for the variable NSF_DEFAULTMETACLASS or
 *      NSF_DEFAULTSUPERCLASS and uses it if present.
 *
 * Results:
 *      Default superclass or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static NsfClass *
DefaultSuperClass(Tcl_Interp *interp, const NsfClass *class, const NsfClass *metaClass, bool isMeta) {
  NsfClass *resultClass = NULL;
  Tcl_Obj  *resultObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(metaClass != NULL);

  /*fprintf(stderr, "DefaultSuperClass cl %s, mcl %s, isMeta %d\n",
    ClassName(class), ClassName(metaClass), isMeta );*/

  resultObj = Nsf_ObjGetVar2((Nsf_Object *)metaClass, interp, (isMeta != 0) ?
                             NsfGlobalObjs[NSF_DEFAULTMETACLASS] :
                             NsfGlobalObjs[NSF_DEFAULTSUPERCLASS], NULL, 0);

  if (resultObj != NULL) {
    if (unlikely(GetClassFromObj(interp, resultObj, &resultClass, NSF_FALSE) != TCL_OK)) {
      NsfPrintError(interp, "default superclass is not a class");
    }
    /*fprintf(stderr, "DefaultSuperClass for %s got from var %s => %s\n",
            ClassName(class),
            ObjStr((isMeta != 0) ? NsfGlobalObjs[NSF_DEFAULTMETACLASS] : NsfGlobalObjs[NSF_DEFAULTSUPERCLASS]),
            ClassName(resultClass));*/
  } else {
    const NsfClasses *sc;

    /*fprintf(stderr, "DefaultSuperClass for %s: search in superClasses starting with %p meta %d\n",
      ClassName(class), cl->super, isMeta);*/

    if (isMeta != 0) {
      /*
       * Is this already the root metaclass ?
       */
      if (IsRootMetaClass(metaClass->object.cl)) {
        return metaClass->object.cl;
      }
    }

    /*
     * Check superClasses of metaclass
     */
    for (sc = metaClass->super; sc && sc->cl != class; sc = sc->nextPtr) {
      /* fprintf(stderr, "  ... check ismeta %d %s root mcl %d root cl %d\n",
         isMeta, ClassName(sc->cl),
         sc->cl->object.flags & NSF_IS_ROOT_META_CLASS,
         sc->cl->object.flags & NSF_IS_ROOT_CLASS); */
      if (isMeta != 0) {
        if (IsRootMetaClass(sc->cl)) {
          return sc->cl;
        }
      } else {
        if (IsRootClass(sc->cl)) {
          /* fprintf(stderr, "found root-class %p %s\n", sc->cl, ClassName(sc->cl)); */
          return sc->cl;
        }
      }

      resultClass = DefaultSuperClass(interp, class, sc->cl, isMeta);
      if (resultClass != NULL) {
        break;
      }
    }
  }

  return resultClass;
}

/*
 *----------------------------------------------------------------------
 * CleanupDestroyClass --
 *
 *      Cleanup class in a destroy call.  Remove filters, mixins, assertions,
 *      instances and remove finally class from class hierarchy. In the recreate
 *      case, it preserves the pointers from other class structures.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Updated class structures.
 *
 *----------------------------------------------------------------------
 */

static void CleanupDestroyClass(Tcl_Interp *interp, NsfClass *class, bool softrecreate, bool recreate)
  nonnull(1) nonnull(2);

static void
CleanupDestroyClass(Tcl_Interp *interp, NsfClass *class, bool softrecreate, bool recreate) {
  NsfClassOpt *clopt;
  NsfClass    *baseClass = NULL;
  NsfClasses  *subClasses;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  PRINTOBJ("CleanupDestroyClass", (NsfObject *)class);
  assert(softrecreate ? recreate : NSF_TRUE);

  clopt = class->opt;
  /*fprintf(stderr, "CleanupDestroyClass %p %s (ismeta=%d) softrecreate=%d, recreate=%d, %p\n",
          class, ClassName(class), IsMetaClass(interp, cl, NSF_TRUE),
          softrecreate, recreate, clopt);*/

  subClasses = DependentSubClasses(class);
  if (subClasses != NULL) {

    /*
     * Perform the next steps even with clopt == NULL, since the class
     * might be used as a superclass of a per object mixin, so it might
     * have no clopt...
     */
    MixinInvalidateObjOrders(subClasses);
    if (FiltersDefined(interp) > 0) {
      FilterInvalidateObjOrders(interp, subClasses);
    }
  }

  if (clopt != NULL) {
    /*
     *  Remove this class from all isClassMixinOf lists and clear the
     *  class mixin list
     */
    if (clopt->classMixins != NULL) {
      RemoveFromClassMixinsOf(clopt->id, clopt->classMixins);
    }

    CmdListFree(&clopt->classMixins, GuardDel);
    CmdListFree(&clopt->classFilters, GuardDel);

    if (clopt->mixinRegObjs != NULL) {
      NsfMixinregInvalidate(interp, clopt->mixinRegObjs);
      DECR_REF_COUNT2("mixinRegObjs", clopt->mixinRegObjs);
      clopt->mixinRegObjs = NULL;
    }

    if (!recreate) {
      /*
       *  Remove this class from all mixin lists and clear the isObjectMixinOf list
       */
      if (clopt->isObjectMixinOf != 0) {
        RemoveFromObjectMixins(clopt->id, clopt->isObjectMixinOf);
      }
      CmdListFree(&clopt->isObjectMixinOf, GuardDel);

      /*
       *  Remove this class from all class mixin lists and clear the
       *  isClassMixinOf list
       */
      if (clopt->isClassMixinOf != 0) {
        RemoveFromClassmixins(clopt->id, clopt->isClassMixinOf);
      }
      CmdListFree(&clopt->isClassMixinOf, GuardDel);
    }

    /*
     * Remove dependent filters of this class from all subclasses
     */
    if (subClasses != NULL) {
      FilterRemoveDependentFilterCmds(class, subClasses);
    }

#if defined(NSF_WITH_ASSERTIONS)
    if (clopt->assertions != NULL) {
        AssertionRemoveStore(clopt->assertions);
        clopt->assertions = NULL;
      }
#endif

#ifdef NSF_OBJECTDATA
    NsfFreeObjectData(class);
#endif
  }

  NSCleanupNamespace(interp, class->nsPtr);
  NSDeleteChildren(interp, class->nsPtr);

  if (!softrecreate) {

    /*
     * Reclass all instances of the current class to the appropriate
     * most general class ("baseClass"). The most general class of a
     * metaclass is the root metaclass, the most general class of an
     * object is the root-class. Instances of metaclasses can be only
     * reset to the root metaclass (and not to the root base
     * class).
     */
    baseClass = DefaultSuperClass(interp, class, class->object.cl,
                                  IsMetaClass(interp, class, NSF_TRUE));
    /*
     * We do not have to reclassing in case, cl is a root-class
     */
    if (!IsRootClass(class)) {
      Tcl_HashTable       *instanceTablePtr = &class->instances;
      Tcl_HashSearch       hSrch;
      const Tcl_HashEntry *hPtr;

      for (hPtr = Tcl_FirstHashEntry(instanceTablePtr, &hSrch); hPtr != NULL;
           hPtr = Tcl_NextHashEntry(&hSrch)) {
        NsfObject *inst = (NsfObject *)Tcl_GetHashKey(instanceTablePtr, hPtr);

        /*fprintf(stderr, "    inst %p %s flags %.6x id %p baseClass %p %s\n",
          inst, ObjectName(inst), inst->flags, inst->id, baseClass, ClassName(baseClass));*/
        if ((inst != NULL)
            && (inst != (NsfObject *)class)
            && likely((inst->flags & NSF_DURING_DELETE) == 0u) /*inst->id*/
            ) {
          if (inst != &(baseClass->object)) {
            AddInstance(inst, baseClass);
          }
        }
      }
    }
    Tcl_DeleteHashTable(&class->instances);
    MEM_COUNT_FREE("Tcl_InitHashTable", &class->instances);
  }

  if (clopt != NULL && !recreate) {
    FREE(NsfClassOpt, clopt);
    class->opt = NULL;
  }

  if (subClasses != NULL) {
    /*
     * On a recreate, it might be possible that the newly created class
     * has a different superclass. So we have to flush the precedence
     * list on a recreate as well.
     */
    FlushPrecedences(subClasses);
    NsfClassListFree(subClasses);
  }

  while (class->super != NULL) {
    (void)RemoveSuper(class, class->super->cl);
  }

  if (!softrecreate) {
    /*
     * Flush all caches, unlink superClasses.
     */

    while (class->sub != NULL) {
      NsfClass *subClass = class->sub->cl;

      (void)RemoveSuper(subClass, class);
      /*
       * If there are no more superclasses add the Object
       * class as superClasses
       * -> don't do that for Object itself!
       */
      if (subClass->super == NULL && !IsRootClass(class)) {
        /* fprintf(stderr, "subClass %p %s baseClass %p %s\n",
           class, ClassName(class), baseClass, ClassName(baseClass)); */
        AddSuper(subClass, baseClass);
      }
    }
  }

}

/*
 *----------------------------------------------------------------------
 * CleanupInitClass --
 *
 *      Basic initialization of a class, setting namespace, super- and
 *      subclasses, and setup optionally instances table.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Makes a class structure usable.
 *
 *----------------------------------------------------------------------
 */
static void CleanupInitClass(
    Tcl_Interp *interp, NsfClass *class, Tcl_Namespace *nsPtr,
    bool softrecreate, bool recreate
) nonnull(1) nonnull(2) nonnull(3);

static void
CleanupInitClass(
    Tcl_Interp *interp, NsfClass *class, Tcl_Namespace *nsPtr,
    bool softrecreate, bool recreate
) {
  NsfClass *defaultSuperclass;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(nsPtr != NULL);
  assert((softrecreate) ? recreate : NSF_TRUE);

#ifdef OBJDELETION_TRACE
  fprintf(stderr, "+++ CleanupInitClass\n");
#endif

  /*
   * Record, that cl is a class and set its namespace
   */
  NsfObjectSetClass((NsfObject *)class);
  class->nsPtr = nsPtr;

  if (!softrecreate) {
    /*
     * Subclasses are preserved during recreate, superClasses not (since the
     * creation statement defined the superclass, might be different the
     * second time).
     */
    class->sub = NULL;
  }
  class->super = NULL;

  /*
   * We can the default superclass from the metaclass, if this exists.
   */
  if (class->object.cl != NULL) {
    /*
     * Look for a configured default superclass.
     */
    defaultSuperclass = DefaultSuperClass(interp, class, class->object.cl, NSF_FALSE);
  } else {
    defaultSuperclass = NULL;
  }
  if (class != defaultSuperclass) {
    AddSuper(class, defaultSuperclass);
  }

  class->color = WHITE;
  class->order = NULL;

  if (!softrecreate) {
    Tcl_InitHashTable(&class->instances, TCL_ONE_WORD_KEYS);
    MEM_COUNT_ALLOC("Tcl_InitHashTable", &class->instances);
  }

  if (!recreate) {
    class->opt = NULL;
  }
}

/*
 *----------------------------------------------------------------------
 * PrimitiveCDestroy --
 *
 *      Delete a class with its namespace and associated data structures. The
 *      physical deallocation is handled by PrimitiveODestroy().
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Free object contents.
 *
 *----------------------------------------------------------------------
 */
static void
PrimitiveCDestroy(ClientData clientData) {
  NsfClass      *class;

  nonnull_assert(clientData != NULL);

  class = (NsfClass *)clientData;
  PRINTOBJ("PrimitiveCDestroy", &class->object);

  /*
   * Check and latch against recurrent calls with obj->teardown
   */
  if (class != NULL && class->object.teardown != NULL) {
    Tcl_Interp *interp;

    interp = class->object.teardown;

    /*
     * Don't destroy, if the interpreted is destroyed already
     * e.g. TK calls Tcl_DeleteInterp directly, if Window is killed
     */
    if (!Tcl_InterpDeleted(interp)) {
      Tcl_Namespace *saved;

      /*
       * Call and latch user destroy with object->id if we haven't
       */
      /*fprintf(stderr, "PrimitiveCDestroy %s flags %.6x\n", ObjectName(object), object->flags);*/

      class->object.teardown = NULL;
      CleanupDestroyClass(interp, class, NSF_FALSE, NSF_FALSE);

      /*
       * handoff the primitive teardown
       */
      saved = class->nsPtr;
      class->object.teardown = interp;

      /*
       * class object destroy + physical destroy
       */
      PrimitiveODestroy(clientData);

      /*fprintf(stderr, "primitive cdestroy calls delete namespace for obj %p, nsPtr %p flags %.6x\n",
        cl, saved, ((Namespace *)saved)->flags);*/
      Nsf_DeleteNamespace(interp, saved);
      /*fprintf(stderr, "primitive cdestroy %p DONE\n", class);*/
    }
  }
  return;
}

/*
 *----------------------------------------------------------------------
 * PrimitiveCInit --
 *
 *      Set/reset a class to a fresh, un-destroyed state
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      initializing object structure
 *
 *----------------------------------------------------------------------
 */
static void PrimitiveCInit(NsfClass *class, Tcl_Interp *interp, const char *name)
  nonnull(1) nonnull(2) nonnull(3);

static void
PrimitiveCInit(NsfClass *class, Tcl_Interp *interp, const char *name) {
  Tcl_CallFrame frame, *framePtr = &frame;

  nonnull_assert(class != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);

  /*
   * Ensure that namespace is newly created during CleanupInitClass. Kill it,
   * if it exists already
   */
  if (Tcl_PushCallFrame(interp, (Tcl_CallFrame *)framePtr,
                        RUNTIME_STATE(interp)->NsfClassesNS, 0) == TCL_OK) {
    Tcl_Namespace *nsPtr;

    nsPtr = NSGetFreshNamespace(interp, &class->object, name);
    Tcl_PopCallFrame(interp);
    CleanupInitClass(interp, class, nsPtr, NSF_FALSE, NSF_FALSE);
  }

  return;
}


/*
 *----------------------------------------------------------------------
 * PrimitiveCCreate --
 *
 *      Allocate memory for a class, initialize the class specific data
 *      structure (e.g. class namespace) and call PrimitiveOCreate() for the
 *      object specific initialization.
 *
 * Results:
 *      NsfClass*
 *
 * Side effects:
 *      Allocating memory
 *
 *----------------------------------------------------------------------
 */
static NsfClass *PrimitiveCCreate(
    Tcl_Interp *interp, Tcl_Obj *nameObj,
    Tcl_Namespace *parentNsPtr, NsfClass *metaClass
) nonnull(1) nonnull(2) returns_nonnull;

static NsfClass *
PrimitiveCCreate(
    Tcl_Interp *interp, Tcl_Obj *nameObj,
    Tcl_Namespace *parentNsPtr, NsfClass *metaClass
) {
  Tcl_Namespace *nsPtr;
  const char    *nameString;
  NsfObject     *object;
  NsfClass      *class;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);

  class = (NsfClass *)ckalloc((int)sizeof(NsfClass));
  nameString = ObjStr(nameObj);
  object = (NsfObject *)class;

#if defined(NSFOBJ_TRACE)
  fprintf(stderr, "CKALLOC Class %p %s\n", (void *)class, nameString);
#endif

  memset(class, 0, sizeof(NsfClass));
  MEM_COUNT_ALLOC("NsfObject/NsfClass", class);

  /*
   * Pass object system from metaclass.
   */
  if (metaClass != NULL) {
    class->osPtr = metaClass->osPtr;
  }

  assert(isAbsolutePath(nameString));
  /*
    fprintf(stderr, "Class alloc %p '%s'\n", cl, nameString);
  */
  nsPtr = NSCheckNamespace(interp, nameString, parentNsPtr);
  if (nsPtr != NULL) {
    NSNamespacePreserve(nsPtr);
  }
#if defined(NRE)
  object->id = Tcl_NRCreateCommand(interp, nameString,
                                   NsfObjDispatch,
                                   NsfObjDispatchNRE,
                                   class, TclDeletesObject);
#else
  object->id = Tcl_CreateObjCommand(interp, nameString, NsfObjDispatch,
                                    class, TclDeletesObject);
#endif
  PrimitiveOInit(object, interp, nameString, nsPtr, metaClass);

  if (nsPtr != NULL) {
    NSNamespaceRelease(nsPtr);
  }
  object->cmdName = nameObj;

  INCR_REF_COUNT(object->cmdName);
  PrimitiveCInit(class, interp, nameString+2);

  ObjTrace("PrimitiveCCreate", object);
  return class;
}


/*
 *----------------------------------------------------------------------
 * ChangeClass --
 *
 *      Change class of a Next Scripting object. This function takes
 *      care that one tries not to change an object into a class or vice
 *      versa. Changing metaclass to metaclass, or class to class, or
 *      object to object is fine, but upgrading/downgrading is not
 *      allowed.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Changes class of object if possible and updates instance relation.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static int ChangeClass(Tcl_Interp *interp, NsfObject *object, NsfClass *class)
  nonnull(1) nonnull(2) nonnull(3);

NSF_INLINE static int
ChangeClass(Tcl_Interp *interp, NsfObject *object, NsfClass *class) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(class != NULL);

  NsfInstanceMethodEpochIncr("ChangeClass");

  /*fprintf(stderr, "changing %s to class %s ismeta %d\n",
          ObjectName(object), ClassName(class),
          IsMetaClass(interp, cl, NSF_TRUE));*/

  if (class != object->cl) {
    if (IsMetaClass(interp, class, NSF_TRUE)) {
      /*
       * Do not allow upgrading from a class to a metaclass (in other words,
       * don't make an object to a class). To allow this, it would be
       * necessary to reallocate the base structures.
       */
      if (!IsMetaClass(interp, object->cl, NSF_TRUE)) {
        return NsfPrintError(interp, "cannot turn object into a class");
      }
    } else {
      /*
       * The target class is not a metaclass.
       */
      /*fprintf(stderr, "target class %s not a metaclass, am i a class %d\n",
        ClassName(class), NsfObjectIsClass(object) );*/

      if (NsfObjectIsClass(object)) {
        return NsfPrintError(interp, "cannot turn class into an object ");
      }
    }
    RemoveInstance(object, object->cl);
    AddInstance(object, class);

    MixinComputeDefined(interp, object);
    FilterComputeDefined(interp, object);
  }
  return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 * DoObjInitialization --
 *
 *      Perform the object initialization: first call "configure" and the
 *      constructor "init", if not called already from configure. The function
 *      will make sure that the called methods do not change the result passed
 *      into this function.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Indirect effects by calling Tcl code
 *
 *----------------------------------------------------------------------
 */
static int DoObjInitialization(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(4);

static int
DoObjInitialization(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[]) {
  Tcl_Obj *methodObj, *savedObjResult;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(objv != NULL);
  assert(objc >= 0);

#if 0
  { int i;
    fprintf(stderr, "DoObjInitialization objc %d: ", objc);
    for(i = 0; i < objc; i++) {fprintf(stderr, " [%d]=%s,", i, ObjStr(objv[i]));}
    fprintf(stderr, "\n");
  }
#endif

  /*
   * Save the result we have so far to return it in case of success
   */
  savedObjResult = Tcl_GetObjResult(interp);
  INCR_REF_COUNT(savedObjResult);

  /*
   * clear INIT_CALLED flag
   */
  object->flags &= ~NSF_INIT_CALLED;
  /*
   * Make sure, the object survives initialization; the cmd/initcmd might
   * destroy it.
   */
  NsfObjectRefCountIncr(object);

  /*
   * Call configure method
   */
  if (CallDirectly(interp, object, NSF_o_configure_idx, &methodObj)) {
    NSF_PROFILE_TIME_DATA;
    if (methodObj == NULL) {
      methodObj = NsfGlobalObjs[NSF_CONFIGURE];
    }
    assert(methodObj != NULL);
    /*
     * The methodObj is just used for error reporting.
     */
    NSF_PROFILE_CALL(interp, object, ObjStr(methodObj));
    result = NsfOConfigureMethod(interp, object, objc, objv, methodObj);
    NSF_PROFILE_EXIT(interp, object, ObjStr(methodObj));
  } else {
    result = CallMethod(object, interp, methodObj, objc+2, objv, NSF_CSC_IMMEDIATE);
  }

  if (likely(result == TCL_OK)) {
    /*
     * Call constructor when needed
     */
    if ((object->flags & (NSF_INIT_CALLED|NSF_DESTROY_CALLED)) == 0u) {
      result = DispatchInitMethod(interp, object, 0, NULL, 0u);
    }

    if (likely(result == TCL_OK)) {
      Tcl_SetObjResult(interp, savedObjResult);
    }
  } else {
    /*
     * Configure failed and might have left the object in a bogus state. To
     * avoid strange errors, we delete the half-baked object.
     */
    Tcl_Obj *errObj;

    /*
     *  Preserve the outer error message, calls triggered by
     *  DispatchDestroyMethod() can cause the interp result to be reset
     */

    errObj = Tcl_GetObjResult(interp);
    INCR_REF_COUNT(errObj);

    DispatchDestroyMethod(interp, (NsfObject *)object, 0u);

    Tcl_SetObjResult(interp, errObj);
    DECR_REF_COUNT(errObj);
  }

  NsfCleanupObject(object, "obj init");
  DECR_REF_COUNT(savedObjResult);
  return result;
}

/*
 *----------------------------------------------------------------------
 * IsRootMetaClass --
 *
 *      Check, of the class has the root metaclass flag set.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool
IsRootMetaClass(const NsfClass *class) {

  nonnull_assert(class != NULL);

  return ((class->object.flags & NSF_IS_ROOT_META_CLASS) != 0u);
}

/*
 *----------------------------------------------------------------------
 * IsBaseClass --
 *
 *      Check, whether the object is a base class.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool
IsBaseClass(const NsfObject *object) {

  nonnull_assert(object != NULL);

  return ((object->flags & (NSF_IS_ROOT_CLASS|NSF_IS_ROOT_META_CLASS)) != 0u);
}

/*
 *----------------------------------------------------------------------
 * IsRootClass --
 *
 *      Check, whether the object is a root-class.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool
IsRootClass(const NsfClass *class) {

  nonnull_assert(class != NULL);

  return ((class->object.flags & (NSF_IS_ROOT_CLASS)) != 0u);
}


/*
 *----------------------------------------------------------------------
 * IsMetaClass --
 *
 *      Check, whether the object is a metaclass. Optionally, mixins are
 *      checked as well.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool
IsMetaClass(Tcl_Interp *interp, NsfClass *class, bool withMixins) {
  NsfClasses *pl;
  bool        result = NSF_FALSE;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  /*
   * Is the class the most general metaclass?
   */
  if (IsRootMetaClass(class)) {
    return NSF_TRUE;
  }

  /*
   * Is the class a subclass of a metaclass?
   */
  for (pl = PrecedenceOrder(class); pl != NULL; pl = pl->nextPtr) {
    if (IsRootMetaClass(pl->cl)) {
      return NSF_TRUE;
    }
  }

  if (withMixins) {
    NsfClasses *checkList = NULL, *mixinClasses = NULL, *mc;

    /*
     * Has the class metaclass mixed in?
     */
    NsfClassListAddPerClassMixins(interp, class, &mixinClasses, &checkList);

    for (mc = mixinClasses; mc != NULL; mc = mc->nextPtr) {
      if (IsMetaClass(interp, mc->cl, NSF_FALSE)) {
        result = NSF_TRUE;
        break;
      }
    }
    if (mixinClasses != NULL) {
      NsfClassListFree(mixinClasses);
    }
    if (checkList != NULL) {
      NsfClassListFree(checkList);
    }
    /*fprintf(stderr, "has MC returns %d, mixinClasses = %p\n",
      result, mixinClasses);*/
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * IsSubType --
 *
 *      Check, whether a class is a subclass of another class.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool
IsSubType(NsfClass *subClass, const NsfClass *class) {
  bool result;

  nonnull_assert(subClass != NULL);
  nonnull_assert(class != NULL);

  if (class != subClass) {
    result = (NsfClassListFind(PrecedenceOrder(subClass), class) != NULL);
  } else {
    result = NSF_TRUE;
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * HasMixin --
 *
 *      Check, whether the specified object the specified class as mixin.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool HasMixin(Tcl_Interp *interp, NsfObject *object, NsfClass *class)
  nonnull(1) nonnull(2) nonnull(3);

static bool
HasMixin(Tcl_Interp *interp, NsfObject *object, NsfClass *class) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(class != NULL);

  if ((object->flags & NSF_MIXIN_ORDER_VALID) == 0u) {
    MixinComputeDefined(interp, object);
  }
  if ((object->flags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) != 0u) {
    NsfCmdList *ml;

    for (ml = object->mixinOrder; ml != NULL; ml = ml->nextPtr) {
      NsfClass *mixinClass = NsfGetClassFromCmdPtr(ml->cmdPtr);

      if (mixinClass == class) {
        return NSF_TRUE;
      }
    }
  }
  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * ImportInstVarIntoCurrentScope --
 *
 *      Import an instance variable into the current variable scope
 *      (e.g. function scope).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int ImportInstVarIntoCurrentScope(Tcl_Interp *interp, const char *cmdName, NsfObject *object,
                                         Tcl_Obj *varName, Tcl_Obj *newName)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static int
ImportInstVarIntoCurrentScope(Tcl_Interp *interp, const char *cmdName, NsfObject *object,
                              Tcl_Obj *varName, Tcl_Obj *newName) {
  Var           *otherPtr = NULL, *arrayPtr;
  unsigned int   flogs = TCL_LEAVE_ERR_MSG;
  Tcl_CallFrame *varFramePtr;
  CallFrame      frame, *framePtr = &frame;
  const char    *varNameString;

  nonnull_assert(interp != NULL);
  nonnull_assert(cmdName != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(varName != NULL);

  if (unlikely(CheckVarName(interp, ObjStr(varName)) != TCL_OK)) {
    return TCL_ERROR;
  }

  Nsf_PushFrameObj(interp, object, framePtr);
  if (object->nsPtr != NULL) {
    flogs = flogs|TCL_NAMESPACE_ONLY;
  }

  otherPtr = TclObjLookupVar(interp, varName, NULL, (int)flogs, "define",
                             /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
  Nsf_PopFrameObj(interp, framePtr);

  if (unlikely(otherPtr == NULL)) {
    return NsfPrintError(interp, "can't import variable %s into method scope: "
                         "can't find variable on %s",
                         ObjStr(varName), ObjectName_(object));
  }

  /*
   * if newName == NULL -> there is no alias, use varName
   * as target link name
   */
  if (newName == NULL) {
    /*
     * Variable link into namespace cannot be an element in an array.
     * see Tcl_VariableObjCmd ...
     */
    if (arrayPtr != NULL) {
      return NsfPrintError(interp, "can't make instance variable %s on %s: "
                           "Variable cannot be an element in an array; use e.g. an alias.",
                           ObjStr(varName), ObjectName_(object));
    }

    newName = varName;
  }
  varNameString = ObjStr(newName);
  varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp);

  /*
   * If we are executing inside a Tcl procedure, create a local
   * variable linked to the new namespace variable "varName".
   */
  if (varFramePtr != NULL && (Tcl_CallFrame_isProcCallFrame(varFramePtr) & FRAME_IS_PROC)) {
    Var *varPtr = (Var *)CompiledLocalsLookup((CallFrame *)varFramePtr, varNameString);
    int new = 0;

    if (varPtr == NULL) {
      /*
       * Look in frame's local var hash-table.
       */
      TclVarHashTable *varTablePtr = Tcl_CallFrame_varTablePtr(varFramePtr);

      if (varTablePtr == NULL) {
        /*
         * The variable table does not exist. This seems to be is the
         * first access to a variable on this frame. We create the and
         * initialize the variable hash-table and update the object
         */
        /*fprintf(stderr, "+++ create varTable in ImportInstVarIntoCurrentScope\n");*/
        Tcl_CallFrame_varTablePtr(varFramePtr) = varTablePtr = VarHashTableCreate();
      }
      varPtr = VarHashCreateVar(varTablePtr, newName, &new);
    }

    /*
     * If we define an alias (newName != varName), be sure that
     * the target does not exist already.
     */
    if (new == 0) {
      /*fprintf(stderr, "GetIntoScope create alias\n");*/
      if (unlikely(varPtr == otherPtr)) {
        return NsfPrintError(interp, "can't instvar to variable itself");
      }
      if (TclIsVarLink(varPtr)) {
        /*
         * We try to make the same instvar again ... this is ok
         */
        Var *linkPtr = TclVarValue(Var, varPtr, linkPtr);
        if (linkPtr == otherPtr) {
          return TCL_OK;
        }

        /*fprintf(stderr, "linkvar flags=%x\n", linkPtr->flags);
          Tcl_Panic("new linkvar %s... When does this happen?", ObjStr(newName), NULL);*/

        /*
         * We have already a variable with the same name imported
         * from a different object. Get rid of this old variable.
         */
        VarHashRefCount(linkPtr)--;
        if (TclIsVarUndefined(linkPtr)) {
          TclCleanupVar(linkPtr, (Var *) NULL);
        }

      } else if (unlikely(TclIsVarUndefined(varPtr) == 0)) {
        return NsfPrintError(interp, "varName '%s' exists already", varNameString);
      } else if (unlikely(TclIsVarTraced(varPtr) != 0)) {
        return NsfPrintError(interp, "varName '%s' has traces: can't use for instvar", varNameString);
      }
    }

    TclSetVarLink(varPtr);
    TclClearVarUndefined(varPtr);
    varPtr->value.linkPtr = otherPtr;
    VarHashRefCount(otherPtr)++;

    /* fprintf(stderr, "defining an alias var='%s' in obj %s fwd %d flags %x isLink %d isTraced %d isUndefined %d\n",
            ObjStr(newName), ObjectName(object),
            0,
            varPtr->flags,
            TclIsVarLink(varPtr), TclIsVarTraced(varPtr), TclIsVarUndefined(varPtr));
    */
  } else {
    return NsfPrintError(interp, "%s cannot import variable '%s' into method scope; "
                         "not called from a method frame", cmdName, varNameString);
  }
  return TCL_OK;
}



/*
 *----------------------------------------------------------------------
 * SetInstVar --
 *
 *      Set an instance variable of the specified object to the given value.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Set instance variable.
 *
 *----------------------------------------------------------------------
 */
static int
SetInstVar(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *nameObj, Tcl_Obj *valueObj, unsigned int flags) {
  CallFrame frame, *framePtr = &frame;
  Tcl_Obj *resultObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(nameObj != NULL);

  Nsf_PushFrameObj(interp, object, framePtr);

  if ((flags & NSF_VAR_TRIGGER_TRACE) != 0u) {
    int tclVarFlags;
    /*
     * The command should trigger traces, use therefore the high-level Tcl_Obj*
     * interface.
     */

    tclVarFlags = (object->nsPtr != NULL) ? TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY : TCL_LEAVE_ERR_MSG;
    if (likely(valueObj == NULL)) {
      resultObj = Tcl_ObjGetVar2(interp, nameObj, NULL, tclVarFlags);
    } else {
      resultObj = Tcl_ObjSetVar2(interp, nameObj, NULL, valueObj, tclVarFlags);
    }
  } else {
    /*
     * The command should not trigger traces, use the low-level TclLookupVar()
     * interface.
     */
    Var *arrayPtr, *varPtr;

    if (likely(valueObj == NULL)) {

      varPtr = TclLookupVar(interp, ObjStr(nameObj), NULL, TCL_LEAVE_ERR_MSG, "access",
                            /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
      if (likely(varPtr != NULL)) {
        resultObj = varPtr->value.objPtr;
      } else {
        resultObj = NULL;
      }

    } else {
      Tcl_Obj *oldValuePtr;

      varPtr = TclLookupVar(interp, ObjStr(nameObj), NULL, TCL_LEAVE_ERR_MSG, "access",
                            /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
      oldValuePtr = varPtr->value.objPtr;
      INCR_REF_COUNT2("SetInstVar", valueObj);
      varPtr->value.objPtr = valueObj;
      if (oldValuePtr != NULL) {
        DECR_REF_COUNT2("SetInstVar", oldValuePtr);
      }
      resultObj = valueObj;
    }
  }
  Nsf_PopFrameObj(interp, framePtr);

  if (likely(resultObj != NULL)) {
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
  }

  return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 * SetInstArray --
 *
 *      Set an instance variable array of the specified object to the given
 *      value. This function performs essentially an "array set" or "array get"
 *      operation.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Set instance variable.
 *
 *----------------------------------------------------------------------
 */
static int SetInstArray(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *arrayNameObj, Tcl_Obj *valueObj)
  nonnull(1) nonnull(2) nonnull(3);

static int
SetInstArray(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *arrayNameObj, Tcl_Obj *valueObj) {
  CallFrame frame, *framePtr = &frame;
  int result;
  Tcl_Obj *ov[4];

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(arrayNameObj != NULL);

  Nsf_PushFrameObj(interp, object, framePtr);

  ov[0] = NsfGlobalObjs[NSF_ARRAY];
  ov[2] = arrayNameObj;

  INCR_REF_COUNT(arrayNameObj);
  if (valueObj == NULL) {
    /*
     * Perform an "array get"
     */
    ov[1] = NsfGlobalObjs[NSF_GET];
    result = Tcl_EvalObjv(interp, 3, ov, 0);
  } else {
    /*
     * Perform an "array set"
     */
    ov[1] = NsfGlobalObjs[NSF_SET];
    ov[3] = valueObj;
    INCR_REF_COUNT(valueObj);
    result = Tcl_EvalObjv(interp, 4, ov, 0);
    DECR_REF_COUNT(valueObj);
  }
  DECR_REF_COUNT(arrayNameObj);
  Nsf_PopFrameObj(interp, framePtr);

  return result;
}


/*
 *----------------------------------------------------------------------
 * UnsetInstVar --
 *
 *      Unset an instance variable of the specified object.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Variable unset.
 *
 *----------------------------------------------------------------------
 */

static int
UnsetInstVar(Tcl_Interp *interp, int withNocomplain, NsfObject *object, const char *name) {
  CallFrame frame, *framePtr = &frame;
  unsigned int flags;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(name != NULL);

  flags = (withNocomplain != 0) ? 0 : TCL_LEAVE_ERR_MSG;
  if (object->nsPtr != NULL) {
    flags |= TCL_NAMESPACE_ONLY;
  }

  Nsf_PushFrameObj(interp, object, framePtr);
  result = Tcl_UnsetVar2(interp, name, NULL, (int)flags);
  Nsf_PopFrameObj(interp, framePtr);

  return (withNocomplain != 0) ? TCL_OK : result;
}

/*
 *----------------------------------------------------------------------
 * NsfSetterMethod --
 *
 *      This Tcl_ObjCmdProc is called, when a setter method is invoked. A setter
 *      is a method that accesses/modifies a same-named instance variable. If
 *      the setter is called without arguments, it returns the values, if it is
 *      called with one argument, the argument is used as new value.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Can set an instance variable.
 *
 *----------------------------------------------------------------------
 */
static int NsfSetterMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(4);

static int
NsfSetterMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
  SetterCmdClientData *cd;
  NsfObject           *object;
  int                  result;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  cd = (SetterCmdClientData *)clientData;
  object = cd->object;

  if (objc > 2) {
    Tcl_Obj *pathObj = NsfMethodNamePath(interp,
                                         CallStackGetTclFrame(interp, NULL, 1),
                                         NsfMethodName(objv[0]));
    INCR_REF_COUNT(pathObj);
    result = NsfObjWrongArgs(interp, "wrong # args", object->cmdName,
                             pathObj, "?value?");
    DECR_REF_COUNT(pathObj);
  } else if (object == NULL) {
    result = NsfDispatchClientDataError(interp, clientData, "object", ObjStr(objv[0]));

  } else {
    Tcl_Obj    *nameObj;
    const char *nameString = ObjStr(objv[0]);

    /*
     * When the setter method is called with a leading colon, pass plain
     * object to SetInstVar(), otherwise we might run into shimmering with
     * tclCmds.
     */
    if (FOR_COLON_RESOLVER(nameString)) {
      nameString ++;
      nameObj = Tcl_NewStringObj(nameString, -1);
      INCR_REF_COUNT(nameObj);
    } else {
      nameObj = objv[0];
    }

    if (cd->paramsPtr != NULL && objc == 2) {
      Tcl_Obj   *outObjPtr;
      unsigned   flags = 0u;
      ClientData checkedData;

      result = ArgumentCheck(interp, objv[1], cd->paramsPtr,
                             RUNTIME_STATE(interp)->doCheckArguments,
                             &flags, &checkedData, &outObjPtr);

      if (likely(result == TCL_OK)) {
        result = SetInstVar(interp, object, nameObj, outObjPtr, NSF_VAR_TRIGGER_TRACE);
      }

      if ((flags & NSF_PC_MUST_DECR) != 0u) {
        DECR_REF_COUNT2("valueObj", outObjPtr);
      }
    } else {
      result = SetInstVar(interp, object, nameObj, objc == 2 ? objv[1] : NULL, NSF_VAR_TRIGGER_TRACE);
    }
    if (nameObj != objv[0]) {
      DECR_REF_COUNT(nameObj);
    }
  }
  return result;
}


/*
 *----------------------------------------------------------------------
 * NsfForwardPrintError --
 *
 *      Helper function to print either an error message directly to
 *      call the forwarder specific callback method specified in
 *      tcd->onerror. Background: ForwardArg() is called at run time to
 *      substitute the argument list. Catching such errors is not
 *      conveniently doable via catch, since it would be necessary to
 *      wrap every possible usage of a forwarder in a catch. Therefore,
 *      the callback function can be used to give a sensible error
 *      message appropriate for each context.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Potential side effects through the script.
 *
 *----------------------------------------------------------------------
 */
static int
NsfForwardPrintError(Tcl_Interp *interp, ForwardCmdClientData *tcd,
                     int objc, Tcl_Obj *const objv[],
                     const char *fmt, ...)
  nonnull(1) nonnull(2) nonnull(5) NSF_attribute_format((printf,5,6));

static int
NsfForwardPrintError(Tcl_Interp *interp, ForwardCmdClientData *tcd,
                     int objc, Tcl_Obj *const objv[],
                     const char *fmt, ...) {
  Tcl_DString ds;
  va_list ap;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(tcd != NULL);
  nonnull_assert(fmt != NULL);

  Tcl_DStringInit(&ds);

  va_start(ap, fmt);
  NsfDStringVPrintf(&ds, fmt, ap);
  va_end(ap);

  //fprintf(stderr, "==== DEBUG AppVeyor: error msg<<%s>> (len %d)\n", ds.string, ds.length);

  if (tcd->onerror != NULL) {
    Tcl_Obj *script = Tcl_DuplicateObj(tcd->onerror);
    Tcl_Obj *cmd;

    if (tcd->object != NULL) {
      cmd = Tcl_DuplicateObj(tcd->object->cmdName);
      if (objc > 0) {
        Tcl_Obj *methodObjPath = NsfMethodNamePath(interp,
                                                   CallStackGetTclFrame(interp, NULL, 1),
                                                   MethodName(objv[0]));
        INCR_REF_COUNT(methodObjPath);
        Tcl_ListObjAppendList(interp, cmd, methodObjPath);
        DECR_REF_COUNT(methodObjPath);

        if (objc > 1) {
          Tcl_ListObjAppendElement(interp, cmd,  Tcl_NewListObj(objc-1, objv+1));
        }
      }
    } else {
      cmd = Tcl_NewListObj(objc, objv);
    }

    Tcl_ListObjAppendElement(interp, script,  cmd);
    Tcl_ListObjAppendElement(interp, script,
                             Tcl_NewStringObj(Tcl_DStringValue(&ds),
                                              Tcl_DStringLength(&ds)));
    INCR_REF_COUNT(script);
    result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT);
    DECR_REF_COUNT(script);
  } else {
    result = NsfPrintError(interp, "%s", Tcl_DStringValue(&ds));
  }

  Tcl_DStringFree(&ds);
  return result;
}

/*
 *----------------------------------------------------------------------
 * ForwardArg --
 *
 *      This function is a helper function of NsfForwardMethod() and
 *      processes a single entry (ForwardArgObj) of the forward
 *      spec. Essentially, it performs the percent substitution of the
 *      forward spec.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Updates the provided output arguments.
 *
 *----------------------------------------------------------------------
 */
static int ForwardArg(
    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    Tcl_Obj *forwardArgObj, ForwardCmdClientData *tcd, Tcl_Obj **out,
    Tcl_Obj **freeListObjPtr, int *inputArg, long *mapvalue,
    int firstPosArg, int *outputincr
) nonnull(1) nonnull(3) nonnull(4) nonnull(5) nonnull(6) nonnull(7) nonnull(8) nonnull(9) nonnull(11);

static int
ForwardArg(
    Tcl_Interp *interp,
    int objc, Tcl_Obj *const objv[],
    Tcl_Obj *forwardArgObj,
    ForwardCmdClientData *tcd,
    Tcl_Obj **out,
    Tcl_Obj **freeListObjPtr,
    int *inputArg,
    long *mapvalue,
    int firstPosArg,
    int *outputincr
) {
  const char *ForwardArgString, *p;
  int         totalargs, result = TCL_OK;
  char        c;

  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(forwardArgObj != NULL);
  nonnull_assert(tcd != NULL);
  nonnull_assert(out != NULL);
  nonnull_assert(freeListObjPtr != NULL);
  nonnull_assert(inputArg != NULL);
  nonnull_assert(mapvalue != NULL);
  nonnull_assert(outputincr != NULL);

  assert(objc >= 1);

  totalargs = objc + tcd->nr_args - 1;
  /*
   * Per default every ForwardArgString from the processed list corresponds to
   * exactly one ForwardArgString in the computed final list.
   */
  *outputincr = 1;
  ForwardArgString = ObjStr(forwardArgObj);
  p = ForwardArgString;

  /* fprintf(stderr, "ForwardArg: processing '%s'\n", ForwardArgString);*/

  c = *ForwardArgString;
  if (c == '%' && *(ForwardArgString+1) == '@') {
    char *remainder = NULL;
    long  pos;

    ForwardArgString += 2;
    pos = strtol(ForwardArgString, &remainder, 0);
    if (ForwardArgString == remainder && *ForwardArgString == 'e'
        && !strncmp(ForwardArgString, "end", 3)) {
      pos = -1;
      remainder += 3;
    } else if (pos < 0) {
      pos --;
    }
    if (ForwardArgString == remainder || labs(pos) > totalargs) {
      return NsfForwardPrintError(interp, tcd, objc, objv,
                                  "forward: invalid index specified in argument %s",
                                  ObjStr(forwardArgObj));
    }
    if (!remainder || *remainder != ' ') {
      return NsfForwardPrintError(interp, tcd, objc, objv,
                                  "forward: invalid syntax in '%s'; use: %%@<pos> <cmd>",
                                  ObjStr(forwardArgObj));
    }

    ForwardArgString = remainder + 1;
    /*
     * In case we address from the end, we reduce further to distinguish from
     * -1 (void)
     */
    if (pos < 0) {
      pos--;
    }
    /*fprintf(stderr, "remainder = '%s' pos = %ld\n", remainder, pos);*/
    *mapvalue = pos;
    c = *ForwardArgString;
  }

  if (c == '%') {
    Tcl_Obj    *listObj = NULL, **listElements = NULL;
    int         nrArgs = objc-1, nrPosArgs = objc - firstPosArg, nrElements = 0;
    char        c1, *firstActualArgument = nrArgs > 0 ? ObjStr(objv[1]) : NULL;
    const char *c1Ptr;

    assert(nrPosArgs >= 0);
    assert(nrArgs >= 0);

    c = *++ForwardArgString;
    c1Ptr = ForwardArgString + 1;
    c1 = *c1Ptr;

    if (c == 's' && !strcmp(ForwardArgString, "self")) {
      *out = tcd->object->cmdName;
    } else if ((c == 'p' && !strcmp(ForwardArgString, "proc"))
               || (c == 'm' && !strcmp(ForwardArgString, "method"))
               ) {
      const char *methodName = ObjStr(objv[0]);

      /*
       * If we dispatch a method via ".", we do not want to see the "." in the
       * %proc, e.g. for the interceptor slots (such as mixin, ...)
       */
      if (FOR_COLON_RESOLVER(methodName)) {
        *out = Tcl_NewStringObj(methodName + 1, -1);
      } else {
        *out = objv[0];
      }
      AddObjToTclList(interp, freeListObjPtr, *out);
    } else if (c == '1' && (c1 == '\0' || NsfHasTclSpace(c1Ptr))) {

      if (c1 != '\0') {
        if (unlikely(Tcl_ListObjIndex(interp, forwardArgObj, 1, &listObj) != TCL_OK)) {
          return NsfForwardPrintError(interp, tcd, objc, objv,
                                      "forward: %%1 must be followed by a valid list, given: '%s'",
                                      ObjStr(forwardArgObj));
        }
        if (unlikely(Tcl_ListObjGetElements(interp, listObj, &nrElements, &listElements) != TCL_OK)) {
          return NsfForwardPrintError(interp, tcd, objc, objv,
                                      "forward: %%1 contains invalid list '%s'",
                                      ObjStr(listObj));
        }
      } else if (unlikely(tcd->subcommands != NULL)) {
        /*
         * This is a deprecated part, kept for backwards compatibility.
         */
        if (Tcl_ListObjGetElements(interp, tcd->subcommands, &nrElements, &listElements) != TCL_OK) {
          return NsfForwardPrintError(interp, tcd, objc, objv,
                                      "forward: %%1 contains invalid list '%s'",
                                      ObjStr(tcd->subcommands));
        }
      } else {
        assert(nrElements <= nrPosArgs);
      }
      /*fprintf(stderr, "nrElements=%d, nra=%d firstPos %d objc %d\n",
        nrElements, nrArgs, firstPosArg, objc);*/

      if (nrElements > nrPosArgs) {
        /*
         * Insert default subcommand depending on number of arguments.
         */
        assert(listElements != NULL);
        /*fprintf(stderr, "inserting listElements[%d] '%s'\n", nrPosArgs,
          ObjStr(listElements[nrPosArgs]));*/
        *out = listElements[nrPosArgs];
      } else if (objc <= 1) {

        result = NsfForwardPrintError(interp, tcd, objc, objv,
                                      "%%1 requires argument; should be \"%s arg ...\"",
                                      ObjStr(objv[0]));
      } else {
        /*fprintf(stderr, "copying %%1: '%s'\n", ObjStr(objv[firstPosArg]));*/
        *out = objv[firstPosArg];
        *inputArg = firstPosArg+1;
      }
    } else if (c == '-') {
      const char *firstElementString;
      int         insertRequired;
      bool        done = NSF_FALSE;

      /*fprintf(stderr, "process flag '%s'\n", firstActualArgument);*/
      if (Tcl_ListObjGetElements(interp, forwardArgObj, &nrElements, &listElements) != TCL_OK) {
        return NsfForwardPrintError(interp, tcd, objc, objv,
                                    "forward: '%s' is not a valid list",
                                    ForwardArgString);
      }
      if (nrElements < 1 || nrElements > 2) {
        return NsfForwardPrintError(interp, tcd, objc, objv,
                                    "forward: '%s': must contain 1 or 2 arguments",
                                    ForwardArgString);
      }
      firstElementString = ObjStr(listElements[0]);
      firstElementString++; /* we skip the dash */

      if (firstActualArgument && *firstActualArgument == '-') {
        int i;

        /*fprintf(stderr, "we have a flag in first argument '%s'\n", firstActualArgument);*/
        for (i = 1; i < firstPosArg; i++) {
          if (strcmp(firstElementString, ObjStr(objv[i])) == 0) {
            /*fprintf(stderr, "We have a MATCH for '%s' oldInputArg %d\n", ForwardArgString, *inputArg);*/
            *out = objv[i];
            /* %1 will start at a different place. Proceed if necessary to firstPosArg */
            if (*inputArg < firstPosArg) {
              *inputArg = firstPosArg;
            }
            done = NSF_TRUE;
            break;
          }
        }
      }

      if (! done) {
        /*
         * We have a flag in the actual arguments that does not match.  We
         * proceed to the actual arguments without dashes.
         */
        if (*inputArg < firstPosArg) {
          *inputArg = firstPosArg;
        }
        /*
         * If the user requested we output the argument also when not
         * given in the argument list.
         */
        if (nrElements == 2
            && Tcl_GetIntFromObj(interp, listElements[1], &insertRequired) == TCL_OK
            && insertRequired) {
          /*
           * No match, but insert of flag is required.
           */
          /*fprintf(stderr, "no match, but insert of %s required\n", firstElementString);*/
          *out = Tcl_NewStringObj(firstElementString, -1);
          *outputincr = 1;

          AddObjToTclList(interp, freeListObjPtr, *out);
        } else {
          /*
           * No match, no insert of flag required, we skip the forwarder
           * option and output nothing.
           */
          /*fprintf(stderr, "no match, nrElements %d insert req %d\n", nrElements, insertRequired);*/
          *outputincr = 0;
        }
      }

    } else if (c == 'a' && !strncmp(ForwardArgString, "argcl", 4)) {

      if (Tcl_ListObjIndex(interp, forwardArgObj, 1, &listObj) != TCL_OK) {
        result = NsfForwardPrintError(interp, tcd, objc, objv,
                                      "forward: %%argclindex must by a valid list, given: '%s'",
                                      ForwardArgString);

      } else if (Tcl_ListObjGetElements(interp, listObj, &nrElements, &listElements) != TCL_OK) {
        result = NsfForwardPrintError(interp, tcd, objc, objv,
                                      "forward: %%argclindex contains invalid list '%s'",
                                      ObjStr(listObj));

      } else if (nrArgs >= nrElements) {
        result = NsfForwardPrintError(interp, tcd, objc, objv,
                                      "forward: not enough elements in specified list of ARGC argument %s",
                                      ForwardArgString);
      } else {
        *out = listElements[nrArgs];
      }
    } else if (c == '%') {
      Tcl_Obj *newarg = Tcl_NewStringObj(ForwardArgString, -1);

      *out = newarg;
      AddObjToTclList(interp, freeListObjPtr, *out);

    } else {
      /*
       * Evaluate the given command.
       */
      /*fprintf(stderr, "evaluating '%s'\n", ForwardArgString);*/
      result = Tcl_EvalEx(interp, ForwardArgString, -1, 0);
      if (likely(result == TCL_OK)) {
        *out = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
        AddObjToTclList(interp, freeListObjPtr, *out);
        /*fprintf(stderr, "result = '%s'\n", ObjStr(*out));*/
      }
    }
  } else {
    if (likely(p == ForwardArgString)) {
      *out = forwardArgObj;
    } else {
      Tcl_Obj *newarg = Tcl_NewStringObj(ForwardArgString, -1);

      *out = newarg;
      AddObjToTclList(interp, freeListObjPtr, *out);
    }
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * CallForwarder --
 *
 *      Invoke the method to which the forwarder points. This function
 *      receives the already transformed argument vector, calls the
 *      method and performs error handling.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Maybe through the invoked command.
 *
 *----------------------------------------------------------------------
 */

static int CallForwarder(ForwardCmdClientData *tcd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(4);

static int
CallForwarder(ForwardCmdClientData *tcd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
  int        result;
  NsfObject *object;
  CallFrame  frame, *framePtr = &frame;

  nonnull_assert(tcd != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  object = tcd->object;
  tcd->object = NULL;

  if (unlikely(tcd->verbose)) {
    Tcl_Obj *cmd = Tcl_NewListObj(objc, objv);

    NsfLog(interp, NSF_LOG_DEBUG, "forwarder calls '%s'",  ObjStr(cmd));
    DECR_REF_COUNT(cmd);
  }
  if (tcd->frame == FrameObjectIdx) {
    Nsf_PushFrameObj(interp, object, framePtr);
  }
  if (tcd->objProc != NULL) {
    /*fprintf(stderr, "CallForwarder Tcl_NRCallObjProc %p\n", tcd->clientData);*/
    result = Tcl_NRCallObjProc(interp, tcd->objProc, tcd->clientData, objc, objv);
  } else if (TclObjIsNsfObject(interp, tcd->cmdName, &object)) {
    /*fprintf(stderr, "CallForwarder NsfObjDispatch object %s, objc=%d\n",
      ObjStr(tcd->cmdName), objc);*/
    if (likely(objc > 1)) {
      result = ObjectDispatch(object, interp, objc, objv, NSF_CSC_IMMEDIATE);
    } else {
      result = DispatchDefaultMethod(interp, object, objv[0], NSF_CSC_IMMEDIATE);
    }
  } else {
    /*fprintf(stderr, "CallForwarder: no nsf object %s [0] %s\n", ObjStr(tcd->cmdName), ObjStr(objv[0]));*/
    result = Tcl_EvalObjv(interp, objc, objv, 0);
  }

  if (tcd->frame == FrameObjectIdx) {
    Nsf_PopFrameObj(interp, framePtr);
  }

#if defined(NSF_FORWARD_WITH_ONERROR)
  if (unlikely(result == TCL_ERROR && tcd->onerror != NULL)) {
    Tcl_Obj *resultObj = Tcl_GetObjResult(interp);
    const char *errorMsg =  ObjStr(resultObj);

    INCR_REF_COUNT(resultObj);
    //fprintf(stderr, "==== DEBUG AppVeyor: calling NsfForwardPrintError with <<%s>> (len %lu)\n",
    //        errorMsg, (unsigned long)strlen(errorMsg));
    result = NsfForwardPrintError(interp, tcd, objc, objv, "%s", errorMsg);
    DECR_REF_COUNT(resultObj);
  }
#endif

  return result;
}

/*
 *----------------------------------------------------------------------
 * NsfForwardMethod --
 *
 *      This Tcl_ObjCmdProc is called, when a forwarder is invoked. It
 *      performs argument substitution through ForwardArg() and calls
 *      finally the method, to which the call was forwarded via
 *      CallForwarder().
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Maybe through the invoked command.
 *
 *----------------------------------------------------------------------
 */

static int NsfForwardMethod(ClientData clientData, Tcl_Interp *interp,
                            int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(4);

static int
NsfForwardMethod(ClientData clientData, Tcl_Interp *interp,
                   int objc, Tcl_Obj *const objv[]) {
  ForwardCmdClientData *tcd = (ForwardCmdClientData *)clientData;
  int                   result, inputArg = 1;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  if (unlikely(!tcd || !tcd->object)) {
    return NsfDispatchClientDataError(interp, tcd, "object",
                                      objc > 0 ? ObjStr(objv[0]) : "forwarder");
  }

  /*
   * First, we handle two short cuts for simple cases.
   */

  if (tcd->passthrough) {
    /*
     * This is set for early binding. This means, that the cmd is already
     * resolved, we have to care only for objscope.
     */
    return CallForwarder(tcd, interp, objc, objv);

  } else if (tcd->args == NULL && *(ObjStr(tcd->cmdName)) != '%') {
    /*
     * We have no args, therefore, we have only to replace the method name
     * with the given cmd name.
     */
    ALLOC_ON_STACK(Tcl_Obj*, objc, ov);
    /*fprintf(stderr, "+++ forwardMethod must subst oc=%d <%s>\n",
      objc, ObjStr(tcd->cmdName));*/
    memcpy(ov, objv, sizeof(Tcl_Obj *) * (size_t)objc);
    ov[0] = tcd->cmdName;
    result = CallForwarder(tcd, interp, objc, ov);
    FREE_ON_STACK(Tcl_Obj *, ov);
    return result;

  } else {
    Tcl_Obj **ov, *freeList = NULL;
    int       j, outputincr, outputArg = 0, firstPosArg=1,
              totalargs = objc + tcd->nr_args + 3;

    ALLOC_ON_STACK(Tcl_Obj*, totalargs, OV);
    {
      ALLOC_ON_STACK(long, totalargs, objvmap);

      /*fprintf(stderr, "+++ forwardMethod standard case, allocated %d args, tcd->args %s\n",
        totalargs, ObjStr(tcd->args));*/

      ov = &OV[1];
      if (tcd->needobjmap) {
        memset(objvmap, -1, sizeof(long) * (size_t)totalargs);
      }

      /*
       * The first argument is always the command, to which we forward.
       */
      if ((result = ForwardArg(interp, objc, objv, tcd->cmdName, tcd,
                               &ov[outputArg], &freeList, &inputArg,
                               &objvmap[outputArg],
                               firstPosArg, &outputincr)) != TCL_OK) {
        goto exitforwardmethod;
      }
      outputArg += outputincr;

      /*
       * If we have non-pos args, determine the first positional arg position
       * for %1
       */
      if (tcd->hasNonposArgs) {
        firstPosArg = objc;
        for (j = outputArg; j < objc; j++) {
          const char *arg = ObjStr(objv[j]);
          if (*arg != '-') {
            firstPosArg = j;
            break;
          }
        }
      }

      if (tcd->args != NULL) {
        Tcl_Obj **listElements;
        int       nrElements;

        /*
         * Copy argument list from the definitions.
         */
        Tcl_ListObjGetElements(interp, tcd->args, &nrElements, &listElements);

        for (j = 0; j < nrElements; j++, outputArg += outputincr) {
          if ((result = ForwardArg(interp, objc, objv, listElements[j], tcd,
                                   &ov[outputArg], &freeList, &inputArg,
                                   &objvmap[outputArg],
                                   firstPosArg, &outputincr)) != TCL_OK) {
            goto exitforwardmethod;
          }
        }
      }

      /*fprintf(stderr, "objc=%d, tcd->nr_subcommands=%d size=%d\n",
        objc, tcd->nr_subcommands, objc+ 2            );*/

      if (objc-inputArg > 0) {
        /*fprintf(stderr, "  copying remaining %d args starting at [%d]\n",
          objc-inputArg, outputArg);*/
        memcpy(ov+outputArg, objv+inputArg, sizeof(Tcl_Obj *) * ((size_t)objc - (size_t)inputArg));
      } else {
        /*fprintf(stderr, "  nothing to copy, objc=%d, inputArg=%d\n", objc, inputArg);*/
      }
      if (tcd->needobjmap) {
        /*
         * The objmap can shuffle the argument list. We have to set the
         * addressing relative from the end; -2 means last, -3 element before
         * last, etc.
         */
        int max = objc + tcd->nr_args - inputArg;

        for (j = 0; j < totalargs; j++) {
          if (objvmap[j] < -1) {
            /*fprintf(stderr, "must reduct, v=%d\n", objvmap[j]);*/
            objvmap[j] = max + objvmap[j] + 2;
            /*fprintf(stderr, "... new value=%d, max = %d\n", objvmap[j], max);*/
          }
        }
      }
      objc += outputArg - inputArg;

#if 0
      for(j = 0; j < objc; j++) {
        /*fprintf(stderr, "  ov[%d]=%p, objc=%d\n", j, ov[j], objc);*/
        fprintf(stderr, " o[%d]=%p %s (%d),", j, ov[j], ov[j] ? ObjStr(ov[j]) : "NADA", objvmap[j]);
      }
      fprintf(stderr, "\n");
#endif

      if (tcd->needobjmap) {

        for (j = 0; j < totalargs; j++) {
          Tcl_Obj *tmp;
          long     pos = objvmap[j], i;

          if (pos == -1 || pos == j) {
            continue;
          }
          tmp = ov[j];
          if (j > pos) {
            for(i = j; i > pos; i--) {
              /*fprintf(stderr, "...moving right %d to %d\n", i-1, i);*/
              ov[i] = ov[i-1];
              objvmap[i] = objvmap[i-1];
            }
          } else {
            for(i = j; i < pos; i++) {
              /*fprintf(stderr, "...moving left %d to %d\n", i+1, i);*/
              ov[i] = ov[i+1];
              objvmap[i] = objvmap[i+1];
            }
          }
          /*fprintf(stderr, "...setting at %d -> %s\n", pos, ObjStr(tmp));*/
          ov[pos] = tmp;
          objvmap[pos] = -1;
        }
      }

      /*
        If a prefix is provided, it will be prepended to the 2nd argument. This
        allows for avoiding name clashes if the 2nd argument denotes a
        subcommand, for example.

        Make sure that the prefix is only prepended, if a second argument is
        actually available! Otherwise, the requested prefix has no effect.
      */
      if (tcd->prefix && objc > 1) {
        Tcl_Obj *methodName = Tcl_DuplicateObj(tcd->prefix);

        Tcl_AppendObjToObj(methodName, ov[1]);
        ov[1] = methodName;
        INCR_REF_COUNT(ov[1]);
      }

#if 0
      for(j = 0; j < objc; j++) {
        /*fprintf(stderr, "  ov[%d]=%p, objc=%d\n", j, ov[j], objc);*/
        fprintf(stderr, "  ov[%d]=%p '%s' map=%d\n", j, ov[j], ov[j] ? ObjStr(ov[j]) : "NADA", objvmap[j]);
      }
#endif

      OV[0] = tcd->cmdName;

      result = CallForwarder(tcd, interp, objc, ov);

      if (tcd->prefix && objc > 1) {
        DECR_REF_COUNT(ov[1]);
      }
    exitforwardmethod:
      if (freeList != NULL) {
        DECR_REF_COUNT2("AddObjToTclList", freeList);
      }

      FREE_ON_STACK(long, objvmap);
    }
    FREE_ON_STACK(Tcl_Obj*, OV);
  }
  return result;
}


/*
 *----------------------------------------------------------------------
 * NsfProcAliasMethod --
 *
 *      Since alias-resolving happens in dispatch, this Tcl_ObjCmdProc
 *      should never be called during normal operations. The only way to
 *      invoke this could happen via directly calling the handle.
 *
 * Results:
 *      Result is always TCL_ERROR (as returned by
 *      NsfDispatchClientDataError()).
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int NsfProcAliasMethod(ClientData clientData,
                              Tcl_Interp *interp, int UNUSED(objc),
                              Tcl_Obj *const UNUSED(objv[]))
  nonnull(1) nonnull(2) nonnull(4);

static int
NsfProcAliasMethod(ClientData clientData,
                   Tcl_Interp *interp, int UNUSED(objc),
                   Tcl_Obj *const UNUSED(objv[])) {
  AliasCmdClientData *tcd;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);

  tcd = (AliasCmdClientData *)clientData;
  return NsfDispatchClientDataError(interp, NULL, "object",
                                    Tcl_GetCommandName(interp, tcd->aliasCmd));
}


/*
 *----------------------------------------------------------------------
 * NsfObjscopedMethod --
 *
 *      This Tcl_ObjCmdProc is called, when an obj-scoped alias is
 *      invoked.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Maybe through the invoked command.
 *
 *----------------------------------------------------------------------
 */

static int NsfObjscopedMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(4);

static int
NsfObjscopedMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
  AliasCmdClientData *tcd;
  NsfObject          *object;
  CallFrame           frame, *framePtr = &frame;
  int                 result;

  nonnull_assert(clientData != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  tcd = (AliasCmdClientData *)clientData;
  /*fprintf(stderr, "objscopedMethod obj=%p %s, ptr=%p\n", object, ObjectName(object), tcd->objProc);*/

  object = tcd->object;
  tcd->object = NULL;

  Nsf_PushFrameObj(interp, object, framePtr);
  result = Tcl_NRCallObjProc(interp, tcd->objProc, tcd->clientData, objc, objv);
  Nsf_PopFrameObj(interp, framePtr);

  return result;
}

/*
 *----------------------------------------------------------------------
 * IsDashArg --
 *
 *      Check, whether the provided argument (pointed to be the index
 *      isFirstArg) starts with a "-", or is a list starting with a
 *      "-". The method returns via **methodName the name of the dashed
 *      argument (without the dash).
 *
 * Results:
 *      Enum value dashArgType.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

typedef enum {NO_DASH, SCALAR_DASH, LIST_DASH} dashArgType;

static dashArgType IsDashArg(Tcl_Interp *interp, Tcl_Obj *obj, int isFirstArg, const char **methodName,
                             int *objcPtr, Tcl_Obj **objvPtr[])
  nonnull(1) nonnull(2) nonnull(4) nonnull(5) nonnull(6);

static dashArgType
IsDashArg(Tcl_Interp *interp, Tcl_Obj *obj, int isFirstArg, const char **methodName,
          int *objcPtr, Tcl_Obj **objvPtr[]) {
  const char *flag;

  nonnull_assert(interp != NULL);
  nonnull_assert(obj != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(objcPtr != NULL);
  nonnull_assert(objvPtr != NULL);

  if (obj->typePtr == Nsf_OT_listType) {
    if (Tcl_ListObjGetElements(interp, obj, objcPtr, objvPtr) == TCL_OK && *objcPtr > 1) {
      flag = ObjStr(*objvPtr[0]);
      /*fprintf(stderr, "we have a list starting with '%s'\n", flag);*/
      if (*flag == '-') {
        *methodName = flag+1;
        return LIST_DASH;
      }
    }
  }
  flag = ObjStr(obj);
  /*fprintf(stderr, "we have a scalar '%s' isFirstArg %d\n", flag, isFirstArg);*/

  if ((*flag == '-') && isalpha(*((flag)+1))) {
    if (isFirstArg == 1) {
      /*
       * If the argument contains a space, try to split.
       */
      const char *p = flag+1;

      while (*p != '\0' && !NsfHasTclSpace(p)) p++;
      if (NsfHasTclSpace(p)) {
        if (Tcl_ListObjGetElements(interp, obj, objcPtr, objvPtr) == TCL_OK) {
          *methodName = ObjStr(*objvPtr[0]);
          if (**methodName == '-') {
            (*methodName)++ ;
          }
          return LIST_DASH;
        }
      }
    }
    *methodName = flag+1;
    *objcPtr = 1;
    return SCALAR_DASH;
  }
  return NO_DASH;
}

/*
 *----------------------------------------------------------------------
 * CallConfigureMethod --
 *
 *      Call a method identified by a string selector; or provide an
 *      error message. This dispatcher function records as well
 *      constructor (init) calls via this interface. The dispatcher is
 *      used in XOTcl's configure(), interpreting arguments with a
 *      leading dash as method dispatches.  This behavior is now
 *      implemented in NsfOResidualargsMethod().
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Maybe side effects from the called methods.
 *
 *----------------------------------------------------------------------
 */
static int CallConfigureMethod(Tcl_Interp *interp, NsfObject *object, const char *initString,
                               const char *methodName,
                               int argc, Tcl_Obj *const argv[])
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static int
CallConfigureMethod(Tcl_Interp *interp, NsfObject *object, const char *initString,
                    const char *methodName,
                    int argc, Tcl_Obj *const argv[]) {
  int result;
  Tcl_Obj *methodObj = Tcl_NewStringObj(methodName, -1);

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(initString != NULL);
  nonnull_assert(methodName != NULL);

  /*
   * When configure gets "-init" passed, we call "init" and notice the fact it
   * in the object's flags.
   */

  if (*initString == *methodName && strcmp(methodName, initString) == 0) {
    object->flags |= NSF_INIT_CALLED;
  }

  Tcl_ResetResult(interp);
  INCR_REF_COUNT(methodObj);
  result = CallMethod(object, interp, methodObj, argc, argv,
                      NSF_CM_NO_UNKNOWN|NSF_CSC_IMMEDIATE|NSF_CM_IGNORE_PERMISSIONS);
  DECR_REF_COUNT(methodObj);

  /*fprintf(stderr, "method  '%s' called args: %d o=%p, result=%d %d\n",
    methodName, argc+1, object, result, TCL_ERROR);*/

  if (unlikely(result != TCL_OK)) {
    Tcl_Obj *res = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); /* save the result */

    INCR_REF_COUNT(res);
    NsfPrintError(interp, "%s during '%s.%s'", ObjStr(res), ObjectName_(object), methodName);
    DECR_REF_COUNT(res);
  }

  return result;
}


/*
 * class method implementations
 */

/*
 *----------------------------------------------------------------------
 * IsRootNamespace --
 *
 *      Check whether the provided namespace is the namespace of the base
 *      class of an object system.
 *
 * Results:
 *      Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool IsRootNamespace(const Tcl_Interp *interp, const Tcl_Namespace *nsPtr)
  nonnull(1) nonnull(2) NSF_pure;

static bool
IsRootNamespace(const Tcl_Interp *interp, const Tcl_Namespace *nsPtr) {
  const NsfObjectSystem *osPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(nsPtr != NULL);

  for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr != NULL; osPtr = osPtr->nextPtr) {
    const Tcl_Command cmd = osPtr->rootClass->object.id;
    if ((Tcl_Namespace *)((Command *)cmd)->nsPtr == nsPtr) {
      return NSF_TRUE;
    }
  }
  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * CallingNameSpace --
 *
 *      Find the last invocation outside the Next Scripting system
 *      namespaces. This function return the namespace of the caller but
 *      skips system-specific namespaces (e.g. the namespaces of the
 *      pre-defined slot handlers for mixin and class
 *      registration. etc.) If we would use such namespaces, we would
 *      resolve non-fully-qualified names against the root namespace).
 *
 * Results:
 *      Tcl_Namespace or NULL
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Namespace *
CallingNameSpace(Tcl_Interp *interp) {
  Tcl_CallFrame *framePtr;
  Tcl_Namespace *nsPtr = NULL;

  nonnull_assert(interp != NULL);

  /*NsfShowStack(interp);*/
  framePtr = CallStackGetActiveProcFrame((Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp));
  /* framePtr = BeginOfCallChain(interp, GetSelfObj(interp));*/

  for (; likely(framePtr != NULL); framePtr = Tcl_CallFrame_callerVarPtr(framePtr)) {
    nsPtr = Tcl_CallFrame_nsPtr(framePtr);

    if (IsRootNamespace(interp, nsPtr)) {
      /*fprintf(stderr, "... %p skip %s\n", framePtr, nsPtr->fullName);*/
      continue;
    }
    /*fprintf(stderr, "... %p take %s\n", framePtr, nsPtr->fullName); */
    break;
  }

  if (framePtr == NULL) {
    nsPtr = Tcl_GetGlobalNamespace(interp);
  }

  /*fprintf(stderr, " **** CallingNameSpace: returns %p %s framePtr %p\n",
    nsPtr, (nsPtr != NULL) ? nsPtr->fullName:"(null)", framePtr);*/
  return nsPtr;
}

/***********************************
 * argument handling
 ***********************************/

static void ArgumentResetRefCounts(const struct Nsf_Param *pPtr, Tcl_Obj *valueObj)
  nonnull(1) nonnull(2);

static void
ArgumentResetRefCounts(const struct Nsf_Param *pPtr, Tcl_Obj *valueObj) {

  nonnull_assert(pPtr != NULL);
  nonnull_assert(valueObj != NULL);

  if ((pPtr->flags & NSF_ARG_IS_CONVERTER) != 0u) {
    DECR_REF_COUNT2("valueObj", valueObj);
  }
}

/*
 *----------------------------------------------------------------------
 * ArgumentCheckHelper --
 *
 *      Helper function for ArgumentCheck() called when argument
 *      checking leads to a different output element (non-pure
 *      checking).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int ArgumentCheckHelper(Tcl_Interp *interp, Tcl_Obj *objPtr, const struct Nsf_Param *pPtr, unsigned int *flags,
                               ClientData *clientData, Tcl_Obj **outObjPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5) nonnull(6);

static int
ArgumentCheckHelper(Tcl_Interp *interp,
                    Tcl_Obj *objPtr,
                    const struct Nsf_Param *pPtr,
                    unsigned int *flags,
                    ClientData *clientData,
                    Tcl_Obj **outObjPtr) {
  int       objc, i, result;
  Tcl_Obj **ov;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(flags != NULL);
  nonnull_assert(clientData != NULL);
  nonnull_assert(outObjPtr != NULL);
  assert((pPtr->flags & NSF_ARG_MULTIVALUED) != 0u);
  assert((*flags & NSF_PC_MUST_DECR) != 0u);

  result = Tcl_ListObjGetElements(interp, objPtr, &objc, &ov);
  if (unlikely(result != TCL_OK)) {
    return result;
  }

  *outObjPtr = Tcl_NewListObj(0, NULL);
  INCR_REF_COUNT2("valueObj", *outObjPtr);

  for (i = 0; i < objc; i++) {
    Tcl_Obj    *elementObjPtr = ov[i];
    const char *valueString = ObjStr(elementObjPtr);

    if ((pPtr->flags & NSF_ARG_ALLOW_EMPTY) != 0u && *valueString == '\0') {
      result = Nsf_ConvertToString(interp, elementObjPtr, pPtr, clientData, &elementObjPtr);
    } else {
      result = (*pPtr->converter)(interp, elementObjPtr, pPtr, clientData, &elementObjPtr);
    }

    /*fprintf(stderr, "ArgumentCheckHelper convert %s result %d (%s)\n",
      valueString, result, ObjStr(elementObjPtr));*/

    if (result == TCL_OK || result == TCL_CONTINUE) {
      Tcl_ListObjAppendElement(interp, *outObjPtr, elementObjPtr);
      /*
       * If the refCount of the valueObj was already incremented, we have to
       * decrement it here, since we want the valueObj reclaimed when the list
       * containing the valueObj is freed.
       */
      ArgumentResetRefCounts(pPtr, elementObjPtr);
    } else {
      Tcl_Obj *resultObj = Tcl_GetObjResult(interp);

      INCR_REF_COUNT(resultObj);
      NsfPrintError(interp, "invalid value in \"%s\": %s", ObjStr(objPtr), ObjStr(resultObj));
      *flags &= ~NSF_PC_MUST_DECR;
      *outObjPtr = objPtr;
      DECR_REF_COUNT2("valueObj", *outObjPtr);
      DECR_REF_COUNT(resultObj);

      break;
    }
  }
  return result;
}


/*
 *----------------------------------------------------------------------
 * ArgumentCheck --
 *
 *      Check a single argument (2nd argument) against the parameter
 *      structure when argument checking is turned on (default).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int
ArgumentCheck(Tcl_Interp *interp, Tcl_Obj *objPtr, const struct Nsf_Param *pPtr,
              unsigned int doCheckArguments,
              unsigned int *flags, ClientData *clientData, Tcl_Obj **outObjPtr) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);
  nonnull_assert(pPtr != NULL);
  nonnull_assert(flags != NULL);
  nonnull_assert(clientData != NULL);
  nonnull_assert(outObjPtr != NULL);

  /*
   * Default assumption: outObjPtr is not modified.
   */
  *outObjPtr = objPtr;

  /*
   * Omit argument checking, provided that ...
   * ... argument checking is turned off *and* no converter is specified, or
   * ... the ruling parameter option is 'cmd'
   * ... slotset is active
   */
  if ((unlikely((doCheckArguments & NSF_ARGPARSE_CHECK) == 0u) && (pPtr->flags & (NSF_ARG_IS_CONVERTER)) == 0u) ||
      ((pPtr->flags & (NSF_ARG_CMD)) != 0u) ||
      ((pPtr->flags & (NSF_ARG_SLOTSET)) != 0u)) {
    /* fprintf(stderr, "*** omit  argument check for arg %s flags %.6x\n", pPtr->name, pPtr->flags); */
    *clientData = ObjStr(objPtr);
    return TCL_OK;
  }

  /*
   * If the argument is multivalued, perform the check for every element
   * of the list (pure checker), or we have to build a new list of
   * values (in case, the converter alters the values).
   */
  if (unlikely((pPtr->flags & NSF_ARG_MULTIVALUED) != 0u)) {
    int objc, i;
    Tcl_Obj **ov;

    result = Tcl_ListObjGetElements(interp, objPtr, &objc, &ov);
    if (unlikely(result != TCL_OK)) {
      return result;
    }

    if (objc == 0 && ((pPtr->flags & NSF_ARG_ALLOW_EMPTY) == 0u)) {
      return NsfPrintError(interp,
                           "invalid value for parameter '%s': list is not allowed to be empty",
                           pPtr->name);
    }

    /*
     * In cases where necessary (the output element changed), switch to the
     * helper function
     */
    for (i = 0; i < objc; i++) {
      Tcl_Obj *elementObjPtr = ov[i];

      result = (*pPtr->converter)(interp, elementObjPtr, pPtr, clientData, &elementObjPtr);
      if (likely(result == TCL_OK || result == TCL_CONTINUE)) {
        if (ov[i] != elementObjPtr) {
          /*fprintf(stderr, "ArgumentCheck: switch to output list construction for value %s\n",
            ObjStr(elementObjPtr));*/
          /*
           * The elementObjPtr differs from the input Tcl_Obj, we switch to
           * the version of this handler building an output list. But first,
           * we have to reset the ref-counts from the first conversion.
           */
          ArgumentResetRefCounts(pPtr, elementObjPtr);
          *flags |= NSF_PC_MUST_DECR;
          result = ArgumentCheckHelper(interp, objPtr, pPtr, flags, clientData, outObjPtr);
          break;
        }
      } else {
        Tcl_Obj *resultObj = Tcl_GetObjResult(interp);
        INCR_REF_COUNT(resultObj);
        NsfPrintError(interp, "invalid value in \"%s\": %s", ObjStr(objPtr), ObjStr(resultObj));
        DECR_REF_COUNT(resultObj);
        break;
      }
    }
  } else {
    assert(objPtr == *outObjPtr);
    if ((pPtr->flags & NSF_ARG_ALLOW_EMPTY) != 0u && *(ObjStr(objPtr)) == '\0') {
      result = Nsf_ConvertToString(interp, objPtr, pPtr, clientData, outObjPtr);
    } else {
      result = (*pPtr->converter)(interp, objPtr, pPtr, clientData, outObjPtr);
    }

    /*fprintf(stderr, "ArgumentCheck param %s type %s is converter %d flags %.6x "
            "outObj changed %d (%p %p) isok %d\n",
            pPtr->name, pPtr->type, pPtr->flags & NSF_ARG_IS_CONVERTER, pPtr->flags,
            objPtr != *outObjPtr, objPtr, *outObjPtr, result == TCL_OK);*/

    if (unlikely((pPtr->flags & NSF_ARG_IS_CONVERTER) != 0u) && objPtr != *outObjPtr) {
      *flags |= NSF_PC_MUST_DECR;
    } else {
      /*
       * If the output obj differs from the input obj, ensure we have
       * MUST_DECR set.
       */
      assert( (*flags & NSF_PC_MUST_DECR) != 0u || objPtr == *outObjPtr );
    }
  }

  if (unlikely(result == TCL_CONTINUE)) {
    *flags |= NSF_ARG_WARN;
    result = TCL_OK;
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * ArgumentDefaults --
 *
 *      Process the argument vector and set defaults in parse context if
 *      provided and necessary.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int ArgumentDefaults(ParseContext *pcPtr, Tcl_Interp *interp,
                            const Nsf_Param *ifd, int nrParams, unsigned int processFlags)
  nonnull(1) nonnull(2) nonnull(3);

static int
ArgumentDefaults(ParseContext *pcPtr, Tcl_Interp *interp,
                 const Nsf_Param *ifd, int nrParams, unsigned int processFlags) {
  const Nsf_Param *pPtr;
  int i;

  nonnull_assert(pcPtr != NULL);
  nonnull_assert(interp != NULL);
  nonnull_assert(ifd != NULL);

  for (pPtr = ifd, i = 0; i < nrParams; pPtr++, i++) {
    /*fprintf(stderr, "ArgumentDefaults got for arg %s (req %d, nrArgs %d) %p => %p %p, default '%s' \n",
            pPtr->name, pPtr->flags & NSF_ARG_REQUIRED, pPtr->nrArgs, pPtr,
            pcPtr->clientData[i], pcPtr->objv[i],
            (pPtr->defaultValue != NULL) ? ObjStr(pPtr->defaultValue) : "NONE");*/

    if (pcPtr->objv[i] != NULL) {
      /*
       * We got an actual value, which was already checked by ArgumentParse().
       * In case the value is a switch and NSF_PC_INVERT_DEFAULT is set, we
       * take the default and invert the value in place.
       */
      if (unlikely((pcPtr->flags[i] & NSF_PC_INVERT_DEFAULT) != 0u)) {
        int boolVal;

        assert(pPtr->defaultValue != NULL);

        Tcl_GetBooleanFromObj(interp, pPtr->defaultValue, &boolVal);
        pcPtr->objv[i] = Tcl_NewBooleanObj(boolVal == 0);
        /*
         * Perform bookkeeping to avoid that someone releases the new obj
         * before we are done. The according DECR is performed by
         * ParseContextRelease()
         */
        INCR_REF_COUNT2("valueObj", pcPtr->objv[i]);
        pcPtr->flags[i] |= NSF_PC_MUST_DECR;
        pcPtr->status |= NSF_PC_STATUS_MUST_DECR;
      }
    } else {
      /*
       * No valued was passed, check whether a default is available.
       */

      if (pPtr->defaultValue != NULL) {
        int mustDecrNewValue;
        Tcl_Obj *newValue = pPtr->defaultValue;
        ClientData checkedData;

        /*
         * We have a default value for the argument.  Mark that this argument
         * gets the default value.
         */
        pcPtr->flags[i] |= NSF_PC_IS_DEFAULT;

        /*
         * Does the user want to substitute in the default value?
         */
        if (unlikely((pPtr->flags & NSF_ARG_SUBST_DEFAULT) != 0u)) {
          int      tclOptions = 0;
          Tcl_Obj *obj;

          if ((pPtr->flags & NSF_ARG_SUBST_DEFAULT_VARIABLES) != 0u) {
            tclOptions |= TCL_SUBST_VARIABLES;
          }
          if ((pPtr->flags & NSF_ARG_SUBST_DEFAULT_COMMANDS) != 0u) {
            tclOptions |= TCL_SUBST_COMMANDS;
          }
          if ((pPtr->flags & NSF_ARG_SUBST_DEFAULT_BACKSLASHES) != 0u) {
            tclOptions |= TCL_SUBST_BACKSLASHES;
          }
          /* fprintf(stderr, "SUBST tclOptions %.4x\n", tclOptions);*/
          obj = Tcl_SubstObj(interp, newValue, tclOptions);

          if (likely(obj != NULL)) {
             newValue = obj;
          } else {
            pcPtr->flags[i] = 0u;
            return TCL_ERROR;
          }

          /*
           * The matching DECR is performed by ParseContextRelease().
           */
          INCR_REF_COUNT2("valueObj", newValue);
          /*fprintf(stderr, "SUBST_DEFAULT increments %p refCount %d\n",
            newValue, newValue->refCount);*/
          mustDecrNewValue = 1;
          pcPtr->flags[i] |= NSF_PC_MUST_DECR;
          pcPtr->status |= NSF_PC_STATUS_MUST_DECR;
        } else {
          mustDecrNewValue = 0;
        }

        pcPtr->objv[i] = newValue;
        /*fprintf(stderr, "==> setting default value '%s' for var '%s' flag %d type %s conv %p\n",
                ObjStr(newValue), pPtr->name, pPtr->flags & NSF_ARG_INITCMD,
                pPtr->type, pPtr->converter);*/
        /*
         * Check the default value if necessary
         */
        if (pPtr->type != NULL || unlikely((pPtr->flags & NSF_ARG_MULTIVALUED) != 0u)) {
          unsigned int mustDecrList = 0;

          if (unlikely((pPtr->flags & NSF_ARG_INITCMD) == 0u &&
                       ArgumentCheck(interp, newValue, pPtr,
                                     RUNTIME_STATE(interp)->doCheckArguments,
                                     &mustDecrList, &checkedData, &pcPtr->objv[i]) != TCL_OK)) {
            if (mustDecrNewValue == 1) {
              DECR_REF_COUNT2("valueObj", newValue);
              pcPtr->flags[i] &= ~NSF_PC_MUST_DECR;
            }
            return TCL_ERROR;
          }

          if (unlikely(pcPtr->objv[i] != newValue)) {
            /*
             * The output Tcl_Obj differs from the input, so the Tcl_Obj was
             * converted; in case we have set previously the flag
             * NSF_PC_MUST_DECR on newValue, we decrement the refCount on
             * newValue here and clear the flag.
             */
            if (mustDecrNewValue == 1) {
              DECR_REF_COUNT2("valueObj", newValue);
              pcPtr->flags[i] &= ~NSF_PC_MUST_DECR;
            }
            /*
             * The new output value itself might require a decrement, so set
             * the flag here if required; this is just necessary for
             * multivalued converted output.
             */
            if (mustDecrList == 1) {
              pcPtr->flags[i] |= NSF_PC_MUST_DECR;
              pcPtr->status |= NSF_PC_STATUS_MUST_DECR;
            }
          }
        } else {
          /*fprintf(stderr, "Param %s default %s type %s\n",
            pPtr->name, ObjStr(pPtr->defaultValue), pPtr->type);*/
          assert((pPtr->type != NULL) ? pPtr->defaultValue == NULL : 1);
        }
      } else if (unlikely((pPtr->flags & NSF_ARG_REQUIRED) != 0u)
                 && ((processFlags & NSF_ARGPARSE_FORCE_REQUIRED) != 0u)) {
        Tcl_Obj *paramDefsObj = NsfParamDefsSyntax(interp, ifd, pcPtr->object, NULL);
        Tcl_Obj *methodPathObj = NsfMethodNamePath(interp,
                                                   CallStackGetTclFrame(interp, NULL, 1),
                                                   MethodName(pcPtr->full_objv[0]));

        INCR_REF_COUNT2("methodPathObj", methodPathObj);

        NsfPrintError(interp, "required argument '%s' is missing, should be:\n        %s%s%s %s",
                      (pPtr->nameObj != NULL) ? ObjStr(pPtr->nameObj) : pPtr->name,
                      (pcPtr->object != NULL) ? ObjectName(pcPtr->object) : "", (pcPtr->object != NULL) ? " " : "",
                      ObjStr(methodPathObj),
                      ObjStr(paramDefsObj));

        DECR_REF_COUNT2("paramDefsObj", paramDefsObj);
        DECR_REF_COUNT2("methodPathObj", methodPathObj);

        return TCL_ERROR;

      } else {
        /*
         * Use as dummy default value an arbitrary symbol, which must
         * not be returned to the Tcl level level; this value is unset
         * later typically by NsfUnsetUnknownArgsCmd().
         */
        pcPtr->objv[i] = NsfGlobalObjs[NSF___UNKNOWN__];
      }
    }
  }
  return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 * ArgumentParse --
 *
 *      Parse the argument vector based on the parameter definitions.
 *      The parsed argument vector is returned in a normalized order
 *      in the parse context.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
int
Nsf_ArgumentParse(
    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    Nsf_Object *object, Tcl_Obj *procNameObj,
    const Nsf_Param *paramPtr, int nrParams, int serial,
    unsigned int processFlags, Nsf_ParseContext *pcPtr
) {

  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(procNameObj != NULL);
  nonnull_assert(pcPtr != NULL);

  return ArgumentParse(interp, objc, objv, (NsfObject *)object, procNameObj,
                       paramPtr, nrParams, serial, processFlags,
                       (ParseContext *)pcPtr);
}

/*
 *----------------------------------------------------------------------
 * NextParam --
 *
 *      Advance in the parameter definitions and return the next parameter.
 *
 * Results:
 *      Next parameter.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static const Nsf_Param * NextParam(Nsf_Param const *paramPtr, const Nsf_Param *lastParamPtr)
  nonnull(1) nonnull(2) returns_nonnull NSF_pure;

static const Nsf_Param *
NextParam(Nsf_Param const *paramPtr, const Nsf_Param *lastParamPtr) {

  nonnull_assert(paramPtr != NULL);
  nonnull_assert(lastParamPtr != NULL);

  for (; (++paramPtr <= lastParamPtr) && (*paramPtr->name == '-'); );
  return paramPtr;
}

/*
 *----------------------------------------------------------------------
 * ArgumentParse --
 *
 *      Parse the provided list of argument against the given definition. The
 *      result is returned in the parse context structure.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

#define SkipNonposParamDefs(cPtr) \
  for (; (++(cPtr) <= lastParamPtr) && (*(cPtr)->name == '-'); )

static int
ArgumentParse(
    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
    NsfObject *object, Tcl_Obj *procNameObj,
    const Nsf_Param *paramPtr, int nrParams, int serial,
    unsigned int processFlags, ParseContext *pcPtr
) {
  int              o, fromArg;
  bool             dashdash = NSF_FALSE;
  long             j;
  const Nsf_Param *currentParamPtr;
  const Nsf_Param *lastParamPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(procNameObj != NULL);
  nonnull_assert(paramPtr != NULL);
  nonnull_assert(pcPtr != NULL);

  if ((processFlags & NSF_ARGPARSE_START_ZERO) != 0u) {
    fromArg = 0;
  } else {
    fromArg = 1;
  }

  ParseContextInit(pcPtr, nrParams, object, procNameObj);

#if defined(PARSE_TRACE)
  { const Nsf_Param *pPtr;
    fprintf(stderr, "PARAMETER ");
    for (o = 0, pPtr = paramPtr; pPtr->name != NULL; o++, pPtr++) {
      fprintf(stderr, "[%d]%s (nrargs %d %s) ", o,
              pPtr->name, pPtr->nrArgs,
              (pPtr->flags & NSF_ARG_REQUIRED) != 0u ? "req" : "opt");
    }
    fprintf(stderr, "\n");
    fprintf(stderr, "BEGIN (%d) [0]%s ", objc, ObjStr(procNameObj));
    for (o = fromArg; o < objc; o++) {
      Tcl_Obj *obj = objv[o];
      if (obj->bytes == NULL) {
        fprintf(stderr, "[%d]unk(%s) ", o, obj->typePtr->name);
      } else {
        fprintf(stderr, "[%d]%s ", o, ObjStr(obj));
      }
    }
    fprintf(stderr, "\n");
  }
#endif

  currentParamPtr = paramPtr;
  lastParamPtr = paramPtr + nrParams - 1;
  for (o = fromArg; o < objc; o++) {
    const Nsf_Param *pPtr = currentParamPtr;
    Tcl_Obj         *argumentObj = objv[o], *valueObj = NULL;
    const char      *valueInArgument = NULL;

#if defined(PARSE_TRACE_FULL)
    fprintf(stderr, "arg [%d]: %s (param %ld, last %d)\n",
            o, ObjStr(argumentObj), currentParamPtr - paramPtr, currentParamPtr == lastParamPtr);
#endif

    if (unlikely(currentParamPtr > lastParamPtr)) {
      int result;
      Tcl_Obj *methodPathObj;

      methodPathObj = NsfMethodNamePath(interp,
                                        CallStackGetTclFrame(interp, NULL, 0),
                                        NsfMethodName(procNameObj));
      INCR_REF_COUNT(methodPathObj);
      result = NsfUnexpectedArgumentError(interp, ObjStr(argumentObj), (Nsf_Object*)object,
                                        paramPtr, methodPathObj);
      DECR_REF_COUNT(methodPathObj);
      return result;
    }

    if (*currentParamPtr->name == '-') {
      /*
       * We expect a non-pos arg. Check whether we a Tcl_Obj already converted
       * to NsfFlagObjType.
       */
      NsfFlag *flagPtr = argumentObj->internalRep.twoPtrValue.ptr1;

#if defined(PARSE_TRACE_FULL)
      fprintf(stderr, "... arg %p %s expect non-pos arg in block %s isFlag %d sig %d serial %d (%d => %d)\n",
              (void*)argumentObj, ObjStr(argumentObj), currentParamPtr->name,
              argumentObj->typePtr == &NsfFlagObjType,
              argumentObj->typePtr == &NsfFlagObjType ? flagPtr->signature == paramPtr : 0,
              argumentObj->typePtr == &NsfFlagObjType ? flagPtr->serial == serial : 0,
              argumentObj->typePtr == &NsfFlagObjType ? flagPtr->serial : 0,
              serial );
#endif

      if (argumentObj->typePtr == &NsfFlagObjType
          && flagPtr->signature == paramPtr
          && flagPtr->serial == serial
          && flagPtr->paramPtr != NULL /* when the parameter was previously used in a cget */
          ) {
        /*
         * The argument was processed before and the Tcl_Obj is still valid.
         */
        if ((flagPtr->flags & NSF_FLAG_DASHDAH) != 0u) {
          /*
           * We got a dashDash, skip non-pos param definitions and continue with next
           * element from objv.
           */
          SkipNonposParamDefs(currentParamPtr);
          assert(!dashdash);
          continue;
        } else if ((flagPtr->flags & NSF_FLAG_CONTAINS_VALUE) != 0u) {
          /*
           * We got a flag with an embedded value (e.g. -flag=1).
           */
          valueInArgument = "flag";
        }
        pPtr = flagPtr->paramPtr;
        valueObj = flagPtr->payload;

      } else if ((argumentObj->typePtr == Nsf_OT_byteArrayType)
                 || (argumentObj->typePtr == Nsf_OT_properByteArrayType)
                 /*
                    || (argumentObj->typePtr == Nsf_OT_intType)
                    || (argumentObj->typePtr == Nsf_OT_doubleType)
                 */
                 ) {
        /*
         * The actual argument belongs to the types, for which we assume that
         * these can't belong to a non-pos flag.  The argument might be e.g. a
         * pure Tcl bytearray, for which we do not want to add a string rep
         * via ObjStr() such it loses its purity (Tcl 8.6). For these
         * argument types.  Proceed in the parameter vector to the next block
         * (positional parameter)
         */
        SkipNonposParamDefs(currentParamPtr);
        pPtr = currentParamPtr;
        /*
         * currentParamPtr is either NULL or points to a positional parameter
         */
        assert(currentParamPtr == NULL || currentParamPtr->name == NULL || *currentParamPtr->name != '-');
      } else {
        const char *argumentString = ObjStr(argumentObj);
        /*
         * We are in a state, where we expect a non-positional argument, and
         * the lookup from the Tcl_Obj has failed.  If this non-pos args are
         * optional, the current argument might contain also a value for a
         * positional argument maybe the argument is for a posarg
         * later). First check whether the argument looks like a flag.
         */
        if (argumentString[0] != '-') {
          /*
           * The actual argument is not a flag, so proceed in the parameter
           * vector to the next block (positional parameter)
           */
          SkipNonposParamDefs(currentParamPtr);
          pPtr = currentParamPtr;
          /*
           * currentParamPtr is either NULL or points to a positional parameter
           */
          assert(currentParamPtr == NULL || currentParamPtr->name == NULL || *currentParamPtr->name != '-');

        } else {
          /*
           * The actual argument starts with a dash, so search for the flag in
           * the current block of non-pos parameter definitions
           */
          char ch1 = *(argumentString+1);

          /*
           * Is there a "--" ?
           */
          if (ch1 == '-' && *(argumentString+2) == '\0' && !dashdash) {
            dashdash = NSF_TRUE;
            NsfFlagObjSet(interp, argumentObj, paramPtr, serial,
                          NULL, NULL, NSF_FLAG_DASHDAH);
            SkipNonposParamDefs(currentParamPtr);
            continue;
          }

          valueInArgument = strchr(argumentString, '=');
          if (valueInArgument != NULL) {
            bool   found = NSF_FALSE;
            long   equalOffset = valueInArgument - argumentString;

            /*
             * Handle parameter like -flag=1
             */
            for (; (pPtr <= lastParamPtr) && (*pPtr->name == '-'); pPtr++) {
              if (pPtr->nrArgs > 0) {
                /*
                 * Parameter expects no arg, can't be this.
                 */
                continue;
              }
              if ((pPtr->flags & NSF_ARG_NOCONFIG) == 0u
                  && ch1 == pPtr->name[1]
                  && strncmp(argumentString, pPtr->name, (size_t)equalOffset) == 0
                  && *(pPtr->name+equalOffset) == '\0') {

                valueObj = Tcl_NewStringObj(valueInArgument+1, -1);
                /*fprintf(stderr, "... value from argument = %s\n", ObjStr(valueObj));*/
                NsfFlagObjSet(interp, argumentObj, paramPtr, serial,
                              pPtr, valueObj, NSF_FLAG_CONTAINS_VALUE);
                found = NSF_TRUE;
                break;
              }
            }
            if (!found) {
              const Nsf_Param *nextParamPtr = NextParam(currentParamPtr, lastParamPtr);

              if (nextParamPtr > lastParamPtr
                  || ((nextParamPtr->flags & NSF_ARG_NODASHALNUM) != 0u)) {
                int result;
                Tcl_Obj *methodPathObj= NsfMethodNamePath(interp,
                                                          CallStackGetTclFrame(interp, NULL, 0),
                                                          NsfMethodName(procNameObj));
                INCR_REF_COUNT(methodPathObj);
                result = NsfUnexpectedNonposArgumentError(interp, argumentString,
                                                          (Nsf_Object *)object,
                                                          currentParamPtr, paramPtr,
                                                          methodPathObj);
                DECR_REF_COUNT(methodPathObj);
                return result;
              }
              pPtr = currentParamPtr = nextParamPtr;
            }
          } else {
            /*
             * Must be a classical non-pos arg; check for a matching parameter
             * definition.
             */
            bool found = NSF_FALSE;

            assert(pPtr == currentParamPtr);

            if (likely(ch1 != '\0')) {
              if (unlikely(NsfParamDefsNonposLookup(interp, argumentString, currentParamPtr, &pPtr) != TCL_OK)) {
                return TCL_ERROR;
              } else {
                if (pPtr != NULL) {
                  found = NSF_TRUE;
                  NsfFlagObjSet(interp, argumentObj, paramPtr, serial, pPtr, NULL, 0u);
                }
              }
            }

            /*
             * We might have found the argument starting with the dash in the
             * parameter definitions or not. If it was not found, then we can
             * advance to the next positional parameter and stuff the value in
             * there, if the parameter definition allows this.
             */
            if (!found) {
              int nonposArgError = 0;
              const Nsf_Param *nextParamPtr = NextParam(currentParamPtr, lastParamPtr);

              /*fprintf(stderr, "non-pos-arg '%s' not found, current %p %s last %p %s next %p %s\n",
                      argumentString,
                      currentParamPtr,  currentParamPtr->name,
                      lastParamPtr, lastParamPtr->name,
                      nextParamPtr, nextParamPtr->name);*/

              if (nextParamPtr > lastParamPtr) {
                nonposArgError = 1;
              } else if ((nextParamPtr->flags & NSF_ARG_NODASHALNUM) != 0u) {
                /*
                 * Check whether argument is numeric, since we want to allow it as
                 * value even when NSF_ARG_NODASHALNUM was specified.
                 */
                nonposArgError = 1;

                if (argumentString[1] >= '0' && argumentString[1] <= '9') {
                  char *p;

                  (void)strtod(&argumentString[1], &p);
                  if (*p == '\0') {
                    /*
                     * Argument is numeric.
                     */
                    nonposArgError = 0;
                  }
                }
              }

              if (nonposArgError != 0) {
                int result;
                Tcl_Obj *methodPathObj = NsfMethodNamePath(interp,
                                                           CallStackGetTclFrame(interp, NULL, 0),
                                                           NsfMethodName(procNameObj));
                INCR_REF_COUNT(methodPathObj);
                result = NsfUnexpectedNonposArgumentError(interp, argumentString,
                                                          (Nsf_Object *)object,
                                                          currentParamPtr, paramPtr,
                                                          methodPathObj);
                DECR_REF_COUNT(methodPathObj);
                return result;
              }
              pPtr = currentParamPtr = nextParamPtr;
            }
          }
        }
        /* end of lookup loop */
      }
    } else {
      valueInArgument = NULL;
    }

    assert(pPtr != NULL);
    /*
     * "pPtr" points to the actual parameter (part of the currentParamPtr
     * block) or might point to a place past the last parameter, in which case
     * an unexpected argument was provided. "o" is the index of the actual
     * parameter, "valueObj" might be already provided for valueInArgument.
     */
    if (unlikely(pPtr > lastParamPtr)) {
      int      result;
      Tcl_Obj *methodPathObj;

      methodPathObj = NsfMethodNamePath(interp, CallStackGetTclFrame(interp, NULL, 0),
                                        NsfMethodName(procNameObj));
      INCR_REF_COUNT(methodPathObj);
      /*fprintf(stderr, "call NsfUnexpectedArgumentError 2\n");*/
      result = NsfUnexpectedArgumentError(interp, ObjStr(argumentObj),
                                        (Nsf_Object *)object, paramPtr,
                                        methodPathObj);
      DECR_REF_COUNT(methodPathObj);
      return result;
    }

    /*
     * Set the position in the downstream argv (normalized order)
     */
    j = pPtr - paramPtr;

#if defined(PARSE_TRACE_FULL)
    fprintf(stderr, "... pPtr->name %s/%d o %d objc %d\n", pPtr->name, pPtr->nrArgs, o, objc);
#endif
    if (*pPtr->name == '-') {
      /*
       * Process the non-pos arg.
       */
      if (pPtr->nrArgs == 1) {
        /*
         * The non-pos arg expects an argument.
         */
        o++;
        if (unlikely(o >= objc)) {
          /*
           * We expect an argument, but we are already at the end of the
           * argument list.
           */
          return NsfPrintError(interp, "value for parameter '%s' expected", pPtr->name);
        }
        assert(valueObj == NULL);
        valueObj = objv[o];
      } else {
        /*
         * The non-pos arg expects no argument.
         */
        if (valueObj == NULL) {
          valueObj = NsfGlobalObjs[NSF_ONE];
        }
      }

    } else if (unlikely((pPtr == lastParamPtr)
                        && (pPtr->converter == ConvertToNothing))) {
      /*
       * "args" was given, use the varargs interface.  Store the actual
       * argument into pcPtr->objv. No checking is performed on "args".
       */
      pcPtr->varArgs = NSF_TRUE;
      pcPtr->objv[j] = argumentObj;


#if defined(PARSE_TRACE_FULL)
      fprintf(stderr, "... args found o %d objc %d is dashdash %d [%ld] <%s>\n",
              o, objc, (int)dashdash, j, ObjStr(argumentObj));
#endif
      break;

    } else {
      /*
       * Process an ordinary positional argument.
       */
      currentParamPtr ++;

#if defined(PARSE_TRACE_FULL)
      fprintf(stderr, "... positional arg o %d objc %d, nrArgs %d next paramPtr %s\n",
              o, objc, pPtr->nrArgs, currentParamPtr->name);
#endif

      if (unlikely(pPtr->nrArgs == 0)) {
        /*
         * Allow positional arguments with 0 args for object parameter
         * aliases, which are always fired. Such parameter are non-consuming,
         * therefore the processing of the current argument is not finished, we
         * have to decrement o. We have to check here if we are already at the
         * end if the parameter vector.
         */
        o--;
        continue;
      }
      if (unlikely(dashdash)) {
        /*
         * Reset dashdash.
         */
        dashdash = NSF_FALSE;
      }

      valueObj = argumentObj;
    }

#if defined(PARSE_TRACE_FULL)
    fprintf(stderr, "... setting parameter %s pos %ld valueObj '%s'\n",
            pPtr->name, j,
            valueObj == argumentObj ? "=" : ObjStr(valueObj));
#endif

    /*
     * The value for the flag is now in the valueObj. We
     * check, whether it is value is permissible.
     */
    assert(valueObj != NULL);

    if (unlikely(ArgumentCheck(interp, valueObj, pPtr, processFlags,
                               &pcPtr->flags[j],
                               &pcPtr->clientData[j],
                               &pcPtr->objv[j]) != TCL_OK)) {
      if (pcPtr->flags[j] & NSF_PC_MUST_DECR) {
        pcPtr->status |= NSF_PC_STATUS_MUST_DECR;
      }
      return TCL_ERROR;
    }

    /*
     * Switches are more tricky: if the flag is provided without
     * valueInArgument, we take the default and invert it. If valueInArgument
     * was used, the default inversion must not happen.
     */
    if (likely(valueInArgument == NULL)) {
      if (unlikely(pPtr->converter == Nsf_ConvertToSwitch)) {
        /*fprintf(stderr, "... set INVERT_DEFAULT for '%s' flags %.6x\n",
          pPtr->name, pPtr->flags);*/
        assert(pPtr->defaultValue != NULL);
        pcPtr->flags[j] |= NSF_PC_INVERT_DEFAULT;
      }
    }

    /*fprintf(stderr, "... non-positional pcPtr %p check [%d] obj %p flags %.6x & %p\n",
      pcPtr, j, pcPtr->objv[j], pcPtr->flags[j], &(pcPtr->flags[j]));        */

    /*
     * Provide warnings for double-settings.
     */
    if (unlikely((pcPtr->flags[j] & NSF_ARG_SET) != 0u)) {
      Tcl_Obj *cmdLineObj = Tcl_NewListObj(objc-1, objv+1);

      INCR_REF_COUNT(cmdLineObj);
      NsfLog(interp, NSF_LOG_WARN, "Non-positional parameter %s was passed more than once (%s%s%s %s)",
             pPtr->name, (object != NULL) ? ObjectName(object) : "", (object != NULL) ? " method " : "",
             ObjStr(procNameObj), ObjStr(cmdLineObj));
      DECR_REF_COUNT(cmdLineObj);
    }
    pcPtr->flags[j] |= NSF_ARG_SET;

    /*
     * Embed error message of converter in current context.
     */
    if (unlikely((pcPtr->flags[j] & NSF_ARG_WARN) != 0u)) {
      Tcl_Obj *resultObj = Tcl_GetObjResult(interp);
      Tcl_DString ds, *dsPtr = &ds;

      Tcl_DStringInit(dsPtr);
      INCR_REF_COUNT(resultObj);
      NsfDStringArgv(dsPtr, objc, objv);
      NsfLog(interp, NSF_LOG_WARN, "%s during:\n%s %s",
             ObjStr(resultObj), (object != NULL) ? ObjectName(object) : "nsf::proc", Tcl_DStringValue(dsPtr));
      DECR_REF_COUNT(resultObj);
      Tcl_DStringFree(dsPtr);
    }

    if (unlikely((pcPtr->flags[j] & NSF_PC_MUST_DECR) != 0u)) {
      pcPtr->status |= NSF_PC_STATUS_MUST_DECR;
    }

    assert(!pcPtr->varArgs);

#if defined(PARSE_TRACE_FULL)
    fprintf(stderr, "... iterate on o %d objc %d, currentParamPtr %s\n",
            o, objc, currentParamPtr->name);
#endif
  }

  if ((currentParamPtr <= lastParamPtr) && (!pcPtr->varArgs)) {
    /*
     * Not all parameter processed, make sure varags is set.
     */

    /*fprintf(stderr, ".... not all parms processed, pPtr '%s' j %ld nrParams %d last '%s' varArgs %d dashdash %d\n",
            currentParamPtr->name, currentParamPtr - paramPtr, nrParams, lastParamPtr->name,
            pcPtr->varArgs, (int)dashdash);*/

    if (lastParamPtr->converter == ConvertToNothing) {
      pcPtr->varArgs = NSF_TRUE;
    }
  }

  /*
   * Set lastObjc as index of the first "unprocessed" parameter.
   */
  pcPtr->lastObjc = o;
  pcPtr->objc = nrParams;

  /*
   * The index "pcPtr->lastObjc-1" can be "-1", which is a problem, when
   * called via nsf::parseargs, where the allocated objv array starts at
   * position 0. It is fine when just a part of the real objv is passed to
   * ArgumentParse().
   *
   *     assert(ISOBJ(objv[pcPtr->lastObjc-1]));
   */

#if defined(PARSE_TRACE_FULL)
  fprintf(stderr, "..... argv processed o %d lastObjc %d nrParams %d o<objc %d varargs %d\n",
          o, pcPtr->lastObjc, nrParams, o<objc, pcPtr->varArgs);
#endif

  return ArgumentDefaults(pcPtr, interp, paramPtr, nrParams, processFlags);
}

/***********************************
 * Begin result setting commands
 * (essentially List*() and support
 ***********************************/
/*
 *----------------------------------------------------------------------
 * ListVarKeys --
 *
 *      Return variable names of the provided hash table in the interp
 *      result. Optionally "pattern" might be used to filter the result
 *      list.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static int ListVarKeys(Tcl_Interp *interp, Tcl_HashTable *tablePtr, const char *pattern)
  nonnull(1);

static int
ListVarKeys(Tcl_Interp *interp, Tcl_HashTable *tablePtr, const char *pattern) {
  const Tcl_HashEntry *hPtr;

  nonnull_assert(interp != NULL);

  if (pattern != NULL && NoMetaChars(pattern)) {
    Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);

    INCR_REF_COUNT(patternObj);
    hPtr = (tablePtr != NULL) ? Tcl_CreateHashEntry(tablePtr, (char *)patternObj, NULL) : NULL;
    if (hPtr != NULL) {
      const Var *val = TclVarHashGetValue(hPtr);

      Tcl_SetObjResult(interp, TclVarHashGetKey(val));
    } else {
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_EMPTY]);
    }
    DECR_REF_COUNT(patternObj);

  } else {
    Tcl_Obj       *list = Tcl_NewListObj(0, NULL);
    Tcl_HashSearch hSrch;

    hPtr = (tablePtr != NULL) ? Tcl_FirstHashEntry(tablePtr, &hSrch) : NULL;
    for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSrch)) {
      const Var *val = TclVarHashGetValue(hPtr);
      Tcl_Obj   *key = TclVarHashGetKey(val);

      if (pattern == NULL || Tcl_StringMatch(ObjStr(key), pattern)) {
        Tcl_ListObjAppendElement(interp, list, key);
      }
    }
    Tcl_SetObjResult(interp, list);
  }
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * GetOriginalCommand --
 *
 *      Obtain for an imported/aliased cmd the original definition.
 *
 * Results:
 *      Tcl command
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Command
GetOriginalCommand(
    Tcl_Command cmd  /* The imported command for which the original
                      * command should be returned.
                      */
) {
  Tcl_Command importedCmd;

  nonnull_assert(cmd != NULL);

  while (1) {
    AliasCmdClientData *tcd;

    /*
     * Dereference the namespace import reference chain
     */
    if ((importedCmd = TclGetOriginalCommand(cmd))) {
      cmd = importedCmd;
    }
    /*
     * Dereference the Next Scripting alias chain
     */
    if (Tcl_Command_deleteProc(cmd) == AliasCmdDeleteProc) {
      tcd = (AliasCmdClientData *)Tcl_Command_objClientData(cmd);
      /*
        fprintf(stderr, "... GetOriginalCommand finds alias %s -> %s\n",
        Tcl_GetCommandName(NULL, cmd), Tcl_GetCommandName(NULL, tcd->aliasedCmd));
      */
      cmd = tcd->aliasedCmd;
      continue;
    }
    /*
     * Dereference the Next Scripting alias chain via potential proc contexts,
     * since we identify the alias reference on the AliasCmdDeleteProc.
     */
    if (Tcl_Command_deleteProc(cmd) == NsfProcDeleteProc
       && Tcl_Command_objProc(cmd) == NsfProcAliasMethod) {
      NsfProcContext *ctxPtr = Tcl_Command_deleteData(cmd);

      if (ctxPtr->oldDeleteProc == AliasCmdDeleteProc) {
        tcd = (AliasCmdClientData *)Tcl_Command_objClientData(cmd);

        /*
           fprintf(stderr, "... GetOriginalCommand finds alias via oldDeleteProc %s -> %s (%p -> %p)\n",
           Tcl_GetCommandName(NULL, cmd), Tcl_GetCommandName(NULL, tcd->aliasedCmd),
           (void*)cmd, (void*)tcd->aliasedCmd  );
           char *name =Tcl_GetCommandName(NULL, cmd);
           if (!strcmp("incr", name)) {char *p = NULL; *p=1;}
        */

        cmd = tcd->aliasedCmd;
        continue;
      }
    }
    break;
  }

  return cmd;
}

/*
 *----------------------------------------------------------------------
 * ListProcBody --
 *
 *      Return the body of a scripted proc as Tcl interp result.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static int ListProcBody(Tcl_Interp *interp, Proc *procPtr)
  nonnull(1) nonnull(2);

static int
ListProcBody(Tcl_Interp *interp, Proc *procPtr) {
  const char *body;

  nonnull_assert(interp != NULL);
  nonnull_assert(procPtr != NULL);

  body = ObjStr(procPtr->bodyPtr);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(StripBodyPrefix(body), -1));
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * ListParamDefs --
 *
 *      Compute the parameter definition in one of four different forms.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj *ListParamDefs(Tcl_Interp *interp, const Nsf_Param *paramsPtr,
                              NsfObject *contextObject, const char *pattern,
                              NsfParamsPrintStyle style)
  nonnull(1) nonnull(2) returns_nonnull;

static Tcl_Obj *
ListParamDefs(Tcl_Interp *interp, const Nsf_Param *paramsPtr,
              NsfObject *contextObject,  const char *pattern,
              NsfParamsPrintStyle style) {
  Tcl_Obj *listObj = NsfGlobalObjs[NSF_EMPTY]; /* enumeration is complete, make stupid checker happy */

  nonnull_assert(interp != NULL);
  nonnull_assert(paramsPtr != NULL);

  switch (style) {
  case NSF_PARAMS_PARAMETER: listObj = ParamDefsFormat(interp, paramsPtr, contextObject, pattern); break;
  case NSF_PARAMS_LIST:      listObj = ParamDefsList(interp, paramsPtr, contextObject, pattern);   break;
  case NSF_PARAMS_NAMES:     listObj = ParamDefsNames(interp, paramsPtr, contextObject, pattern);  break;
  case NSF_PARAMS_SYNTAX:    listObj = NsfParamDefsSyntax(interp, paramsPtr, contextObject, pattern); break;
  }

  return listObj;
}

/*
 *----------------------------------------------------------------------
 * ListCmdParams --
 *
 *      Obtains a cmd and a method name. As a side effect, sets the Tcl
 *      interp result to a list of parameter definitions, if
 *      available. The print-style NSF_PARAMS_NAMES, NSF_PARAMS_LIST,
 *      NSF_PARAMS_PARAMETER, NSF_PARAMS_SYNTAX controls the list
 *      content.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int ListCmdParams(Tcl_Interp *interp, Tcl_Command cmd, NsfObject *contextObject,
                         const char *pattern, const char *methodName, NsfParamsPrintStyle printStyle)
  nonnull(1) nonnull(2) nonnull(5);

static int
ListCmdParams(Tcl_Interp *interp, Tcl_Command cmd,  NsfObject *contextObject,
                const char *pattern, const char *methodName, NsfParamsPrintStyle printStyle) {
  NsfParamDefs *paramDefs;
  Tcl_Obj      *listObj;
  Proc         *procPtr;
  int           result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cmd != NULL);

  paramDefs = ParamDefsGet(cmd, NULL, NULL);

  if (paramDefs != NULL && paramDefs->paramsPtr != NULL) {
    /*
     * Obtain parameter info from paramDefs.
     */
    listObj = ListParamDefs(interp, paramDefs->paramsPtr, contextObject, pattern, printStyle);
    Tcl_SetObjResult(interp, listObj);
    DECR_REF_COUNT2("paramDefsObj", listObj);
    return TCL_OK;
  }

  procPtr = GetTclProcFromCommand(cmd);
  if (procPtr != NULL) {
    /*
     * Obtain parameter info from compiled locals.
     */
    CompiledLocal *args = procPtr->firstLocalPtr;

    listObj = Tcl_NewListObj(0, NULL);
    for ( ; args; args = args->nextPtr) {

      if (!TclIsCompiledLocalArgument(args)) {
        continue;
      }
      if (pattern != NULL && !Tcl_StringMatch(args->name, pattern)) {
        continue;
      }

      if (printStyle == NSF_PARAMS_SYNTAX && strcmp(args->name, "args") == 0) {
        if (args != procPtr->firstLocalPtr) {
          Tcl_AppendToObj(listObj, " ", 1);
        }
        Tcl_AppendToObj(listObj, "?/arg .../?", 11);
      } else {
        if (printStyle == NSF_PARAMS_SYNTAX) {
          /*
           * A default means that the argument is optional.
           */
          if (args->defValuePtr != NULL) {
            Tcl_AppendToObj(listObj, "?", 1);
            Tcl_AppendToObj(listObj, args->name, -1);
            Tcl_AppendToObj(listObj, "?", 1);
          } else {
            Tcl_AppendToObj(listObj, "/", 1);
            Tcl_AppendToObj(listObj, args->name, -1);
            Tcl_AppendToObj(listObj, "/", 1);
          }
          if (args->nextPtr != NULL) {
            Tcl_AppendToObj(listObj, " ", 1);
          }
        } else {
          Tcl_Obj *innerListObj = Tcl_NewListObj(0, NULL);

          Tcl_ListObjAppendElement(interp, innerListObj, Tcl_NewStringObj(args->name, -1));
          /*
           * Return default just for NSF_PARAMS_PARAMETER.
           */
          if ((args->defValuePtr != NULL) && (printStyle == NSF_PARAMS_PARAMETER)) {
            Tcl_ListObjAppendElement(interp, innerListObj, args->defValuePtr);
          }
          Tcl_ListObjAppendElement(interp, listObj, innerListObj);
        }
      }
    }

    Tcl_SetObjResult(interp, listObj);
    return TCL_OK;
  }

  {
    /*
     * If a command is not found for the object|class, check whether we
     * find the parameter definitions for the C-defined method.
     */
    Nsf_methodDefinition *mdPtr = Nsf_CmdDefinitionGet(((Command *)cmd)->objProc);
    if (mdPtr != NULL) {
      NsfParamDefs localParamDefs = {mdPtr->paramDefs, mdPtr->nrParameters, 1, 0};
      Tcl_Obj     *list = ListParamDefs(interp, localParamDefs.paramsPtr, contextObject, pattern, printStyle);

      Tcl_SetObjResult(interp, list);
      DECR_REF_COUNT2("paramDefsObj", list);
      return TCL_OK;
    }
  }

  if (((Command *)cmd)->objProc == NsfSetterMethod) {
    SetterCmdClientData *cd = (SetterCmdClientData *)Tcl_Command_objClientData(cmd);

    if (cd != NULL && cd->paramsPtr) {
      NsfParamDefs localParamDefs;
      Tcl_Obj     *list;

      localParamDefs.paramsPtr = cd->paramsPtr;
      /*localParamDefs.nrParams = 1;*/
      list = ListParamDefs(interp, localParamDefs.paramsPtr, contextObject, pattern, printStyle);
      Tcl_SetObjResult(interp, list);
      DECR_REF_COUNT2("paramDefsObj", list);
    } else {
      Tcl_SetObjResult(interp, Tcl_NewStringObj(methodName, -1));
    }
    return TCL_OK;
  }

  /*
   * In case, we failed so far to obtain a result, try to use the
   * object-system implementors definitions in the global array
   * ::nsf::parametersyntax. Note that we can only obtain the
   * parameter syntax this way.
   */
  if (printStyle == NSF_PARAMS_SYNTAX) {
    Tcl_DString ds, *dsPtr = &ds;
    Tcl_Obj *parameterSyntaxObj;

    Tcl_DStringInit(dsPtr);
    DStringAppendQualName(dsPtr, Tcl_Command_nsPtr(cmd), methodName);
    /*fprintf(stderr, "Looking up ::nsf::parametersyntax(%s) ...\n", Tcl_DStringValue(dsPtr));*/
    parameterSyntaxObj = Tcl_GetVar2Ex(interp, NsfGlobalStrings[NSF_ARRAY_PARAMETERSYNTAX],
                                       Tcl_DStringValue(dsPtr), TCL_GLOBAL_ONLY);

    /*fprintf(stderr, "No parametersyntax so far methodName %s cmd name %s ns %s\n",
      methodName, Tcl_GetCommandName(interp, cmd), Tcl_DStringValue(dsPtr));*/

    Tcl_DStringFree(dsPtr);
    if (parameterSyntaxObj != NULL) {
      Tcl_SetObjResult(interp, parameterSyntaxObj);
      return TCL_OK;
    }
  }

  if (Tcl_Command_objProc(cmd) == NsfForwardMethod) {
    result = NsfPrintError(interp, "could not obtain parameter definition for forwarder '%s'",
                           methodName);

  } else if (CmdIsNsfObject(cmd)) {
    /* procPtr == NsfObjDispatch:

       Reached for:
       ... ensemble objects
       ... plain objects
     */
  } else if (Tcl_Command_objProc(cmd) == NsfProcStub) {
    /*
     * Reached for C-implemented Tcl command procs.
     */

  } else {
    /*
     * Reached for other C-implemented command procs.
     */
    result = NsfPrintError(interp, "could not obtain parameter definition for method '%s'", methodName);
  }
  return result;
}


/*
 *----------------------------------------------------------------------
 * AppendForwardDefinition --
 *
 *      Append the parameters of a forward definition to the specified listObj.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Appending to listObj
 *
 *----------------------------------------------------------------------
 */
static void AppendForwardDefinition(Tcl_Interp *interp, Tcl_Obj *listObj, ForwardCmdClientData *tcd)
  nonnull(1) nonnull(2) nonnull(3);

static void
AppendForwardDefinition(Tcl_Interp *interp, Tcl_Obj *listObj, ForwardCmdClientData *tcd) {

  nonnull_assert(interp != NULL);
  nonnull_assert(listObj != NULL);
  nonnull_assert(tcd != NULL);

  if (tcd->prefix != NULL) {
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-prefix", -1));
    Tcl_ListObjAppendElement(interp, listObj, tcd->prefix);
  }
  if (tcd->subcommands != NULL) {
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-default", -1));
    Tcl_ListObjAppendElement(interp, listObj, tcd->subcommands);
  }
  if (tcd->objProc != NULL) {
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-earlybinding", -1));
  }
  if (tcd->frame == FrameObjectIdx) {
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-frame", 6));
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("object", 6));
  }
  Tcl_ListObjAppendElement(interp, listObj, tcd->cmdName);

  if (tcd->args != NULL) {
    Tcl_Obj **args;
    int nrArgs, i;

    Tcl_ListObjGetElements(interp, tcd->args, &nrArgs, &args);
    for (i = 0; i < nrArgs; i++) {
      Tcl_ListObjAppendElement(interp, listObj, args[i]);
    }
  }
}

/*
 *----------------------------------------------------------------------
 * AppendMethodRegistration --
 *
 *      Append to the listObj the command words needed for definition /
 *      registration.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Appending to listObj
 *
 *----------------------------------------------------------------------
 */

static void AppendMethodRegistration(Tcl_Interp *interp, Tcl_Obj *listObj, const char *registerCmdName,
                                     NsfObject *object, const char *methodName, Tcl_Command cmd,
                                     bool withObjFrame, bool withPer_object, int withProtection)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5) nonnull(6);

static void
AppendMethodRegistration(Tcl_Interp *interp, Tcl_Obj *listObj, const char *registerCmdName,
                         NsfObject *object, const char *methodName, Tcl_Command cmd,
                         bool withObjFrame, bool withPer_object, int withProtection) {

  nonnull_assert(interp != NULL);
  nonnull_assert(listObj != NULL);
  nonnull_assert(registerCmdName != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cmd != NULL);

  Tcl_ListObjAppendElement(interp, listObj, object->cmdName);
  if (withProtection != CallprotectionNULL) {
    Tcl_ListObjAppendElement(interp, listObj,
                             (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_CALL_PRIVATE_METHOD) != 0)
                             ? Tcl_NewStringObj("private", 7)
                             : (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_CALL_PROTECTED_METHOD) != 0)
                             ? Tcl_NewStringObj("protected", 9)
                             : Tcl_NewStringObj("public", 6));
  }

  if (!NsfObjectIsClass(object) || withPer_object) {
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("object", 6));
  }
  Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(registerCmdName, -1));
  Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(methodName, -1));

  if (withObjFrame) {
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-frame", 6));
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("object", 6));
  }
  if (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD) != 0) {
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-frame", 6));
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("method", 6));
  }
}

/*
 *----------------------------------------------------------------------
 * AppendReturnsClause --
 *
 *      Append to the listObj a returns clause, if it was specified for
 *      the current cmd.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Appending to listObj
 *
 *----------------------------------------------------------------------
 */

static void AppendReturnsClause(Tcl_Interp *interp, Tcl_Obj *listObj, Tcl_Command cmd)
  nonnull(1) nonnull(2) nonnull(3);

static void
AppendReturnsClause(Tcl_Interp *interp, Tcl_Obj *listObj, Tcl_Command cmd) {
  Tcl_Obj *returnsObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(listObj != NULL);
  nonnull_assert(cmd != NULL);

  returnsObj = ParamDefsGetReturns(cmd);
  if (returnsObj != NULL) {
    /* TODO: avoid hard-coding the script-level/NX-specific keyword "-returns" */
    Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-returns", -1));
    Tcl_ListObjAppendElement(interp, listObj, returnsObj);
  }
}

static Tcl_Obj *DisassembleProc(Tcl_Interp *interp, Proc *procPtr,
                                const char *procName, Namespace *nsPtr)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

static Tcl_Obj *DisassembleProc(Tcl_Interp *interp, Proc *procPtr,
                                const char *procName, Namespace *nsPtr) {
  unsigned int dummy = 0;
  Tcl_Obj *byteCodeObj = NULL;

  if ((procPtr->bodyPtr->typePtr == Nsf_OT_byteCodeType) ||
      (ByteCompiled(interp, &dummy, procPtr, nsPtr, procName) == TCL_OK)) {
    Tcl_Obj *ov[3];

    ov[0] = NULL;
    ov[1] = NsfGlobalObjs[NSF_SCRIPT];
    ov[2] = procPtr->bodyPtr;

    if ((NsfCallCommand(interp, NSF_DISASSEMBLE, 3, ov) == TCL_OK)) {
      byteCodeObj = Tcl_GetObjResult(interp);
    }
  }

  return byteCodeObj;
}



/*
 *----------------------------------------------------------------------
 * ListMethod --
 *
 *      Construct a command to regenerate the specified method. The
 *      method might be scripted or not (alias, forwarder, ...). The
 *      command is returned in the interp result.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static int ListMethod(Tcl_Interp *interp,
                      NsfObject *regObject,
                      NsfObject *defObject,
                      const char *methodName,
                      Tcl_Command cmd,
                      InfomethodsubcmdIdx_t subcmd,
                      NsfObject *contextObject,
                      const char *pattern,
                      bool withPer_object)
  nonnull(1) nonnull(4) nonnull(5);

static int ListDefinedMethods(Tcl_Interp *interp, NsfObject *object, const char *pattern,
                              bool withPer_object,
                              MethodtypeIdx_t methodType,
                              CallprotectionIdx_t withCallprotection,
                              bool withPath)
  nonnull(1) nonnull(2);

static int
ListMethod(Tcl_Interp *interp,
           NsfObject *regObject,
           NsfObject *defObject,
           const char *methodName,
           Tcl_Command cmd,
           InfomethodsubcmdIdx_t subcmd,
           NsfObject *contextObject,
           const char *pattern,
           bool withPer_object) {

  Tcl_ObjCmdProc *objCmdProc;
  Proc           *procPtr;
  bool            outputPerObject;
  Tcl_Obj        *resultObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cmd != NULL);

  assert(*methodName != ':');

  Tcl_ResetResult(interp);

  if (regObject != NULL && !NsfObjectIsClass(regObject)) {
    withPer_object = 1;
    /*
     * Don't output "object" modifier, if regObject is not a class.
     */
    outputPerObject = NSF_FALSE;
  } else {
    outputPerObject = withPer_object;
  }

  switch (subcmd) {
  case InfomethodsubcmdRegistrationhandleIdx:
    {
      if (regObject != NULL) {
        Tcl_SetObjResult(interp, MethodHandleObj(regObject, withPer_object, methodName));
      }
      return TCL_OK;
    }
  case InfomethodsubcmdDefinitionhandleIdx:
    {
      if (defObject != NULL) {
        Tcl_SetObjResult(interp, MethodHandleObj(defObject,
                                                 NsfObjectIsClass(defObject) ? withPer_object : 1,
                                                 Tcl_GetCommandName(interp, cmd)));
      }
      return TCL_OK;
    }
  case InfomethodsubcmdExistsIdx:
    {
      Tcl_SetObjResult(interp, Tcl_NewIntObj((int)(!CmdIsNsfObject(cmd))));
      return TCL_OK;
    }
  case InfomethodsubcmdArgsIdx:
    {
      Tcl_Command importedCmd = GetOriginalCommand(cmd);
      return ListCmdParams(interp, importedCmd, contextObject, pattern, methodName, NSF_PARAMS_NAMES);
    }
  case InfomethodsubcmdParameterIdx:
    {
      Tcl_Command importedCmd = GetOriginalCommand(cmd);
      return ListCmdParams(interp, importedCmd, contextObject, pattern, methodName, NSF_PARAMS_PARAMETER);
    }
  case InfomethodsubcmdReturnsIdx:
    {
      Tcl_Obj *returnsObj = ParamDefsGetReturns(GetOriginalCommand(cmd));

      if (returnsObj != NULL) {
        Tcl_SetObjResult(interp, returnsObj);
      }
      return TCL_OK;
    }
  case InfomethodsubcmdSyntaxIdx:
    {
      Tcl_Command importedCmd = GetOriginalCommand(cmd);
      return ListCmdParams(interp, importedCmd, contextObject, pattern, methodName, NSF_PARAMS_SYNTAX);
    }

  case InfomethodsubcmdPreconditionIdx:
#if defined(NSF_WITH_ASSERTIONS)
      if (regObject != NULL) {
        NsfProcAssertion *procs = NULL;

        if (withPer_object == 1) {
          if (regObject->opt != NULL && regObject->opt->assertions != NULL) {
            procs = AssertionFindProcs(regObject->opt->assertions, methodName);
          }
        } else {
          NsfClass *class = (NsfClass *)regObject;
          if (class->opt != NULL && class->opt->assertions != NULL) {
            procs = AssertionFindProcs(class->opt->assertions, methodName);
          }
        }
        if (procs != NULL) {
          Tcl_SetObjResult(interp, AssertionList(interp, procs->pre));
        }
      }
#endif
      return TCL_OK;


  case InfomethodsubcmdPostconditionIdx:
#if defined(NSF_WITH_ASSERTIONS)
      if (regObject != NULL) {
        NsfProcAssertion *procs = NULL;

        if (withPer_object == 1) {
          if (regObject->opt != NULL && regObject->opt->assertions != NULL) {
            procs = AssertionFindProcs(regObject->opt->assertions, methodName);
          }
        } else {
          NsfClass *class = (NsfClass *)regObject;
          if (class->opt != NULL && class->opt->assertions != NULL) {
            procs = AssertionFindProcs(class->opt->assertions, methodName);
          }
        }
        if (procs != NULL) {
          Tcl_SetObjResult(interp, AssertionList(interp, procs->post));
        }
      }
#endif
      return TCL_OK;

  case InfomethodsubcmdSubmethodsIdx:
    {
      Tcl_Command origCmd = GetOriginalCommand(cmd);

      if (CmdIsNsfObject(origCmd)) {
        NsfObject *subObject = NsfGetObjectFromCmdPtr(origCmd);
        if (subObject != NULL) {
          return ListDefinedMethods(interp, subObject, NULL, NSF_TRUE /* per-object */,
                                    NSF_METHODTYPE_ALL, CallprotectionAllIdx, NSF_FALSE);
        }
      }
      /*
       * All other cases return empty.
       */
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_EMPTY]);
      return TCL_OK;
    }

  case InfomethodsubcmdBodyIdx:        NSF_FALL_THROUGH; /* fall through */
  case InfomethodsubcmdOriginIdx:      NSF_FALL_THROUGH; /* fall through */
  case InfomethodsubcmdTypeIdx:        NSF_FALL_THROUGH; /* fall through */
  case InfomethodsubcmdDefinitionIdx:  NSF_FALL_THROUGH; /* fall through */
  case InfomethodsubcmdDisassembleIdx: NSF_FALL_THROUGH; /* fall through */
  case InfomethodsubcmdNULL:
    break;
  }

  objCmdProc = Tcl_Command_objProc(cmd);
  procPtr = GetTclProcFromCommand(cmd);

  /*
   * The subcommands differ per type of method. The converter in
   * InfoMethods defines the types:
   *
   *    all|scripted|builtin|alias|forwarder|object|setter|nsfproc
   */
  if (procPtr != NULL) {
    /*
     * A scripted method.
     */
    switch (subcmd) {

    case InfomethodsubcmdTypeIdx:
      if (regObject != NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("scripted", -1));
      } else {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("proc", -1));
      }
      break;

    case InfomethodsubcmdBodyIdx:
      ListProcBody(interp, procPtr);
      break;

    case InfomethodsubcmdDisassembleIdx:
    {
      Tcl_Namespace *nsPtr;
      NsfParamDefs  *paramDefs;

      paramDefs = ParamDefsGet(cmd, NULL, &nsPtr);

      if (paramDefs == NULL || nsPtr == NULL) {
        nsPtr = (Tcl_Namespace *)procPtr->cmdPtr->nsPtr;
      }

      resultObj = DisassembleProc(interp, procPtr, methodName,
                                  (Namespace *)nsPtr);

      if (resultObj != NULL) {
        Tcl_SetObjResult(interp, resultObj);
      }
    }
    break;
    case InfomethodsubcmdDefinitionIdx:
      {
        resultObj = Tcl_NewListObj(0, NULL);

        /* todo: don't hard-code registering command name "method" / NSF_METHOD */
        if (regObject != NULL) {
          AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_METHOD],
                                   regObject, methodName, cmd, NSF_FALSE, outputPerObject, 1);
        } else {
          Tcl_DString ds, *dsPtr = &ds;

          Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("::proc", -1));

          Tcl_DStringInit(dsPtr);
          DStringAppendQualName(dsPtr, Tcl_Command_nsPtr(cmd), methodName);
          Tcl_ListObjAppendElement(interp, resultObj,
                                   Tcl_NewStringObj(Tcl_DStringValue(dsPtr),
                                                    Tcl_DStringLength(dsPtr)));
          Tcl_DStringFree(dsPtr);
        }
        ListCmdParams(interp, cmd, contextObject, NULL, methodName, NSF_PARAMS_PARAMETER);
        Tcl_ListObjAppendElement(interp, resultObj, Tcl_GetObjResult(interp));

        AppendReturnsClause(interp, resultObj, cmd);

        ListProcBody(interp, procPtr);
        Tcl_ListObjAppendElement(interp, resultObj, Tcl_GetObjResult(interp));

#if defined(NSF_WITH_ASSERTIONS)
        if (regObject != NULL) {
          NsfAssertionStore *assertions;

          if (withPer_object == 1) {
            assertions = (regObject->opt != NULL) ? regObject->opt->assertions : NULL;
          } else {
            NsfClass *class = (NsfClass *)regObject;
            assertions = (class->opt != NULL) ? class->opt->assertions : NULL;
          }

          if (assertions != NULL) {
            NsfProcAssertion *procs = AssertionFindProcs(assertions, methodName);
            if (procs != NULL) {
              Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("-precondition", -1));
              Tcl_ListObjAppendElement(interp, resultObj, AssertionList(interp, procs->pre));
              Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("-postcondition", -1));
              Tcl_ListObjAppendElement(interp, resultObj, AssertionList(interp, procs->post));
            }
          }
        }
#endif
        Tcl_SetObjResult(interp, resultObj);
        break;
      }
    case InfomethodsubcmdArgsIdx:               NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdDefinitionhandleIdx:   NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdExistsIdx:             NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdOriginIdx:             NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdParameterIdx:          NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdPostconditionIdx:      NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdPreconditionIdx:       NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdRegistrationhandleIdx: NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdReturnsIdx:            NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdSubmethodsIdx:         NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdSyntaxIdx:             NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdNULL:
    break;
    }

  } else if (objCmdProc == NsfForwardMethod) {
    /*
     * The command is a forwarder.
     */
    switch (subcmd) {
    case InfomethodsubcmdTypeIdx:
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_FORWARD]);
      break;
    case InfomethodsubcmdDefinitionIdx:
      if (regObject != NULL) {
        ClientData clientData;

        clientData = Tcl_Command_objClientData(cmd);
        if (clientData != NULL) {
          resultObj = Tcl_NewListObj(0, NULL);
          /* todo: don't hard-code registering command name "forward" / NSF_FORWARD*/
          AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_FORWARD],
                                   regObject, methodName, cmd, NSF_FALSE, outputPerObject, 1);
          AppendReturnsClause(interp, resultObj, cmd);

          AppendForwardDefinition(interp, resultObj, clientData);
          Tcl_SetObjResult(interp, resultObj);
        }
      }
      break;
    case InfomethodsubcmdArgsIdx:                NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdBodyIdx:                NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdDefinitionhandleIdx:    NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdExistsIdx:              NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdOriginIdx:              NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdParameterIdx:           NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdPostconditionIdx:       NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdPreconditionIdx:        NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdRegistrationhandleIdx:  NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdReturnsIdx:             NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdSubmethodsIdx:          NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdSyntaxIdx:              NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdDisassembleIdx:         NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdNULL:
      break;
    }

  } else if (objCmdProc == NsfSetterMethod) {
    /*
     * The cmd is one of the setter methods.
     */
    switch (subcmd) {
    case InfomethodsubcmdTypeIdx:
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_SETTER]);
      break;
    case InfomethodsubcmdDefinitionIdx:
      if (regObject != NULL) {
        SetterCmdClientData *cd = (SetterCmdClientData *)Tcl_Command_objClientData(cmd);

        resultObj = Tcl_NewListObj(0, NULL);
        /* todo: don't hard-code registering command name "setter" / NSF_SETTER */
        AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_SETTER], regObject,
                                 (cd != NULL && cd->paramsPtr) ? ObjStr(cd->paramsPtr->paramObj) : methodName,
                                 cmd, NSF_FALSE, outputPerObject, 1);
        Tcl_SetObjResult(interp, resultObj);
      }
      break;
    case InfomethodsubcmdArgsIdx:                NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdBodyIdx:                NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdDefinitionhandleIdx:    NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdExistsIdx:              NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdOriginIdx:              NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdParameterIdx:           NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdPostconditionIdx:       NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdPreconditionIdx:        NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdRegistrationhandleIdx:  NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdReturnsIdx:             NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdSubmethodsIdx:          NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdSyntaxIdx:              NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdDisassembleIdx:         NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdNULL:
      break;
    }
  } else if (objCmdProc == NsfProcStub) {
    /*
     * Special nsfproc handling:
     */
    NsfProcClientData *tcd = Tcl_Command_objClientData(cmd);

    if (tcd != NULL && tcd->procName) {
      Tcl_Command  procCmd = Tcl_GetCommandFromObj(interp, tcd->procName);
      Proc         *tProcPtr = GetTclProcFromCommand(procCmd);
      Tcl_DString  ds, *dsPtr = &ds;

      switch (subcmd) {

      case InfomethodsubcmdTypeIdx:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("nsfproc", -1));
        break;

      case InfomethodsubcmdBodyIdx:
        ListProcBody(interp, tProcPtr);
        break;

      case InfomethodsubcmdDefinitionIdx:
        resultObj = Tcl_NewListObj(0, NULL);
        Tcl_DStringInit(dsPtr);
        DStringAppendQualName(dsPtr, Tcl_Command_nsPtr(cmd), methodName);
        /* don't hardcode names */
        Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("::nsf::proc", -1));
        if ((tcd->flags & NSF_PROC_FLAG_AD) != 0) {
          Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("-ad", 3));
        }
        if (((unsigned int)Tcl_Command_flags(tcd->wrapperCmd) & NSF_CMD_DEBUG_METHOD) != 0) {
          Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("-debug", 6));
        }
        if (((unsigned int)Tcl_Command_flags(tcd->wrapperCmd) & NSF_CMD_DEPRECATED_METHOD) != 0) {
          Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("-deprecated", 11));
        }

        Tcl_ListObjAppendElement(interp, resultObj,
                                 Tcl_NewStringObj(Tcl_DStringValue(dsPtr),
                                                  Tcl_DStringLength(dsPtr)));
        ListCmdParams(interp, cmd, NULL, NULL, Tcl_DStringValue(dsPtr), NSF_PARAMS_PARAMETER);
        Tcl_ListObjAppendElement(interp, resultObj, Tcl_GetObjResult(interp));
        ListProcBody(interp, tProcPtr);
        Tcl_ListObjAppendElement(interp, resultObj, Tcl_GetObjResult(interp));
        Tcl_SetObjResult(interp, resultObj);
        Tcl_DStringFree(dsPtr);
        break;
      case InfomethodsubcmdDisassembleIdx:

        resultObj = DisassembleProc(interp, tProcPtr, methodName,
                                    tProcPtr->cmdPtr->nsPtr);

        if (resultObj != NULL) {
          Tcl_SetObjResult(interp, resultObj);
        }
        break;
      case InfomethodsubcmdArgsIdx:                NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdDefinitionhandleIdx:    NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdExistsIdx:              NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdOriginIdx:              NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdParameterIdx:           NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdPostconditionIdx:       NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdPreconditionIdx:        NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdRegistrationhandleIdx:  NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdReturnsIdx:             NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdSubmethodsIdx:          NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdSyntaxIdx:              NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdNULL:
        break;
      }
    }

  } else if (defObject != NULL) {
    /*
     * The cmd must be an alias or object.
     *
     * Note that some aliases come with objCmdProc == NsfObjDispatch.  In order
     * to distinguish between "object" and alias, we have to do the lookup for
     * the entryObj to determine whether it is really an alias.
     */
    Tcl_Obj *entryObj;

    entryObj = AliasGet(interp, defObject->cmdName,
                        Tcl_GetCommandName(interp, cmd),
                        regObject != defObject ? NSF_TRUE : withPer_object, NSF_FALSE);
    /*
      fprintf(stderr, "aliasGet %s -> %s/%s (%d) returned %p\n",
      ObjectName(defObject), methodName, Tcl_GetCommandName(interp, cmd),
      withPer_object, entryObj);
      fprintf(stderr, "... regObject %p %s\n", regObject, ObjectName(regObject));
      fprintf(stderr, "... defObject %p %s\n", defObject, ObjectName(defObject));
    */

    if (entryObj != NULL) {
      /*
       * The entry is an alias.
       */
      switch (subcmd) {
      case InfomethodsubcmdTypeIdx:
        Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_ALIAS]);
        break;
      case InfomethodsubcmdDefinitionIdx:
        if (regObject != NULL) {
          int nrElements;
          Tcl_Obj **listElements;

          resultObj = Tcl_NewListObj(0, NULL);
          Tcl_ListObjGetElements(interp, entryObj, &nrElements, &listElements);
          /* todo: don't hard-code registering command name "alias" / NSF_ALIAS */
          AppendMethodRegistration(interp, resultObj, NsfGlobalStrings[NSF_ALIAS],
                                   regObject, methodName, cmd,
                                   objCmdProc == NsfObjscopedMethod,
                                   outputPerObject, 1);
          AppendReturnsClause(interp, resultObj, cmd);
          Tcl_ListObjAppendElement(interp, resultObj, listElements[nrElements-1]);
          Tcl_SetObjResult(interp, resultObj);
        }
        break;

      case InfomethodsubcmdOriginIdx:
        {
          int nrElements;
          Tcl_Obj **listElements;
          Tcl_ListObjGetElements(interp, entryObj, &nrElements, &listElements);
          Tcl_SetObjResult(interp, listElements[nrElements-1]);
          break;
        }

      case InfomethodsubcmdArgsIdx:                NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdBodyIdx:                NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdDefinitionhandleIdx:    NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdExistsIdx:              NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdParameterIdx:           NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdPostconditionIdx:       NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdPreconditionIdx:        NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdRegistrationhandleIdx:  NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdReturnsIdx:             NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdSubmethodsIdx:          NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdSyntaxIdx:              NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdDisassembleIdx:         NSF_FALL_THROUGH; /* fall through */
      case InfomethodsubcmdNULL:
        break;
      }
    } else {
      /*
       * Check if the command is and nsfObject to be on the safe side.
       */
      if (CmdIsNsfObject(cmd)) {
        /*
         * The command is an object.
         */
        switch (subcmd) {
        case InfomethodsubcmdTypeIdx:
          Tcl_SetObjResult(interp, Tcl_NewStringObj("object", -1));
          break;
        case InfomethodsubcmdDefinitionIdx:
          {
            NsfObject *subObject = NsfGetObjectFromCmdPtr(cmd);

            assert(subObject != NULL);
            resultObj = Tcl_NewListObj(0, NULL);
            AppendMethodRegistration(interp, resultObj, "create",
                                     &(subObject->cl)->object,
                                     ObjStr(subObject->cmdName), cmd,
                                     NSF_FALSE, NSF_FALSE, 0);
            Tcl_SetObjResult(interp, resultObj);
            break;
          }

        case InfomethodsubcmdArgsIdx:                NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdBodyIdx:                NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdDefinitionhandleIdx:    NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdExistsIdx:              NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdParameterIdx:           NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdPostconditionIdx:       NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdPreconditionIdx:        NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdRegistrationhandleIdx:  NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdReturnsIdx:             NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdSubmethodsIdx:          NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdSyntaxIdx:              NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdOriginIdx:              NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdDisassembleIdx:         NSF_FALL_THROUGH; /* fall through */
        case InfomethodsubcmdNULL:
          break;
        }
      } else {
        /*
         * Should never happen.
         *
         * The warning is just a guess, so we don't raise an error here.
         */
        NsfLog(interp, NSF_LOG_WARN, "Could not obtain alias definition for %s. "
               "Maybe someone deleted the alias %s for object %s?",
               methodName, methodName, ObjectName(regObject));
        Tcl_ResetResult(interp);
      }
    }
  } else {
    /*
     * The cmd must be a plain unregistered cmd
     */
    switch (subcmd) {
    case InfomethodsubcmdTypeIdx:
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_CMD]);
      break;
    case InfomethodsubcmdDefinitionIdx:
      break;
    case InfomethodsubcmdOriginIdx:
      break;

    case InfomethodsubcmdArgsIdx:                NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdBodyIdx:                NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdDefinitionhandleIdx:    NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdExistsIdx:              NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdParameterIdx:           NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdPostconditionIdx:       NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdPreconditionIdx:        NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdRegistrationhandleIdx:  NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdReturnsIdx:             NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdSubmethodsIdx:          NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdSyntaxIdx:              NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdDisassembleIdx:         NSF_FALL_THROUGH; /* fall through */
    case InfomethodsubcmdNULL:
      break;
    }
  }

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * ListMethodResolve --
 *
 *      Call essentially ListMethod(), but try to resolve the method
 *      name/handle first.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int
ListMethodResolve(Tcl_Interp *interp, InfomethodsubcmdIdx_t subcmd,
                  NsfObject *contextObject, const char *pattern,
                  Tcl_Namespace *nsPtr, NsfObject *object,
                  Tcl_Obj *methodNameObj, bool fromClassNS)
  nonnull(1) nonnull(7);

static int
ListMethodResolve(Tcl_Interp *interp, InfomethodsubcmdIdx_t subcmd,
                  NsfObject *contextObject, const char *pattern,
                  Tcl_Namespace *nsPtr, NsfObject *object,
                  Tcl_Obj *methodNameObj, bool fromClassNS) {
  NsfObject   *regObject, *defObject;
  const char  *methodName1 = NULL;
  int          result = TCL_OK;
  Tcl_DString  ds, *dsPtr = &ds;
  Tcl_Command  cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodNameObj != NULL);

  Tcl_DStringInit(dsPtr);

  cmd = ResolveMethodName(interp, nsPtr, methodNameObj,
                          dsPtr, &regObject, &defObject, &methodName1, &fromClassNS);
  /*
   * If the cmd is NOT found, we return empty, unless for the sub-command
   * "exists", we return TCL_ERROR.
   */
  if (likely(cmd != NULL)) {

    result = ListMethod(interp, (regObject != NULL) ? regObject : object, (defObject != NULL) ? defObject : object,
                        methodName1, cmd, subcmd,
                        contextObject, pattern, (fromClassNS == 0));

  } else if (subcmd == InfomethodsubcmdExistsIdx) {
    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
  }

  Tcl_DStringFree(dsPtr);
  return result;
}


/*
 *----------------------------------------------------------------------
 * MethodSourceMatches --
 *
 *      Check, whether the provided class or object (mutually exclusive)
 *      matches with the required method source (typically
 *      all|application|system).
 *
 * Results:
 *      Returns boolean
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool MethodSourceMatches(DefinitionsourceIdx_t withSource, NsfClass *class, NsfObject *object) NSF_pure;

static bool
MethodSourceMatches(DefinitionsourceIdx_t withSource, NsfClass *class, NsfObject *object) {
  bool result;

  if (withSource == DefinitionsourceAllIdx) {
    result = NSF_TRUE;

  } else if (class == NULL) {
    /*
     * If the method is object specific, it can't be from a baseclass and must
     * be application specific.
     */
    assert(object != NULL);
    result = (withSource == DefinitionsourceApplicationIdx && !IsBaseClass(object));

  } else {
    bool isBaseClass;

    assert(class != NULL);

    isBaseClass = IsBaseClass(&class->object);
    if (withSource == DefinitionsourceSystemIdx && isBaseClass) {
      result = NSF_TRUE;
    } else if (withSource == DefinitionsourceApplicationIdx && !isBaseClass) {
      result = NSF_TRUE;
    } else {
      result = NSF_FALSE;
    }
  }
  return result;
}


/*
 *----------------------------------------------------------------------
 * MethodTypeMatches --
 *
 *      Check, whether the provided method (specified as a cmd) matches
 *      with the required method type (typically
 *      all|scripted|builtin|alias|forwarder|object|setter).
 *
 * Results:
 *      Returns Boolean value
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static bool MethodTypeMatches(Tcl_Interp *interp, MethodtypeIdx_t methodType, Tcl_Command cmd,
                              NsfObject *object, const char *methodName, int withPer_object,
                              bool *isObject)
  nonnull(1) nonnull(3) nonnull(5) nonnull(7);

static bool
MethodTypeMatches(Tcl_Interp *interp, MethodtypeIdx_t methodType, Tcl_Command cmd,
                  NsfObject *object, const char *methodName, int withPer_object,
                  bool *isObject) {
  Tcl_ObjCmdProc *proc;
  Tcl_Command     importedCmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(cmd != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(isObject != NULL);

  proc = Tcl_Command_objProc(cmd);
  importedCmd = GetOriginalCommand(cmd);

  /*
   * Return always state isObject, since the cmd might be an ensemble,
   * where we have to search further.
   */
  *isObject = CmdIsNsfObject(importedCmd);

  if (methodType == NSF_METHODTYPE_ALIAS) {
    if (!(proc == NsfProcAliasMethod
          || AliasGet(interp, object->cmdName, methodName, withPer_object, NSF_FALSE))
       ) {
      return NSF_FALSE;
      }
  } else {
    Tcl_ObjCmdProc *resolvedProc;

    if (proc == NsfProcAliasMethod) {
      if ((methodType & NSF_METHODTYPE_ALIAS) == 0) {
        return NSF_FALSE;
      }
    }
    resolvedProc = Tcl_Command_objProc(importedCmd);

    /*
     * The following cases are disjoint.
     */
    if (CmdIsProc(importedCmd)) {
      /*fprintf(stderr, "%s scripted %d\n", methodName, methodType & NSF_METHODTYPE_SCRIPTED);*/
      if ((methodType & NSF_METHODTYPE_SCRIPTED) == 0) {
        return NSF_FALSE;
      }
    } else if (resolvedProc == NsfForwardMethod) {
      if ((methodType & NSF_METHODTYPE_FORWARDER) == 0) {
        return NSF_FALSE;
      }
    } else if (resolvedProc == NsfSetterMethod) {
      if ((methodType & NSF_METHODTYPE_SETTER) == 0) {
        return NSF_FALSE;
      }
    } else if (*isObject) {
      if ((methodType & NSF_METHODTYPE_OBJECT) == 0) {
        return NSF_FALSE;
      }
    } else if (resolvedProc == NsfProcStub) {
      if ((methodType & NSF_METHODTYPE_NSFPROC) == 0) {
        return NSF_FALSE;
      }
    } else if ((methodType & NSF_METHODTYPE_OTHER) == 0) {
      /* fprintf(stderr, "OTHER %s not wanted %.4x\n", methodName, methodType);*/
      return NSF_FALSE;
    }
    /* NsfObjscopedMethod ??? */
  }
  return NSF_TRUE;
}

/*
 *----------------------------------------------------------------------
 * ProtectionMatches --
 *
 *      Check, whether the provided method (specified as a cmd) matches
 *      with the required call-protection (typically
 *      all|public|protected|private).
 *
 * Results:
 *      Returns boolean
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool ProtectionMatches(CallprotectionIdx_t withCallprotection, Tcl_Command cmd)
  nonnull(2) NSF_pure;

static bool
ProtectionMatches(CallprotectionIdx_t withCallprotection, Tcl_Command cmd) {
  int          result;
  bool         isProtected, isPrivate;
  unsigned int cmdFlags;

  nonnull_assert(cmd != NULL);

  cmdFlags    = (unsigned int)Tcl_Command_flags(cmd);
  isProtected = ((cmdFlags & NSF_CMD_CALL_PROTECTED_METHOD) != 0u);
  isPrivate   = ((cmdFlags & NSF_CMD_CALL_PRIVATE_METHOD) != 0u);

  if (withCallprotection == CallprotectionNULL) {
    withCallprotection = CallprotectionPublicIdx;
  }
  switch (withCallprotection) {
  case CallprotectionAllIdx: result = NSF_TRUE; break;
  case CallprotectionPublicIdx: result = (isProtected == 0); break;
  case CallprotectionProtectedIdx: result = (isProtected && !isPrivate); break;
  case CallprotectionPrivateIdx: result = isPrivate; break;
  case CallprotectionNULL: result = NSF_TRUE; break;
  default: result = NSF_FALSE; break;
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ListMethodKeys --
 *
 *      List the method names contained in the specified hash-table
 *      according to the filtering options (types, pattern,
 *      protection, etc.). Optionally, a name prefix can be provided
 *      in form of a Tcl_DString. The result is placed into the interp
 *      result.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static int ListMethodKeys(Tcl_Interp *interp, Tcl_HashTable *tablePtr,
                          Tcl_DString *prefix, const char *pattern,
                          MethodtypeIdx_t methodType, CallprotectionIdx_t withCallprotection, bool withPath,
                          Tcl_HashTable *dups, NsfObject *object, bool withPer_object)
  nonnull(1) nonnull(2);

static int
ListMethodKeys(Tcl_Interp *interp, Tcl_HashTable *tablePtr,
               Tcl_DString *prefix, const char *pattern,
               MethodtypeIdx_t methodType, CallprotectionIdx_t withCallprotection, bool withPath,
               Tcl_HashTable *dups, NsfObject *object, bool withPer_object) {
  Tcl_HashSearch       hSrch;
  const Tcl_HashEntry *hPtr;
  Tcl_Command          cmd;
  const char          *key;
  bool                 isObject, methodTypeMatch;
  Tcl_Obj             *resultObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(tablePtr != NULL);

  resultObj = Tcl_GetObjResult(interp);
  if (pattern != NULL && NoMetaChars(pattern) && strchr(pattern, ' ') == NULL) {
    /*
     * We have a pattern that can be used for direct lookup; no need
     * to iterate.
     */
    hPtr = Tcl_CreateHashEntry(tablePtr, pattern, NULL);
    if (hPtr != NULL) {
      NsfObject   *childObject;
      Tcl_Command  origCmd;

      key = Tcl_GetHashKey(tablePtr, hPtr);
      cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
      methodTypeMatch = MethodTypeMatches(interp, methodType, cmd, object, key,
                                          withPer_object, &isObject);
      if (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_CLASS_ONLY_METHOD) != 0u
          && !NsfObjectIsClass(object)) {
        return TCL_OK;
      }
      /*
       * Aliased objects methods return NSF_TRUE but lookup from cmd returns
       * NULL. Below, we are just interested on true sub-objects.
       */
      origCmd = GetOriginalCommand(cmd);
      childObject = (isObject) ? NsfGetObjectFromCmdPtr(origCmd) : NULL;

      if (childObject != NULL && withPath) {
        return TCL_OK;
      }

      if (ProtectionMatches(withCallprotection, cmd) && methodTypeMatch) {
        int prefixLength = (prefix != NULL) ? Tcl_DStringLength(prefix) : 0;

        if (prefixLength != 0) {
          Tcl_DStringAppend(prefix, key, -1);
          key = Tcl_DStringValue(prefix);
        }
        if (dups != NULL) {
          int new;

          (void)Tcl_CreateHashEntry(dups, key, &new);
          if (new != 0) {
            Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(key, -1));
          }
        } else {
          Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(key, -1));
        }
      }
    }
    return TCL_OK;

  } else {
    int prefixLength = (prefix != NULL) ? Tcl_DStringLength(prefix) : 0;

    /*
     * We have to iterate over the elements.
     */

    for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSrch);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&hSrch)) {
      NsfObject   *childObject;
      Tcl_Command  origCmd;

      key = Tcl_GetHashKey(tablePtr, hPtr);
      cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
      if (prefixLength != 0) {
        Tcl_DStringSetLength(prefix, prefixLength);
      }
      methodTypeMatch = MethodTypeMatches(interp, methodType, cmd, object, key,
                                          withPer_object, &isObject);
      /*
       * Aliased objects methods return NSF_TRUE but lookup from cmd returns
       * NULL. Below, we are just interested on true sub-objects.
       */
      origCmd = GetOriginalCommand(cmd);
      childObject = (isObject) ? NsfGetObjectFromCmdPtr(origCmd) : NULL;

      if (childObject != NULL) {
        if (withPath) {
          Tcl_HashTable *cmdTablePtr;

          if (childObject->nsPtr == NULL) {
            /*
             * Nothing to do.
             */
            continue;
          }
          cmdTablePtr = Tcl_Namespace_cmdTablePtr(childObject->nsPtr);
          if (cmdTablePtr == NULL) {
            /*
             * Nothing to do.
             */
            continue;
          }
          if ((childObject->flags & NSF_IS_SLOT_CONTAINER) != 0u) {
            /*
             * Don't report slot container.
             */
            continue;
          }
          if ((childObject->flags & NSF_KEEP_CALLER_SELF) == 0u) {
            /*
             * Do only report sub-objects with keep caller self.
             */
            continue;
          }

          /*fprintf(stderr, "ListMethodKeys key %s append key space flags %.6x\n",
            key, childObject->flags);*/
          if (prefix == NULL) {
            Tcl_DString ds, *dsPtr = &ds;

            DSTRING_INIT(dsPtr);
            Tcl_DStringAppend(dsPtr, key, -1);
            Tcl_DStringAppend(dsPtr, " ", 1);
            ListMethodKeys(interp, cmdTablePtr, dsPtr, pattern, methodType,
                           withCallprotection, NSF_TRUE, dups, object, withPer_object);
            DSTRING_FREE(dsPtr);
          } else {
            Tcl_DStringAppend(prefix, key, -1);
            Tcl_DStringAppend(prefix, " ", 1);
            ListMethodKeys(interp, cmdTablePtr, prefix, pattern, methodType,
                           withCallprotection, NSF_TRUE, dups, object, withPer_object);
          }
          /*
           * Don't list ensembles by themselves.
           */
          continue;
        }
      }

      if (((unsigned int)Tcl_Command_flags(cmd) & NSF_CMD_CLASS_ONLY_METHOD) != 0u
          && !NsfObjectIsClass(object)
          ) {
        continue;
      }
      if (!ProtectionMatches(withCallprotection, cmd)
          || (!methodTypeMatch)) {
        continue;
      }

      if (prefixLength != 0) {
        Tcl_DStringAppend(prefix, key, -1);
        key = Tcl_DStringValue(prefix);
      }

      if (pattern != NULL && !Tcl_StringMatch(key, pattern)) {
        continue;
      }
      if (dups != NULL) {
        int new;

        Tcl_CreateHashEntry(dups, key, &new);
        if (new == 0) {
          continue;
        }
      }
      Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(key, -1));
    }
  }
  /*fprintf(stderr, "listkeys returns '%s'\n", ObjStr(Tcl_GetObjResult(interp)));*/
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListChildren --
 *
 *      List the children of the specified object. The result can be
 *      filtered via a pattern or a type.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static int ListChildren(
    Tcl_Interp *interp, NsfObject *object,
    const char *pattern,
    bool classesOnly, NsfClass *typeClass
) nonnull(1) nonnull(2);

static int
ListChildren(
    Tcl_Interp *interp, NsfObject *object,
    const char *pattern,
    bool classesOnly, NsfClass *typeClass
) {
  NsfObject *childObject;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (object->nsPtr == NULL) {
    return TCL_OK;
  }

  if (pattern != NULL && NoMetaChars(pattern)) {
    Tcl_DString ds, *dsPtr = &ds;

    Tcl_DStringInit(dsPtr);

    if (*pattern != ':') {
      /*
       * Build a fully qualified name.
       */
      DStringAppendQualName(dsPtr, object->nsPtr, pattern);
      pattern = Tcl_DStringValue(dsPtr);
    }

    if ((childObject = GetObjectFromString(interp, pattern)) &&
        (!classesOnly || NsfObjectIsClass(childObject)) &&
        ((typeClass == NULL) || IsSubType(childObject->cl, typeClass)) &&
        (Tcl_Command_nsPtr(childObject->id) == object->nsPtr)  /* true children */
        ) {
      Tcl_SetObjResult(interp, childObject->cmdName);
    } else {
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_EMPTY]);
    }
    Tcl_DStringFree(dsPtr);

  } else {
    Tcl_Obj *list = Tcl_NewListObj(0, NULL);
    Tcl_HashSearch hSrch;
    Tcl_HashTable *cmdTablePtr = Tcl_Namespace_cmdTablePtr(object->nsPtr);
    const Tcl_HashEntry *hPtr;

    for (hPtr = Tcl_FirstHashEntry(cmdTablePtr, &hSrch);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&hSrch)) {
      const char *key = Tcl_GetHashKey(cmdTablePtr, hPtr);

      if (pattern == NULL || Tcl_StringMatch(key, pattern)) {
        Tcl_Command cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);

        /*fprintf(stderr, "... check %s child key %s child object %p %p\n",
                ObjectName(object), key, GetObjectFromString(interp, key),
                NsfGetObjectFromCmdPtr(cmd));*/

        if ((childObject = NsfGetObjectFromCmdPtr(cmd)) &&
            (!classesOnly || NsfObjectIsClass(childObject)) &&
            ((typeClass == NULL) || IsSubType(childObject->cl, typeClass)) &&
            (Tcl_Command_nsPtr(childObject->id) == object->nsPtr)  /* true children */
            ) {
          Tcl_ListObjAppendElement(interp, list, childObject->cmdName);
        }
      }
    }
    Tcl_SetObjResult(interp, list);
  }

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListForward --
 *
 *      List registered forwarder defined in the hash table. The result
 *      can be filtered via a pattern, optionally the forward definition
 *      is returned.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static int ListForward(Tcl_Interp *interp, Tcl_HashTable *tablePtr,
            const char *pattern, int withDefinition)
  nonnull(1) nonnull(2);

static int
ListForward(Tcl_Interp *interp, Tcl_HashTable *tablePtr,
            const char *pattern, int withDefinition) {

  nonnull_assert(interp != NULL);
  nonnull_assert(tablePtr != NULL);

  if (withDefinition != 0) {
    const Tcl_HashEntry *hPtr = (pattern != NULL) ? Tcl_CreateHashEntry(tablePtr, pattern, NULL) : NULL;
    /*
     * Notice: we don't use pattern for wildcard matching here; pattern can
     * only contain wildcards when used without "-definition".
     */
    if (hPtr != NULL) {
      Tcl_Command cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
      ClientData clientData = (cmd != NULL) ? Tcl_Command_objClientData(cmd) : NULL;
      ForwardCmdClientData *tcd = (ForwardCmdClientData *)clientData;

      if (tcd != NULL && Tcl_Command_objProc(cmd) == NsfForwardMethod) {
        Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);

        AppendForwardDefinition(interp, listObj, tcd);
        Tcl_SetObjResult(interp, listObj);
        return TCL_OK;
      }
    }
    return NsfPrintError(interp, "'%s' is not a forwarder", pattern);
  }
  return ListMethodKeys(interp, tablePtr, NULL, pattern, NSF_METHODTYPE_FORWARDER,
                        CallprotectionAllIdx, NSF_FALSE, NULL, NULL, NSF_FALSE);
}

/*
 *----------------------------------------------------------------------
 *
 * ListDefinedMethods --
 *
 *      List the methods defined by the specified object/class
 *      according to the filtering options (types, pattern,
 *      protection, etc.). The result is placed into the interp
 *      result.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */
static int
ListDefinedMethods(Tcl_Interp *interp, NsfObject *object, const char *pattern,
                   bool withPer_object,
                   MethodtypeIdx_t methodType,
                   CallprotectionIdx_t withCallprotection,
                   bool withPath) {
  Tcl_HashTable *cmdTablePtr;
  Tcl_DString ds, *dsPtr = NULL;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (pattern != NULL && *pattern == ':' && *(pattern + 1) == ':') {
    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
    const char *remainder;

    /*fprintf(stderr, "we have a colon pattern '%s' methodtype %.6x\n", pattern, methodType);*/

    TclGetNamespaceForQualName(interp, pattern, NULL, 0,
                               &nsPtr, &dummy1Ptr, &dummy2Ptr, &remainder);
    /*fprintf(stderr,
            "TclGetNamespaceForQualName with %s => (%p %s) (%p %s) (%p %s) (%p %s)\n",
            pattern,
            nsPtr, (nsPtr != NULL) ? nsPtr->fullName : "",
            dummy1Ptr, (dummy1Ptr != NULL) ? dummy1Ptr->fullName : "",
            dummy2Ptr, (dummy2Ptr != NULL) ? dummy2Ptr->fullName : "",
            remainder, (remainder != 0) ? remainder : "");*/
    if (nsPtr != NULL) {
      cmdTablePtr = Tcl_Namespace_cmdTablePtr(nsPtr);
      dsPtr = &ds;
      Tcl_DStringInit(dsPtr);
      Tcl_DStringAppend(dsPtr, nsPtr->fullName, -1);
      if (Tcl_DStringLength(dsPtr) > 2) {
        Tcl_DStringAppend(dsPtr, "::", 2);
      }
      pattern = remainder;
    } else {
      cmdTablePtr = NULL;
    }
  } else if (NsfObjectIsClass(object) && !withPer_object) {
    cmdTablePtr = Tcl_Namespace_cmdTablePtr(((NsfClass *)object)->nsPtr);
  } else {
    cmdTablePtr = (object->nsPtr != NULL) ? Tcl_Namespace_cmdTablePtr(object->nsPtr) : NULL;
  }

  if (cmdTablePtr != NULL) {
    ListMethodKeys(interp, cmdTablePtr, dsPtr, pattern, methodType, withCallprotection, withPath,
                   NULL, object, withPer_object);
    if (dsPtr != NULL) {
      Tcl_DStringFree(dsPtr);
    }
  }
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ListSuperClasses --
 *
 *      List the superclasses of a class. Optionally the transitive
 *      closure is computed and the result can be filtered via a
 *      pattern.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int ListSuperClasses(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *pattern, bool withClosure)
  nonnull(1) nonnull(2);

static int
ListSuperClasses(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *pattern, bool withClosure) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  if (class->super != NULL) {
    NsfObject   *matchObject = NULL;
    Tcl_Obj     *outObjPtr, *patternObj = NULL;
    const char  *patternString = NULL;
    ClientData   clientData;
    bool         found;

    if (pattern != NULL
        && ConvertToObjpattern(interp, pattern, NULL, &clientData, &outObjPtr) == TCL_OK
        ) {
      patternObj = (Tcl_Obj *)clientData;

      if (GetMatchObject(interp, patternObj, pattern, &matchObject, &patternString) == -1) {
        /*
         * The pattern has no meta chars and does not correspond to an existing
         * object. Therefore, it can't be a superclass.
         */
        if (patternObj != NULL) {
          DECR_REF_COUNT2("patternObj", patternObj);
        }
        return TCL_OK;
      }
    }

    if (withClosure) {
      NsfClasses *pl = PrecedenceOrder(class);

      if (pl != NULL) {
        pl = pl->nextPtr;
      }
      found = AppendMatchingElementsFromClasses(interp, pl, patternString, matchObject);
    } else {
      NsfClasses *clSuper = NsfReverseClasses(class->super);

      found = AppendMatchingElementsFromClasses(interp, clSuper, patternString, matchObject);
      NsfClassListFree(clSuper);
    }

    if (matchObject != NULL) {
      Tcl_SetObjResult(interp, found ? matchObject->cmdName : NsfGlobalObjs[NSF_EMPTY]);
    }

    if (patternObj != NULL) {
      DECR_REF_COUNT2("patternObj", patternObj);
    }

  }
  return TCL_OK;
}


/********************************
 * End result setting commands
 ********************************/

/*
 *----------------------------------------------------------------------
 *
 * AliasIndex --
 *
 *      The alias index is an internal data structure keeping track of
 *      constructing aliases. This function computes the key of the index.
 *
 * Results:
 *      Returns a fresh Tcl_Obj. The caller is responsible for refcounting.
 *
 * Side effects:
 *      updating DString
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj *AliasIndex(Tcl_Obj *cmdName, const char *methodName, bool withPer_object)
  nonnull(1) nonnull(2) returns_nonnull;

static Tcl_Obj *
AliasIndex(Tcl_Obj *cmdName, const char *methodName, bool withPer_object) {
  Tcl_DString  ds, *dsPtr = &ds;
  Tcl_Obj     *resultObj;

  nonnull_assert(cmdName != NULL);
  nonnull_assert(methodName != NULL);

  Tcl_DStringInit(dsPtr);
  Tcl_DStringAppend(dsPtr,  ObjStr(cmdName), -1);
  Tcl_DStringAppend(dsPtr,  ",", 1);
  Tcl_DStringAppend(dsPtr,  methodName, -11);
  if (withPer_object) {
    Tcl_DStringAppend(dsPtr, ",1", 2);
  } else {
    Tcl_DStringAppend(dsPtr, ",0", 2);
  }
  /*fprintf(stderr, "AI %s\n", Tcl_DStringValue(dsPtr));*/
  resultObj = Tcl_NewStringObj(dsPtr->string, dsPtr->length);
  Tcl_DStringFree(dsPtr);

  return resultObj;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasAdd --
 *
 *      Add an alias to the alias index
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Adding value to the hidden associated array.
 *
 *----------------------------------------------------------------------
 */
static int AliasAdd(Tcl_Interp *interp, Tcl_Obj *cmdName, const char *methodName, bool withPer_object,
         Tcl_Obj *cmdObj)
  nonnull(1) nonnull(2) nonnull(3) nonnull(5);

static int
AliasAdd(Tcl_Interp *interp, Tcl_Obj *cmdName, const char *methodName, bool withPer_object,
         Tcl_Obj *cmdObj) {
  Tcl_Obj    *indexObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(cmdName != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cmdObj != NULL);



  indexObj = AliasIndex(cmdName, methodName, withPer_object);

  INCR_REF_COUNT(indexObj);
  Tcl_ObjSetVar2(interp, NsfGlobalObjs[NSF_ARRAY_ALIAS],
                 indexObj,
                 cmdObj,
                 TCL_GLOBAL_ONLY);
  DECR_REF_COUNT(indexObj);

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasDelete --
 *
 *      Deletes an alias from the index.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Deletes an entry from the hidden associative array.
 *
 *----------------------------------------------------------------------
 */
static int
AliasDelete(Tcl_Interp *interp, Tcl_Obj *cmdName, const char *methodName, bool withPer_object) {
  int         result;
  Tcl_Obj    *indexObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(cmdName != NULL);
  nonnull_assert(methodName != NULL);

  indexObj = AliasIndex(cmdName, methodName, withPer_object);
  INCR_REF_COUNT(indexObj);
  result = Tcl_UnsetVar2(interp, NsfGlobalStrings[NSF_ARRAY_ALIAS],
                         ObjStr(indexObj),
                         TCL_GLOBAL_ONLY);
  DECR_REF_COUNT(indexObj);

  /*fprintf(stderr, "aliasDelete ::nsf::alias(%s) returned %d (%d)\n",
    AliasIndex(dsPtr, cmdName, methodName, withPer_object), result);*/

  return result;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasGet --
 *
 *      Get an entry from the alias index.
 *
 * Results:
 *      Alias in form of a Tcl_Obj* (or NULL).
 *
 * Side effects:
 *      delete an entry from the hidden associative array
 *
 *----------------------------------------------------------------------
 */
static Tcl_Obj *
AliasGet(Tcl_Interp *interp, Tcl_Obj *cmdName, const char *methodName, bool withPer_object, bool leaveError) {
  Tcl_Obj *obj, *indexObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(cmdName != NULL);
  nonnull_assert(methodName != NULL);

  indexObj = AliasIndex(cmdName, methodName, withPer_object);

  INCR_REF_COUNT(indexObj);
  obj = Tcl_ObjGetVar2(interp,
                       NsfGlobalObjs[NSF_ARRAY_ALIAS],
                       indexObj,
                       TCL_GLOBAL_ONLY);
  DECR_REF_COUNT(indexObj);

  /*fprintf(stderr, "aliasGet methodName '%s' returns %p\n", methodName, obj);*/

  if (obj == NULL && leaveError) {
    NsfPrintError(interp, "could not obtain alias definition for %s %s.",
                  ObjStr(cmdName), methodName);
  }

  return obj;
}


/*
 *----------------------------------------------------------------------
 * AliasDeleteObjectReference --
 *
 *      Delete an alias to a referenced object. Such aliases are
 *      created by registering an alias to an object. This function
 *      distinguishes between a sub-object and an alias to an object,
 *      deletes the alias but never the referenced object.
 *
 * Results:
 *      Boolean value indicating when alias is deleted.
 *
 * Side effects:
 *      Deletes cmd sometimes
 *
 *----------------------------------------------------------------------
 */
static bool
AliasDeleteObjectReference(Tcl_Interp *interp, Tcl_Command cmd) {
  NsfObject *referencedObject = NsfGetObjectFromCmdPtr(cmd);

  nonnull_assert(interp != NULL);
  nonnull_assert(cmd != NULL);
  nonnull_assert(referencedObject != NULL);

  /*fprintf(stderr, "AliasDeleteObjectReference on %p obj %p\n", cmd, referencedObject);*/
  if (referencedObject->refCount > 0
      && cmd != referencedObject->id) {
    /*
     * The cmd is an aliased object, reduce the refCount of the
     * object, delete the cmd.
     */
    /*fprintf(stderr, "remove alias %s to %s\n",
      Tcl_GetCommandName(interp, cmd), ObjectName(referencedObject));*/
    NsfCleanupObject(referencedObject, "AliasDeleteObjectReference");
    Tcl_DeleteCommandFromToken(interp, cmd);
    return NSF_TRUE;
  }
  return NSF_FALSE;
}

/*
 *----------------------------------------------------------------------
 * AliasRefetch --
 *
 *      Perform a refetch of an epoched aliased cmd and update the
 *      AliasCmdClientData structure with fresh values.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static int
AliasRefetch(Tcl_Interp *interp, NsfObject *object, const char *methodName, AliasCmdClientData *tcd) {
  Tcl_Obj **listElements, *entryObj, *targetObj;
  int nrElements, withPer_object;
  NsfObject *defObject;
  Tcl_Command cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(tcd != NULL);

  /*fprintf(stderr, "AliasRefetch %s\n", methodName);*/

  defObject = (tcd->class != NULL) ? &(tcd->class->object) : object;

  /*
   * Get the targetObject. Currently, we can get it just via the
   * alias array.
   */
  withPer_object = (tcd->class == NULL);
  entryObj = AliasGet(interp, defObject->cmdName, methodName, withPer_object, NSF_TRUE);
  if (unlikely(entryObj == NULL)) {
    return TCL_ERROR;
  }

  INCR_REF_COUNT(entryObj);
  Tcl_ListObjGetElements(interp, entryObj, &nrElements, &listElements);
  targetObj = listElements[nrElements-1];

  NsfLog(interp, NSF_LOG_NOTICE,
         "trying to refetch an epoched cmd %p as %s -- cmdName %s",
         (void *)tcd->aliasedCmd, methodName, ObjStr(targetObj));

  /*
   * Replace cmd and its objProc and clientData with a newly fetched
   * version.
   */
  cmd = Tcl_GetCommandFromObj(interp, targetObj);
  if (cmd != NULL) {
    cmd = GetOriginalCommand(cmd);
    /*fprintf(stderr, "cmd %p epoch %d deleted %.6x\n",
      cmd,
      Tcl_Command_cmdEpoch(cmd),
      Tcl_Command_flags(cmd) & CMD_IS_DELETED);*/
    if (((unsigned int)Tcl_Command_flags(cmd) & CMD_IS_DELETED) != 0u) {
      cmd = NULL;
    }
  }
  if (cmd == NULL) {
    int result = NsfPrintError(interp, "target \"%s\" of alias %s apparently disappeared",
                               ObjStr(targetObj), methodName);
    DECR_REF_COUNT(entryObj);
    return result;
  }

  assert(Tcl_Command_objProc(cmd) != NULL);

  NsfCommandRelease(tcd->aliasedCmd);
  tcd->objProc    = Tcl_Command_objProc(cmd);
  tcd->aliasedCmd = cmd;
  tcd->clientData = Tcl_Command_objClientData(cmd);
  NsfCommandPreserve(tcd->aliasedCmd);

  DECR_REF_COUNT(entryObj);
  /*
   * Now, we should be able to proceed as planned, we have an
   * non-epoched aliasCmd.
   */
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * AliasDereference --
 *
 *      Dereference a cmd in respect of the alias structure. If necessary,
 *      this command refetches the aliased command.
 *
 * Results:
 *      NULL, in case refetching fails,
 *      the aliased cmd if it was an alias, or
 *      the original cmd
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
NSF_INLINE static Tcl_Command AliasDereference(Tcl_Interp *interp, NsfObject *object, const char *methodName, Tcl_Command cmd)
  nonnull(1) nonnull(2) nonnull(3) nonnull(4);

NSF_INLINE static Tcl_Command
AliasDereference(Tcl_Interp *interp, NsfObject *object, const char *methodName, Tcl_Command cmd) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);
  nonnull_assert(cmd != NULL);

  if (unlikely(Tcl_Command_objProc(cmd) == NsfProcAliasMethod)) {
    AliasCmdClientData *tcd = (AliasCmdClientData *)Tcl_Command_objClientData(cmd);

    assert(tcd != NULL);
    /*fprintf(stderr, "AliasDereference %s epoch %d\n", methodName, Tcl_Command_cmdEpoch(tcd->aliasedCmd));*/
    if (unlikely(Tcl_Command_cmdEpoch(tcd->aliasedCmd) != 0)) {

      /*fprintf(stderr, "NsfProcAliasMethod aliasedCmd %p epoch %p\n",
        tcd->aliasedCmd, Tcl_Command_cmdEpoch(tcd->aliasedCmd));*/

      if (AliasRefetch(interp, object, methodName, tcd) != TCL_OK) {
        return NULL;
      }
    }
    return tcd->aliasedCmd;
  }

  return cmd;
}

#if defined(NSF_ASSEMBLE)
# include "asm/nsfAssemble.c"
#else
static int
  NsfAsmMethodCreateCmd(Tcl_Interp *UNUSED(interp),
                        NsfObject *UNUSED(defObject),
                        int UNUSED(with_checkAlways),
                        int UNUSED(withInner_namespace),
                        int UNUSED(withPer_object),
                        NsfObject *UNUSED(regObject),
                        Tcl_Obj *UNUSED(nameObj),
                        Tcl_Obj *UNUSED(argumentsObj),
                        Tcl_Obj *UNUSED(bodyObj))
{
  /*
   * Dummy stub; used, when compiled without NSF_ASSEMBLE
   */
  return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 * SetBooleanFlag --
 *
 *      Set an unsigned int flag based on valueObj
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      update passed flags
 *
 *----------------------------------------------------------------------
 */

static int SetBooleanFlag(Tcl_Interp *interp, unsigned int *flagsPtr, unsigned int flag, Tcl_Obj *valueObj, int *flagValue)
  nonnull(1) nonnull(2) nonnull(4) nonnull(5);

static int
SetBooleanFlag(Tcl_Interp *interp, unsigned int *flagsPtr, unsigned int flag, Tcl_Obj *valueObj, int *flagValue) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(flagsPtr != NULL);
  nonnull_assert(valueObj != NULL);
  nonnull_assert(flagValue != NULL);

  result = Tcl_GetBooleanFromObj(interp, valueObj, flagValue);
  if (unlikely(result != TCL_OK)) {
    return result;
  }
  if (*flagValue) {
    *flagsPtr |= flag;
  } else {
    *flagsPtr &= ~flag;
  }
  return result;
}

/***********************************************************************
 * Begin generated Next Scripting commands
 ***********************************************************************/

/*
cmd __db_compile_epoch NsfDebugCompileEpoch {}
 */
static int NsfDebugCompileEpoch(Tcl_Interp *interp)
  nonnull(1);

static int
NsfDebugCompileEpoch(Tcl_Interp *interp) {

  nonnull_assert(interp != NULL);

  Tcl_SetObjResult(interp, Tcl_NewIntObj((int)(((Interp *)interp)->compileEpoch)));
  return TCL_OK;
}

/*
cmd __db_show_obj NsfDebugShowObj {
  {-argName "obj"    -required 1 -type tclobj}
}
*/
static int NsfDebugShowObj(Tcl_Interp *interp, Tcl_Obj *obj)
  nonnull(1) nonnull(2);

static int
NsfDebugShowObj(Tcl_Interp *interp, Tcl_Obj *obj) {

  nonnull_assert(interp != NULL);
  nonnull_assert(obj != NULL);

  fprintf(stderr, "*** obj %p refCount %d type <%s> ",
          (void *)obj, obj->refCount, ObjTypeStr(obj));

  if (obj->typePtr == &NsfObjectMethodObjType
      || obj->typePtr == &NsfInstanceMethodObjType
      ) {
    NsfMethodContext *mcPtr = obj->internalRep.twoPtrValue.ptr1;
    unsigned int currentMethodEpoch = obj->typePtr == &NsfObjectMethodObjType ?
      RUNTIME_STATE(interp)->objectMethodEpoch :
      RUNTIME_STATE(interp)->instanceMethodEpoch;
    Tcl_Command cmd = mcPtr->cmd;

    fprintf(stderr, "   method epoch %u max %u cmd %p objProc 0x%" PRIxPTR " flags %.6x",
            mcPtr->methodEpoch, currentMethodEpoch,
            (void *)cmd,
            (cmd != NULL) ? (unsigned long)PTR2UINT(((Command *)cmd)->objProc) : 0ul,
            mcPtr->flags);
    if (cmd != NULL) {
      fprintf(stderr, "... cmd %p flags %.6x\n", (void *)cmd, Tcl_Command_flags(cmd));
      assert(((Command *)cmd)->objProc != NULL);
    }
    assert(currentMethodEpoch >= mcPtr->methodEpoch);

  } else if (obj->typePtr == Nsf_OT_tclCmdNameType) {
    Tcl_Command cmd = Tcl_GetCommandFromObj(interp, obj);

    if (likely(cmd != NULL)) {
      Command    *procPtr = (Command *)cmd;
      const char *tail = Tcl_GetHashKey(procPtr->hPtr->tablePtr, procPtr->hPtr);

      fprintf(stderr, "... cmd %p flags %.6x name '%s' ns '%s' objProcName %s",
              (void *)cmd, Tcl_Command_flags(cmd), tail, procPtr->nsPtr->name,
              CmdObjProcName(cmd));
    }
  } else if ((obj->typePtr == Nsf_OT_byteArrayType)
             || (obj->typePtr == Nsf_OT_properByteArrayType)) {
    const char *bytes;
    int         i, length;

    bytes = (char *)Tcl_GetByteArrayFromObj(obj, &length);

    fprintf(stderr, "bytearray proper %d length %d string rep %p: ",
            (obj->typePtr == Nsf_OT_properByteArrayType),
            length, (void*)obj->bytes);
    for (i = 0; i < length; i++) {
      fprintf(stderr, "%.2x", (unsigned)(*(bytes+i)) & 0xff);
    }
  }
  fprintf(stderr, "\n");

  return TCL_OK;
}

/*
cmd __db_get_obj NsfDebugGetDict {
  {-argName "obj"    -required 1 -type tclobj}
}
*/
#define NSF_DEBUG_SHOW_BYTES 10u
static int NsfDebugGetDict(Tcl_Interp *interp, Tcl_Obj *obj)
  nonnull(1) nonnull(2);

static int
NsfDebugGetDict(Tcl_Interp *interp, Tcl_Obj *obj) {
  Tcl_Obj    *resultObj;
  const char *typeString;

  nonnull_assert(interp != NULL);
  nonnull_assert(obj != NULL);

  typeString = (obj->typePtr != NULL) ? obj->typePtr->name : "";

  resultObj = Tcl_NewListObj(0, NULL);
  Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("type", -1));
  Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(typeString, -1));
  Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("refcount", -1));
  Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewIntObj(obj->refCount));
  Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("length", -1));
  Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewIntObj(obj->length));
  Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("hex", -1));

  if (obj->bytes != NULL) {
    size_t       i, objLength = (size_t)obj->length;
    char         trailer[3] = "...";
    char         buffer[NSF_DEBUG_SHOW_BYTES*2u + sizeof(trailer) + 1u];

    for (i = 0; i < NSF_DEBUG_SHOW_BYTES && i < objLength; i++) {
      snprintf(buffer + i*2, sizeof(buffer) - (i+1)*2, "%.2x", (unsigned)(*((obj->bytes)+i) & 0xff));
    }
    if (objLength > NSF_DEBUG_SHOW_BYTES) {
      memmove(buffer, trailer, sizeof(buffer) - strlen(buffer) - 1);
    }
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(buffer, -1));

  } else {
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("", 0));
  }
  Tcl_SetObjResult(interp, resultObj);

  return TCL_OK;
}

/*
cmd __db_show_stack NsfShowStackCmd {}
*/
static int
NsfShowStackCmd(Tcl_Interp *interp) {

  nonnull_assert(interp != NULL);

  NsfShowStack(interp);
  return TCL_OK;
}

/*
cmd __db_run_assertions NsfDebugRunAssertionsCmd {}
*/
static int
NsfDebugRunAssertionsCmd(Tcl_Interp *interp) {
  NsfObjectSystem *osPtr;
  NsfCmdList      *instances = NULL, *entry;

  nonnull_assert(interp != NULL);

  /*
   * Collect all instances from all object systems.
   */
  for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr != NULL; osPtr = osPtr->nextPtr) {
    GetAllInstances(interp, &instances, osPtr->rootClass);
  }

  for (entry = instances; entry != NULL; entry = entry->nextPtr) {
#if !defined(NDEBUG)
    NsfObject *object = (NsfObject *)entry->clorobj;
#endif

    assert(object != NULL);
    assert(object->refCount > 0);
    assert(object->cmdName->refCount > 0);
    assert(object->activationCount >= 0);

#if defined(CHECK_ACTIVATION_COUNTS)
    if (object->activationCount > 0) {
      Tcl_CallFrame *framePtr;
      int            count = 0;
      NsfClasses    *unstackedEntries = RUNTIME_STATE(interp)->cscList;

      /*fprintf(stderr, "DEBUG obj %p %s activationcount %d\n",
        object, ObjectName(object), object->activationCount);*/

      framePtr = (Tcl_CallFrame *)Tcl_Interp_framePtr(interp);
      for (; framePtr != NULL; framePtr = Tcl_CallFrame_callerPtr(framePtr)) {
        int                  frameFlags = Tcl_CallFrame_isProcCallFrame(framePtr);
        NsfCallStackContent *cscPtr =
          ((frameFlags & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) != 0u) ?
          ((NsfCallStackContent *)Tcl_CallFrame_clientData(framePtr)) : NULL;

        if (cscPtr != NULL && cscPtr->self == object) {
          count ++;
        }
        if (cscPtr != NULL && (NsfObject *)cscPtr->cl == object) {
          count ++;
        }
      }
      for (; unstackedEntries; unstackedEntries = unstackedEntries->nextPtr) {
        NsfCallStackContent *cscPtr = (NsfCallStackContent *)unstackedEntries->cl;

        if (cscPtr != NULL && cscPtr->self == object) {
          count ++;
        }
        if (cscPtr != NULL && (NsfObject *)cscPtr->cl == object) {
          count ++;
        }
      }

      if (count != object->activationCount) {
        fprintf(stderr, "DEBUG obj %p %s activationcount %d on stack %d; "
                "might be from non-stacked but active call-stack content\n",
                object, ObjectName(object), object->activationCount, count);
        fprintf(stderr, "fixed count %d\n", count);
        /*NsfShowStack(interp);*/
        /*return NsfPrintError(interp, "wrong activation count for object %s", ObjectName(object));*/
      }
    }
#endif

  }
  CmdListFree(&instances, NULL);
  /*fprintf(stderr, "all assertions passed\n");*/

  return TCL_OK;
}

/*
cmd __profile_clear_data NsfProfileClearDataStub {}
cmd __profile_get_data NsfProfileGetDataStub {}
cmd __profile_trace NsfProfileTraceStub {
  {-argName "-enable" -required 1 -nrargs 1 -type boolean}
  {-argName "-verbose" -required 0 -nrargs 1 -type boolean}
  {-argName "-dontsave" -required 0 -nrargs 1 -type boolean}
  {-argName "-builtins" -required 0 -nrargs 1 -type tclobj}
}
*/

static int NsfProfileClearDataStub(Tcl_Interp *interp)
  nonnull(1);
static int NsfProfileGetDataStub(Tcl_Interp *interp)
  nonnull(1);
static int NsfProfileTraceStub(Tcl_Interp *interp,
                               int withEnable, int withVerbose, int withDontsave,
                               Tcl_Obj *builtinsObj)
  NSF_nonnull(1);

#if defined(NSF_PROFILE)

static int
NsfProfileClearDataStub(Tcl_Interp *interp) {
  nonnull_assert(interp != NULL);
  NsfProfileClearData(interp);
  return TCL_OK;
}


static int
NsfProfileGetDataStub(Tcl_Interp *interp) {
  nonnull_assert(interp != NULL);
  NsfProfileGetData(interp);
  return TCL_OK;
}

static int
NsfProfileTraceStub(Tcl_Interp *interp, int withEnable, int withVerbose, int withDontsave, Tcl_Obj *builtinsObj) {
  nonnull_assert(interp != NULL);
  NsfProfileTrace(interp, withEnable, withVerbose, withDontsave, builtinsObj);
  return TCL_OK;
}

#else
static int NsfProfileClearDataStub(Tcl_Interp *UNUSED(interp)) {
  return TCL_OK;
}
static int NsfProfileGetDataStub(  Tcl_Interp *UNUSED(interp)) {
  return TCL_OK;
}
static int NsfProfileTraceStub(    Tcl_Interp *UNUSED(interp),
                    int UNUSED(withEnable),
                    int UNUSED(withVerbose),
                    int UNUSED(withDontsave),
                    Tcl_Obj *UNUSED(builtins)) {
  return TCL_OK;
}
#endif

/*
 * Valgrind/callgrind support
 */
#if defined(NSF_VALGRIND)

#include <valgrind/callgrind.h>
/*
cmd __callgrind_dump_stats NsfCallgrindDumpStatsCmd {
  {-argName "-name" -required 0 -nrargs 1}
}
cmd __callgrind_start_instrumentation NsfCallgrindStartInstrumentationCmd {}
cmd __callgrind_stop_instrumentation NsfCallgrindStopInstrumentationCmd {}
cmd __callgrind_toggle_collect NsfCallgrindToggleCollectCmd {}
cmd __callgrind_zero_stats NsfCallgrindZeroStatsCmd {}
*/

static int
NsfCallgrindDumpStatsCmd(Tcl_Interp *UNUSED(interp), const char *nameString) {
  if (nameString == NULL) {
    CALLGRIND_DUMP_STATS;
  } else {
    CALLGRIND_DUMP_STATS_AT(nameString);
  }
  return TCL_OK;
}

static int
NsfCallgrindStartInstrumentationCmd(Tcl_Interp *UNUSED(interp)) {
  CALLGRIND_START_INSTRUMENTATION;
  return TCL_OK;
}

static int
NsfCallgrindStopInstrumentationCmd(Tcl_Interp *UNUSED(interp)) {
  CALLGRIND_STOP_INSTRUMENTATION;
  return TCL_OK;
}

static int
NsfCallgrindToggleCollectCmd(Tcl_Interp *UNUSED(interp)) {
  CALLGRIND_TOGGLE_COLLECT;
  return TCL_OK;
}

static int
NsfCallgrindZeroStatsCmd(Tcl_Interp *UNUSED(interp)) {
  CALLGRIND_ZERO_STATS;
  return TCL_OK;
}
#else

static int NsfCallgrindDumpStatsCmd(Tcl_Interp *UNUSED(interp), const char *UNUSED(nameString)) {
  return TCL_OK;
}
static int NsfCallgrindStartInstrumentationCmd(Tcl_Interp *UNUSED(interp)) {
  return TCL_OK;
}
static int NsfCallgrindStopInstrumentationCmd(Tcl_Interp *UNUSED(interp))  {
  return TCL_OK;
}
static int NsfCallgrindToggleCollectCmd(Tcl_Interp *UNUSED(interp))        {
  return TCL_OK;
}
static int NsfCallgrindZeroStatsCmd(Tcl_Interp *UNUSED(interp))            {
  return TCL_OK;
}

#endif

/*
 *----------------------------------------------------------------------
 * NsfUnsetUnknownArgsCmd --
*
 *      Unset variables set from arguments with the default dummy
 *      default value. The dummy default values are set by
 *      ArgumentDefaults()
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      unsets some variables
 *
 *----------------------------------------------------------------------
 */
/*
cmd __unset_unknown_args NsfUnsetUnknownArgsCmd {}
*/

static int
NsfUnsetUnknownArgsCmd(Tcl_Interp *interp) {
  CallFrame *varFramePtr;
  Proc      *proc;

  nonnull_assert(interp != NULL);

  varFramePtr = Tcl_Interp_varFramePtr(interp);
  proc = Tcl_CallFrame_procPtr(varFramePtr);

  if (likely(proc != NULL)) {
    const CompiledLocal *ap;
    const Var           *varPtr;
    int                  i;

    for (ap = proc->firstLocalPtr, i = 0; ap; ap = ap->nextPtr, i++) {
      if (!TclIsCompiledLocalArgument(ap)) {
        continue;
      }
      varPtr = &Tcl_CallFrame_compiledLocals(varFramePtr)[i];
      /*fprintf(stderr, "NsfUnsetUnknownArgsCmd var '%s' i %d fi %d var %p flags %.8x obj %p unk %p\n",
              ap->name, i, ap->frameIndex, varPtr, varPtr->flags, varPtr->value.objPtr,
              NsfGlobalObjs[NSF___UNKNOWN__]);*/
      if (varPtr->value.objPtr != NsfGlobalObjs[NSF___UNKNOWN__]) {
        continue;
      }
      /*fprintf(stderr, "NsfUnsetUnknownArgsCmd must unset %s\n", ap->name);*/
      Tcl_UnsetVar2(interp, ap->name, NULL, 0);
    }
  }

  return TCL_OK;
}

/*
cmd asmproc NsfAsmProcCmd {
  {-argName "-ad" -required 0  -nrargs 0 -type switch}
  {-argName "-checkalways" -required 0  -nrargs 0 -type switch}
  {-argName "procName" -required 1 -type tclobj}
  {-argName "arguments" -required 1 -type tclobj}
  {-argName "body" -required 1 -type tclobj}
}
*/
#if !defined(NSF_ASSEMBLE)
static int
NsfAsmProcCmd(Tcl_Interp *UNUSED(interp),
              int UNUSED(with_ad),
              int UNUSED(with_checkAlways),
              Tcl_Obj *UNUSED(nameObj),
              Tcl_Obj *UNUSED(arguments),
              Tcl_Obj *UNUSED(body))
{
  return TCL_OK;
}
#else
static int
NsfAsmProcCmd(Tcl_Interp *interp, int with_ad, int with_checkAlways, Tcl_Obj *nameObj, Tcl_Obj *arguments, Tcl_Obj *body) {
  NsfParsedParam parsedParam;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(arguments != NULL);
  nonnull_assert(body != NULL);

  /*
   * Parse argument list "arguments" to determine if we should provide
   * nsf parameter handling.
   */
  result = ParamDefsParse(interp, nameObj, arguments,
                          NSF_DISALLOWED_ARG_METHOD_PARAMETER, NSF_FALSE,
                          &parsedParam, NULL);
  if (unlikely(result != TCL_OK)) {
    return result;
  }

  if (parsedParam.paramDefs != NULL) {
    /*
     * We need parameter handling.
     */
    result = NsfAsmProcAddParam(interp, &parsedParam, nameObj, body, with_ad, with_checkAlways);

  } else {
    /*
     * No parameter handling needed.
     */
    result = NsfAsmProcAddArgs(interp, arguments, nameObj, body, with_ad, with_checkAlways);
  }

  return result;
}
#endif

/*
cmd "cmd::info" NsfCmdInfoCmd {
  {-argName "subcmd" -required 1 -typeName "methodgetcmd" -type "args|body|definition|exists|registrationhandle|definitionhandle|origin|parameter|syntax|type|precondition|postcondition|submethods|returns"}
  {-argName "-context" -required 0 -type object}
  {-argName "methodName" -required 1 -type tclobj}
  {-argName "pattern" -required 0}
} {-nxdoc 1}
*/
static int
NsfCmdInfoCmd(Tcl_Interp *interp, InfomethodsubcmdIdx_t subcmd, NsfObject *contextObject,
              Tcl_Obj *methodNameObj, const char *pattern) {

  nonnull_assert(interp != NULL);
  nonnull_assert(methodNameObj != NULL);

  return ListMethodResolve(interp, subcmd, contextObject, pattern, NULL, NULL, methodNameObj, NSF_FALSE);
}

/*
cmd configure NsfConfigureCmd {
  {-argName "option" -required 1 -type "debug|dtrace|filter|profile|softrecreate|objectsystems|keepcmds|checkresults|checkarguments"}
  {-argName "value" -required 0 -type tclobj}
}
*/
static int
NsfConfigureCmd(Tcl_Interp *interp, ConfigureoptionIdx_t option, Tcl_Obj *valueObj) {
  int boolVal = 0;

  nonnull_assert(interp != NULL);
#if defined(NSF_DTRACE)
  if (NSF_DTRACE_CONFIGURE_PROBE_ENABLED()) {
    NSF_DTRACE_CONFIGURE_PROBE(Nsf_Configureoption[option-1].key,
                               (valueObj != NULL) ? ObjStr(valueObj) : NULL);
  }
#endif

  if (option == ConfigureoptionObjectsystemsIdx) {
    NsfObjectSystem *osPtr;
    Tcl_Obj         *list = Tcl_NewListObj(0, NULL);

    for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr != NULL; osPtr = osPtr->nextPtr) {
      Tcl_Obj *osObj = Tcl_NewListObj(0, NULL);
      Tcl_Obj *systemMethods = Tcl_NewListObj(0, NULL);
      int      idx;

      Tcl_ListObjAppendElement(interp, osObj, osPtr->rootClass->object.cmdName);
      Tcl_ListObjAppendElement(interp, osObj, osPtr->rootMetaClass->object.cmdName);

      for (idx = 0; Nsf_SystemMethodOpts[idx]; idx++) {
        /*fprintf(stderr, "opt %s %s\n", Nsf_SystemMethodOpts[idx],
          osPtr->methods[idx] ? ObjStr(osPtr->methods[idx]) : "NULL");*/
        if (osPtr->methods[idx] == NULL) {
          continue;
        }
        Tcl_ListObjAppendElement(interp, systemMethods, Tcl_NewStringObj(Nsf_SystemMethodOpts[idx], -1));
        if (osPtr->handles[idx] || osPtr->protected[idx]) {
          Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);

          Tcl_ListObjAppendElement(interp, listObj, osPtr->methods[idx]);
          Tcl_ListObjAppendElement(interp, listObj, osPtr->handles[idx]);
          if (osPtr->protected[idx]) {
            Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(1));
          }
          Tcl_ListObjAppendElement(interp, systemMethods, listObj);
        } else {
          Tcl_ListObjAppendElement(interp, systemMethods, osPtr->methods[idx]);
        }
      }
      Tcl_ListObjAppendElement(interp, osObj, systemMethods);
      Tcl_ListObjAppendElement(interp, list, osObj);
    }
    Tcl_SetObjResult(interp, list);
    return TCL_OK;
  }

  if (option == ConfigureoptionDebugIdx) {

    if (valueObj != NULL) {
      int level, result = Tcl_GetIntFromObj(interp, valueObj, &level);

      if (unlikely(result != TCL_OK)) {
        return result;
      }
      RUNTIME_STATE(interp)->logSeverity = level;
    }
    Tcl_SetIntObj(Tcl_GetObjResult(interp),
                  RUNTIME_STATE(interp)->logSeverity);

    return TCL_OK;
  }

  /*
   * All other configure options are boolean.
   */
  if (valueObj != NULL) {
    int result = Tcl_GetBooleanFromObj(interp, valueObj, &boolVal);
    if (unlikely(result != TCL_OK)) {
      return result;
    }
  }

  switch (option) {

  case ConfigureoptionDebugIdx: NSF_FALL_THROUGH; /* fall through */
  case ConfigureoptionObjectsystemsIdx:
    /*
     * Handled above.
     */
    break;

  case ConfigureoptionDtraceIdx:
    /*
     * Not implemented.
     */
    break;

  case ConfigureoptionNULL:
    /*
     * Do nothing; just for detection if option was specified.
     */
    break;

  case ConfigureoptionFilterIdx:
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
                      (RUNTIME_STATE(interp)->doFilters));
    if (valueObj != NULL) {
      RUNTIME_STATE(interp)->doFilters = boolVal;
    }
    break;

  case ConfigureoptionSoftrecreateIdx:
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
                      (RUNTIME_STATE(interp)->doSoftrecreate));
    if (valueObj != NULL) {
      RUNTIME_STATE(interp)->doSoftrecreate = boolVal;
    }
    break;

  case ConfigureoptionKeepcmdsIdx:
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
                      (RUNTIME_STATE(interp)->doKeepcmds));
    if (valueObj != NULL) {
      RUNTIME_STATE(interp)->doKeepcmds = boolVal;
    }
    break;

  case ConfigureoptionCheckresultsIdx:
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
                      (RUNTIME_STATE(interp)->doCheckResults));
    if (valueObj != NULL) {
      RUNTIME_STATE(interp)->doCheckResults = (unsigned int)boolVal;
    }
    break;

  case ConfigureoptionCheckargumentsIdx:
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
                      (RUNTIME_STATE(interp)->doCheckArguments) != 0);
    if (valueObj != NULL) {
      RUNTIME_STATE(interp)->doCheckArguments = (boolVal != 0) ? NSF_ARGPARSE_CHECK : 0;
    }
    break;

  }
  return TCL_OK;
}


/*
cmd colon NsfColonCmd {
  {-argName "args" -type allargs}
}
*/
static int
NsfColonCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
  const char *methodName = ObjStr(objv[0]);
  NsfObject  *self;
  int         result;

  nonnull_assert(interp != NULL);

  self = GetSelfObj(interp);
  if (unlikely(self == NULL)) {
    return NsfNoCurrentObjectError(interp, methodName);
  }
  /*fprintf(stderr, "Colon dispatch %s.%s (%d)\n",
    ObjectName(self), ObjStr(objv[0]), objc);*/

  /*
   * Do we have a method, which is NOT a single colon?
   */
  if (likely(!(*methodName == ':' && *(methodName + 1) == '\0'))) {
    /*
     * A method like ":foo" is called via plain ObjectDispatch().
     */
    result = ObjectDispatch(self, interp, objc, objv, NSF_CM_NO_SHIFT);

  } else {

    /*
     * The method name is a single colon, and might have one or more
     * arguments.
     */
    if (objc <= 1) {
      /*
       * Single colon and no arguments.
       */
      Tcl_SetObjResult(interp, self->cmdName);
      result = TCL_OK;

    } else {
      /*
       * Single colon and multiple arguments.
       */
      methodName = ObjStr(objv[1]);
      if (*methodName != '-') {
        /*
         * No need to parse arguments (local, intrinsic, ...).
         */
        result = ObjectDispatch(self, interp, objc, objv, 0u);
      } else {
        ParseContext pc;

        /*
         * Parse arguments, use definitions from nsf::my
         */
        result = ArgumentParse(interp, objc, objv, NULL, objv[0],
                               method_definitions[NsfMyCmdIdx].paramDefs,
                               method_definitions[NsfMyCmdIdx].nrParameters,
                               0, NSF_ARGPARSE_BUILTIN, &pc);
        if (likely(result == TCL_OK)) {
          int      withIntrinsic, withLocal, withSystem;
          Tcl_Obj *methodObj;

          withIntrinsic = (int)PTR2INT(pc.clientData[0]);
          withLocal     = (int)PTR2INT(pc.clientData[1]);
          withSystem    = (int)PTR2INT(pc.clientData[2]);
          methodObj     = (Tcl_Obj *)pc.clientData[3];

          assert(pc.status == 0);

          if ((withIntrinsic && withLocal)
              || (withIntrinsic && withSystem)
              || (withLocal && withSystem)) {
            result = NsfPrintError(interp, "flags '-intrinsic', '-local' and '-system' are mutual exclusive");
          } else {
            unsigned int flags;

            flags = NSF_CSC_IMMEDIATE;
            if (withIntrinsic != 0) {
              flags |= NSF_CM_INTRINSIC_METHOD;
            }
            if (withLocal != 0)     {
              flags |= NSF_CM_LOCAL_METHOD;
            }
            if (withSystem != 0)    {
              flags |= NSF_CM_SYSTEM_METHOD;
            }
            result = CallMethod(self, interp, methodObj, (objc - pc.lastObjc) + 2, objv + pc.lastObjc, flags);
          }
        }
      }
    }
  }
  return result;
}

/*
cmd "definitionnamespace" NsfDefinitionNamespaceCmd {
}
*/
static int
NsfDefinitionNamespaceCmd(Tcl_Interp *interp)
{
  Tcl_Namespace *nsPtr;

  nonnull_assert(interp != NULL);

  nsPtr = CallingNameSpace(interp);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(nsPtr->fullName, -1));

  return TCL_OK;
}


/*
cmd "directdispatch" NsfDirectDispatchCmd {
  {-argName "object" -required 1 -type object}
  {-argName "-frame" -required 0 -nrargs 1 -type "method|object|default" -default "default"}
  {-argName "command" -required 1 -type tclobj}
  {-argName "args"  -type args}
}
*/
static int
NsfDirectDispatchCmd(Tcl_Interp *interp, NsfObject *object, FrameIdx_t withFrame,
                     Tcl_Obj *commandObj, int trailingObjc, Tcl_Obj *const trailingObjv[]) {
  int result;
  const char     *methodName;
  Tcl_Command     cmd, importedCmd;
  CallFrame       frame, *framePtr = &frame;
  Tcl_ObjCmdProc *proc;
  unsigned int    flags = 0u;
  bool            useCmdDispatch = NSF_TRUE;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(commandObj != NULL);

  /*fprintf(stderr, "NsfDirectDispatchCmd obj=%s, cmd m='%s' oc %d\n", ObjectName(object), methodName, nobjc);*/

  methodName = ObjStr(commandObj);
  if (unlikely(*methodName != ':')) {
    return NsfPrintError(interp, "method name '%s' must be fully qualified", methodName);
  }

  /*
   * We have a fully qualified name of a Tcl command that will be dispatched.
   */

  cmd = Tcl_GetCommandFromObj(interp, commandObj);
  if (likely(cmd != NULL)) {
    importedCmd = TclGetOriginalCommand(cmd);
    if (unlikely(importedCmd != NULL)) {
      cmd = importedCmd;
    }
  }

  if (unlikely(cmd == NULL)) {
    return NsfPrintError(interp, "cannot lookup command '%s'", methodName);
  }

  proc = Tcl_Command_objProc(cmd);
  if (proc == TclObjInterpProc ||
      proc == NsfForwardMethod ||
      proc == NsfObjscopedMethod ||
      proc == NsfSetterMethod ||
      CmdIsNsfObject(cmd)) {

    if (withFrame && withFrame != FrameDefaultIdx) {
      return NsfPrintError(interp, "cannot use -frame object|method in dispatch for command '%s'",
                           methodName);
    }
    useCmdDispatch = NSF_FALSE;
  } else {
    if (unlikely(withFrame == FrameMethodIdx)) {
      useCmdDispatch = NSF_FALSE;
    }
  }

  /*
   * If "withFrame == FrameObjectIdx" is specified, a call-stack frame is
   * pushed to make instance variables accessible for the command.
   */
  if (unlikely(withFrame == FrameObjectIdx)) {
    Nsf_PushFrameObj(interp, object, framePtr);
    flags = NSF_CSC_IMMEDIATE;
  }
  /*
   * Since we know, that we are always called with a full argument
   * vector, we can include the cmd name in the objv by using
   * nobjv-1; this way, we avoid a memcpy().
   */
  if (useCmdDispatch) {

    if (NSF_DTRACE_METHOD_ENTRY_ENABLED()) {
      NSF_DTRACE_METHOD_ENTRY(ObjectName(object),
                              "",
                              (char *)methodName,
                              trailingObjc, (Tcl_Obj **)trailingObjv);
    }

    result = CmdMethodDispatch(object, interp, trailingObjc + 1, trailingObjv - 1,
                               object, cmd, NULL);
  } else {
    /*
     * If "withFrame == FrameMethodIdx" is specified, a call-stack frame is
     * pushed to make instance variables accessible for the command.
     */
    if (unlikely(withFrame == FrameMethodIdx)) {
      flags = NSF_CSC_FORCE_FRAME|NSF_CSC_IMMEDIATE;
    }

    result = MethodDispatch(interp, trailingObjc + 1, trailingObjv - 1, cmd, object,
                            NULL /*NsfClass *cl*/,
                            Tcl_GetCommandName(interp, cmd),
                            NSF_CSC_TYPE_PLAIN, flags);
  }

  if (unlikely(withFrame == FrameObjectIdx)) {
    Nsf_PopFrameObj(interp, framePtr);
  }

  return result;
}


/*
cmd "dispatch" NsfDispatchCmd {
  {-argName "object" -required 1 -type object}
  {-argName "-intrinsic" -required 0 -nrargs 0}
  {-argName "-system" -required 0 -nrargs 0}
  {-argName "command" -required 1 -type tclobj}
  {-argName "args"  -type args}
}
*/
static int
NsfDispatchCmd(Tcl_Interp *interp, NsfObject *object,
               int withIntrinsic, int withSystem,
               Tcl_Obj *commandObj,
               int trailingObjc, Tcl_Obj *const trailingObjv[]) {
  unsigned int    flags = NSF_CM_NO_UNKNOWN|NSF_CSC_IMMEDIATE|NSF_CM_IGNORE_PERMISSIONS|NSF_CM_NO_SHIFT;
  Tcl_Obj *const *objv = trailingObjv-1;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(commandObj != NULL);

  /*
   * We use the construct "tclobj" + "args" in the spec to enforce that at least a
   * commandName is specified (this way we allow empty "args", and can provide
   * a nice error message, if cmdName is not specified). Since the we know
   * that the commandObj has to be right before "args" in the objv, we can
   * decrement the nobjv to obtain objv (and increment nobjc), be we make sure
   * that this assumption is correct.
   */
  assert(objv[0] == commandObj);
  assert(ISOBJ_(commandObj));

  trailingObjc++;

#if 0
  {int i;
  fprintf(stderr, "NsfDispatchCmd %s method %s oc %2d", ObjectName(object), ObjStr(commandObj), trailingObjc);
  for(i = 0; i < trailingObjc; i++) {fprintf(stderr, " [%d]=%s,", i, ObjStr(trailingObjv[i]));}
  fprintf(stderr, "\n");
  }
#endif

  if (unlikely(withIntrinsic && withSystem)) {
    return NsfPrintError(interp, "flags '-intrinsic' and '-system' are mutual exclusive");
  }

  /*
   * Dispatch the command the method from the precedence order, with filters
   * etc. -- strictly speaking unnecessary, but this function can be used to
   * call protected methods and provide the flags '-intrinsics' and '-system'.
   */

  if (withIntrinsic != 0) {
    flags |= NSF_CM_INTRINSIC_METHOD;
  }
  if (withSystem != 0) {
    flags |= NSF_CM_SYSTEM_METHOD;
  }

  /*
   * Since we know, that we are always called with a full argument
   * vector, we can include the cmd name in the objv by using
   * nobjv-1; this way, we avoid a memcpy().
   */
  return ObjectDispatch(object, interp,  trailingObjc, objv, flags);
}

/*
cmd finalize NsfFinalizeCmd {
  {-argName "-keepvars" -required 0 -nrargs 0}
}
*/
static int
NsfFinalizeCmd(Tcl_Interp *interp, int withKeepvars) {
  int result;

  /* fprintf(stderr, "#### (%lx) NsfFinalizeCmd exitHandlerRound %d\n",
     (long)(void*)pthread_self(), RUNTIME_STATE(interp)->exitHandlerDestroyRound );*/

  nonnull_assert(interp != NULL);

#if defined(NSF_PROFILE)
  /*
   * Check whether profile trace is still running. If so, delete it here.
   * Interestingly, NsfLog() seems to be unavailable at this place.
   */
  if (RUNTIME_STATE(interp)->doTrace == 1) {
    NsfLog(interp, NSF_LOG_WARN, "tracing is still active; deactivate it due to cleanup.");
    NsfProfileTrace(interp, 0, 0, 0, NULL);
  }
#endif

#if defined(NSF_STACKCHECK)
  {NsfRuntimeState *rst = RUNTIME_STATE(interp);

    NsfLog(interp, NSF_LOG_WARN, "Stack max usage %ld",
           labs(rst->maxStack - rst->bottomOfStack));
  }
#endif

  /*fprintf(stderr, "+++ call tcl-defined exit handler (%x)\n", PTR2INT(pthread_self()));*/

  /*
   * Evaluate user-defined exit handler.
   */
  result = Tcl_Eval(interp, "::nsf::__exithandler");

  if (unlikely(result != TCL_OK)) {
    fprintf(stderr, "User defined exit handler contains errors!\n"
            "Error in line %d: %s\nExecution interrupted.\n",
            (int)Tcl_GetErrorLine(interp), ObjStr(Tcl_GetObjResult(interp)));
  }

  ObjectSystemsCleanup(interp, withKeepvars ? NSF_TRUE : NSF_FALSE);


#ifdef DO_CLEANUP
  {
    NsfRuntimeState *rst = RUNTIME_STATE(interp);

# if defined(CHECK_ACTIVATION_COUNTS)
    assert(rst->cscList == NULL);
# endif
    /*fprintf(stderr, "CLEANUP TOP NS\n");*/
    Tcl_Export(interp, rst->NsfNS, "", 1);
    if (rst->NsfClassesNS != NULL) {
      MEM_COUNT_FREE("TclNamespace", rst->NsfClassesNS);
      Tcl_DeleteNamespace(rst->NsfClassesNS);
    }
    if (rst->NsfNS != NULL) {
      MEM_COUNT_FREE("TclNamespace", rst->NsfNS);
      Tcl_DeleteNamespace(rst->NsfNS);
    }

    {
      NsfDList *dlPtr = &rst->freeDList;
      size_t    i;

#if defined(COLON_CMD_STATS)
      fprintf(stderr, "#### DList free size %lu avail %lu\n", dlPtr->size, dlPtr->avail);
#endif
      for (i = 0u; i < dlPtr->size; i++) {
        /*
           fprintf(stderr, "#### DList free data[%lu] %p: %p\n", i,
           (void*)&(dlPtr->data[i]), (void*)dlPtr->data[i]);
        */
        NsfColonCmdContextFree(dlPtr->data[i]);
      }
      NsfDListFree(dlPtr);
    }
  }
#endif
  return TCL_OK;
}


/*
cmd interp NsfInterpObjCmd {
  {-argName "name"}
  {-argName "args" -type allargs}
}
*/
/*
 * Create a slave interp that calls Next Scripting Init
 */
static int
NsfInterpObjCmd(Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[]) {

  nonnull_assert(interp != NULL);
  nonnull_assert(name != NULL);

  /*
   * Create a fresh Tcl interpreter, or pass command to an existing one
   */
  if (unlikely(NsfCallCommand(interp, NSF_INTERP, objc, objv) != TCL_OK)) {
    return TCL_ERROR;
  }

  /*
   * Upon [interp create], set up NSF for the new child interp by running
   * Nsf_Init()
   */

  if (isCreateString(name)) {
    Tcl_Obj    *slaveCmdObj;
    Tcl_Interp *slavePtr;

    /*
     * Tcl_InterpObjCmd() stores the newly created child interp's command name
     * in the interp result store.
     */

    slaveCmdObj = Tcl_GetObjResult(interp);
    slavePtr = Tcl_GetSlave(interp, ObjStr(slaveCmdObj));

    if (slavePtr == NULL) {
      return NsfPrintError(interp, "creation of slave interpreter failed");
    }
    if (unlikely(Nsf_Init(slavePtr) == TCL_ERROR)) {
      return TCL_ERROR;
    }
  }
  return TCL_OK;
}

/*
cmd is NsfIsCmd {
  {-argName "-complain"  -nrargs 0}
  {-argName "-configure" -nrargs 0}
  {-argName "-name" -required 0}
  {-argName "constraint" -required 1 -type tclobj}
  {-argName "value" -required 1 -type tclobj}
} {-nxdoc 1}
*/
static int
NsfIsCmd(Tcl_Interp *interp,
         int withComplain,
         int withConfigure,
         const char *withName,
         Tcl_Obj *constraintObj,
         Tcl_Obj *valueObj) {
  Nsf_Param *paramPtr = NULL;
  int        result;

  nonnull_assert(interp != NULL);
  nonnull_assert(constraintObj != NULL);
  nonnull_assert(valueObj != NULL);

  result = ParameterCheck(interp, constraintObj, valueObj,
                          (withName != NULL) ? withName : "value:", 1,
                          (withName != NULL),
                          (withConfigure == 1),
                          &paramPtr,
                          Tcl_GetCurrentNamespace(interp)->fullName);

  if (unlikely(paramPtr == NULL)) {
    /*
     * We could not convert the arguments. Even with noComplain, we
     * report the invalid converter spec as exception.
     */
    result = TCL_ERROR;

  } else {
    if (paramPtr->converter == ConvertViaCmd
        && (withComplain == 0 || result == TCL_OK)) {
      Tcl_ResetResult(interp);
    }

    if (withComplain == 0) {
      Tcl_SetIntObj(Tcl_GetObjResult(interp), (result == TCL_OK));
      result = TCL_OK;
    } else if (likely(result == TCL_OK)) {
      Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
    }
  }

  return result;
}

/*
cmd parseargs NsfParseArgsCmd {
  {-argName "argspec" -required 1 -type tclobj}
  {-argName "arglist" -required 1 -type tclobj}
} {-nxdoc 0}
*/
static int
NsfParseArgsCmd(Tcl_Interp *interp, Tcl_Obj *argspecObj, Tcl_Obj *arglistObj) {
  NsfParsedParam   parsedParam;
  Tcl_Obj        **objv;
  int              result, objc;

  result = ParamDefsParse(interp, NsfGlobalObjs[NSF_PARSE_ARGS], argspecObj,
                          NSF_DISALLOWED_ARG_METHOD_PARAMETER,
                          NSF_TRUE /* force use of param structure,
                                      even for Tcl-only params */,
                          &parsedParam, Tcl_GetCurrentNamespace(interp)->fullName);

  if (unlikely(result != TCL_OK)) {
    return result;
  }

  result = Tcl_ListObjGetElements(interp, arglistObj, &objc, &objv);

  if (likely(result == TCL_OK) && parsedParam.paramDefs != NULL) {
    ParseContext  pc;
    NsfParamDefs *paramDefs = parsedParam.paramDefs;
    unsigned int  processFlags = 0u;

    ParamDefsRefCountIncr(paramDefs);
    result = ArgumentParse(interp, objc, objv, NULL, NsfGlobalObjs[NSF_PARSE_ARGS],
                           paramDefs->paramsPtr, paramDefs->nrParams, paramDefs->serial,
                           processFlags|NSF_ARGPARSE_START_ZERO|RUNTIME_STATE(interp)->doCheckArguments,
                           &pc);

    if (result == TCL_OK) {
      Nsf_Param *paramPtr;
      Tcl_Obj   *resultObj;
      int        i;

      for (i = 0, paramPtr = paramDefs->paramsPtr; paramPtr->name != NULL; paramPtr++, i++) {
        Tcl_Obj *valueObj = pc.objv[i];

        if (valueObj != NsfGlobalObjs[NSF___UNKNOWN__]) {
          /*fprintf(stderr, "param %s -> <%s>\n", paramPtr->name,  ObjStr(valueObj));*/
          resultObj = Tcl_ObjSetVar2(interp, paramPtr->nameObj, NULL, valueObj, TCL_LEAVE_ERR_MSG);
          if (resultObj == NULL) {
            result = TCL_ERROR;
            break;
          }
        }
      }
    }
    ParamDefsRefCountDecr(paramDefs);
    ParseContextRelease(&pc);
  }
  return result;
}

/*
cmd method::alias NsfMethodAliasCmd {
  {-argName "object" -type object}
  {-argName "-per-object"}
  {-argName "methodName"}
  {-argName "-frame" -required 0 -nrargs 1 -type "method|object|default" -default "default"}
  {-argName "-protection" -required 0 -type "call-protected|redefine-protected|none" -default "none"}
  {-argName "cmdName" -required 1 -type tclobj}
}
*/
static int
NsfMethodAliasCmd(
    Tcl_Interp *interp, NsfObject *object, int withPer_object,
    const char *methodName, FrameIdx_t withFrame, ProtectionIdx_t withProtection,
    Tcl_Obj *cmdNameObj
) {
  Tcl_ObjCmdProc     *objProc, *newObjProc;
  Tcl_CmdDeleteProc  *deleteProc;
  AliasCmdClientData *tcd;
  Tcl_Command         cmd, oldCmd, newCmd;
  Tcl_Namespace      *nsPtr;
  int                 result;
  unsigned int        flags = 0u;
  const NsfClass     *class;
  NsfObject          *newTargetObject;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodName != NULL);
  assert(*methodName != ':');
  nonnull_assert(cmdNameObj != NULL);

  cmd = Tcl_GetCommandFromObj(interp, cmdNameObj);
  if (cmd == NULL) {
    return NsfPrintError(interp, "cannot lookup command '%s'", ObjStr(cmdNameObj));
  }

  cmd = GetOriginalCommand(cmd);
  objProc = Tcl_Command_objProc(cmd);
  assert(objProc != NULL);

  /*
   * objProc is either ...
   *
   * 1. NsfObjDispatch: a command representing a Next Scripting object
   *
   * 2. TclObjInterpProc: a cmd standing for a Tcl proc (including
   *    Next Scripting methods), verified through CmdIsProc() -> to be
   *    wrapped by NsfProcAliasMethod()
   *
   * 3. NsfForwardMethod: a Next Scripting forwarder
   *
   * 4. NsfSetterMethod: a Next Scripting setter
   *
   * 5. Arbitrary Tcl commands (e.g. set, ..., ::nsf::relation, ...)
   *
   */

  if (withFrame == FrameObjectIdx) {
    newObjProc = NsfObjscopedMethod;
  } else {
    newObjProc = NULL;
  }

  /*
   * We need to perform a defensive lookup of a previously defined
   * object-alias under the given methodName.
   */
  class = (withPer_object || ! NsfObjectIsClass(object)) ? NULL : (NsfClass *)object;

  nsPtr = (class != NULL) ? class->nsPtr : object->nsPtr;
  oldCmd = (nsPtr != NULL) ? FindMethod(nsPtr, methodName) : NULL;
  newTargetObject = NsfGetObjectFromCmdPtr(cmd);

  if (oldCmd != NULL) {
#if 1
    /*
     * Old solution, leasds to a broken regression test with Tcl 8.7a1.
     * However, using Tcl_DeleteCommandFromToken() leads to a crash also with
     * earlier solutions when defining recursive aliases.
     */
    NsfObject *oldTargetObject;

    /*fprintf(stderr, "... DELETE preexisting cmd %s in ns %s\n", methodName, nsPtr->fullName);*/

    oldTargetObject = NsfGetObjectFromCmdPtr(oldCmd);
    /* fprintf(stderr, "oldTargetObject %p flags %.6x newTargetObject %p\n",
       oldTargetObject, (oldTargetObject != NULL) ? oldTargetObject->flags : 0, newTargetObject);*/

    /*
     * We might have to decrement the reference counter on a previously
     * aliased object. Decrement the reference count to the old aliased object
     * only, when it is different to the new target Object.
     */

    if (oldTargetObject != NULL && oldTargetObject != newTargetObject) {
      /*fprintf(stderr, "--- releasing old target object %p refCount %d\n",
        oldTargetObject, oldTargetObject->refCount);*/
      assert(oldTargetObject->refCount > 0);
      AliasDeleteObjectReference(interp, oldCmd);
    }

#else
    Tcl_DeleteCommandFromToken(interp, oldCmd);
#endif

  }

  if (newTargetObject != NULL) {
    /*
     * We set now for every alias to an object a stub proc, such we can
     * distinguish between cases, where the user wants to create a method, and
     * between cases, where object-invocation via method interface might
     * happen.
     */
    newObjProc = NsfProcAliasMethod;

  } else if (CmdIsProc(cmd)) {
    /*
     * When we have a Tcl proc|nsf-method as alias, then use the
     * wrapper, which will be deleted automatically when the original
     * proc/method is deleted.
     */
    newObjProc = NsfProcAliasMethod;

    if (objProc == TclObjInterpProc) {
      /*
       * We have an alias to a Tcl proc;
       */
      Proc    *procPtr = (Proc *)Tcl_Command_objClientData(cmd);
      Tcl_Obj *bodyObj = (procPtr != NULL) ? procPtr->bodyPtr : NULL;

      if (bodyObj && bodyObj->typePtr == Nsf_OT_byteCodeType) {
        /*
         * Flush old byte code
         */
        /*fprintf(stderr, "flush byte code\n");*/
        TclFreeIntRep(bodyObj);
      }
    }

    if (withFrame && withFrame != FrameDefaultIdx) {
      return NsfPrintError(interp,
                          "cannot use -frame object|method in alias for scripted command '%s'",
                           ObjStr(cmdNameObj));
    }
  }

  if (newObjProc != NULL) {
    /*
     * Add a wrapper.
     */
    /*fprintf(stderr, "NsfMethodAliasCmd add wrapper cmd %p\n", cmd);*/
    NsfCommandPreserve(cmd);
    tcd = NEW(AliasCmdClientData);
    tcd->cmdName    = object->cmdName;
    tcd->interp     = interp; /* just for deleting the alias */
    tcd->object     = NULL;
    tcd->class      = (class != NULL) ? (NsfClass *) object : NULL;
    tcd->objProc    = objProc;
    tcd->aliasedCmd = cmd;
    tcd->clientData = Tcl_Command_objClientData(cmd);

    objProc         = newObjProc;
    deleteProc      = AliasCmdDeleteProc;
    if (tcd->cmdName != NULL) {
      INCR_REF_COUNT(tcd->cmdName);
    }
  } else {
    /*
     * Call the command directly (must be a c-implemented command not
     * depending on a volatile client data)
     */
    deleteProc = NULL;
    tcd = Tcl_Command_objClientData(cmd);
    /*fprintf(stderr, "NsfMethodAliasCmd no wrapper cmd %p\n", cmd);*/
  }

  switch (withProtection) {
  case ProtectionCall_protectedIdx:     flags = NSF_CMD_CALL_PROTECTED_METHOD; break;
  case ProtectionRedefine_protectedIdx: flags = NSF_CMD_REDEFINE_PROTECTED_METHOD; break;
  case ProtectionNoneIdx: NSF_FALL_THROUGH; /* fall through */
  case ProtectionNULL:
    flags = 0u;
    break;
  }

  if (class != NULL) {
    result = NsfAddClassMethod(interp, (Nsf_Class *)class, methodName,
                               objProc, tcd, deleteProc, flags);
    nsPtr = class->nsPtr;
  } else {
    result = NsfAddObjectMethod(interp, (Nsf_Object *)object, methodName,
                                objProc, tcd, deleteProc, flags);
    nsPtr = object->nsPtr;
  }

  if (likely(result == TCL_OK)) {
    newCmd = FindMethod(nsPtr, methodName);
  } else {
    newCmd = NULL;
  }

#if defined(WITH_IMPORT_REFS)
  if (newObjProc != NULL) {
    /*
     * Define the reference chain like for 'namespace import' to
     * obtain automatic deletes when the original command is deleted.
     */
    ImportRef *refPtr = (ImportRef *) ckalloc((int)sizeof(ImportRef));

    refPtr->importedCmdPtr = (Command *) newCmd;
    refPtr->nextPtr = ((Command *) tcd->aliasedCmd)->importRefPtr;
    ((Command *) tcd->aliasedCmd)->importRefPtr = refPtr;
    tcd->aliasCmd = newCmd;
  }
#else
  if (newObjProc != NULL) {
    tcd->aliasCmd = newCmd;
  }
#endif

  if (newCmd != NULL) {
    AliasAdd(interp, object->cmdName, methodName, class == NULL, cmdNameObj);

    if (withFrame == FrameMethodIdx) {
      Tcl_Command_flags(newCmd) |= NSF_CMD_NONLEAF_METHOD;
      /*fprintf(stderr, "setting aliased for cmd %p %s flags %.6x, tcd = %p\n",
        newCmd, methodName, Tcl_Command_flags(newCmd), tcd);*/
    }

    Tcl_SetObjResult(interp, MethodHandleObj(object, class == NULL, methodName));
    result = TCL_OK;
  }

  return result;
}

/*
cmd method::assertion NsfMethodAssertionCmd {
  {-argName "object" -type object}
  {-argName "assertionsubcmd" -required 1 -type "check|object-invar|class-invar"}
  {-argName "arg" -required 0 -type tclobj}
}

  Make "::nsf::assertion" a cmd rather than a method, otherwise we
  cannot define e.g. a "method check options {...}" to reset the check
  options in case of a failed option, since assertion checking would
  be applied on the sketched method already.
*/

static int
NsfMethodAssertionCmd(Tcl_Interp *interp, NsfObject *object, AssertionsubcmdIdx_t subcmd, Tcl_Obj *argObj) {
#if defined(NSF_WITH_ASSERTIONS)
  NsfClass *class;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  switch (subcmd) {
  case AssertionsubcmdCheckIdx:
    if (argObj != NULL) {
      return AssertionSetCheckOptions(interp, object, argObj);
    } else {
      return AssertionListCheckOption(interp, object);
    }
    /*break; unreachable */

  case AssertionsubcmdObject_invarIdx:
    if (argObj != NULL) {
      NsfObjectOpt *opt = NsfRequireObjectOpt(object);

      AssertionSetInvariants(interp, &opt->assertions, argObj);
    } else {
      if (object->opt != NULL && object->opt->assertions != NULL) {
        Tcl_SetObjResult(interp, AssertionList(interp, object->opt->assertions->invariants));
      }
    }
    break;

  case AssertionsubcmdClass_invarIdx:

    if (!NsfObjectIsClass(object)) {
      return NsfPrintError(interp, "object is not a class");
    }

    class = (NsfClass *)object;
    if (argObj != NULL) {
      NsfClassOpt *opt = NsfRequireClassOpt(class);

      AssertionSetInvariants(interp, &opt->assertions, argObj);
    } else {
      if (class->opt != NULL && class->opt->assertions != NULL) {
        Tcl_SetObjResult(interp, AssertionList(interp, class->opt->assertions->invariants));
      }
    }

  case AssertionsubcmdNULL:
    /*
     * Do nothing; just for detection if option was specified.
     */
    break;
  }
#endif
  return TCL_OK;
}

/*
cmd method::create NsfMethodCreateCmd {
  {-argName "object" -required 1 -type object}
  {-argName "-checkalways" -required 0 -nrargs 0 -type switch}
  {-argName "-inner-namespace"}
  {-argName "-per-object"}
  {-argName "-reg-object" -required 0 -nrargs 1 -type object}
  {-argName "name" -required 1 -type tclobj}
  {-argName "arguments" -required 1 -type tclobj}
  {-argName "body" -required 1 -type tclobj}
  {-argName "-precondition"  -nrargs 1 -type tclobj}
  {-argName "-postcondition" -nrargs 1 -type tclobj}
}
*/
static int
NsfMethodCreateCmd(Tcl_Interp *interp, NsfObject *object,
                   int withCheckalways, int withInner_namespace,
                   int withPer_object, NsfObject *regObject,
                   Tcl_Obj *methodNameObj, Tcl_Obj *argumentsObj, Tcl_Obj *bodyObj,
                   Tcl_Obj *preconditionObj, Tcl_Obj *postconditionObj) {
  NsfClass *class;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodNameObj != NULL);
  nonnull_assert(argumentsObj != NULL);
  nonnull_assert(bodyObj != NULL);

  class = (withPer_object || ! NsfObjectIsClass(object)) ? NULL : (NsfClass *)object;
  if (class == NULL) {
    RequireObjNamespace(interp, object);

  }
  return MakeMethod(interp, object, regObject, class,
                    methodNameObj, argumentsObj, bodyObj,
                    preconditionObj, postconditionObj,
                    withInner_namespace, (withCheckalways != 0) ? NSF_ARGPARSE_CHECK : 0);
}

/*
cmd "method::delete" NsfMethodDeleteCmd {
  {-argName "object" -required 1 -type object}
  {-argName "-per-object"}
  {-argName "methodName" -required 1 -type tclobj}
}
*/
static int
NsfMethodDeleteCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object,
                   Tcl_Obj *methodNameObj) {
  NsfObject      *regObject, *defObject;
  const char     *methodName1 = NULL;
  const NsfClass *class;
  bool            fromClassNS;
  int             result;
  Tcl_DString     ds, *dsPtr = &ds;
  Tcl_Command     cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodNameObj != NULL);

  class = withPer_object == 0 && NsfObjectIsClass(object) ? (NsfClass *)object : NULL;
  fromClassNS = (class != NULL);

  Tcl_DStringInit(dsPtr);

  cmd = ResolveMethodName(interp, (class != NULL) ? class->nsPtr : object->nsPtr, methodNameObj,
                          dsPtr, &regObject, &defObject, &methodName1, &fromClassNS);

  /*fprintf(stderr,
          "NsfMethodDeleteCmd method %s '%s' object %p regObject %p defObject %p cl %p fromClass %d cmd %p\n",
          ObjStr(methodNameObj), methodName1, object, regObject, defObject, cl, fromClassNS, cmd);*/

  if (cmd != NULL) {
    methodName1 = Tcl_GetCommandName(interp, cmd);
    if (defObject != NULL) {
      class = (withPer_object == 0 && NsfObjectIsClass(defObject)) ? (NsfClass *)defObject : NULL;
    } else {
      defObject = object;
    }

    if (RUNTIME_STATE(interp)->exitHandlerDestroyRound == NSF_EXITHANDLER_OFF) {
      result = (class != NULL) ?
        NsfRemoveClassMethod(interp,  (Nsf_Class *)defObject, methodName1) :
        NsfRemoveObjectMethod(interp, (Nsf_Object *)defObject, methodName1);
    } else {
      result = TCL_OK;
    }

  } else {
    result = NsfPrintError(interp, "%s: %s method '%s' does not exist",
                           ObjectName_(object), (withPer_object == 1) ? "object specific" : "instance",
                           ObjStr(methodNameObj));
  }

  Tcl_DStringFree(dsPtr);

  return result;
}

/*
cmd method::forward NsfMethodForwardCmd {
  {-argName "object" -required 1 -type object}
  {-argName "-per-object" -required 0 -nrargs 0 -type switch}
  {-argName "method" -required 1 -type tclobj}
  {-argName "-default" -type tclobj}
  {-argName "-earlybinding" -nrargs 0}
  {-argName "-prefix" -type tclobj}
  {-argName "-frame" -nrargs 1 -type "object|method|default" -default default}
  {-argName "-verbose" -nrargs 0}
  {-argName "target" -type tclobj}
  {-argName "args" -type args}
}
*/
static int
NsfMethodForwardCmd(Tcl_Interp *interp,
                    NsfObject *object,
                    int withPer_object,
                    Tcl_Obj *methodObj,
                    Tcl_Obj *defaultObj,
                    int withEarlybinding,
                    Tcl_Obj *onerrorObj,
                    Tcl_Obj *prefixObj,
                    FrameIdx_t withFrame,
                    int withVerbose,
                    Tcl_Obj *targetObj,
                    int trailingObjc, Tcl_Obj *const trailingObjv[]) {
  ForwardCmdClientData *tcd = NULL;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodObj != NULL);

  result = ForwardProcessOptions(interp,
                                 methodObj,
                                 defaultObj,
                                 withEarlybinding,
                                 onerrorObj,
                                 prefixObj,
                                 (int)withFrame,
                                 (withVerbose == 1),
                                 targetObj,
                                 trailingObjc, trailingObjv,
                                 &tcd);

  if (likely(result == TCL_OK)) {
    const char *methodName = NSTail(ObjStr(methodObj));
    NsfClass *class =
      (withPer_object || ! NsfObjectIsClass(object)) ?
      NULL : (NsfClass *)object;

    tcd->object = object;

    if (class == NULL) {
      result = NsfAddObjectMethod(interp, (Nsf_Object *)object, methodName,
                                  (Tcl_ObjCmdProc *)NsfForwardMethod,
                                  tcd, ForwardCmdDeleteProc, 0u);
    } else {
      result = NsfAddClassMethod(interp, (Nsf_Class *)class, methodName,
                                 (Tcl_ObjCmdProc *)NsfForwardMethod,
                                 tcd, ForwardCmdDeleteProc, 0u);
    }
    if (likely(result == TCL_OK)) {
      Tcl_SetObjResult(interp, MethodHandleObj(object, (class == NULL), methodName));
    }
  }

  if (result != TCL_OK && tcd != NULL) {
    ForwardCmdDeleteProc(tcd);
  }
  return result;
}


/*
cmd "method::forward::property" NsfForwardPropertyCmd {
  {-argName "object" -required 1 -type object}
  {-argName "-per-object" -required 0 -nrargs 0 -type switch}
  {-argName "methodName" -required 1 -type tclobj}
  {-argName "forwardProperty" -required 1 -type "target|verbose"}
  {-argName "value" -type tclobj}
}
*/
static int
NsfForwardPropertyCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object,
                     Tcl_Obj *methodNameObj, ForwardpropertyIdx_t forwardProperty, Tcl_Obj *valueObj) {
  ForwardCmdClientData *tcd;
  Tcl_ObjCmdProc       *procPtr;
  Tcl_Command           cmd;
  NsfObject            *defObject;
  const NsfClass       *class;
  bool                  fromClassNS;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodNameObj != NULL);

  class = withPer_object == 0 && NsfObjectIsClass(object) ? (NsfClass *)object : NULL;
  fromClassNS = (class != NULL);

  cmd = ResolveMethodName(interp, (class != NULL) ? class->nsPtr : object->nsPtr, methodNameObj,
                          NULL, NULL, &defObject, NULL, &fromClassNS);

  if (unlikely(cmd == NULL)) {
    return NsfPrintError(interp, "cannot lookup %smethod '%s' for %s",
                         class == NULL ? "object " : "",
                         ObjStr(methodNameObj), ObjectName_(object));
  }

  procPtr = Tcl_Command_objProc(cmd);
  if (procPtr != NsfForwardMethod) {
    return NsfPrintError(interp, "%s is not a forwarder method",
                         ObjStr(methodNameObj));
  }

  tcd = (ForwardCmdClientData *)Tcl_Command_objClientData(cmd);
  if (tcd == NULL) {
    return NsfPrintError(interp, "forwarder method has no client data");
  }

  switch (forwardProperty) {
  case ForwardpropertyTargetIdx:
    if (valueObj != NULL) {
      DECR_REF_COUNT(tcd->cmdName);
      INCR_REF_COUNT(valueObj);
      tcd->cmdName = valueObj;
    }
    Tcl_SetObjResult(interp, tcd->cmdName);
    break;

  case ForwardpropertyPrefixIdx:
    if (valueObj != NULL) {
      DECR_REF_COUNT(tcd->prefix);
      INCR_REF_COUNT(valueObj);
      tcd->prefix = valueObj;
    }
    Tcl_SetObjResult(interp, tcd->prefix);
    break;

  case ForwardpropertyVerboseIdx:
    if (valueObj != NULL) {
      int boolValue;

      Tcl_GetBooleanFromObj(interp, valueObj, &boolValue);
      tcd->verbose = (boolValue != 0);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(tcd->verbose));
    break;

  case ForwardpropertyNULL:
    /*
     * Do nothing; just for detection if option was specified.
     */
    break;
  }

  return TCL_OK;
}

/*
cmd ::method::property NsfMethodPropertyCmd {
  {-argName "object" -required 1 -type object}
  {-argName "-per-object"}
  {-argName "methodName" -required 1 -type tclobj}
  {-argName "methodProperty" -required 1 -type "class-only|call-private|call-protected|debug|deprecated|exists|redefine-protected|returns"}
  {-argName "value" -type tclobj}
}
*/
static int
NsfMethodPropertyCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object,
                     Tcl_Obj *methodNameObj, MethodpropertyIdx_t methodProperty, Tcl_Obj *valueObj) {
  NsfObject      *defObject;
  Tcl_Command     cmd;
  const NsfClass *class;
  bool            fromClassNS;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(methodNameObj != NULL);

  class = withPer_object == 0 && NsfObjectIsClass(object) ? (NsfClass *)object : NULL;
  fromClassNS = (class != NULL);

  cmd = ResolveMethodName(interp,
                          (class != NULL) ? class->nsPtr : object->nsPtr,
                          methodNameObj, NULL, NULL, &defObject, NULL, &fromClassNS);
  /*fprintf(stderr, "methodProperty for method '%s' prop %d value %s => cl %p cmd %p\n",
    ObjStr(methodNameObj), methodproperty, (valueObj != NULL) ? ObjStr(valueObj) : "NULL", cl, cmd);*/


  if (unlikely(cmd == NULL)) {
    if (methodProperty == MethodpropertyExistsIdx) {
      Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
      return TCL_OK;
    } else {
      return NsfPrintError(interp, "cannot lookup %smethod '%s' for %s",
                           class == NULL ? "object " : "",
                           ObjStr(methodNameObj), ObjectName_(object));
    }
  }

  switch (methodProperty) {
  case MethodpropertyExistsIdx:
    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
    break;
  case MethodpropertyClass_onlyIdx:          NSF_FALL_THROUGH; /* fall through */
  case MethodpropertyCall_privateIdx:        NSF_FALL_THROUGH; /* fall through */
  case MethodpropertyCall_protectedIdx:      NSF_FALL_THROUGH; /* fall through */
  case MethodpropertyDebugIdx:               NSF_FALL_THROUGH; /* fall through */
  case MethodpropertyDeprecatedIdx:          NSF_FALL_THROUGH; /* fall through */
  case MethodpropertyRedefine_protectedIdx:
    {
      int          impliedSetFlag = 0, impliedClearFlag = 0;
      unsigned int flag = 0u;

      switch (methodProperty) {
      case MethodpropertyClass_onlyIdx:
        flag = NSF_CMD_CLASS_ONLY_METHOD;
        break;
      case MethodpropertyCall_privateIdx:
        flag = NSF_CMD_CALL_PRIVATE_METHOD;
        impliedSetFlag = NSF_CMD_CALL_PROTECTED_METHOD;
        break;
      case MethodpropertyCall_protectedIdx:
        impliedClearFlag = NSF_CMD_CALL_PRIVATE_METHOD;
        flag = NSF_CMD_CALL_PROTECTED_METHOD;
        break;
      case MethodpropertyDebugIdx:
        flag = NSF_CMD_DEBUG_METHOD;
        break;
      case MethodpropertyDeprecatedIdx:
        flag = NSF_CMD_DEPRECATED_METHOD;
        break;
      case MethodpropertyRedefine_protectedIdx:
        flag = NSF_CMD_REDEFINE_PROTECTED_METHOD;
        break;
      case MethodpropertyNULL:       NSF_FALL_THROUGH; /* fall through */
      case MethodpropertyReturnsIdx: NSF_FALL_THROUGH; /* fall through */
      case MethodpropertyExistsIdx:
        flag = 0u;
        break;
      }

      if (valueObj != NULL) {
        int boolVal, result;

        result = Tcl_GetBooleanFromObj(interp, valueObj, &boolVal);
        if (unlikely(result != TCL_OK)) {
          return result;
        }
        if (boolVal != 0) {

          /*
           * set flag
           */
          Tcl_Command_flags(cmd) |= (int)flag;
          if (impliedSetFlag != 0) {
            Tcl_Command_flags(cmd) |= (int)impliedSetFlag;
          }
        } else {
          /*
           * clear flag
           */
          Tcl_Command_flags(cmd) &= (int)~flag;
          if (impliedClearFlag != 0) {
            Tcl_Command_flags(cmd) &= (int)~impliedClearFlag;
          }
        }
        if (class != NULL) {
          NsfInstanceMethodEpochIncr("Permissions");
        } else {
          NsfObjectMethodEpochIncr("Permissions");
        }
      }
      Tcl_SetIntObj(Tcl_GetObjResult(interp), ((unsigned int)Tcl_Command_flags(cmd) & flag) != 0u);
    }
    break;

  case MethodpropertyReturnsIdx:
    {
      NsfProcContext *pCtx = ProcContextGet(cmd);

      /*fprintf(stderr, "MethodProperty, ParamDefsGet cmd %p paramDefs %p returns %p\n",
        cmd, paramDefs, (paramDefs != NULL) ? paramDefs->returns:NULL);*/

      if (valueObj == NULL) {
        /*
         * Return the actual value for "returns".
         */
        Tcl_Obj *resultObj;

        if (pCtx == NULL || pCtx->returnsObj == NULL) {
          resultObj = NsfGlobalObjs[NSF_EMPTY];
        } else {
          resultObj = pCtx->returnsObj;
        }
        Tcl_SetObjResult(interp, resultObj);

      } else {
        /*
         * Set the value of "returns".
         */
        const char *valueString = ObjStr(valueObj);

        if (pCtx == NULL) {
          pCtx = ProcContextRequire(cmd);
        }

        /*
         * Set a new value; if there is already a value, free it.
         */
        if (pCtx->returnsObj != NULL) {
          DECR_REF_COUNT2("returnsObj", pCtx->returnsObj);
        }
        if (*valueString == '\0') {
          /*
           * Set returnsObj to NULL
           */
          pCtx->returnsObj = NULL;
        } else {
          pCtx->returnsObj = valueObj;
          INCR_REF_COUNT2("returnsObj", pCtx->returnsObj);
        }
      }
    }
    break;

  case MethodpropertyNULL:
    /*
     * Do nothing; just for detection if option was specified.
     */
    break;
  }

  return TCL_OK;
}


/*
cmd "method::registered" NsfMethodRegisteredCmd {
  {-argName "handle" -required 1 -type tclobj}
}
*/
static int
NsfMethodRegisteredCmd(Tcl_Interp *interp, Tcl_Obj *handleObj) {
  NsfObject  *regObject;
  bool        fromClassNS = NSF_FALSE;
  Tcl_Command cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(handleObj != NULL);

  cmd = ResolveMethodName(interp, NULL, handleObj,
                          NULL, &regObject, NULL, NULL, &fromClassNS);

  /*
   * In case the provided cmd is fully qualified and refers to a registered
   * method, the function returns the object, on which the method was
   * resisted.
   */
  Tcl_SetObjResult(interp, ((cmd != NULL) && (regObject != NULL)) ? regObject->cmdName : NsfGlobalObjs[NSF_EMPTY]);

  return TCL_OK;
}

/*
cmd method::setter NsfMethodSetterCmd {
  {-argName "object" -required 1 -type object}
  {-argName "-per-object"}
  {-argName "parameter" -type tclobj}
  }
*/
static int
NsfMethodSetterCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, Tcl_Obj *parameterObj) {
  SetterCmdClientData *setterClientData;
  const NsfClass      *class;
  const char          *methodName;
  size_t               j, length;
  int                  result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(parameterObj != NULL);

  methodName = ObjStr(parameterObj);
  if (unlikely(*methodName == '-' || *methodName == ':')) {
    return NsfPrintError(interp, "invalid setter name \"%s\" (must not start with a dash or colon)",
                         methodName);
  }

  setterClientData = NEW(SetterCmdClientData);
  setterClientData->object = NULL;
  setterClientData->paramsPtr = NULL;

  length = strlen(methodName);

  for (j = 0; j < length; j++) {
    if (methodName[j] == ':' || NsfHasTclSpace(&methodName[j])) {
      break;
    }
  }

  class = (withPer_object || ! NsfObjectIsClass(object)) ? NULL : (NsfClass *)object;

  if (j < length) {
    /*
     * Looks as if we have a parameter specification.
     */
    int rc, possibleUnknowns = 0, plainParams = 0, nrNonposArgs = 0;
    NsfObject *ctx = (class != NULL) ? (NsfObject *)class : object;
    Tcl_Namespace *nsPtr = Tcl_Command_nsPtr(ctx->id);

    setterClientData->paramsPtr = ParamsNew(1u);
    rc = ParamDefinitionParse(interp, NsfGlobalObjs[NSF_SETTER], parameterObj,
                              NSF_DISALLOWED_ARG_SETTER|NSF_ARG_HAS_DEFAULT,
                              setterClientData->paramsPtr, &possibleUnknowns,
                              &plainParams, &nrNonposArgs,
                              nsPtr != NULL ? nsPtr->fullName : NULL);

    if (unlikely(rc != TCL_OK)) {
      SetterCmdDeleteProc(setterClientData);
      return rc;
    }
    methodName = setterClientData->paramsPtr->name;
  } else {
    setterClientData->paramsPtr = NULL;
  }

  if (class != NULL) {
    result = NsfAddClassMethod(interp, (Nsf_Class *)class, methodName,
                               (Tcl_ObjCmdProc *)NsfSetterMethod,
                               setterClientData, SetterCmdDeleteProc, 0u);
  } else {
    result = NsfAddObjectMethod(interp, (Nsf_Object *)object, methodName,
                                (Tcl_ObjCmdProc *)NsfSetterMethod,
                                setterClientData, SetterCmdDeleteProc, 0u);
  }
  if (likely(result == TCL_OK)) {
    Tcl_SetObjResult(interp, MethodHandleObj(object, class == NULL, methodName));
  } else {
    SetterCmdDeleteProc(setterClientData);
  }
  return result;
}

/*
cmd "object::alloc" NsfObjectAllocCmd {
  {-argName "class" -required 1 -type class}
  {-argName "name" -required 1 -type tclobj}
  {-argName "initcmd" -required 0 -type tclobj}
}
*/
static int
NsfObjectAllocCmd(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *nameObj, Tcl_Obj *initcmdObj) {
  Tcl_Obj *newNameObj = NULL;
  int      result;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(nameObj != NULL);

  /*
   * If the provided name is empty, make a new symbol
   */
  if (strlen(ObjStr(nameObj)) == 0) {
    Tcl_DString ds, *dsPtr = &ds;

    Tcl_DStringInit(dsPtr);
    Tcl_DStringAppend(dsPtr, autonamePrefix, (int)autonamePrefixLength);

    NewTclCommand(interp, dsPtr);

    newNameObj = Tcl_NewStringObj(Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr));
    INCR_REF_COUNT(newNameObj);
    Tcl_DStringFree(dsPtr);

    nameObj = newNameObj;
  }

  /*fprintf(stderr, "trying to alloc <%s>\n", ObjStr(nameObj));*/

  result = NsfCAllocMethod(interp, class, nameObj);

  if (result == TCL_OK && initcmdObj != NULL) {
    NsfObject *object;
    Tcl_Obj   *initNameObj = Tcl_GetObjResult(interp);

    INCR_REF_COUNT(initNameObj);
    if (unlikely(GetObjectFromObj(interp, initNameObj, &object) != TCL_OK)) {
      result = NsfPrintError(interp, "couldn't find result of alloc");
    } else {
      result = NsfDirectDispatchCmd(interp, object, 1,
                                    NsfGlobalObjs[NSF_EVAL],
                                    1, &initcmdObj);
      if (likely(result == TCL_OK)) {
        Tcl_SetObjResult(interp, initNameObj);
      }
    }
    DECR_REF_COUNT(initNameObj);
  }

  if (newNameObj != NULL) {
    DECR_REF_COUNT(newNameObj);
  }

  return result;
}

/*
cmd "object::exists" NsfObjectExistsCmd {
  {-argName "value" -required 1 -type tclobj}
}
*/
static int
NsfObjectExistsCmd(Tcl_Interp *interp, Tcl_Obj *valueObj) {
  NsfObject *object;

  nonnull_assert(interp != NULL);
  nonnull_assert(valueObj != NULL);

  /*
   * Pass the object as Tcl_Obj, since we do not want to raise an error in
   * case the object does not exist.
   */
  Tcl_SetBooleanObj(Tcl_GetObjResult(interp), GetObjectFromObj(interp, valueObj, &object) == TCL_OK);
  return TCL_OK;
}

/*
cmd "object::property" NsfObjectPropertyCmd {
  {-argName "object" -required 1 -type object}
  {-argName "objectproperty" -type "initialized|class|rootmetaclass|rootclass|volatile|autonamed|slotcontainer|hasperobjectslots|keepcallerself|perobjectdispatch" -required 1}
  {-argName "value" -required 0 -type tclobj}
}
*/

static int
NsfObjectPropertyCmd(Tcl_Interp *interp, NsfObject *object, ObjectpropertyIdx_t objectProperty, Tcl_Obj *valueObj) {
  unsigned int flags = 0u, allowSet = 0u;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  switch (objectProperty) {
  case ObjectpropertyAutonamedIdx: flags = NSF_IS_AUTONAMED; allowSet = 1; break;
  case ObjectpropertyInitializedIdx: flags = NSF_INIT_CALLED; allowSet = 1; break;
  case ObjectpropertyClassIdx: flags = NSF_IS_CLASS; break;
  case ObjectpropertyRootmetaclassIdx: flags = NSF_IS_ROOT_META_CLASS; break;
  case ObjectpropertyVolatileIdx:
    if (valueObj == NULL) {
      Tcl_SetObjResult(interp,
                       NsfGlobalObjs[object->opt != NULL && object->opt->volatileVarName ? NSF_ONE : NSF_ZERO]);
      return TCL_OK;
    }
    allowSet = 1;
    break;

    /*
     * If a value is provided, return the error below.
     */
  case ObjectpropertyRootclassIdx: flags = NSF_IS_ROOT_CLASS; break;
  case ObjectpropertySlotcontainerIdx: flags = NSF_IS_SLOT_CONTAINER; allowSet = 1; break;
  case ObjectpropertyKeepcallerselfIdx: flags = NSF_KEEP_CALLER_SELF; allowSet = 1; break;
  case ObjectpropertyPerobjectdispatchIdx: flags = NSF_PER_OBJECT_DISPATCH; allowSet = 1; break;
  case ObjectpropertyHasperobjectslotsIdx: flags = NSF_HAS_PER_OBJECT_SLOTS; allowSet = 1; break;
  case ObjectpropertyNULL:
    /*
     * Do nothing; just for detection if option was specified.
     */
    break;
  }

  if (valueObj != NULL) {
    if (likely(allowSet)) {
      int flagValue, result;

      result = SetBooleanFlag(interp, &object->flags, flags, valueObj, &flagValue);
      if (unlikely(result != TCL_OK)) {
        return result;
      }

      if (objectProperty == ObjectpropertySlotcontainerIdx) {
        assert(object->nsPtr != NULL);
        if (flagValue != 0) {
          /*
           * Turn on SlotContainerCmdResolver.
           */
          Tcl_SetNamespaceResolvers(object->nsPtr,
                                    (Tcl_ResolveCmdProc *)SlotContainerCmdResolver,
                                    NsColonVarResolver,
                                    (Tcl_ResolveCompiledVarProc *)NULL);
        } else {
          /*
           * Turn off SlotContainerCmdResolver.
           */
          Tcl_SetNamespaceResolvers(object->nsPtr,
                                    (Tcl_ResolveCmdProc *)NULL,
                                    NsColonVarResolver,
                                    (Tcl_ResolveCompiledVarProc *)NULL);
        }
      } else if (objectProperty == ObjectpropertyVolatileIdx) {
        bool objectIsVolatile = (object->opt != NULL && object->opt->volatileVarName != NULL);

        if (flagValue != 0 && !objectIsVolatile) {
          /*
           * Set volatile property.
           */

          /*NsfObjectSystem *osPtr = GetObjectSystem(object);*/
          /*fprintf(stderr, "change volatile ... make volatile %s\n",
            ObjectName(&osPtr->rootClass->object));*/
          result = VolatileMethod(interp, object, NSF_TRUE);

        } else if (flagValue == 0 && objectIsVolatile) {
          /*
           * Remove volatile property.
           */
          UnsetTracedVars(interp, object);
          object->opt->volatileVarName = NULL;
        } else {
          /*
           * Nothing to do.
           */
        }

        if (unlikely(result != TCL_OK)) {
          return result;
        }
      }
    } else {
      return NsfPrintError(interp, "object property is read only");
    }
  }

  Tcl_SetObjResult(interp,
                   NsfGlobalObjs[(object->flags & flags) ?
                                 NSF_ONE : NSF_ZERO]);
  return TCL_OK;
}

/*
cmd "object::qualify" NsfObjectQualifyCmd {
  {-argName "objectName" -required 1 -type tclobj}
}
*/
static int
NsfObjectQualifyCmd(Tcl_Interp *interp, Tcl_Obj *objectNameObj) {
  const char *nameString;

  nonnull_assert(interp != NULL);
  nonnull_assert(objectNameObj != NULL);

  nameString = ObjStr(objectNameObj);
  if (isAbsolutePath(nameString)) {
    Tcl_SetObjResult(interp, objectNameObj);
  } else {
    Tcl_SetObjResult(interp, NameInNamespaceObj(nameString, CallingNameSpace(interp)));
  }
  return TCL_OK;
}

/*
cmd "objectsystem::create" NsfObjectSystemCreateCmd {
  {-argName "rootClass" -required 1 -type tclobj}
  {-argName "rootMetaClass" -required 1 -type tclobj}
  {-argName "systemMethods" -required 0 -type tclobj}
}
*/
static int
NsfObjectSystemCreateCmd(Tcl_Interp *interp, Tcl_Obj *rootClassObj, Tcl_Obj *rootMetaClassObj, Tcl_Obj *systemMethodsObj) {
  NsfClass        *theobj = NULL, *thecls = NULL;
  Tcl_Obj         *object, *class;
  const char      *objectName, *className;
  NsfObjectSystem *osPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(rootClassObj != NULL);
  nonnull_assert(rootMetaClassObj != NULL);

  osPtr = NEW(NsfObjectSystem);
  memset(osPtr, 0, sizeof(NsfObjectSystem));

  objectName = ObjStr(rootClassObj);
  object = isAbsolutePath(objectName) ? rootClassObj :
    NameInNamespaceObj(objectName, CallingNameSpace(interp));

  className = ObjStr(rootMetaClassObj);
  class = isAbsolutePath(className) ? rootMetaClassObj :
    NameInNamespaceObj(className, CallingNameSpace(interp));

  GetClassFromObj(interp, object, &theobj, NSF_FALSE);
  GetClassFromObj(interp, class, &thecls, NSF_FALSE);

  if ((theobj != NULL) || (thecls != NULL)) {
    ObjectSystemFree(interp, osPtr);
    NsfLog(interp, NSF_LOG_WARN, "Base class '%s' exists already; ignoring definition",
           (theobj != NULL) ? objectName : className);
    return TCL_OK;
  }

  if (systemMethodsObj != NULL) {
    int       oc, idx;
    Tcl_Obj **ov;

    if ((Tcl_ListObjGetElements(interp, systemMethodsObj, &oc, &ov)) == TCL_OK) {
      int i;

      if (oc % 2) {
        ObjectSystemFree(interp, osPtr);
        return NsfPrintError(interp, "system methods must be provided as pairs");
      }
      for (i = 0; i < oc; i += 2) {
        Tcl_Obj *arg, **arg_ov = NULL;
        int      arg_oc = -1, result;

        arg = ov[i+1];
        result = Tcl_GetIndexFromObj(interp, ov[i], Nsf_SystemMethodOpts, "system method", 0, &idx);
        if (likely(result == TCL_OK)) {
          result = Tcl_ListObjGetElements(interp, arg, &arg_oc, &arg_ov);
        }
        if (unlikely(result != TCL_OK)) {
          ObjectSystemFree(interp, osPtr);
          return NsfPrintError(interp, "invalid system method '%s'", ObjStr(ov[i]));
        } else if (arg_oc < 1 || arg_oc > 3) {
          ObjectSystemFree(interp, osPtr);
          return NsfPrintError(interp, "invalid system method argument '%s'", ObjStr(ov[i]), ObjStr(arg));
        }
        /*fprintf(stderr, "NsfCreateObjectSystemCmd [%d] = %p %s (max %d, given %d)\n",
          idx, ov[i+1], ObjStr(ov[i+1]), NSF_s_set_idx, oc);*/

        if (arg_oc == 1) {
          osPtr->methods[idx] = arg;
          osPtr->methodNames[idx] = ObjStr(arg);
        } else { /* (arg_oc == 2) */
          osPtr->methods[idx] = arg_ov[0];
          osPtr->methodNames[idx] = ObjStr(arg_ov[0]);
          osPtr->handles[idx] = arg_ov[1];
          if  (arg_oc == 3) {
            int boolVal = 0;
            Tcl_GetBooleanFromObj(interp, arg_ov[2], &boolVal);
            osPtr->protected[idx] = (char)boolVal;
          }
          INCR_REF_COUNT(osPtr->handles[idx]);
        }
        INCR_REF_COUNT(osPtr->methods[idx]);
      }
    } else {
      ObjectSystemFree(interp, osPtr);
      return NsfPrintError(interp, "provided system methods are not a proper list");
    }
  }
  /*
   * Create a basic object system with the basic root-class Object and the
   * basic metaclass Class, and store them in the RUNTIME STATE if successful.
   */
  theobj = PrimitiveCCreate(interp, object, NULL, NULL);
  thecls = PrimitiveCCreate(interp, class, NULL, NULL);
  /* fprintf(stderr, "CreateObjectSystem created base classes \n"); */

  /*
   * Check whether Object and Class creation was successful.
   */
  if ((theobj == NULL) || (thecls == NULL)) {

    if (thecls != NULL) {
      PrimitiveCDestroy(thecls);
    }
    if (theobj != NULL) {
      PrimitiveCDestroy(theobj);
    }

    ObjectSystemFree(interp, osPtr);
    return NsfPrintError(interp, "creation of object system failed");
  }

  theobj->osPtr = osPtr;
  thecls->osPtr = osPtr;
  osPtr->rootClass = theobj;
  osPtr->rootMetaClass = thecls;

  theobj->object.flags |= (NSF_IS_ROOT_CLASS|NSF_INIT_CALLED);
  thecls->object.flags |= (NSF_IS_ROOT_META_CLASS|NSF_INIT_CALLED);

  ObjectSystemAdd(interp, osPtr);

  AddInstance((NsfObject *)theobj, thecls);
  AddInstance((NsfObject *)thecls, thecls);
  AddSuper(thecls, theobj);

  if (NSF_DTRACE_OBJECT_ALLOC_ENABLED()) {
    NSF_DTRACE_OBJECT_ALLOC(ObjectName((NsfObject *)theobj), ClassName(((NsfObject *)theobj)->cl));
    NSF_DTRACE_OBJECT_ALLOC(ObjectName((NsfObject *)thecls), ClassName(((NsfObject *)thecls)->cl));
  }

  return TCL_OK;
}


/*
cmd my NsfMyCmd {
  {-argName "-intrinsic" -nrargs 0}
  {-argName "-local" -nrargs 0}
  {-argName "-system" -nrargs 0}
  {-argName "method" -required 1 -type tclobj}
  {-argName "args" -type args}
}
*/
static int
NsfMyCmd(Tcl_Interp *interp,
         int withIntrinsic, int withLocal, int withSystem,
         Tcl_Obj *methodNameObj,
         int trailingObjc, Tcl_Obj *const trailingObjv[]) {
  NsfObject *self;
  int        result;

  nonnull_assert(interp != NULL);
  nonnull_assert(methodNameObj != NULL);

  self = GetSelfObj(interp);
  if (unlikely(self == NULL)) {
    result = NsfNoCurrentObjectError(interp, method_definitions[NsfMyCmdIdx].methodName);

  } else if ((withIntrinsic && withLocal)
             || (withIntrinsic && withSystem)
             || (withLocal && withSystem)) {
    result = NsfPrintError(interp, "flags '-intrinsic', '-local' and '-system' are mutual exclusive");

  } else {
    unsigned int  flags;
#if 0
    /* TODO attempt to make "my" NRE-enabled, failed so far (crash in mixinInheritanceTest) */
    NsfCallStackContent *cscPtr = CallStackGetTopFrame0(interp);

    if (cscPtr == NULL || self != cscPtr->self) {
      flags = NSF_CSC_IMMEDIATE;
    } else {
      flags = NsfImmediateFromCallerFlags(cscPtr->flags);
      fprintf(stderr, "XXX MY %s.%s frame has flags %.6x -> next-flags %.6x\n",
              ObjectName(self), ObjStr(methodNameObj), cscPtr->flags, flags);
    }
    if (withIntrinsic != 0) {flags |= NSF_CM_INTRINSIC_METHOD;}
    if (withLocal != 0)     {flags |= NSF_CM_LOCAL_METHOD;}
    if (withSystem != 0)    {flags |= NSF_CM_SYSTEM_METHOD;}
    result = CallMethod(self, interp, methodNameObj, trailingObjc+2, trailingObjv, flags);
#else
    flags = NSF_CSC_IMMEDIATE;
    if (withIntrinsic != 0) {flags |= NSF_CM_INTRINSIC_METHOD;}
    if (withLocal != 0)     {flags |= NSF_CM_LOCAL_METHOD;}
    if (withSystem != 0)    {flags |= NSF_CM_SYSTEM_METHOD;}
    result = CallMethod(self, interp, methodNameObj, trailingObjc+2, trailingObjv, flags);
#endif
  }

  return result;
}


/*
 *----------------------------------------------------------------------
 * NsfNextCmd --
 *
 *      nsf::next calls the next shadowed method. It might get a single
 *      argument which is used as argument vector for that method. If no
 *      argument is provided, the argument vector of the last invocation
 *      is used.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      The invoked method might produce side effects
 *
 *----------------------------------------------------------------------
 */
/*
cmd next NsfNextCmd {
  {-argName "arguments" -required 0 -type tclobj}
}
*/
static int
NsfNextCmd(Tcl_Interp *interp, Tcl_Obj *argumentsObj) {
  int                  oc, nobjc = 0, result;
  bool                 freeArgumentVector;
  NsfCallStackContent *cscPtr = NULL;
  const char          *methodName = NULL;
  Tcl_Obj            **nobjv = NULL, **ov;

  nonnull_assert(interp != NULL);

  if (argumentsObj != NULL) {
    /*
     * Arguments were provided.
     */
    int rc = Tcl_ListObjGetElements(interp, argumentsObj, &oc, &ov);

    if (unlikely(rc != TCL_OK)) {
      return rc;
    }
  } else {
    /*
     * No arguments were provided.
     */
    oc = -1;
    ov = NULL;
  }

  result = NextGetArguments(interp, oc, ov, &cscPtr, &methodName,
                            &nobjc, &nobjv, &freeArgumentVector);
  if (likely(result == TCL_OK)) {
    assert(cscPtr != NULL);
    result = NextSearchAndInvoke(interp, methodName, nobjc, nobjv, cscPtr, freeArgumentVector);
  }
  return result;
}

/*
cmd nscopyvars NsfNSCopyVars {
  {-argName "fromNs" -required 1 -type tclobj}
  {-argName "toNs" -required 1 -type tclobj}
}
*/
static int
NsfNSCopyVarsCmd(Tcl_Interp *interp, Tcl_Obj *fromNsObj, Tcl_Obj *toNsObj) {
  Tcl_Namespace       *fromNsPtr = NULL, *toNsPtr;
  Var                 *varPtr = NULL;
  Tcl_HashSearch       hSrch;
  const Tcl_HashEntry *hPtr;
  TclVarHashTable     *varTablePtr;
  NsfObject           *destObject;
  const char          *destFullName;
  Tcl_Obj             *destFullNameObj;
  Tcl_CallFrame        frame, *framePtr = &frame;
  int                  result;

  nonnull_assert(interp != NULL);
  nonnull_assert(fromNsObj != NULL);
  nonnull_assert(toNsObj != NULL);

  TclGetNamespaceFromObj(interp, fromNsObj, &fromNsPtr);

  if (fromNsPtr != NULL) {
    if (TclGetNamespaceFromObj(interp, toNsObj, &toNsPtr) != TCL_OK) {
      return NsfPrintError(interp, "CopyVars: Destination namespace %s does not exist",
                           ObjStr(toNsObj));
    }

    destFullName = toNsPtr->fullName;
    destFullNameObj = Tcl_NewStringObj(destFullName, -1);
    INCR_REF_COUNT(destFullNameObj);
    varTablePtr = Tcl_Namespace_varTablePtr(fromNsPtr);
    Tcl_PushCallFrame(interp, (Tcl_CallFrame *)framePtr, toNsPtr, 0);
  } else {
    NsfObject *newObject, *object;

    if (GetObjectFromObj(interp, fromNsObj, &object) != TCL_OK) {
      return NsfPrintError(interp, "CopyVars: Origin object/namespace %s does not exist",
                           ObjStr(fromNsObj));

    } else if (GetObjectFromObj(interp, toNsObj, &newObject) != TCL_OK) {
      return NsfPrintError(interp, "CopyVars: Destination object/namespace %s does not exist",
                           ObjStr(toNsObj));
    } else {
      varTablePtr = object->varTablePtr;
      destFullNameObj = newObject->cmdName;
      destFullName = ObjStr(destFullNameObj);
    }
  }

  destObject = GetObjectFromString(interp, destFullName);
  result = TCL_OK;

  /*
   * Copy all vars in the namespace.
   */
  hPtr = (varTablePtr != NULL) ? Tcl_FirstHashEntry(TclVarHashTablePtr(varTablePtr), &hSrch) : NULL;
  while (hPtr != NULL) {
    Tcl_Obj *varNameObj, *resultObj;

    GetVarAndNameFromHash(hPtr, &varPtr, &varNameObj);
    INCR_REF_COUNT(varNameObj);

    if (!TclIsVarUndefined(varPtr) && !TclIsVarLink(varPtr)) {
      if (TclIsVarScalar(varPtr)) {
        /*
         * Copy scalar variables from the namespace, which might be
         * either instance or namespace variables.
         */

        if (destObject != NULL) {
          /* fprintf(stderr, "copy in obj %s var %s val '%s'\n", ObjectName(destObject), ObjStr(varNameObj),
             ObjStr(TclVarValue(Tcl_Obj, varPtr, objPtr)));*/

          resultObj = Nsf_ObjSetVar2((Nsf_Object *)destObject, interp, varNameObj, NULL,
                                     TclVarValue(Tcl_Obj, varPtr, objPtr), TCL_LEAVE_ERR_MSG);
        } else {
          resultObj = Tcl_ObjSetVar2(interp, varNameObj, NULL,
                                     TclVarValue(Tcl_Obj, varPtr, objPtr),
                                     TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
        }
        if (unlikely(resultObj == NULL)) {
          DECR_REF_COUNT(varNameObj);
          result = TCL_ERROR;
          goto copy_done;
        }
      } else {
        if (TclIsVarArray(varPtr)) {
          /* HERE!! PRE85 Why not [array get/set] based? Let the core iterate */
          TclVarHashTable *aTable = TclVarValue(TclVarHashTable, varPtr, tablePtr);
          Tcl_HashSearch ahSrch;
          Tcl_HashEntry *ahPtr = (aTable != NULL) ? Tcl_FirstHashEntry(TclVarHashTablePtr(aTable), &ahSrch) : 0;

          for (; ahPtr != NULL; ahPtr = Tcl_NextHashEntry(&ahSrch)) {
            Tcl_Obj *eltNameObj;
            Var *eltVar;

            GetVarAndNameFromHash(ahPtr, &eltVar, &eltNameObj);
            INCR_REF_COUNT(eltNameObj);

            if (TclIsVarScalar(eltVar)) {
              if (destObject != NULL) {
                resultObj = Nsf_ObjSetVar2((Nsf_Object *)destObject, interp, varNameObj, eltNameObj,
                                           TclVarValue(Tcl_Obj, eltVar, objPtr), TCL_LEAVE_ERR_MSG);
              } else {
                resultObj = Tcl_ObjSetVar2(interp, varNameObj, eltNameObj,
                                           TclVarValue(Tcl_Obj, eltVar, objPtr),
                                           TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
              }
              if (unlikely(resultObj == NULL)) {
                DECR_REF_COUNT(varNameObj);
                result = TCL_ERROR;
                goto copy_done;
              }
            }
            DECR_REF_COUNT(eltNameObj);
          }
        }
      }
    }
    DECR_REF_COUNT(varNameObj);
    hPtr = Tcl_NextHashEntry(&hSrch);
  }
 copy_done:
  if (fromNsPtr != NULL) {
    DECR_REF_COUNT(destFullNameObj);
    Tcl_PopCallFrame(interp);
  }
  return result;
}

/*
cmd parameter::info NsfParameterInfoCmd {
  {-argName "subcmd"   -typeName "parametersubcmd" -type "default|list|name|syntax|type" -required 1}
  {-argName "parameterspec"   -required 1 -type tclobj}
  {-argName "varname"         -required 0 -type tclobj}
}
*/
static int
NsfParameterInfoCmd(Tcl_Interp *interp, ParametersubcmdIdx_t subcmd, Tcl_Obj *specObj,  Tcl_Obj *varnameObj) {
  NsfParsedParam parsedParam;
  Tcl_Obj *paramsObj, *listObj = NULL;
  Nsf_Param *paramsPtr;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(specObj != NULL);

  if (subcmd != ParametersubcmdDefaultIdx && varnameObj != NULL) {
    return NsfPrintError(interp, "parameter::info: provided third argument is only valid for querying defaults");
  }

  paramsObj = Tcl_NewListObj(1, &specObj);
  INCR_REF_COUNT(paramsObj);
  result = ParamDefsParse(interp, NULL, paramsObj,
                          NSF_DISALLOWED_ARG_OBJECT_PARAMETER, NSF_TRUE,
                          &parsedParam, NULL);
  DECR_REF_COUNT(paramsObj);

  if (unlikely(result != TCL_OK)) {
    return result;
  }

  assert(parsedParam.paramDefs != NULL);
  paramsPtr = parsedParam.paramDefs->paramsPtr;
  assert(paramsPtr != NULL);

  /*
   * Since we are passing in a parameter definition in Tcl syntax, and we want
   * to extract information from that syntax, it makes limited sense to
   * provide a context object for virtual parameter expansion. At least, we do
   * not allow this so far.
   */

  switch (subcmd) {
  case ParametersubcmdDefaultIdx:
    if (paramsPtr->defaultValue != NULL) {
      if (varnameObj != NULL) {
        Tcl_Obj *resultObj = Tcl_ObjSetVar2(interp, varnameObj, NULL,
                                            paramsPtr->defaultValue,
                                            TCL_LEAVE_ERR_MSG);
        if (unlikely(resultObj == NULL)) {
          ParamDefsRefCountDecr(parsedParam.paramDefs);
          return TCL_ERROR;
        }
      }
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_ONE]);
    } else {
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_ZERO]);
    }
    break;

  case ParametersubcmdListIdx:
    listObj = ParamDefsList(interp, paramsPtr, NULL, NULL);
    Tcl_SetObjResult(interp, listObj);
    DECR_REF_COUNT2("paramDefsObj", listObj);
    break;

  case ParametersubcmdNameIdx:
    listObj = ParamDefsNames(interp, paramsPtr, NULL, NULL);
    Tcl_SetObjResult(interp, listObj);
    DECR_REF_COUNT2("paramDefsObj", listObj);
    break;

  case ParametersubcmdSyntaxIdx:
    listObj = NsfParamDefsSyntax(interp, paramsPtr, NULL, NULL);
    Tcl_SetObjResult(interp, listObj);
    DECR_REF_COUNT2("paramDefsObj", listObj);
    break;

  case ParametersubcmdTypeIdx:
    if (paramsPtr->type != NULL) {

      if (paramsPtr->converter == Nsf_ConvertToTclobj && paramsPtr->converterArg) {
        Tcl_SetObjResult(interp, paramsPtr->converterArg);

      } else {
        if (paramsPtr->converter == Nsf_ConvertToObject || paramsPtr->converter == Nsf_ConvertToClass) {
          const char *what = paramsPtr->type;
          /*
           * baseclass and metaclass are communicated via flags
           */
          if (unlikely((paramsPtr->flags & NSF_ARG_BASECLASS) != 0u)) {
            what = "baseclass";
          } else if (unlikely((paramsPtr->flags & NSF_ARG_METACLASS) != 0u)) {
            what = "metaclass";
          }
          /*
           * The converterArg might contain a class for type checking
           */
          if (paramsPtr->converterArg == NULL) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(what, -1));
          } else {
            Tcl_SetObjResult(interp, paramsPtr->converterArg);
          }
        } else {
          Tcl_SetObjResult(interp, Tcl_NewStringObj(paramsPtr->type, -1));
        }
      }
    } else {
      Tcl_SetObjResult(interp, NsfGlobalObjs[NSF_EMPTY]);
    }
    break;

  case ParametersubcmdNULL:
    /*
     * Do nothing; just for detection if option was specified.
     */
    break;
  }

  ParamDefsRefCountDecr(parsedParam.paramDefs);

  return TCL_OK;
}

/*
cmd parameter::cache::classinvalidate NsfParameterCacheClassInvalidateCmd {
  {-argName "class" -required 1 -type class}
}
*/
static int
NsfParameterCacheClassInvalidateCmd(Tcl_Interp *interp, NsfClass *class) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  /*
   * First, increment the epoch in case we have a parsedParam. The
   * classParamPtrEpoch is just used for PER_OBJECT_PARAMETER_CACHING
   */
#if defined(PER_OBJECT_PARAMETER_CACHING)
  if (unlikely(class->parsedParamPtr != NULL)) {
    NsfClassParamPtrEpochIncr("NsfParameterCacheClassInvalidateCmd");
  }
#endif

  /*
   * During shutdown, no new objects are created, therefore, we do not need to
   * to invalidate the cached parsedParamPtr of the classes.
   */
  if (unlikely(RUNTIME_STATE(interp)->exitHandlerDestroyRound == NSF_EXITHANDLER_OFF)) {
    NsfClasses *dependentSubClasses;
    NsfClasses *clPtr;

    /*
     * Clear the cached parsedParam of the class and all its subclasses (the
     * result of DependentSubClasses() contains the starting
     * class). Furthermore, make a quick check whether any of the subclasses
     * is a class mixin of some other class.
     */

    dependentSubClasses = DependentSubClasses(class);
    if (dependentSubClasses != NULL) {

      for (clPtr = dependentSubClasses; clPtr != NULL; clPtr = clPtr->nextPtr) {
        NsfClass *subClass = clPtr->cl;

        if (subClass->parsedParamPtr != NULL) {
          ParsedParamFree(subClass->parsedParamPtr);
          subClass->parsedParamPtr = NULL;
        }

      }
      NsfClassListFree(dependentSubClasses);
    }

  }
  return TCL_OK;
}


/*
cmd parameter::cache::objectinvalidate NsfParameterCacheObjectInvalidateCmd {
  {-argName "object" -required 1 -type object}
}
*/
static int
NsfParameterCacheObjectInvalidateCmd(Tcl_Interp *UNUSED(interp), NsfObject *object) {

  nonnull_assert(object != NULL);

#if defined(PER_OBJECT_PARAMETER_CACHING)
  if (object->opt != NULL && object->opt->parsedParamPtr) {
    /*fprintf(stderr, "   %p %s invalidate %p\n", object,
      ObjectName(object),  object->opt->parsedParamPtr);*/
    ParsedParamFree(object->opt->parsedParamPtr);
    object->opt->parsedParamPtr = NULL;
  }
#endif
  return TCL_OK;
}

/*
cmd parameter::specs NsfParameterSpecsCmd {
  {-argName "-configure"  -nrargs 0 -required 0}
  {-argName "-nonposargs"  -nrargs 0 -required 0}
  {-argName "slotobjs"    -required 1 -type tclobj}
}
*/

static int
NsfParameterSpecsCmd(Tcl_Interp *interp, int withConfigure, int withNonposargs, Tcl_Obj *slotobjsObj) {
  NsfTclObjList *objList = NULL, *elt;
  Tcl_Obj **objv, *resultObj;
  int result = TCL_OK, i, objc;

  nonnull_assert(interp != NULL);
  nonnull_assert(slotobjsObj != NULL);

  if (Tcl_ListObjGetElements(interp, slotobjsObj, &objc, &objv) != TCL_OK) {
    return NsfPrintError(interp, "NsfParameterSpecsCmd: invalid slot object list");
  }

  /*
   * Iterate over the slot objects and obtain the position and the
   * parameterSpec.
   */
  for (i = 0; i < objc; i++) {
    NsfObject *slotObject;
    Tcl_Obj *positionObj, *specObj = NULL;

    if (GetObjectFromObj(interp, objv[i], &slotObject) != TCL_OK) {
      return NsfPrintError(interp, "objectparameter: slot element is not a next scripting object");
    }
    assert(slotObject != NULL);

    /*
     * When withConfigure is provided, skip this parameter ...
     *  - when configure is not set
     *  - or  configure == 0
     */
    if (withConfigure != 0) {
      int configure = 0;
      Tcl_Obj *configureObj = Nsf_ObjGetVar2((Nsf_Object *)slotObject, interp,
                                             NsfGlobalObjs[NSF_CONFIGURABLE], NULL, 0);
      if (configureObj == NULL) {
        continue;
      }
      Tcl_GetBooleanFromObj(interp, configureObj, &configure);
      if (configure == 0) {
        continue;
      }
    }

    /*
     * When withNonposargs is provided, skip this parameter ...
     *  - when positional == 1
     */
    if (withNonposargs != 0) {
      Tcl_Obj *positionalObj = Nsf_ObjGetVar2((Nsf_Object *)slotObject, interp,
                                             NsfGlobalObjs[NSF_POSITIONAL], NULL, 0);
      if (positionalObj != NULL) {
        int positional = 0;

        Tcl_GetBooleanFromObj(interp, positionalObj, &positional);
        if (positional != 0) {
          continue;
        }
      }
    }

    positionObj = Nsf_ObjGetVar2((Nsf_Object *)slotObject, interp,
                                 NsfGlobalObjs[NSF_POSITION], NULL, 0);
    specObj = Nsf_ObjGetVar2((Nsf_Object *)slotObject, interp,
                             NsfGlobalObjs[NSF_PARAMETERSPEC], NULL, 0);
    if (specObj == NULL) {
      result = CallMethod(slotObject, interp, NsfGlobalObjs[NSF_GET_PARAMETER_SPEC], 2, NULL,
                          NSF_CM_IGNORE_PERMISSIONS|NSF_CSC_IMMEDIATE);
      if (unlikely(result != TCL_OK)) {
        return NsfPrintError(interp, "objectparameter: %s %s returned error",
                             ObjectName_(slotObject),
                             NsfGlobalStrings[NSF_GET_PARAMETER_SPEC]);
      }
      specObj = Tcl_GetObjResult(interp);
    }
    /*fprintf(stderr, "NsfParameterSpecsCmd  slot obj = %s pos %s spec %s\n", ObjStr(objv[i]), (positionObj != NULL) ? ObjStr(positionObj) : "NONE", ObjStr(specObj)  );*/
    /*
     * Add the spec to the list indicated by the position
     */
    TclObjListAdd(interp, &objList, positionObj, specObj);
  }

  /*
   * Fold the per-position lists into a flat result list
   */
  resultObj = Tcl_NewListObj(0, NULL);
  for (elt = objList; elt != NULL; elt = elt->nextPtr) {
    Tcl_ListObjGetElements(interp, elt->payload, &objc, &objv);
    for (i = 0; i < objc; i++) {
      Tcl_ListObjAppendElement(interp, resultObj, objv[i]);

    }
  }

  Tcl_SetObjResult(interp, resultObj);
  if (objList != NULL) {
    TclObjListFreeList(objList);
  }

  return result;
}

/*
cmd proc NsfProcCmd {
  {-argName "-ad"          -required 0 -nrargs 0 -type switch}
  {-argName "-checkalways" -required 0 -nrargs 0 -type switch}
  {-argName "-debug"       -required 0 -nrargs 0 -type switch}
  {-argName "-deprecated"  -required 0 -nrargs 0 -type switch}
  {-argName "procName"     -required 1 -type tclobj}
  {-argName "arguments"    -required 1 -type tclobj}
  {-argName "body"         -required 1 -type tclobj}
}
*/
static int
NsfProcCmd(Tcl_Interp *interp, int withAd, int withCheckalways, int withDebug, int withDeprecated,
           Tcl_Obj *procNameObj, Tcl_Obj *argumentsObj, Tcl_Obj *bodyObj) {
  NsfParsedParam parsedParam;
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(procNameObj != NULL);
  nonnull_assert(argumentsObj != NULL);
  nonnull_assert(bodyObj != NULL);

  /*
   * Parse argument list "arguments" to determine if we should provide
   * nsf parameter handling.
   */
  result = ParamDefsParse(interp, procNameObj, argumentsObj,
                          NSF_DISALLOWED_ARG_METHOD_PARAMETER, (withDebug != 0),
                          &parsedParam, Tcl_GetCurrentNamespace(interp)->fullName);
  if (unlikely(result != TCL_OK)) {
    return result;
  }

  if (parsedParam.paramDefs != NULL || withDebug != 0 || withDeprecated != 0) {
    /*
     * We need parameter handling. In such cases, a thin C-based layer
     * is added which handles the parameter passing and calls the proc
     * later.
     */
    result = NsfProcAdd(interp, &parsedParam, ObjStr(procNameObj), bodyObj,
                        withAd, withCheckalways, withDebug, withDeprecated);

  } else {
    /*
     * No parameter handling needed. A plain Tcl proc is added.
     */
    Tcl_Obj *ov[4];

    ov[0] = NULL;
    ov[1] = procNameObj;
    ov[2] = argumentsObj;
    ov[3] = bodyObj;
    result = Tcl_ProcObjCmd(0, interp, 4, ov);
  }

  return result;
}

/*
cmd relation::get NsfRelationGetCmd {
  {-argName "object" -type object}
  {-argName "type" -required 1 -typeName "relationtype" -type "object-mixin|class-mixin|object-filter|class-filter|class|superclass|rootclass"}
}
*/
static int
NsfRelationGetCmd(Tcl_Interp *interp, NsfObject *object, RelationtypeIdx_t type) {

  return NsfRelationSetCmd(interp, object, type, NULL);
}


/*
 *----------------------------------------------------------------------
 * NsfRelationClassMixinsSet --
 *
 *      Set class mixins; the main reason for the factored-out semantics is that
 *      it supports to undo/redo the operations in case of a failure.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      class mixins are set, various kinds of invalidations.
 *
 *----------------------------------------------------------------------
 */
static int NsfRelationClassMixinsSet(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *valueObj, int oc, Tcl_Obj **ov)
  nonnull(1) nonnull(2) nonnull(3);

static int
NsfRelationClassMixinsSet(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *valueObj, int oc, Tcl_Obj **ov) {
  NsfCmdList  *newMixinCmdList = NULL, *cmds;
  NsfClasses  *subClasses;
  NsfClassOpt *clopt;
  int          i;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(valueObj != NULL);

  for (i = 0; i < oc; i++) {
    if (unlikely(MixinAdd(interp, &newMixinCmdList, ov[i]) != TCL_OK)) {
      CmdListFree(&newMixinCmdList, GuardDel);
      return TCL_ERROR;
    }
  }
  clopt = class->opt;
  assert(clopt != NULL);

  if (clopt->classMixins != NULL) {
    RemoveFromClassMixinsOf(class->object.id, clopt->classMixins);
    CmdListFree(&clopt->classMixins, GuardDel);
  }

  subClasses = DependentSubClasses(class);
  MixinInvalidateObjOrders(subClasses);

  /*
   * Since methods of mixed in classes may be used as filters, we have to
   * invalidate the filters as well.
   */
  if (FiltersDefined(interp) > 0) {
    FilterInvalidateObjOrders(interp, subClasses);
  }
  NsfClassListFree(subClasses);

  /*
   * Now register the specified mixins.
   */
  clopt->classMixins = newMixinCmdList;

  /*
   * Finally, update classMixinOfs
   */
  for (cmds = newMixinCmdList; cmds; cmds = cmds->nextPtr) {
    NsfObject *nObject = NsfGetObjectFromCmdPtr(cmds->cmdPtr);

    if (nObject != NULL) {
      NsfClassOpt *nclopt = NsfRequireClassOpt((NsfClass *) nObject);

      CmdListAddSorted(&nclopt->isClassMixinOf, class->object.id, NULL);
    } else {
      NsfLog(interp, NSF_LOG_WARN,
             "Problem registering %s as a class mixin of %s\n",
             ObjStr(valueObj), ClassName_(class));
    }
  }

  return TCL_OK;
}


/*
cmd relation::set NsfRelationSetCmd {
  {-argName "object"  -required 1 -type object}
  {-argName "type" -required 1 -typeName "relationtype" -type "object-mixin|class-mixin|object-filter|class-filter|class|superclass|rootclass"}
  {-argName "value" -required 0 -type tclobj}
}
*/
static int
NsfRelationSetCmd(Tcl_Interp *interp, NsfObject *object, RelationtypeIdx_t type, Tcl_Obj *valueObj) {
  int            oc = 0, i;
  Tcl_Obj      **ov;
  NsfClass      *class = NULL;
  NsfObjectOpt  *objopt = NULL;
  NsfClassOpt   *clopt = NULL, *nclopt = NULL;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  /*fprintf(stderr, "NsfRelationSetCmd %s rel=%d val='%s'\n",
    ObjectName(object), relationtype, (valueObj != NULL) ? ObjStr(valueObj) : "NULL");*/

  if (type == RelationtypeClass_mixinIdx ||
      type == RelationtypeClass_filterIdx) {
    if (NsfObjectIsClass(object)) {
      class = (NsfClass *)object;
    } else {
      /*
       * Fall back to per-object case.
       */
      type = (type == RelationtypeClass_mixinIdx) ?
        RelationtypeObject_mixinIdx :
        RelationtypeObject_filterIdx ;
    }
  }

  /*
   * The first switch block is just responsible for obtaining objopt or clopt
   * or handling other simple cases.
   */
  switch (type) {
  case RelationtypeObject_filterIdx: NSF_FALL_THROUGH; /* fall through */
  case RelationtypeObject_mixinIdx:
    if (valueObj == NULL) {
      objopt = object->opt;
      if (type == RelationtypeObject_mixinIdx) {
        return (objopt != NULL) ? MixinInfo(interp, objopt->objMixins, NULL, NSF_TRUE, NULL) : TCL_OK;
      } else /* (type == RelationtypeObject_filterIdx) */ {
        return (objopt != NULL) ? FilterInfo(interp, objopt->objFilters, NULL, NSF_TRUE, NSF_FALSE) : TCL_OK;
      }
    }
    if (unlikely(Tcl_ListObjGetElements(interp, valueObj, &oc, &ov) != TCL_OK)) {
      return TCL_ERROR;
    }
    objopt = NsfRequireObjectOpt(object);
    break;

  case RelationtypeClass_mixinIdx: NSF_FALL_THROUGH; /* fall through */
  case RelationtypeClass_filterIdx:
    assert(class != NULL);
    if (valueObj == NULL) {
      clopt = class->opt;
      if (type == RelationtypeClass_mixinIdx) {
        return (clopt != NULL) ? MixinInfo(interp, clopt->classMixins, NULL, NSF_TRUE, NULL) : TCL_OK;
      } else /* if (relationtype == RelationtypeClass_filterIdx) */ {
        return (clopt != NULL) ? FilterInfo(interp, clopt->classFilters, NULL, NSF_TRUE, NSF_FALSE) : TCL_OK;
      }
    }
    if (unlikely(Tcl_ListObjGetElements(interp, valueObj, &oc, &ov) != TCL_OK)) {
      return TCL_ERROR;
    }
    clopt = NsfRequireClassOpt(class);
    break;

  case RelationtypeSuperclassIdx:
    if (!NsfObjectIsClass(object)) {
      return NsfObjErrType(interp, "superclass", object->cmdName, "class", NULL);
    }
    class = (NsfClass *)object;
    if (valueObj == NULL) {
      return ListSuperClasses(interp, class, NULL, NSF_FALSE);
    }
    if (unlikely(Tcl_ListObjGetElements(interp, valueObj, &oc, &ov) != TCL_OK)) {
      return TCL_ERROR;
    }
    return SuperclassAdd(interp, class, oc, ov, valueObj);

  case RelationtypeClassIdx:
    if (valueObj == NULL) {
      Tcl_SetObjResult(interp, object->cl->object.cmdName);
      return TCL_OK;
    }
    GetClassFromObj(interp, valueObj, &class, NSF_TRUE);
    if (class == NULL) {
      return NsfObjErrType(interp, "class", valueObj, "a class", NULL);
    }
    i = ChangeClass(interp, object, class);
    if (i == TCL_OK) {
      Tcl_SetObjResult(interp, object->cl->object.cmdName);
    }
    return i;

  case RelationtypeRootclassIdx:
    {
    NsfClass *metaClass = NULL;

    if (!NsfObjectIsClass(object)) {
      return NsfObjErrType(interp, "rootclass", object->cmdName, "class", NULL);
    }
    class = (NsfClass *)object;

    if (valueObj == NULL) {
      return NsfPrintError(interp, "metaclass must be specified as third argument");
    }
    GetClassFromObj(interp, valueObj, &metaClass, NSF_FALSE);
    if (metaClass == NULL) {
      return NsfObjErrType(interp, "rootclass", valueObj, "class", NULL);
    }

    class->object.flags |= NSF_IS_ROOT_CLASS;
    metaClass->object.flags |= NSF_IS_ROOT_META_CLASS;

    return TCL_OK;

    /* TODO:
       Need to remove these properties?
       Allow one to delete a class system at run time?
    */
    }

  case RelationtypeNULL:
    /* do nothing; just for detection if option was specified */
    return TCL_OK;
  }

  /*
   * The second switch block is responsible for the more complex handling of
   * the relations.
   */

  switch (type) {
  case RelationtypeObject_mixinIdx:
    {
      NsfCmdList *newMixinCmdList = NULL, *cmds;

      /*
       * Add every mixin class
       */
      for (i = 0; i < oc; i++) {
        if (unlikely(MixinAdd(interp, &newMixinCmdList, ov[i]) != TCL_OK)) {
          CmdListFree(&newMixinCmdList, GuardDel);
          return TCL_ERROR;
        }
      }

      if (objopt->objMixins != NULL) {
        NsfCmdList *cmdlist, *del;

        /*
         * Delete from old isObjectMixinOf lists
         */
        for (cmdlist = objopt->objMixins; cmdlist != NULL; cmdlist = cmdlist->nextPtr) {
          class = NsfGetClassFromCmdPtr(cmdlist->cmdPtr);
          clopt = (class != NULL) ? class->opt : NULL;
          if (clopt != NULL) {
            del = CmdListFindCmdInList(object->id, clopt->isObjectMixinOf);
            if (del != NULL) {
              /* fprintf(stderr, "Removing object %s from isObjectMixinOf of class %s\n",
                 ObjectName(object), ObjStr(NsfGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */
              del = CmdListRemoveFromList(&clopt->isObjectMixinOf, del);
              CmdListDeleteCmdListEntry(del, GuardDel);
            }
          }
        }
        CmdListFree(&objopt->objMixins, GuardDel);
      }

      /*
       * Invalidate per-object infos
       */
      NsfParameterCacheObjectInvalidateCmd(interp, object);
      object->flags &= ~NSF_MIXIN_ORDER_VALID;
      /*
       * Since mixin procs may be used as filters -> we have to invalidate
       * filters as well.
       */
      object->flags &= ~NSF_FILTER_ORDER_VALID;

      /*
       * Now register the specified mixins.
       */
      objopt->objMixins = newMixinCmdList;

      for (cmds = newMixinCmdList; cmds; cmds = cmds->nextPtr) {
        NsfObject *nObject = NsfGetObjectFromCmdPtr(cmds->cmdPtr);

        if (nObject != NULL) {
          nclopt = NsfRequireClassOpt((NsfClass *) nObject);
          CmdListAddSorted(&nclopt->isObjectMixinOf, object->id, NULL);
        } else {
          NsfLog(interp, NSF_LOG_WARN,
                 "Problem registering %s as an object mixin of %s\n",
                 ObjStr(valueObj), ObjectName_(object));
        }
      }

      MixinComputeDefined(interp, object);
      FilterComputeDefined(interp, object);
    }
    break;

  case RelationtypeObject_filterIdx:
    {
      NsfCmdList *newFilterCmdList = NULL;

      for (i = 0; i < oc; i ++) {
        if (unlikely(FilterAdd(interp, &newFilterCmdList, ov[i], object, NULL) != TCL_OK)) {
          CmdListFree(&newFilterCmdList, GuardDel);
          return TCL_ERROR;
        }
      }

      if (objopt->objFilters != NULL) {
        CmdListFree(&objopt->objFilters, GuardDel);
      }

      object->flags &= ~NSF_FILTER_ORDER_VALID;
      objopt->objFilters = newFilterCmdList;

      /*FilterComputeDefined(interp, object);*/
    }
    break;

  case RelationtypeClass_mixinIdx:
    if (unlikely(NsfRelationClassMixinsSet(interp, class, valueObj, oc, ov) != TCL_OK)) {
      return TCL_ERROR;
    }
    break;

  case RelationtypeClass_filterIdx:
    {
      NsfCmdList *newFilterCmdList = NULL;

      for (i = 0; i < oc; i ++) {
        if (unlikely(FilterAdd(interp, &newFilterCmdList, ov[i], NULL, class) != TCL_OK)) {
          CmdListFree(&newFilterCmdList, GuardDel);
          return TCL_ERROR;
        }
      }

      if (clopt->classFilters != NULL) {
        CmdListFree(&clopt->classFilters, GuardDel);
      }

      if (FiltersDefined(interp) > 0) {
        NsfClasses *subClasses = DependentSubClasses(class);
        if (subClasses != NULL) {
          FilterInvalidateObjOrders(interp, subClasses);
          NsfClassListFree(subClasses);
        }
      }

      clopt->classFilters = newFilterCmdList;

    }
    break;

  case RelationtypeClassIdx:      NSF_FALL_THROUGH; /* fall through */
  case RelationtypeRootclassIdx:  NSF_FALL_THROUGH; /* fall through */
  case RelationtypeSuperclassIdx: NSF_FALL_THROUGH; /* fall through */
  case RelationtypeNULL:
    /* handled above */
    break;

  }

  /*
   * Return on success the final setting
   */
  NsfRelationSetCmd(interp, object, type, NULL);
  return TCL_OK;
}

/*
cmd current NsfCurrentCmd {
  {-argName "option" -required 0 -typeName "currentoption" -type "activelevel|activemixin|args|calledclass|calledmethod|calledproc|callingclass|callinglevel|callingmethod|callingobject|callingproc|class|filterreg|isnextcall|level|methodpath|method|nextmethod|object|proc" -default object}
}
*/
static int
NsfCurrentCmd(Tcl_Interp *interp, CurrentoptionIdx_t option) {
  NsfObject           *object;
  NsfCallStackContent *cscPtr;
  Tcl_CallFrame       *framePtr;
  int                  result = TCL_OK;

  nonnull_assert(interp != NULL);

  object = GetSelfObj(interp);

  /*
   * The first two clauses can succeed even it we are outside an NSF context
   * (no object known). The commands are "nsf::current", "nsf::current
   * object", "nsf::current level", and "nsf::current activelevel"
   */
  if (option == CurrentoptionNULL || option == CurrentoptionObjectIdx) {
    if (likely(object != NULL)) {
      Tcl_SetObjResult(interp, object->cmdName);
    } else {
      result = NsfNoCurrentObjectError(interp, NULL);
    }
    return result;
  }

  if (unlikely(object == NULL)) {
    if (option == CurrentoptionCallinglevelIdx) {
      Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
    } else if (option == CurrentoptionLevelIdx) {
      /*
       * Return empty, if we are not on an NSF level.
       */
      Tcl_ResetResult(interp);
    } else {
      result = NsfNoCurrentObjectError(interp, NULL);
    }
    return result;
  }

  /*
   * From here on, we have to be on a valid nsf frame/level, object has to be
   * know.
   */
  assert(object != NULL);

  switch (option) {
  case CurrentoptionMethodIdx: NSF_FALL_THROUGH; /* fall through */
  case CurrentoptionProcIdx:
    cscPtr = CallStackGetTopFrame0(interp);
    if (cscPtr != NULL) {
      const char *procName = Tcl_GetCommandName(interp, cscPtr->cmdPtr);
      Tcl_SetObjResult(interp, Tcl_NewStringObj(procName, -1));
    } else {
      /* TODO: Is this, practically, reachable? */
      return NsfPrintError(interp,  "can't find method");
    }
    break;

  case CurrentoptionMethodpathIdx:
    cscPtr = CallStackGetTopFrame0(interp);
    if (cscPtr != NULL) {
      Tcl_SetObjResult(interp, NsfMethodNamePath(interp,
                                                 CallStackGetTclFrame(interp, NULL, 1),
                                                 Tcl_GetCommandName(interp, cscPtr->cmdPtr)));
    } else {
      /* TODO: Is this, practically, reachable? */
      return NsfPrintError(interp,  "can't find method");
    }
    break;

  case CurrentoptionClassIdx: /* class subcommand */
    cscPtr = CallStackGetTopFrame0(interp);
    Tcl_SetObjResult(interp, (cscPtr != NULL && cscPtr->cl) ?
                     cscPtr->cl->object.cmdName : NsfGlobalObjs[NSF_EMPTY]);
    break;

  case CurrentoptionActivelevelIdx:
    Tcl_SetObjResult(interp, ComputeLevelObj(interp, ACTIVE_LEVEL));
    break;

  case CurrentoptionArgsIdx: {
    cscPtr = CallStackGetTopFrame(interp, &framePtr);

    if (cscPtr != NULL) {
      int nobjc;
      Tcl_Obj **nobjv;

      if (cscPtr->objv != NULL) {
        nobjc = cscPtr->objc;
        nobjv = (Tcl_Obj **)cscPtr->objv;
      } else {
        nobjc = Tcl_CallFrame_objc(framePtr);
        nobjv = (Tcl_Obj **)Tcl_CallFrame_objv(framePtr);
      }
      Tcl_SetObjResult(interp, Tcl_NewListObj(nobjc-1, nobjv+1));
    } else {
      return NsfPrintError(interp,  "can't find proc");
    }
    break;
  }

  case CurrentoptionActivemixinIdx: {
    NsfObject *cmdObject = NULL;

    if (RUNTIME_STATE(interp)->currentMixinCmdPtr) {
      cmdObject = NsfGetObjectFromCmdPtr(RUNTIME_STATE(interp)->currentMixinCmdPtr);
    }
    Tcl_SetObjResult(interp, (cmdObject != NULL) ? cmdObject->cmdName : NsfGlobalObjs[NSF_EMPTY]);
    break;
  }

  case CurrentoptionCalledprocIdx:
  case CurrentoptionCalledmethodIdx:
    cscPtr = CallStackFindActiveFilter(interp);
    if (cscPtr != NULL) {
      Tcl_SetObjResult(interp,
                       Tcl_NewStringObj(MethodName(cscPtr->filterStackEntry->calledProc), -1));
    } else {
      result = NsfPrintError(interp, "called from outside of a filter");
    }
    break;

  case CurrentoptionCalledclassIdx: {
    const NsfClass *class = FindCalledClass(interp, object);
    Tcl_SetObjResult(interp, (class != NULL) ? class->object.cmdName : NsfGlobalObjs[NSF_EMPTY]);
    break;
  }
  case CurrentoptionCallingmethodIdx:
  case CurrentoptionCallingprocIdx: {
    Tcl_Obj *resultObj;

    cscPtr = NsfCallStackFindLastInvocation(interp, 1, &framePtr);
    if ((cscPtr != NULL) && (cscPtr->cmdPtr != NULL)) {
      resultObj = NsfMethodNamePath(interp,
                                    CallStackGetTclFrame(interp, framePtr, 1),
                                    Tcl_GetCommandName(interp, cscPtr->cmdPtr));
    } else {
      resultObj = NsfGlobalObjs[NSF_EMPTY];
    }
    Tcl_SetObjResult(interp, resultObj);
    break;
  }
  case CurrentoptionCallingclassIdx:
    cscPtr = NsfCallStackFindLastInvocation(interp, 1, NULL);
    Tcl_SetObjResult(interp, (cscPtr != NULL && cscPtr->cl != NULL)
                     ? cscPtr->cl->object.cmdName
                     : NsfGlobalObjs[NSF_EMPTY]);
    break;

  case CurrentoptionCallinglevelIdx:
    /*
     * Special case of object==NULL handled above.
     */
    Tcl_SetObjResult(interp, ComputeLevelObj(interp, CALLING_LEVEL));
    break;

  case CurrentoptionCallingobjectIdx:
    cscPtr = NsfCallStackFindLastInvocation(interp, 1, NULL);
    Tcl_SetObjResult(interp, (cscPtr != NULL) ? cscPtr->self->cmdName : NsfGlobalObjs[NSF_EMPTY]);
    break;

  case CurrentoptionFilterregIdx:
    cscPtr = CallStackFindActiveFilter(interp);
    if (cscPtr != NULL) {
      Tcl_SetObjResult(interp, FilterFindReg(interp, object, cscPtr->cmdPtr));
    } else {
      result = NsfPrintError(interp, "called from outside of a filter");
    }
    break;

  case CurrentoptionIsnextcallIdx: {

    cscPtr = CallStackGetTopFrame(interp, &framePtr);

    if ((cscPtr->frameType & NSF_CSC_TYPE_ENSEMBLE) != 0u) {
      (void)CallStackFindEnsembleCsc(framePtr, &framePtr);
    }

    framePtr = CallStackNextFrameOfType(Tcl_CallFrame_callerPtr(framePtr),
                                        FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD);
    cscPtr = (framePtr != NULL) ? Tcl_CallFrame_clientData(framePtr) : NULL;

    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
                      (cscPtr != NULL && ((cscPtr->flags & NSF_CSC_CALL_IS_NEXT) != 0u)));
    break;
  }

  case CurrentoptionLevelIdx:
    /*
     * We have an "object", therefore, we are on an NSF-frame/level. In this
     * case, "nsf level" behaves like "info level" (without arguments).
     */
    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_CallFrame_level(Tcl_Interp_varFramePtr(interp))));
    break;

  case CurrentoptionNextmethodIdx: {
    Tcl_Obj *methodHandle;

    cscPtr = CallStackGetTopFrame(interp, &framePtr);
    assert(cscPtr != NULL);

    methodHandle = FindNextMethod(interp, framePtr);
    if (methodHandle == NULL) {
      Tcl_ResetResult(interp);
    } else {
      Tcl_SetObjResult(interp, methodHandle);
    }

    break;
  }

  case CurrentoptionObjectIdx: NSF_FALL_THROUGH; /* fall through */
  case CurrentoptionNULL:
    /* handled above */
    break;
  }

  return result;
}

/*
cmd self NsfSelfCmd {
}
*/
static int
NsfSelfCmd(Tcl_Interp *interp) {
  NsfObject *object;

  nonnull_assert(interp != NULL);

  object = GetSelfObj(interp);
  if (likely(object != NULL)) {
    Tcl_SetObjResult(interp, object->cmdName);
    return TCL_OK;
  } else {
    return NsfNoCurrentObjectError(interp, NULL);
  }
}

/*
cmd var::exists NsfVarExistsCmd {
  {-argName "-array" -required 0 -nrargs 0}
  {-argName "object" -required 1 -type object}
  {-argName "varName" -required 1}
}
*/
static int
NsfVarExistsCmd(Tcl_Interp *interp, int withArray, NsfObject *object, const char *varName) {
  unsigned int flags =
    NSF_VAR_TRIGGER_TRACE|NSF_VAR_REQUIRE_DEFINED|
    ((withArray != 0) ? NSF_VAR_ISARRAY : 0u);

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(varName != NULL);

  if (unlikely(CheckVarName(interp, varName) != TCL_OK)) {
    return TCL_ERROR;
  }
  Tcl_SetIntObj(Tcl_GetObjResult(interp), VarExists(interp, object, varName, NULL, flags));

  return TCL_OK;
}

/*
cmd var::get NsfVarGetCmd {
  {-argName "-array" -required 0 -nrargs 0 -type switch}
  {-argName "-notrace" -required 0 -nrargs 0 -type switch}
  {-argName "object" -required 1 -type object}
  {-argName "varName" -required 1 -type tclobj}
}
*/
static int
NsfVarGetCmd(Tcl_Interp *interp, int withArray, int withNotrace,
             NsfObject *object, Tcl_Obj *varNameObj) {

  return NsfVarSetCmd(interp, withArray, withNotrace, object, varNameObj, NULL);
}

/*
cmd var::import NsfVarImportCmd {
  {-argName "object" -type object}
  {-argName "args" -type args}
}
*/
static int NsfVarImport(Tcl_Interp *interp, NsfObject *object, const char *cmdName,
                        int objc, Tcl_Obj *const objv[])
  nonnull(1) nonnull(2) nonnull(3) nonnull(5);

static int
NsfVarImport(Tcl_Interp *interp, NsfObject *object, const char *cmdName,
             int objc, Tcl_Obj *const objv[]) {
  int i, result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(cmdName != NULL);
  nonnull_assert(objv != NULL);

  for (i = 0; i < objc && result == TCL_OK; i++) {
    Tcl_Obj **ov;
    int oc;

    /*fprintf(stderr, "ListGetElements %p %s\n", objv[i], ObjStr(objv[i]));*/
    if ((result = Tcl_ListObjGetElements(interp, objv[i], &oc, &ov)) == TCL_OK) {
      Tcl_Obj *varName = NULL, *alias = NULL;
      switch (oc) {
      case 0:
        varName = objv[i];
        break;
      case 1:
        varName = ov[0];
        break;
      case 2:
        varName = ov[0];
        alias = ov[1];
        break;
      default:
        break;
      }
      if (likely(varName != NULL)) {
        result = ImportInstVarIntoCurrentScope(interp, cmdName, object, varName, alias);
      } else {
        assert(objv[i] != NULL);
        result = NsfPrintError(interp, "invalid variable specification '%s'", ObjStr(objv[i]));
      }
    }
  }

  return result;
}

static int
NsfVarImportCmd(Tcl_Interp *interp, NsfObject *object, int trailingObjc, Tcl_Obj *const trailingObjv[]) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  return NsfVarImport(interp, object, "importvar", trailingObjc, trailingObjv);
}

/*
cmd var::set NsfVarSetCmd {
  {-argName "-array" -required 0 -nrargs 0 -type switch}
  {-argName "-notrace" -required 0 -nrargs 0 -type switch}
  {-argName "object" -required 1 -type object}
  {-argName "varName" -required 1 -type tclobj}
  {-argName "value" -required 0 -type tclobj}
}
*/
static int
NsfVarSetCmd(Tcl_Interp *interp, int withArray, int withNotrace,
             NsfObject *object, Tcl_Obj *varNameObj, Tcl_Obj *valueObj) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(varNameObj != NULL);

  if (unlikely(CheckVarName(interp, ObjStr(varNameObj)) != TCL_OK)) {
    return TCL_ERROR;
  }

  if (withArray != 0) {
    return SetInstArray(interp, object, varNameObj, valueObj);
  } else {
    return SetInstVar(interp, object, varNameObj, valueObj, withNotrace ? 0 : NSF_VAR_TRIGGER_TRACE);
  }
}

/*
cmd var::unset NsfVarUnsetCmd {
  {-argName "-nocomplain" -required 0 -nrargs 0}
  {-argName "object" -required 1 -type object}
  {-argName "varName" -required 1 -type tclobj}
}
*/
static int
NsfVarUnsetCmd(Tcl_Interp *interp, int withNocomplain, NsfObject *object, Tcl_Obj *varNameObj) {
  const char *varName;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(varNameObj != NULL);

  varName = ObjStr(varNameObj);
  if (unlikely(CheckVarName(interp, varName) != TCL_OK)) {
    return TCL_ERROR;
  }

  return UnsetInstVar(interp, withNocomplain, object, varName);
}
/***********************************************************************
 * End generated Next Scripting  commands
 ***********************************************************************/

/*
 * Parameter support functions
 */

typedef struct NsfParamWrapper {
  Nsf_Param *paramPtr;
  int refCount;
  bool canFree;
} NsfParamWrapper;

static Tcl_DupInternalRepProc      ParamDupInteralRep;
static Tcl_FreeInternalRepProc     ParamFreeInternalRep;
static Tcl_UpdateStringProc        ParamUpdateString;

static void ParamUpdateString(Tcl_Obj *objPtr)
  nonnull(1);
static void ParamDupInteralRep(Tcl_Obj *srcPtr, Tcl_Obj *UNUSED(dupPtr))
  nonnull(1);
static void ParamFreeInternalRep(register Tcl_Obj *objPtr)
  nonnull(1);
static int ParamSetFromAny(Tcl_Interp *interp,        register Tcl_Obj *objPtr)
  nonnull(1) nonnull(2);
static int ParamSetFromAny2(Tcl_Interp *interp, const char *varNamePrefix,
                            bool allowObjectParameter, register Tcl_Obj *objPtr,
                            const char *qualifier)
  nonnull(1) nonnull(2) nonnull(4);

static void
ParamUpdateString(Tcl_Obj *objPtr) {
  nonnull_assert(objPtr != NULL);
  Tcl_Panic("%s of type %s should not be called", "updateStringProc",
            objPtr->typePtr->name);
}

static void
ParamDupInteralRep(Tcl_Obj *srcPtr, Tcl_Obj *UNUSED(dupPtr)) {
  nonnull_assert(srcPtr != NULL);
  Tcl_Panic("%s of type %s should not be called", "dupStringProc",
            srcPtr->typePtr->name);
}

static Tcl_ObjType paramObjType = {
    "nsfParam",                          /* name */
    ParamFreeInternalRep,                /* freeIntRepProc */
    ParamDupInteralRep,                  /* dupIntRepProc */
    ParamUpdateString,                   /* updateStringProc */
    ParamSetFromAny                      /* setFromAnyProc */
};

static void
ParamFreeInternalRep(
    register Tcl_Obj *objPtr)   /* Param structure object with internal
                                 * representation to free. */
{
  NsfParamWrapper *paramWrapperPtr;

  nonnull_assert(objPtr != NULL);

  paramWrapperPtr = (NsfParamWrapper *)objPtr->internalRep.twoPtrValue.ptr1;
  if (paramWrapperPtr != NULL) {
    /* fprintf(stderr, "ParamFreeInternalRep freeing wrapper %p paramPtr %p refCount %dcanFree %d\n",
            paramWrapperPtr, paramWrapperPtr->paramPtr, paramWrapperPtr->refCount,
            paramWrapperPtr->canFree);*/

    if (paramWrapperPtr->canFree) {
      ParamsFree(paramWrapperPtr->paramPtr);
      FREE(NsfParamWrapper, paramWrapperPtr);
    } else {
      paramWrapperPtr->refCount--;
    }
  }
}

/*
 *----------------------------------------------------------------------
 * ParamSetFromAny2 --
 *
 *      Convert the second argument (e.g. "x:integer") into the internal
 *      representation of a Tcl_Obj of the type parameter. The conversion is
 *      performed by the usual ParamDefinitionParse() function, used e.g. for
 *      the parameter passing for arguments.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Converted internal rep of Tcl_Obj
 *
 *----------------------------------------------------------------------
 */

static int
ParamSetFromAny2(
    Tcl_Interp *interp,               /* Used for error reporting if not NULL. */
    const char *varNamePrefix,        /* shows up as varName in error message */
    bool allowObjectParameter,        /* allow object parameters */
    register Tcl_Obj *objPtr,         /* The object to convert. */
    const char *qualifier)
{
  Tcl_Obj         *fullParamObj = Tcl_NewStringObj(varNamePrefix, -1);
  int              result, possibleUnknowns = 0, plainParams = 0, nrNonposArgs = 0;
  NsfParamWrapper *paramWrapperPtr = NEW(NsfParamWrapper);

  nonnull_assert(interp != NULL);
  nonnull_assert(varNamePrefix != NULL);
  nonnull_assert(objPtr != NULL);

  paramWrapperPtr->paramPtr = ParamsNew(1u);
  paramWrapperPtr->refCount = 1;
  paramWrapperPtr->canFree = NSF_FALSE;

  Tcl_AppendLimitedToObj(fullParamObj, ObjStr(objPtr), -1, INT_MAX, NULL);
  INCR_REF_COUNT(fullParamObj);

  result = ParamDefinitionParse(interp, NsfGlobalObjs[NSF_VALUECHECK], fullParamObj,
                                (allowObjectParameter ? NSF_DISALLOWED_ARG_OBJECT_PARAMETER : NSF_DISALLOWED_ARG_VALUECHECK),
                                paramWrapperPtr->paramPtr, &possibleUnknowns,
                                &plainParams, &nrNonposArgs, qualifier);
  /*
   * We treat currently unknown user level converters as error.
   */
  if (unlikely((paramWrapperPtr->paramPtr->flags & NSF_ARG_CURRENTLY_UNKNOWN) != 0u)) {
    result = TCL_ERROR;
  }

  if (likely(result == TCL_OK)) {
    /*
     * In success cases, the memory allocated by this function is freed via
     * the Tcl_Obj type.
     */
    paramWrapperPtr->paramPtr->flags |= NSF_ARG_UNNAMED;
    if (*(paramWrapperPtr->paramPtr->name) == 'r') {
      paramWrapperPtr->paramPtr->flags |= NSF_ARG_IS_RETURNVALUE;
    }
    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = (void *)paramWrapperPtr;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    objPtr->typePtr = &paramObjType;
  } else {
    /*
     * In error cases, free manually memory allocated by this function.
     */
    ParamsFree(paramWrapperPtr->paramPtr);
    FREE(NsfParamWrapper, paramWrapperPtr);
  }

  DECR_REF_COUNT(fullParamObj);
  return result;
}

static int
ParamSetFromAny(
    Tcl_Interp *interp,               /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr)         /* The object to convert. */
{
  nonnull_assert(interp != NULL);
  nonnull_assert(objPtr != NULL);

  return ParamSetFromAny2(interp, "value:", NSF_FALSE, objPtr, NULL);
}

/*
 *----------------------------------------------------------------------
 * GetObjectParameterDefinition --
 *
 *      Obtain the parameter definitions for an object by calling the method
 *    "__objectparameter" if the value is not cached already. Either "object"
 *      or "class" must be non-null. Caching is performed on the class, the
 *      cached values are used in case there are no object-specific slots.
 *
 * Results:
 *      A standard Tcl result, parsed structure in last argument
 *
 * Side effects:
 *      Updates potentially cl->parsedParamPtr
 *
 *----------------------------------------------------------------------
 */
static int
ComputeParameterDefinition(
    Tcl_Interp *interp, Tcl_Obj *procNameObj,
    NsfObject *object, NsfClass *class,
    NsfParsedParam *parsedParamPtr
) {
  int        result;
  Tcl_Obj   *methodObj;
  NsfObject *self;

  if (object != NULL) {
    methodObj = NsfMethodObj(object, NSF_o_configureparameter_idx);
    self = object;
  } else {
    assert(class != NULL);
    self = &class->object;
    methodObj = NsfMethodObj(self, NSF_c_configureparameter_idx);
  }

  if (methodObj == NULL) {
    result = TCL_OK;
  } else {
    /*fprintf(stderr, "calling %s %s\n", ObjectName(self), ObjStr(methodObj));*/
    result = CallMethod(self, interp, methodObj, 2, NULL,
                        NSF_CM_IGNORE_PERMISSIONS|NSF_CSC_IMMEDIATE);

    if (likely(result == TCL_OK)) {
      Tcl_Obj *rawConfArgs = Tcl_GetObjResult(interp);

      /*      fprintf(stderr, ".... rawConfArgs for %s => '%s'\n",
              ObjectName(self), ObjStr(rawConfArgs));*/
      INCR_REF_COUNT(rawConfArgs);

      /*
       * Parse the string representation to obtain the internal
       * representation.
       */
      result = ParamDefsParse(interp, procNameObj, rawConfArgs,
                              NSF_DISALLOWED_ARG_OBJECT_PARAMETER, NSF_TRUE,
                              parsedParamPtr, NULL);
      if (likely(result == TCL_OK)) {
        NsfParsedParam *ppDefPtr = NEW(NsfParsedParam);

        ppDefPtr->paramDefs = parsedParamPtr->paramDefs;
        ppDefPtr->possibleUnknowns = parsedParamPtr->possibleUnknowns;
        if (class != NULL) {
          assert(class->parsedParamPtr == NULL);
          class->parsedParamPtr = ppDefPtr;
#if defined(PER_OBJECT_PARAMETER_CACHING)
        } else if (object != NULL) {
          NsfObjectOpt *opt = NsfRequireObjectOpt(object);

          if (object->opt->parsedParamPtr != NULL) {
            NsfParameterCacheObjectInvalidateCmd(interp, object);
          }
          opt->parsedParamPtr = ppDefPtr;
          opt->classParamPtrEpoch = RUNTIME_STATE(interp)->classParamPtrEpoch;
          /*fprintf(stderr, "set obj param for obj %p %s epoch %d ppDefPtr %p\n",
            object, ObjectName(object), opt->classParamPtrEpoch, ppDefPtr);*/
#endif
        }
        if (ppDefPtr->paramDefs != NULL) {
          ParamDefsRefCountIncr(ppDefPtr->paramDefs);
        }
      }
      DECR_REF_COUNT(rawConfArgs);
    }
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 * GetObjectParameterDefinition --
 *
 *      Obtain the parameter definitions for an object by calling the method
 *    "__objectparameter" if the value is not cached already. Caching is
 *      performed on the class, the cached values are used in case there are no
 *      object-specific slots.
 *
 * Results:
 *      A standard Tcl result, parsed structure in last argument.
 *
 * Side effects:
 *      Updates potentially cl->parsedParamPtr
 *
 *----------------------------------------------------------------------
 */
static int
GetObjectParameterDefinition(
    Tcl_Interp *interp, Tcl_Obj *procNameObj,
    NsfObject *object, NsfClass *class,
    NsfParsedParam *parsedParamPtr
) {
  int result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(procNameObj != NULL);
  nonnull_assert(parsedParamPtr != NULL);

  parsedParamPtr->paramDefs = NULL;
  parsedParamPtr->possibleUnknowns = 0;

  if (class == NULL) {
    assert(object != NULL);
    if ((object->flags & NSF_HAS_PER_OBJECT_SLOTS) != 0u
        || (object->opt != NULL && object->opt->objMixins)
        ) {
      /*
       * We have object-specific parameters.  Do not use the per-class cache,
       * and do not save the results in the per-class cache.
       */
      /*fprintf(stderr, "per-object configure obj %s flags %.6x\n",
        ObjectName(object), object->flags);*/
    } else {
      class = object->cl;
    }
  }

  /*
   * Parameter definitions are cached in the class, for which
   * instances are created. The parameter definitions are flushed in
   * the following situations:
   *
   * a) on class cleanup: ParsedParamFree(cl->parsedParamPtr)
   * b) on class structure changes,
   * c) when class-mixins are added,
   * d) when new slots are defined,
   * e) when slots are removed
   *
   * When slot defaults or types are changed, the slots have to
   * perform a manual "::nsf::invalidateobjectparameter $domain".
   */

  /*
   * Check whether there is already a parameter definition available for
   * creating objects of this class.
   */

  if (likely(class != NULL && class->parsedParamPtr != NULL)) {
    NsfParsedParam *clParsedParamPtr = class->parsedParamPtr;

    parsedParamPtr->paramDefs = clParsedParamPtr->paramDefs;
    parsedParamPtr->possibleUnknowns = clParsedParamPtr->possibleUnknowns;
    result = TCL_OK;

#if defined(PER_OBJECT_PARAMETER_CACHING)
  } else if (object != NULL && object->opt != NULL && object->opt->parsedParamPtr != NULL &&
             object->opt->classParamPtrEpoch == RUNTIME_STATE(interp)->classParamPtrEpoch) {
    NsfParsedParam *objParsedParamPtr = object->opt->parsedParamPtr;

    /*fprintf(stderr, "reuse obj param for obj %p  %s paramPtr %p\n",
      (void *)object, ObjectName(object), (void *)objParsedParamPtr);*/
    parsedParamPtr->paramDefs = objParsedParamPtr->paramDefs;
    parsedParamPtr->possibleUnknowns = objParsedParamPtr->possibleUnknowns;
    result = TCL_OK;
#endif

  } else {
    /*
     * There is no parameter definition available, get a new one in
     * the string representation.
     */
    result = ComputeParameterDefinition(interp, procNameObj,
                                        object, class,
                                        parsedParamPtr);
  }

  return result;
}

/*
 *----------------------------------------------------------------------
 * ParameterCheck --
 *
 *      Check the provided valueObj against the parameter specification
 *      provided in the second argument (paramObjPtr), when
 *      doCheckArguments is true. This function is used e.g. by nsf::is,
 *      where only the right-hand side of a parameter specification
 *      (after the colon) is specified. The argument Name (before the
 *      colon in a parameter spec) is provided via argNamePrefix. The
 *      converted parameter structure is returned optionally via the
 *      last argument.
 *
 * Results:
 *      A standard Tcl result and parsed structure in last argument.
 *
 * Side effects:
 *      Converts potentially tcl_obj type of paramObjPtr
 *
 *----------------------------------------------------------------------
 */

static int
ParameterCheck(
    Tcl_Interp *interp, Tcl_Obj *paramObjPtr, Tcl_Obj *valueObj,
    const char *argNamePrefix, unsigned int doCheckArguments,
    bool isNamed, bool doConfigureParameter,
    Nsf_Param **paramPtrPtr, const char *qualifier
) {
  Nsf_Param       *paramPtr;
  NsfParamWrapper *paramWrapperPtr;
  Tcl_Obj         *outObjPtr;
  ClientData       checkedData;
  int              result;
  unsigned int     flags = 0u;

  nonnull_assert(interp != NULL);
  nonnull_assert(paramObjPtr != NULL);
  nonnull_assert(valueObj != NULL);

  /* fprintf(stderr, "ParameterCheck %s value %p %s\n",
     ObjStr(paramObjPtr), valueObj, ObjStr(valueObj)); */

  if (paramObjPtr->typePtr == &paramObjType) {
    paramWrapperPtr = (NsfParamWrapper *) paramObjPtr->internalRep.twoPtrValue.ptr1;
  } else {
    /*
     * We could use in principle Tcl_ConvertToType(..., &paramObjType) instead
     * of checking the type manually, but we want to pass the argNamePrefix
     * explicitly.
     */
    result = ParamSetFromAny2(interp, argNamePrefix, doConfigureParameter, paramObjPtr, qualifier);
    if (likely(result == TCL_OK)) {
      paramWrapperPtr = (NsfParamWrapper *) paramObjPtr->internalRep.twoPtrValue.ptr1;
    } else {
      const char *errMsg = ObjStr(Tcl_GetObjResult(interp));

      Tcl_SetErrorCode(interp, "NSF", "VALUE", "CONSTRAINT", NULL);
      if (*errMsg == '\0') {
        return NsfPrintError(interp, "invalid value constraints \"%s\"",
                             ObjStr(paramObjPtr) );
      } else {
        return NsfPrintError(interp, "invalid value constraints \"%s\": %s",
                             ObjStr(paramObjPtr), errMsg);
      }
    }
  }
  paramPtr = paramWrapperPtr->paramPtr;
  if (paramPtrPtr != NULL) *paramPtrPtr = paramPtr;

  if (isNamed) {
    paramPtr->flags &= ~NSF_ARG_UNNAMED;
  }

  RUNTIME_STATE(interp)->doClassConverterOmitUnknown = 1;
  outObjPtr = NULL;
  result = ArgumentCheck(interp, valueObj, paramPtr, doCheckArguments, &flags, &checkedData, &outObjPtr);
  RUNTIME_STATE(interp)->doClassConverterOmitUnknown = 0;

  /*fprintf(stderr, "ParameterCheck paramPtr %p final refCount of wrapper %d can free %d flags %.6x\n",
    paramPtr, paramWrapperPtr->refCount,  paramWrapperPtr->canFree, flags);*/

  assert(paramWrapperPtr->refCount > 0);
  paramWrapperPtr->canFree = NSF_TRUE;

  if ((flags & NSF_PC_MUST_DECR) != 0u) {
    DECR_REF_COUNT2("valueObj", outObjPtr);
  }

  return result;
}



/***********************************************************************
 * Begin Object Methods
 ***********************************************************************/
/*
objectMethod autoname NsfOAutonameMethod {
  {-argName "-instance"}
  {-argName "-reset"}
  {-argName "name" -required 1 -type tclobj}
}
*/
static int
NsfOAutonameMethod(
    Tcl_Interp *interp, NsfObject *object, int withInstance, int withReset,
    Tcl_Obj *nameObj
) {
  Tcl_Obj *autonamedObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(nameObj != NULL);

  autonamedObj = AutonameIncr(interp, nameObj, object, withInstance, withReset);
  if (autonamedObj != NULL) {
    Tcl_SetObjResult(interp, autonamedObj);
    DECR_REF_COUNT2("autoname", autonamedObj);
    return TCL_OK;
  }

  return NsfPrintError(interp, "autoname failed. Probably format string (with %%) was not well-formed");
}

/*
objectMethod class NsfOClassMethod {
  {-argName "class" -required 0 -type tclobj}
}
*/
static int
NsfOClassMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *classObj) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  return NsfRelationSetCmd(interp, object, RelationtypeClassIdx, classObj);
}

/*
objectMethod cleanup NsfOCleanupMethod {
}
*/
static int
NsfOCleanupMethod(Tcl_Interp *interp, NsfObject *object) {
  NsfClass *class;
  Tcl_Obj  *savedNameObj;
  bool      softrecreate;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

#if defined(OBJDELETION_TRACE)
  fprintf(stderr, "+++ NsfOCleanupMethod\n");
#endif
  PRINTOBJ("NsfOCleanupMethod", object);

  savedNameObj = object->cmdName;
  INCR_REF_COUNT(savedNameObj);

  /*
   * Get the class before the object is destroyed.
   */
  class = NsfObjectToClass(object);
  /*
   * Save and pass around softrecreate.
   */
  softrecreate =
    ((object->flags & NSF_RECREATE) != 0u
     && RUNTIME_STATE(interp)->doSoftrecreate);

  CleanupDestroyObject(interp, object, softrecreate);
  CleanupInitObject(interp, object, object->cl, object->nsPtr, softrecreate);

  if (class != NULL) {
    CleanupDestroyClass(interp, class, softrecreate, NSF_TRUE);
    CleanupInitClass(interp, class, class->nsPtr, softrecreate, NSF_TRUE);
  }

  DECR_REF_COUNT(savedNameObj);
  return TCL_OK;
}

/*
objectMethod configure NsfOConfigureMethod {
  {-argName "args" -type allargs}
}
*/

static NsfObject* GetSlotObject(Tcl_Interp *interp, Tcl_Obj *slotObj)
  nonnull(1) nonnull(2);

static NsfObject*
GetSlotObject(Tcl_Interp *interp, Tcl_Obj *slotObj) {
  NsfObject *slotObject = NULL;

  nonnull_assert(interp != NULL);
  nonnull_assert(slotObj != NULL);

  if (unlikely(GetObjectFromObj(interp, slotObj, &slotObject) != TCL_OK || slotObject == NULL)) {
    NsfPrintError(interp, "couldn't resolve slot object %s", ObjStr(slotObj));
  }

  return slotObject;
}


static int
NsfOConfigureMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[], Tcl_Obj *objv0) {
  int result, i;
  NsfParsedParam  parsedParam;
  Nsf_Param      *paramPtr;
  NsfParamDefs   *paramDefs;
  Tcl_Obj        *newValue, *initMethodObj;
  const char     *initString;
  ParseContext    pc;
  CallFrame       frame, *framePtr = &frame, *uplevelVarFramePtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(objv != NULL);
  nonnull_assert(objv0 != NULL);

#if 0
  fprintf(stderr, "NsfOConfigureMethod %s.%s flags %.6x oc %2d", ObjectName(object), ObjStr(objv0), object->flags, objc);
  for(i = 0; i < objc; i++) {fprintf(stderr, " [%d]=%s,", i, ObjStr(objv[i]));}
  fprintf(stderr, "\n");
#endif

  /*
   * Get the object parameter definition.
   */
  result = GetObjectParameterDefinition(interp, objv0, object, NULL, &parsedParam);

  if (result != TCL_OK || parsedParam.paramDefs == NULL) {
    /*fprintf(stderr, "... nothing to do for method %s\n", ObjStr(objv0));*/
    return result;
  }

  /*
   * Get the initMethodObj/initString outside the loop iterating over the
   * arguments.
   */
  if (CallDirectly(interp, object, NSF_o_init_idx, &initMethodObj)) {
    initString = NULL;
  } else {
    initString = ObjStr(initMethodObj);
  }

  /*
   * The effective call site of the configure() method (e.g., a proc or a
   * method) can result from up-leveling the object creation procedure;
   * therefore, the *effective* call site can deviate from the *declaring*
   * call site (e.g. as in XOTcl2's unknown method). In such a scenario, the
   * configure() dispatch finds itself in a particular call-stack
   * configuration: The top-most frame reflects the declaring call site
   * (interp->framePtr), while the effective call site (interp->varFramePtr)
   * is identified by a lower call-stack level.
   *
   * Since configure pushes an object frame (for accessing the instance
   * variables) and sometimes a CMETHOD frame (for method invocations) we
   * record a) whether there was a preceding uplevel (identifiable through
   * deviating interp->framePtr and interp->varFramePtr) and, in case, b) the
   * ruling variable frame context. The preserved call-frame reference can
   * later be used to restore the uplevel'ed call frame context.
   */

  uplevelVarFramePtr =
    (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp) != Tcl_Interp_framePtr(interp)
    ? Tcl_Interp_varFramePtr(interp)
    : NULL;

  /*
   * Push frame to allow for [self] and make instance variables of the object
   * accessible as locals.
   */
  Nsf_PushFrameObj(interp, object, framePtr);

  /*
   * Process the actual arguments based on the parameter definitions.
   */
  paramDefs = parsedParam.paramDefs;
  ParamDefsRefCountIncr(paramDefs);

#if 0
  if (parsedParam.paramDefs != NULL) {
    Tcl_Obj *listObj = ParamDefsList(interp, paramDefs->paramsPtr, NULL, NULL);
    fprintf(stderr, "... got params <%s>\n", ObjStr(listObj));
  }
#endif

  result = ProcessMethodArguments(&pc, interp, object,
                                  NSF_ARGPARSE_START_ZERO, paramDefs,
                                  NsfGlobalObjs[NSF_CONFIGURE], objc, objv);

  if (unlikely(result != TCL_OK)) {
    Nsf_PopFrameObj(interp, framePtr);
    goto configure_exit;
  }

  /*
   * At this point, the arguments are tested to be valid (according to the
   * parameter definitions) and the defaults are set. Now we have to apply the
   * arguments (mostly setting instance variables).
   */

#if defined(CONFIGURE_ARGS_TRACE)
  fprintf(stderr, "*** POPULATE OBJ '%s': nr of parsed args %d\n", ObjectName(object), pc.objc);
#endif
  for (i = 1, paramPtr = paramDefs->paramsPtr;
       paramPtr->name != NULL;
       paramPtr++, i++) {

    /*
     * Set the new value always when the new value was specified (was not
     * taken from the default). When we take the default, we do not overwrite
     * already existing values (which might have been set via parameter
     * alias).
     */
    /*fprintf(stderr, "[%d] param %s, object init called %d is default %d value = '%s' nrArgs %d\n",
            i, paramPtr->name, (object->flags & NSF_INIT_CALLED),
            (pc.flags[i-1] & NSF_PC_IS_DEFAULT),
            ObjStr(pc.full_objv[i]), paramPtr->nrArgs);*/

    if ((pc.flags[i-1] & NSF_PC_IS_DEFAULT)) {
      /*
       * Object parameter method calls (when the flag
       * NSF_ARG_METHOD_INVOCATION is set) do not set instance variables, so
       * we do not have to check for existing variables.
       */
      if ((paramPtr->flags & NSF_ARG_METHOD_INVOCATION) == 0u) {
        Tcl_Obj *varObj = Tcl_ObjGetVar2(interp, paramPtr->nameObj, NULL, 0);

        if (varObj != NULL) {
          /*
           * The value exists already, ignore this parameter.
           */
          /*fprintf(stderr, "a variable for %s exists already, "
                  "ignore param flags %.6x valueObj %p\n",
                  paramPtr->name, paramPtr->flags, pc.full_objv[i]);*/
          continue;
        }
      } else if ((object->flags & NSF_INIT_CALLED) != 0u) {
        /*
         * The object is already initialized. Don't use the default, since it
         * might change part of the state back to the original default.  This
         * might happen, when e.g. configure is called on a class manually,
         * where "superclass" has a default.
         */
        /*fprintf(stderr, "%s skip default %s in configure\n",
          ObjectName(object), ObjStr(pc.full_objv[i]));*/
        continue;
      }
    } else if (unlikely((paramPtr->flags & NSF_ARG_REQUIRED) != 0u
                        && pc.full_objv[i] == NsfGlobalObjs[NSF___UNKNOWN__])) {

      /* Previous versions contained a test for
       *   (object->flags & NSF_INIT_CALLED)
       *
       * to perform required testing just for in the non-initialized state. We
       * switched in 2.0b5 to checking for the existence of the associated
       * instance variable, which works under the assumption that the instance
       * variable has the same name and that e.g. a required alias parameter
       * sets this variable either. Similar assumption is in the default
       * handling. Future versions might use a more general handling of the
       * parameter states.
       */

      Tcl_Obj *varObj = Tcl_ObjGetVar2(interp, paramPtr->nameObj, NULL, 0);
      if (unlikely(varObj == NULL)) {
        Tcl_Obj *paramDefsObj = NsfParamDefsSyntax(interp, paramDefs->paramsPtr, object, NULL);

        NsfPrintError(interp, "required argument '%s' is missing, should be:\n        %s%s%s %s", (paramPtr->nameObj != NULL) ? ObjStr(paramPtr->nameObj) : paramPtr->name, (pc.object != NULL) ? ObjectName(pc.object) : "", (pc.object != NULL) ? " " : "",
                      ObjStr(pc.full_objv[0]),
                      ObjStr(paramDefsObj));
        DECR_REF_COUNT2("paramDefsObj", paramDefsObj);

        Nsf_PopFrameObj(interp, framePtr);
        result = TCL_ERROR;
        goto configure_exit;
      }
    }

    newValue = pc.full_objv[i];
    /*fprintf(stderr, "     new Value of %s = [%d] %p '%s', type %s addr %p\n",
            ObjStr(paramPtr->nameObj), i,
            newValue, (newValue != NULL) ? ObjStr(newValue) : "(null)", paramPtr->type,
            &(pc.full_objv[i]));*/

    /*
     * Handling slot initialize
     */
    if ((paramPtr->flags & NSF_ARG_SLOTINITIALIZE) != 0u) {
      NsfObject *slotObject = GetSlotObject(interp, paramPtr->slotObj);

      if (likely(slotObject != NULL)) {
        Tcl_Obj *ov[1];

        ov[0] = paramPtr->nameObj;
        result = NsfCallMethodWithArgs(interp, (Nsf_Object *)slotObject, NsfGlobalObjs[NSF_INITIALIZE],
                                       object->cmdName, 2, ov,
                                       NSF_CSC_IMMEDIATE|NSF_CM_IGNORE_PERMISSIONS);

      }
      if (unlikely(result != TCL_OK)) {
        /*
         * The error message was set either by GetSlotObject or by ...CallMethod...
         */
        Nsf_PopFrameObj(interp, framePtr);
        goto configure_exit;
      }
    }

    /*
     * Special setter methods for invoking methods calls; handles types
     * "cmd", "initcmd", "alias" and "forward".
     */
    if ((paramPtr->flags & NSF_ARG_METHOD_INVOCATION) != 0u) {
      int consuming = (*paramPtr->name == '-' || paramPtr->nrArgs > 0);

      if (consuming && newValue == NsfGlobalObjs[NSF___UNKNOWN__]) {
        /*
         * In the case we have a consuming parameter, but we have no value
         * provided and not default, there is no reason to call the invocation
         * parameter.
         */
        /*fprintf(stderr, "%s consuming nrargs %d no value\n", paramPtr->name, paramPtr->nrArgs);*/
        continue;
      }

      if ((paramPtr->flags & NSF_ARG_INITCMD) != 0u) {

        if (paramPtr->defaultValue != NULL) {
          /*
           * The "defaultValue" holds the initcmd to be executed
           */
          Tcl_Obj *varObj = Tcl_ObjGetVar2(interp, NsfGlobalObjs[NSF_ARRAY_INITCMD],
                                           paramPtr->nameObj, 0);

          /*fprintf(stderr, "### NSF_ARRAY_INITCMD %s has a value %s\n",
                  NsfGlobalStrings[NSF_ARRAY_INITCMD],
                  ObjStr(paramPtr->defaultValue));*/

          if (varObj == NULL) {
            /*
             * The variable is not set. Therefore, we assume, we have to
             * execute the initcmd. On success, we note the execution in the NSF_ARRAY_INITCMD
             * variable (usually __initcmd(name))
             */
            result = ParameterMethodDispatch(interp, object, paramPtr, paramPtr->defaultValue,
                                             uplevelVarFramePtr, initString,
                                             (Tcl_Obj **)&objv[pc.lastObjc],
                                             objc - pc.lastObjc);

            if (unlikely(result != TCL_OK)) {
              Nsf_PopFrameObj(interp, framePtr);
              goto configure_exit;
            }
            if (unlikely(Tcl_ObjSetVar2(interp, NsfGlobalObjs[NSF_ARRAY_INITCMD],
                                        paramPtr->nameObj, Tcl_NewIntObj(1), TCL_LEAVE_ERR_MSG) == NULL)) {
              Nsf_PopFrameObj(interp, framePtr);
              goto configure_exit;
            }
          }

        } else {
          /*
           * We could consider to require a default.
           */
        }
        /*
         * If we have a new actual value, proceed to setvars.
         */
        if ((pc.flags[i-1] & NSF_PC_IS_DEFAULT) == 0) {
          goto setvars;
        }
        continue;
      }
      /*
       * lastObjc points to the first "unprocessed" argument, the argument before should be valid, when lastObjc > 1
       */
      if (pc.lastObjc > 1) {
        assert(ISOBJ(objv[pc.lastObjc-1]));
      }
      result = ParameterMethodDispatch(interp, object, paramPtr, newValue,
                                       uplevelVarFramePtr, initString,
                                       (Tcl_Obj **)&objv[pc.lastObjc],
                                       objc - pc.lastObjc);
      if (unlikely(result != TCL_OK)) {
        Nsf_PopFrameObj(interp, framePtr);
        goto configure_exit;
      }
      continue;
    }

  setvars:
    if (newValue == NsfGlobalObjs[NSF___UNKNOWN__]) {
      /*
       * Nothing to do, we have a value setter, but no value is specified and
       * no default was provided.
       */
      continue;
    }

    /*
     * Set the instance variable unless the last argument of the
     * definition is varArgs.
     */
    if (i < paramDefs->nrParams || (!pc.varArgs)) {

#if defined(CONFIGURE_ARGS_TRACE)
      fprintf(stderr, "*** %s SET %s '%s' // %p\n",
              ObjectName(object), ObjStr(paramPtr->nameObj), ObjStr(newValue),
              (void *)paramPtr->slotObj);
#endif
      /*
       * Actually, set instance variable with the provided value or default
       * value. In case, explicit invocation of the setter is needed, we call the method, which
       * is typically a forwarder to the slot object.
       */

      if ((paramPtr->flags & NSF_ARG_SLOTSET) != 0u) {
        NsfObject *slotObject = GetSlotObject(interp, paramPtr->slotObj);

        if (likely(slotObject != NULL)) {
          Tcl_Obj *ov[2];
          Tcl_Obj *methodObj = NsfMethodObj(object, NSF_s_set_idx);

          ov[0] = (paramPtr->method != NULL) ? paramPtr->method : paramPtr->nameObj;
          ov[1] = newValue;

          /*fprintf(stderr, "SLOTSET %s %s %s %s %s idx %d %p\n", ObjectName(slotObject),
                  ObjStr(NsfGlobalObjs[NSF_SET]), ObjStr(object->cmdName),
                  ObjStr(paramPtr->nameObj), ObjStr(newValue),
                  NSF_s_set_idx, methodObj);*/

          result = NsfCallMethodWithArgs(interp, (Nsf_Object *)slotObject,
                                         (methodObj != NULL) ? methodObj : NsfGlobalObjs[NSF_SLOT_SET],
                                         object->cmdName, 3, ov, NSF_CSC_IMMEDIATE);
        }
        if (unlikely(result != TCL_OK)) {
          /*
           * The error message was set either by GetSlotObject or by ...CallMethod...
           */
          Nsf_PopFrameObj(interp, framePtr);
          goto configure_exit;
        }
      } else {
        Tcl_Obj *resultObj;
        /*
         * Plain set of the variable.
         */
        resultObj = Tcl_ObjSetVar2(interp, paramPtr->nameObj, NULL, newValue, TCL_LEAVE_ERR_MSG);
        if (unlikely(resultObj == NULL)) {
          /*
           * When the setting of the variable failed (e.g. caused by variable
           * traces), report the error back.
           */
          result = TCL_ERROR;
          Nsf_PopFrameObj(interp, framePtr);
          goto configure_exit;
        }
      }
    }
  }

  Nsf_PopFrameObj(interp, framePtr);

 configure_exit:

  ParamDefsRefCountDecr(paramDefs);
  ParseContextRelease(&pc);

  if (likely(result == TCL_OK)) {
    Tcl_ResetResult(interp);
  }
  return result;
}

/*
objectMethod cget NsfOCgetMethod {
  {-argName "name" -type tclobj -required 1}
}
*/
static int
NsfOCgetMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *nameObj) {
  int              result;
  NsfParsedParam   parsedParam;
  const Nsf_Param *paramPtr = NULL;
  CallFrame        frame, *framePtr = &frame, *uplevelVarFramePtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(nameObj != NULL);

  /*
   * Get the object parameter definition
   */

  result = GetObjectParameterDefinition(interp, NsfGlobalObjs[NSF_EMPTY],
                                        object, NULL, &parsedParam);
  if (unlikely(result != TCL_OK)) {
    return result;
  }

  /*
   * GetObjectParameterDefinition() was returning TCL_OK, the paramdefs have
   * to be set.
   */
  assert(parsedParam.paramDefs != NULL);

  /*
   * We do not stack a plain stack from NSF_CSC_TYPE_PLAIN here, as we do in
   * NsfOConfigureMethod (but maybe we have to for full compatibility TODO:
   * check and compare with configure stack setup). Therefore, we pass NULL as
   * cscPtr to ParameterMethodForwardDispatch).
   */

  /*
   * The uplevel handling is exactly the same as in NsfOConfigureMethod() and
   * is needed, when methods are called, which perform an upvar.
   */
  uplevelVarFramePtr =
    (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp) != Tcl_Interp_framePtr(interp)
    ? Tcl_Interp_varFramePtr(interp)
    : NULL;

  /*
   * Push frame to allow invocations of [self] and make instance variables of
   * the object accessible as locals.
   */
  Nsf_PushFrameObj(interp, object, framePtr);
  ParamDefsRefCountIncr(parsedParam.paramDefs);

  result = CGetParamLookup(interp, nameObj, parsedParam.paramDefs, &paramPtr);
  if (result != TCL_OK) {
    /*
     * Error message is already set by CGetParamLookup()
     */
  } else if (paramPtr == NULL) {
    result = NsfPrintError(interp, "cget: unknown configure parameter %s", ObjStr(nameObj));

  } else {

    /*
     * Check for slot invocation.
     */
    if (paramPtr->slotObj != NULL) {
      NsfObject *slotObject = GetSlotObject(interp, paramPtr->slotObj);
      Tcl_Obj   *methodObj = NsfMethodObj(object, NSF_s_get_idx);
      Tcl_Obj   *ov[1];

      /*
       * Get instance variable via slot.
       */
      if (uplevelVarFramePtr != NULL) {
        Tcl_Interp_varFramePtr(interp) = uplevelVarFramePtr;
      }
      ov[0] = (paramPtr->method != NULL) ? paramPtr->method : paramPtr->nameObj;

      /*fprintf(stderr, "SLOTGET %s idx %d %p method %s\n", ObjectName(slotObject),
        NSF_s_get_idx, (void *)methodObj, ObjStr(ov[0]));*/

      result = NsfCallMethodWithArgs(interp, (Nsf_Object *)slotObject,
                                     (methodObj != NULL) ? methodObj : NsfGlobalObjs[NSF_SLOT_GET],
                                     object->cmdName, 2, ov, NSF_CSC_IMMEDIATE);
    } else {
      /*
       * We do NOT have a slot
       */
      if ((paramPtr->flags & NSF_ARG_METHOD_CALL) != 0u) {
        if ((paramPtr->flags & NSF_ARG_ALIAS) != 0u) {
          /*
           * It is a parameter associated with an aliased method. Invoke the
           * method without an argument.
           */
          Tcl_Obj *methodObj = (paramPtr->method != NULL) ? paramPtr->method : paramPtr->nameObj;

          if (uplevelVarFramePtr != NULL) {
            Tcl_Interp_varFramePtr(interp) = uplevelVarFramePtr;
          }

          result = CallMethod(object, interp, methodObj, 2, NULL, NSF_CSC_IMMEDIATE);
        } else {
          /*
           * Must be NSF_ARG_FORWARD
           */
          assert((paramPtr->flags & NSF_ARG_FORWARD) != 0u);

          /*
           * Since we have no cscPtr, we provide NULL.
           */
          result = ParameterMethodForwardDispatch(interp, object,
                                                  paramPtr, NULL, NULL /* cscPtr */);
        }
      } else {
      /*
       * Must be a parameter associated with a variable.
       */
        unsigned int flags = (object->nsPtr != NULL) ? (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY) : TCL_LEAVE_ERR_MSG;
        Tcl_Obj     *resultObj = Tcl_ObjGetVar2(interp, paramPtr->nameObj, NULL, (int)flags);

        if (resultObj != NULL) {
          /*
           * The value exists.
           */
          Tcl_SetObjResult(interp, resultObj);
        }
      }
    }
  }

  Nsf_PopFrameObj(interp, framePtr);
  ParamDefsRefCountDecr(parsedParam.paramDefs);

  return result;
}

/*
objectMethod destroy NsfODestroyMethod {
}
*/
static int
NsfODestroyMethod(Tcl_Interp *interp, NsfObject *object) {
  PRINTOBJ("NsfODestroyMethod", object);

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  /*
   * Provide protection against destroy on base classes.
   */
  if (unlikely(IsBaseClass(object))) {
    if (RUNTIME_STATE(interp)->exitHandlerDestroyRound != NSF_EXITHANDLER_ON_SOFT_DESTROY) {
      return NsfPrintError(interp, "cannot destroy base class %s", ObjectName_(object));
    }
  }

  /*fprintf(stderr, "NsfODestroyMethod %p %s flags %.6x activation %d cmd %p cmd->flags %.6x\n",
          object, ((Command *)object->id)->flags == 0 ? ObjectName(object) : "(deleted)",
          object->flags, object->activationCount, object->id, ((Command *)object->id)->flags);*/

  /*
   * NSF_DESTROY_CALLED might be set already be DispatchDestroyMethod(),
   * the implicit destroy calls. It is necessary to set it here for
   * the explicit destroy calls in the script, which reach the
   * Object->destroy.
   */

  if ((object->flags & NSF_DESTROY_CALLED) == 0u) {
    object->flags |= NSF_DESTROY_CALLED;
    /*fprintf(stderr, "NsfODestroyMethod %p sets DESTROY_CALLED %.6x\n", object, object->flags);*/
  }
  object->flags |= NSF_DESTROY_CALLED_SUCCESS;

  if (likely((object->flags & NSF_DURING_DELETE) == 0u)) {
    int result;
    Tcl_Obj *methodObj;

    /*fprintf(stderr, "   call dealloc on %p %s\n", object,
      ((Command *)object->id)->flags == 0u ? ObjectName(object) : "(deleted)");*/

    if (CallDirectly(interp, &object->cl->object, NSF_c_dealloc_idx, &methodObj)) {
      NSF_PROFILE_TIME_DATA;
      NSF_PROFILE_CALL(interp, &object->cl->object, Nsf_SystemMethodOpts[NSF_c_dealloc_idx]);
      result = DoDealloc(interp, object);
      NSF_PROFILE_EXIT(interp, &object->cl->object, Nsf_SystemMethodOpts[NSF_c_dealloc_idx]);
    } else {
      result = NsfCallMethodWithArgs(interp, (Nsf_Object *)object->cl, methodObj,
                                     object->cmdName, 1, NULL,
                                     NSF_CSC_IMMEDIATE|NSF_CM_IGNORE_PERMISSIONS);
      if (unlikely(result != TCL_OK)) {
        /*
         * In case, the call of the dealloc method has failed above (e.g. NS_DYING),
         * we have to call dealloc manually, otherwise we have a memory leak
         */
        /*fprintf(stderr, "*** dealloc failed for %p %s flags %.6x, retry\n",
          object, ObjectName(object), object->flags);*/
        result = DoDealloc(interp, object);
      }
    }
    return result;
  } else {
#if defined(OBJDELETION_TRACE)
    fprintf(stderr, "  Object->destroy already during delete, don't call dealloc %p\n", (void *)object);
#endif
  }
  return TCL_OK;
}

/*
objectMethod exists NsfOExistsMethod {
  {-argName "varName" -required 1}
}
*/
static int
NsfOExistsMethod(Tcl_Interp *interp, NsfObject *object, const char *varName) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(varName != NULL);

  Tcl_SetIntObj(Tcl_GetObjResult(interp),
                VarExists(interp, object, varName, NULL,
                          NSF_VAR_TRIGGER_TRACE|NSF_VAR_REQUIRE_DEFINED));
  return TCL_OK;
}

/*
objectMethod filterguard NsfOFilterGuardMethod {
  {-argName "filter" -required 1}
  {-argName "guard" -required 1 -type tclobj}
}
*/

static int
NsfOFilterGuardMethod(Tcl_Interp *interp, NsfObject *object, const char *filter, Tcl_Obj *guardObj) {
  NsfObjectOpt *opt;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(filter != NULL);
  nonnull_assert(guardObj != NULL);

  opt = object->opt;
  if (opt != NULL && opt->objFilters) {
    NsfCmdList *h;

    h = CmdListFindNameInList(interp, filter, opt->objFilters);
    if (h != NULL) {
      if (h->clientData != NULL) {
        GuardDel((NsfCmdList *) h);
      }
      GuardAdd(h, guardObj);
      object->flags &= ~NSF_FILTER_ORDER_VALID;
      return TCL_OK;
    }
  }

  return NsfPrintError(interp, "filterguard: can't find filter %s on %s",
                       filter, ObjectName_(object));
}

/*
objectMethod instvar NsfOInstvarMethod {
  {-argName "args" -type allargs}
}
*/

static int
NsfOInstvarMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[]) {
  callFrameContext ctx = {NULL, NULL, 0};
  int              result;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if ((object->filterStack != NULL) || (object->mixinStack != NULL)) {
    CallStackUseActiveFrame(interp, &ctx);
  }

  if (unlikely(Tcl_Interp_varFramePtr(interp) == NULL)) {
    CallStackRestoreSavedFrames(interp, &ctx);
    return NsfPrintError(interp, "instvar used on %s, but call-stack is not in procedure scope",
                         ObjectName_(object));
  }

  result = NsfVarImport(interp, object, ObjStr(objv[0]), objc-1, objv+1);
  CallStackRestoreSavedFrames(interp, &ctx);

  return result;
}

/*
objectMethod mixinguard NsfOMixinGuardMethod {
  {-argName "mixin" -required 1 -type tclobj}
  {-argName "guard" -required 1 -type tclobj}
}
*/

static int
NsfOMixinGuardMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *mixinObj, Tcl_Obj *guardObj) {
  NsfObjectOpt *opt;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(mixinObj != NULL);
  nonnull_assert(guardObj != NULL);

  opt = object->opt;
  if (opt != NULL && opt->objMixins) {
    const Tcl_Command mixinCmd = Tcl_GetCommandFromObj(interp, mixinObj);

    if (mixinCmd != NULL) {
      const NsfClass *mixinClass = NsfGetClassFromCmdPtr(mixinCmd);

      if (mixinClass != NULL) {
        NsfCmdList *h = CmdListFindCmdInList(mixinCmd, opt->objMixins);

        if (h != NULL) {
          if (h->clientData != NULL) {
            GuardDel((NsfCmdList *) h);
          }
          GuardAdd(h, guardObj);
          object->flags &= ~NSF_MIXIN_ORDER_VALID;
          return TCL_OK;
        }
      }
    }
  }

  return NsfPrintError(interp, "mixinguard: can't find mixin %s on %s",
                       ObjStr(mixinObj), ObjectName_(object));
}

/*
objectMethod noinit NsfONoinitMethod {
}
*/
static int
NsfONoinitMethod(Tcl_Interp *UNUSED(interp), NsfObject *object) {

  nonnull_assert(object != NULL);

  object->flags |= NSF_INIT_CALLED;
  return TCL_OK;
}

/*
objectMethod requirenamespace NsfORequireNamespaceMethod {
}
*/
static int
NsfORequireNamespaceMethod(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  RequireObjNamespace(interp, object);
  return TCL_OK;
}

/*
objectMethod residualargs NsfOResidualargsMethod {
  {-argName "args" -type allargs}
}
*/
static int
NsfOResidualargsMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[]) {
  int          i, start = 1, argc = 0, nextArgc = 0, normalArgs, result = TCL_OK;
  dashArgType  isdasharg = NO_DASH;
  const char  *methodName, *nextMethodName = NULL, *initString = NULL;
  Tcl_Obj    **argv = NULL, **nextArgv = NULL;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

#if 0
  fprintf(stderr, "NsfOResidualargsMethod %s %2d ", ObjectName_(object), objc);
  for(i = 0; i < objc; i++) {fprintf(stderr, " [%d]=%p %s,", i, &objv[i], ObjStr(objv[i]));}
  fprintf(stderr, "\n");
#endif

  /*
   * Skip arguments without leading dash.
   */
  for (i = start; i < objc; i++) {
    if ((isdasharg = IsDashArg(interp, objv[i], 1, &methodName, &argc, &argv))) {
      break;
    }
  }
  normalArgs = i-1;

  /*
   * Get the init string; do it once, outside the loop.  If initString is not
   * obtainable (i.e. not configured in the object system), don't call the
   * "init" method in the loop.
   */
  if (i < objc) {
    NsfObjectSystem *osPtr   = GetObjectSystem(object);
    Tcl_Obj         *initObj = osPtr->methods[NSF_o_init_idx];

    if (initObj != NULL) {
      initString = osPtr->methodNames[NSF_o_init_idx];
      assert(initString != NULL);
    }
  }


  for( ; i < objc; argc = nextArgc, argv = nextArgv, methodName = nextMethodName) {

    Tcl_ResetResult(interp);

    switch (isdasharg) {
    case SCALAR_DASH:    /* Argument is a scalar with a leading dash */
      { int j;

        nextMethodName = NULL;
        nextArgv = NULL;
        nextArgc = 0;

        for (j = i+1; j < objc; j++, argc++) {
          if ((isdasharg = IsDashArg(interp, objv[j], 1, &nextMethodName, &nextArgc, &nextArgv))) {
            break;
          }
        }
        if (initString != NULL) {
          result = CallConfigureMethod(interp, object, initString, methodName, argc+1, objv+i+1);
          if (unlikely(result != TCL_OK)) {
            return result;
          }
        }
        i += argc;
        break;
      }

    case LIST_DASH:  /* Argument is a list with a leading dash, grouping determined by list */
      i++;
      nextMethodName = NULL;

      if (i < objc) {
        isdasharg = IsDashArg(interp, objv[i], 1, &nextMethodName, &nextArgc, &nextArgv);
      } else {
        nextMethodName = NULL;
        nextArgv = NULL;
        nextArgc = 0;
      }
      if (initString != NULL) {
        result = CallConfigureMethod(interp, object, initString, methodName, argc+1, argv+1);
        if (unlikely(result != TCL_OK)) {
          return result;
        }
      }
      break;

    case NO_DASH:
      nextArgc = 0;
      return NsfPrintError(interp, "%s configure: unexpected argument '%s' between parameters",
                             ObjectName_(object), ObjStr(objv[i]));
    }
  }

  /*
   * Call init with residual args in case it was not called yet.
   */
  result = DispatchInitMethod(interp, object, normalArgs, objv+1, 0u);

  if (likely(result == TCL_OK)) {
    /*
     * Return the non-processed leading arguments unless there was an
     * error (XOTcl convention).
     */
    Tcl_SetObjResult(interp, Tcl_NewListObj(normalArgs, objv+1));
  }

  return result;
}

/*
objectMethod uplevel NsfOUplevelMethod {
  {-argName "args" -type allargs}
}
*/
static int
NsfOUplevelMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[]) {
  int        result, getFrameResult = 0;
  CallFrame *requestedFramePtr = NULL;

  nonnull_assert(interp != NULL);
  nonnull_assert(objv != NULL);

  if (objc < 2) {
    result = NsfPrintError(interp,
                         "wrong # args: should be \"%s %s ?level? command ?arg ...?\"",
                         ObjectName_(object),
                         NsfMethodName(objv[0]));

  } else  if (objc == 2) {
    result = TCL_OK;

  } else {
    /*
     * TclObjGetFrame returns:
     *  0 ... when a syntactically invalid (incl. no) level specifier was provided
     *  1 ... when a syntactically valid level specifier with corresp. frame
              was found
     * -1 ... when a syntactically valid level specifier was provided,
              but an error occurred while finding the frame
              (error msg in interp, "bad level")
     */
    getFrameResult = TclObjGetFrame(interp, objv[1], &requestedFramePtr);
    result = unlikely(getFrameResult == -1) ? TCL_ERROR : TCL_OK;
  }

  if (likely(result == TCL_OK)) {
    Tcl_CallFrame *framePtr, *savedVarFramePtr;

    objc -= getFrameResult + 1;
    objv += getFrameResult + 1;

    if (getFrameResult == 0) {
      /*
       * 0 is returned from TclObjGetFrame when no (or, an invalid) level
       * specifier was provided; objv[0] is interpreted as a command word,
       * uplevel defaults to the computed level.
       */
      Tcl_CallFrame *callingFramePtr = NULL;

      framePtr = NULL;
      NsfCallStackFindCallingContext(interp, 1, &framePtr, &callingFramePtr);

      if (framePtr == NULL) {
        /*
         * No proc frame was found, default to parent frame.
         */
        framePtr = callingFramePtr;
      }
    } else {
      /*
       * Use the requested frame corresponding to the (valid) level specifier.
       */
      framePtr = (Tcl_CallFrame *)requestedFramePtr;
    }

    assert(framePtr != NULL);

    savedVarFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp);
    Tcl_Interp_varFramePtr(interp) = (CallFrame *)framePtr;

    /*
     * Execute the residual arguments as a command.
     */

    if (objc == 1) {
      result = Tcl_EvalObjEx(interp, objv[0], TCL_EVAL_DIRECT);
    } else {
      /*
       * More than one argument: concatenate them together with spaces
       * between, then evaluate the result.  Tcl_EvalObjEx will delete
       * the object when it decrements its refCount after eval'ing it.
       */
      Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);

      result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
    }

    if (unlikely(result == TCL_ERROR)) {
      Tcl_AppendObjToErrorInfo(interp,
                               Tcl_ObjPrintf("\n    (\"uplevel\" body line %d)",
                                             Tcl_GetErrorLine(interp)));
    }

    /*
     * Restore the variable frame, and return.
     */
    Tcl_Interp_varFramePtr(interp) = (CallFrame *)savedVarFramePtr;
  }

  return result;
}

/*
objectMethod upvar NsfOUpvarMethod {
  {-argName "args" -type allargs}
}
*/
static int
NsfOUpvarMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[]) {
  Tcl_Obj         *frameInfoObj;
  int              i, result = TCL_ERROR;
  const char      *frameInfo;
  callFrameContext ctx = {NULL, NULL, 0};

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (objc < 3) {
    return NsfPrintError(interp,
                         "wrong # args: should be \"%s %s "
                         "?level? otherVar localVar ?otherVar localVar ...?\"",
                         ObjectName_(object),
                         NsfMethodName(objv[0]));
  }

  if (objc % 2 == 0) {
    /*
     * Even number of arguments (including method), therefore, the level
     * specifier is considered to be the first argument.
     */
    frameInfoObj = NULL;
    frameInfo = ObjStr(objv[1]);
    i = 2;
  } else {
    /*
     * Odd number of arguments (including method), therefore, the level
     * specifier considered absent and the level has to be computed.
     */
    frameInfoObj = ComputeLevelObj(interp, CALLING_LEVEL);
    INCR_REF_COUNT(frameInfoObj);
    frameInfo = ObjStr(frameInfoObj);
    i = 1;
  }

  if ((object->filterStack != NULL) || (object->mixinStack != NULL)) {
    CallStackUseActiveFrame(interp, &ctx);
  }

  for ( ;  i < objc;  i += 2) {
    result = Tcl_UpVar2(interp, frameInfo, ObjStr(objv[i]), NULL,
                        ObjStr(objv[i+1]), 0 /*flags*/);
    if (unlikely(result != TCL_OK)) {
      break;
    }
  }

  if (frameInfoObj != NULL) {
    DECR_REF_COUNT(frameInfoObj);
  }
  CallStackRestoreSavedFrames(interp, &ctx);
  return result;

}

/*
objectMethod volatile NsfOVolatileMethod {
}
objectMethod volatile1 NsfOVolatile1Method {
}
*/
static int
VolatileMethod(Tcl_Interp *interp, NsfObject *object, bool shallow) {
  int               result = TCL_ERROR;
  Tcl_Obj          *objPtr;
  const char       *fullName, *vn;
  callFrameContext  ctx = {NULL, NULL, 0};

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (unlikely(RUNTIME_STATE(interp)->exitHandlerDestroyRound != NSF_EXITHANDLER_OFF)) {
    return NsfPrintError(interp, "can't make objects volatile during shutdown");
  }

  if (shallow) {
    CallStackUseActiveFrame(interp, &ctx);

  } else {
    NsfObjectSystem *osPtr = GetObjectSystem(object);
    Tcl_CallFrame   *invocationFrame;

    /*
     * XOTcl1 style
     */
    /*NsfShowStack(interp);*/

    CallStackUseActiveFrame(interp, &ctx);

    /*fprintf(stderr, "active varframe %p\n", (void*)Tcl_Interp_varFramePtr(interp));*/
    invocationFrame = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp);

    while (1) {

      if (((unsigned int)Tcl_CallFrame_isProcCallFrame(invocationFrame) & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) != 0u) {
        NsfCallStackContent *cscPtr;

        cscPtr = ((NsfCallStackContent *)Tcl_CallFrame_clientData(invocationFrame));
        /*
         * We were not called from an NSF frame.
         */
        if (cscPtr == NULL) {
          break;
        }


        /*
         * Walk up the stack of invocations of the current object to skip
         * e.g. overloaded internally called methods like "configure".
         */
        /*fprintf(stderr, "compare object %p == %p\n", (void*)object, (void*)cscPtr->self);*/
        if (cscPtr->self == object &&
            strcmp(osPtr->methodNames[NSF_o_configure_idx],
                   Tcl_GetCommandName(interp, cscPtr->cmdPtr)) == 0) {
          invocationFrame =  Tcl_CallFrame_callerPtr(invocationFrame);
          /*fprintf(stderr, "same object, continue with %p\n", (void*)invocationFrame);*/
          continue;
        }

        /*
         * If this was a "next" call, continue to walk up.
         */
        if ((cscPtr->flags & NSF_CSC_CALL_IS_NEXT) != 0u) {
          invocationFrame =  Tcl_CallFrame_callerPtr(invocationFrame);
          /*fprintf(stderr, "next call with %p\n", (void*)invocationFrame);*/
          continue;
        }

        /*
         * Final special case for XOTcl1 compliance: In case, we were called
         * from an "unknown" method, skip this frame as well.
         */
        /*fprintf(stderr, "cmd %s\n", Tcl_GetCommandName(interp, cscPtr->cmdPtr));*/
        if (strcmp(osPtr->methodNames[NSF_o_unknown_idx], Tcl_GetCommandName(interp, cscPtr->cmdPtr)) == 0) {
          invocationFrame =  Tcl_CallFrame_callerPtr(invocationFrame);
          /*fprintf(stderr, "have unknown, continue with %p\n", (void*)invocationFrame);*/
          continue;
        }

      }
      break;
    }
    /*
     * Finally, set the invocation frame. The original frame context was saved
     * already by CallStackUseActiveFrame() and will be properly restored.
     */
    Tcl_Interp_varFramePtr(interp) = (CallFrame *)invocationFrame;

  }

  objPtr = object->cmdName;
  fullName = ObjStr(objPtr);
  vn = NSTail(fullName);

  if (Tcl_SetVar2(interp, vn, NULL, fullName, 0)) {
    NsfObjectOpt *opt = NsfRequireObjectOpt(object);

    /*fprintf(stderr, "### setting trace for %s on frame %p\n", fullName,
      Tcl_Interp_varFramePtr(interp));
      NsfShowStack(interp);*/
    result = Tcl_TraceVar(interp, vn, TCL_TRACE_UNSETS,
                          (Tcl_VarTraceProc *)NsfUnsetTrace,
                          objPtr);
    opt->volatileVarName = vn;
  }
  CallStackRestoreSavedFrames(interp, &ctx);

  if (likely(result == TCL_OK)) {
    INCR_REF_COUNT(objPtr);
  }
  return result;
}

static int
NsfOVolatileMethod(Tcl_Interp *interp, NsfObject *object) {

  return VolatileMethod(interp, object, NSF_TRUE);
}

static int
NsfOVolatile1Method(Tcl_Interp *interp, NsfObject *object) {

  return VolatileMethod(interp, object, NSF_FALSE);
}

/***********************************************************************
 * End Object Methods
 ***********************************************************************/


/***********************************************************************
 * Begin Class Methods
 ***********************************************************************/

static int
NsfCAllocMethod_(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *nameObj, Tcl_Namespace *parentNsPtr) {
  const char *nameString;
  NsfObject  *newObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(nameObj != NULL);

  nameString = ObjStr(nameObj);
  assert(isAbsolutePath(nameString));
  assert(NSValidObjectName(nameString, 0) != 0);

  /*
   * Create a new object from scratch.
   */
  if (! IsMetaClass(interp, class, NSF_TRUE)) {
    /*
     * If the base class is an ordinary class, we create an object.
     */
    newObj = PrimitiveOCreate(interp, nameObj, parentNsPtr, class);

  } else {
    /*
     * If the base class is a metaclass, we create a class.
     */
    newObj = (NsfObject *)PrimitiveCCreate(interp, nameObj, parentNsPtr, class);
  }

  if (unlikely(newObj == NULL)) {
    return NsfPrintError(interp, "alloc failed to create '%s' "
                         "(possibly parent namespace does not exist)",
                         nameString);
  }

  if (NSF_DTRACE_OBJECT_ALLOC_ENABLED()) {
    NSF_DTRACE_OBJECT_ALLOC(ObjectName(newObj), ClassName(class));
  }

  /*fprintf(stderr, "PrimitiveCCreate returns nameObj %p typePtr %p %s\n",
          nameObj, nameObj->typePtr,
          ObjTypeStr(nameObj)); */
  Tcl_SetObjResult(interp, nameObj);

  return TCL_OK;
}

/*
classMethod alloc NsfCAllocMethod {
  {-argName "name" -required 1 -type tclobj}
}
*/
static int
NsfCAllocMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *nameObj) {
  const char *nameString;
  int         result, nameLength = 0;

  /*
   * Create a new object from scratch.
   */

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(nameObj != NULL);

  /*
   * Check for illegal names.
   */
  nameString = TclGetStringFromObj(nameObj, &nameLength);
  if (unlikely(NSValidObjectName(nameString, (size_t)nameLength) == 0)) {
    result = NsfPrintError(interp, "cannot allocate object - illegal name '%s'", nameString);

  } else {
    Tcl_Namespace *parentNsPtr;
    Tcl_Obj       *tmpName;

    /*
     * Name is valid. If the path is not absolute, we add the appropriate
     * namespace.
     */
    if (isAbsolutePath(nameString)) {
      parentNsPtr = NULL;
      tmpName = NULL;
    } else {
      parentNsPtr = CallingNameSpace(interp);
      nameObj = tmpName = NameInNamespaceObj(nameString, parentNsPtr);
      if (strchr(nameString, ':')) {
        parentNsPtr = NULL;
      }
      INCR_REF_COUNT(tmpName);
      /*fprintf(stderr, " **** NoAbsoluteName for '%s' -> determined = '%s' parentNs %s\n",
        nameString, ObjStr(tmpName), parentNsPtr->fullName);*/
    }

    result = NsfCAllocMethod_(interp, class, nameObj, parentNsPtr);

    if (tmpName != NULL) {
      DECR_REF_COUNT(tmpName);
    }
  }
  return result;
}

/*
classMethod create NsfCCreateMethod {
  {-argName "name" -required 1}
  {-argName "args" -type allargs}
}
*/
static int
NsfCCreateMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *nameObj, int objc, Tcl_Obj *const objv[]) {
  NsfObject     *newObject = NULL;
  Tcl_Obj       *actualNameObj, *methodObj, *tmpObj = NULL;
  int            result, nameLength = 0;
  bool           autoNameCreate;
  const char    *nameString;
  Tcl_Namespace *parentNsPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(nameObj != NULL);
  nonnull_assert(objv != NULL);

  nameString = TclGetStringFromObj(nameObj, &nameLength);
#if 0
  { int i;
    fprintf(stderr, "NsfCCreateMethod %s create <%s> oc %d ", ClassName(class), ObjStr(nameObj), objc);
    for(i = 0; i < objc; i++) {fprintf(stderr, " [%d]=%s,", i, ObjStr(objv[i]));}
    fprintf(stderr, "\n");
  }
#endif

  if (unlikely(RUNTIME_STATE(interp)->exitHandlerDestroyRound != NSF_EXITHANDLER_OFF)) {
    fprintf(stderr, "### Can't create instance %s of class %s during interp shutdown.\n",
            ObjStr(nameObj), ClassName_(class));
    /*
     * Don't fail, if this happens during destroy, it might be canceled.
     */
    return TCL_OK;
  }

  /*
   * Check for illegal names.
   */
  if (unlikely(NSValidObjectName(nameString, (size_t)nameLength) == 0)) {
    result = NsfPrintError(interp, "cannot allocate object - illegal name '%s'", nameString);
    goto create_method_exit;
  }

  /*fprintf(stderr, "NsfCCreateMethod specifiedName %s\n", nameString);*/
  /*
   * Complete the name if it is not absolute.
   */
  if (!isAbsolutePath(nameString)) {
    parentNsPtr = CallingNameSpace(interp);
    tmpObj = NameInNamespaceObj(nameString, parentNsPtr);
    /*
     * If the name contains colons, the parentNsPtr is not appropriate
     * for determining the parent.
     */
    if (strchr(nameString, ':')) {
      parentNsPtr = NULL;
    }
    nameString = ObjStr(tmpObj);
    /* fprintf(stderr, " **** fixed name is '%s'\n", nameString); */
    INCR_REF_COUNT(tmpObj);
    actualNameObj = tmpObj;
    autoNameCreate = NSF_FALSE;

  } else {
    parentNsPtr = NULL;
    actualNameObj = nameObj;
    /* fprintf(stderr, " **** used specified name is '%s'\n", nameString); */

    /*
     * Check for autname prefix string. This string is always an absolute path
     * name, so it is sufficient to test here.
     */
    autoNameCreate = (strncmp(autonamePrefix, nameString, autonamePrefixLength) == 0);
  }

  /*
   * Check whether we have to call recreate (i.e. when the object exists
   * already). First check whether we have such a command, then check whether
   * the command is an object.
   */
  {
    Tcl_Command cmd = NSFindCommand(interp, nameString);
    if (cmd != NULL) {
      newObject = NsfGetObjectFromCmdPtr(cmd);
      if (newObject == NULL) {
        /*
         * We have a cmd, but no object. Don't allow one to overwrite an
         * ordinary cmd by an NSF object.
         */
        result = NsfPrintError(interp, "refuse to overwrite cmd %s; delete/rename it before overwriting", nameString);
        goto create_method_exit;
      }
    }
  }

  /*fprintf(stderr, "+++ createspecifiedName '%s', nameString '%s', newObject=%p ismeta(%s) %d, ismeta(%s) %d\n",
          ObjStr(specifiedNameObj), nameString, newObject,
          ClassName(class), IsMetaClass(interp, class, NSF_TRUE),
          (newObject != NULL) ? ClassName(newObject->cl) : "NULL",
          (newObject != NULL) ? IsMetaClass(interp, newObject->cl, NSF_TRUE) : 0
          );*/

  /*
   * Provide protection against recreation if base classes.
   */
  if (unlikely(newObject != NULL && unlikely(IsBaseClass(newObject)))) {
    result = NsfPrintError(interp, "cannot recreate base class %s", ObjectName(newObject));
    goto create_method_exit;
  }

  /*
   * Don't allow one to
   *  - recreate an object as a class,
   *  - recreate a class as an object, and to
   *  - recreate an object in a different object system
   *
   * In these cases, we use destroy followed by create instead of recreate.
   */

  if ((newObject != NULL)
      && (IsMetaClass(interp, class, NSF_TRUE) == IsMetaClass(interp, newObject->cl, NSF_TRUE))
      && GetObjectSystem(newObject) == class->osPtr) {

    /*fprintf(stderr, "%%%% recreate, call recreate method ... %s, objc=%d oldOs %p != newOs %p EQ %d\n",
            ObjStr(actualNameObj), objc+1,
            GetObjectSystem(newObject), cl->osPtr,
            GetObjectSystem(newObject) != cl->osPtr
            );*/


    /*
     * Call recreate --> initialization.
     */
    if (CallDirectly(interp, &class->object, NSF_c_recreate_idx, &methodObj)) {
      NSF_PROFILE_TIME_DATA;
      NSF_PROFILE_CALL(interp, &class->object, Nsf_SystemMethodOpts[NSF_c_recreate_idx]);
      result = RecreateObject(interp, class, newObject, objc, objv);
      NSF_PROFILE_EXIT(interp, &class->object, Nsf_SystemMethodOpts[NSF_c_recreate_idx]);

    } else {
      ALLOC_ON_STACK(Tcl_Obj*, objc+3, xov);

      xov[0] = NULL; /* just a placeholder for passing conventions in ObjectDispatch() */
      xov[1] = methodObj;
      xov[2] = actualNameObj;
      if (objc >= 1) {
        memcpy(xov+3, objv, sizeof(Tcl_Obj *) * (size_t)objc);
      }
      result = ObjectDispatch(class, interp, objc+3, xov, NSF_CM_IGNORE_PERMISSIONS|NSF_CSC_IMMEDIATE);

      FREE_ON_STACK(Tcl_Obj *, xov);
    }

    if (unlikely(result != TCL_OK)) {
      goto create_method_exit;
    }

    Tcl_SetObjResult(interp, newObject->cmdName);
    ObjTrace("RECREATE", newObject);

  } else {
    /*
     * "newObject" might exist here, but will be automatically destroyed by
     * alloc.
     */

    if (CallDirectly(interp, &class->object, NSF_c_alloc_idx, &methodObj)) {
      NSF_PROFILE_TIME_DATA;
      NSF_PROFILE_CALL(interp, &class->object, Nsf_SystemMethodOpts[NSF_c_alloc_idx]);
      result = NsfCAllocMethod_(interp, class, actualNameObj, parentNsPtr);
      NSF_PROFILE_EXIT(interp, &class->object, Nsf_SystemMethodOpts[NSF_c_alloc_idx]);
    } else {
      result = CallMethod(class, interp, methodObj,
                          3, &actualNameObj, NSF_CSC_IMMEDIATE);
    }

    if (unlikely(result != TCL_OK)) {
      goto create_method_exit;
    }
    actualNameObj = Tcl_GetObjResult(interp);

    if (unlikely(GetObjectFromObj(interp, actualNameObj, &newObject) != TCL_OK)) {
      result = NsfPrintError(interp, "couldn't find result of alloc");
      goto create_method_exit;
    }

    ObjTrace("CREATE", newObject);

    if (autoNameCreate) {
      newObject->flags |= NSF_IS_AUTONAMED;
    }

    /*
     * In case, the object is destroyed during initialization, we increment
     * the refCount.
     */
    INCR_REF_COUNT(actualNameObj);
    result = DoObjInitialization(interp, newObject, objc, objv);
    DECR_REF_COUNT(actualNameObj);
  }
 create_method_exit:

  if (tmpObj != NULL) {
    DECR_REF_COUNT(tmpObj);
  }
  return result;
}

/*
classMethod dealloc NsfCDeallocMethod {
  {-argName "object" -required 1 -type tclobj}
}
*/

static int
NsfCDeallocMethod(Tcl_Interp *interp, NsfClass *UNUSED(class), Tcl_Obj *objectObj) {
  NsfObject *object;

  nonnull_assert(interp != NULL);

  if (GetObjectFromObj(interp, objectObj, &object) != TCL_OK) {
    return NsfPrintError(interp, "can't destroy object %s that does not exist",
                         ObjStr(objectObj));
  }

  return DoDealloc(interp, object);
}

/*
classMethod filterguard NsfCFilterGuardMethod {
  {-argName "filter" -required 1}
  {-argName "guard" -required 1 -type tclobj}
}
*/

static int
NsfCFilterGuardMethod(Tcl_Interp *interp, NsfClass *class,
                      const char *filter, Tcl_Obj *guardObj) {
  NsfClassOpt *opt;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(filter != NULL);
  nonnull_assert(guardObj != NULL);

  opt = class->opt;
  if (opt != NULL && opt->classFilters) {
    NsfCmdList *h = CmdListFindNameInList(interp, filter, opt->classFilters);

    if (h != NULL) {
      NsfClasses *subClasses = DependentSubClasses(class);

      if (h->clientData != NULL) {
        GuardDel(h);
      }
      GuardAdd(h, guardObj);

      if (subClasses != NULL) {
        FilterInvalidateObjOrders(interp, subClasses);
        NsfClassListFree(subClasses);
      }

      return TCL_OK;
    }
  }

  return NsfPrintError(interp, "filterguard: can't find filter %s on %s",
                       filter, ClassName_(class));
}

/*
classMethod getCachedParameters NsfCGetCachendParametersMethod {
}
*/
static int
NsfCGetCachendParametersMethod(Tcl_Interp *interp, NsfClass *class) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  if (likely(class->parsedParamPtr != NULL && class->parsedParamPtr->paramDefs != NULL)) {
    Tcl_Obj *listObj;

    listObj = ListParamDefs(interp, class->parsedParamPtr->paramDefs->paramsPtr,
                            NULL, NULL, NSF_PARAMS_PARAMETER);
    Tcl_SetObjResult(interp, listObj);
    DECR_REF_COUNT2("paramDefsObj", listObj);
  }
  return TCL_OK;
}

/*
classMethod mixinguard NsfCMixinGuardMethod {
  {-argName "mixin" -required 1 -type tclobj}
  {-argName "guard" -required 1 -type tclobj}
}
*/
static int
NsfCMixinGuardMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *mixinObj, Tcl_Obj *guardObj) {
  NsfClassOpt *opt;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(mixinObj != NULL);
  nonnull_assert(guardObj != NULL);

  opt = class->opt;
  if (opt != NULL && opt->classMixins != NULL) {
    const Tcl_Command mixinCmd = Tcl_GetCommandFromObj(interp, mixinObj);

    if (mixinCmd != NULL) {
     const NsfClass *mixinClass = NsfGetClassFromCmdPtr(mixinCmd);

      if (mixinClass != NULL) {
        NsfCmdList *h = CmdListFindCmdInList(mixinCmd, opt->classMixins);

        if (h != NULL) {
          NsfClasses *subClasses;

          if (h->clientData != NULL) {
            GuardDel((NsfCmdList *) h);
          }
          GuardAdd(h, guardObj);
          subClasses = DependentSubClasses(class);
          MixinInvalidateObjOrders(subClasses);
          NsfClassListFree(subClasses);
          return TCL_OK;
        }
      }
    }
  }

  return NsfPrintError(interp, "mixinguard: can't find mixin %s on %s",
                       ObjStr(mixinObj), ClassName_(class));
}

/*
classMethod new NsfCNewMethod {
  {-argName "-childof" -required 0 -type tclobj}
  {-argName "args" -required 0 -type args}
}
*/

static int
NsfCNewMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *childofObj,
              int trailingObjc, Tcl_Obj *const trailingObjv[]) {
  Tcl_Obj     *fullnameObj;
  Tcl_DString  dFullname, *dsPtr = &dFullname;
  int          result;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

#if 0
  { int i;
    fprintf(stderr, "NsfCNewMethod %s withChildof %p oc %d ", ClassName(class), childofObj, trailingObjc);
    for(i = 0; i < trailingObjc; i++) {fprintf(stderr, " [%d]=%s,", i, ObjStr(trailingObjv[i]));}
    fprintf(stderr, "\n");
  }
#endif

  Tcl_DStringInit(dsPtr);
  if (childofObj != 0) {
    const char *parentName = ObjStr(childofObj);

    /*
     * If "parentName" is fully qualified, use it as prefix, else prepend the
     * CallingNameSpace() to be compatible with the object name completion.
     */
    if (*parentName == ':' && *(parentName + 1) == ':') {
      /*
       * Prepend parentName only if it is not "::"
       */
      if (*(parentName + 2) != '\0') {
        Tcl_DStringAppend(dsPtr, parentName, -1);
      }
    } else {
      Tcl_Obj    *tmpName = NameInNamespaceObj(parentName, CallingNameSpace(interp));
      const char *completedParentName;

      INCR_REF_COUNT(tmpName);
      completedParentName = ObjStr(tmpName);
      if (strcmp(completedParentName, "::")) {
        Tcl_DStringAppend(dsPtr, ObjStr(tmpName), -1);
      }
      DECR_REF_COUNT(tmpName);
    }
    Tcl_DStringAppend(dsPtr, "::__#", 5);
  } else {
    Tcl_DStringAppend(dsPtr, autonamePrefix, (int)autonamePrefixLength);
  }

  NewTclCommand(interp, dsPtr);

  fullnameObj = Tcl_NewStringObj(Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr));
  INCR_REF_COUNT(fullnameObj);

  {
    Tcl_Obj *methodObj;
    int      callDirectly;

    callDirectly = CallDirectly(interp, &class->object, NSF_c_create_idx, &methodObj);

    if (callDirectly != 0) {
      NSF_PROFILE_TIME_DATA;
      NSF_PROFILE_CALL(interp, &class->object, Nsf_SystemMethodOpts[NSF_c_create_idx]);
      result = NsfCCreateMethod(interp, class, fullnameObj, trailingObjc, trailingObjv);
      NSF_PROFILE_EXIT(interp, &class->object, Nsf_SystemMethodOpts[NSF_c_create_idx]);
    } else {
      ALLOC_ON_STACK(Tcl_Obj*, trailingObjc+3, ov);

      ov[0] = NULL; /* just a placeholder for passing conventions in ObjectDispatch() */
      ov[1] = methodObj;
      ov[2] = fullnameObj;
      if (trailingObjc >= 1) {
        memcpy(ov+3, trailingObjv, sizeof(Tcl_Obj *) * (size_t)trailingObjc);
      }
      result = ObjectDispatch(class, interp, trailingObjc+3, ov, NSF_CSC_IMMEDIATE);
      FREE_ON_STACK(Tcl_Obj *, ov);
    }
  }

  DECR_REF_COUNT(fullnameObj);
  Tcl_DStringFree(dsPtr);

  return result;
}

/*
classMethod recreate NsfCRecreateMethod {
  {-argName "objectName" -required 1 -type tclobj}
  {-argName "args" -type virtualclassargs}
}
*/
static int
RecreateObject(Tcl_Interp *interp, NsfClass *class, NsfObject *object,
               int objc, Tcl_Obj *const objv[]) {
  int result;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(objv != NULL);

  object->flags |= NSF_RECREATE;

  /*
   * First, cleanup the data from the object.
   *
   * Check whether we have a pending destroy on the object; if yes,
   * clear it, such that the recreated object and won't be destroyed
   * on a POP.
   */
  MarkUndestroyed(object);

  /*
   * Ensure correct class for object.
   */
  result = ChangeClass(interp, object, class);

  if (likely(result == TCL_OK)) {
    Tcl_Obj *methodObj;

    /*
     * Dispatch "cleanup" method.
     */
    if (CallDirectly(interp, object, NSF_o_cleanup_idx, &methodObj)) {
      NSF_PROFILE_TIME_DATA;
      /*fprintf(stderr, "RECREATE calls cleanup directly for object %s\n", ObjectName(object));*/
      NSF_PROFILE_CALL(interp, object, Nsf_SystemMethodOpts[NSF_o_cleanup_idx]);
      result = NsfOCleanupMethod(interp, object);
      NSF_PROFILE_EXIT(interp, object, Nsf_SystemMethodOpts[NSF_o_cleanup_idx]);
    } else {
      /*NsfObjectSystem *osPtr = GetObjectSystem(object);
      fprintf(stderr, "RECREATE calls method cleanup for object %p %s OS %s\n",
              object, ObjectName(object), ObjectName(&osPtr->rootClass->object));*/
      result = CallMethod(object, interp, methodObj,
                          2, NULL, NSF_CM_IGNORE_PERMISSIONS|NSF_CSC_IMMEDIATE);
    }
  }

  /*
   * Second: if cleanup was successful, initialize the object as usual.
   */
  if (likely(result == TCL_OK)) {
    result = DoObjInitialization(interp, object, objc, objv);
    if (likely(result == TCL_OK)) {
      Tcl_SetObjResult(interp, object->cmdName);
    } else {
      /* fprintf(stderr, "recreate DoObjInitialization returned %d\n", result);*/
    }
  }
  return result;
}

static int
NsfCRecreateMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *objectNameObj,
                   int trailingObjc, Tcl_Obj *const trailingObjv[]) {
  NsfObject *object;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(objectNameObj != NULL);

  if (GetObjectFromObj(interp, objectNameObj, &object) != TCL_OK) {
    return NsfPrintError(interp, "can't recreate non existing object %s", ObjStr(objectNameObj));
  }
  return RecreateObject(interp, class, object, trailingObjc, trailingObjv);
}

/*
classMethod superclass NsfCSuperclassMethod {
  {-argName "superclasses" -required 0 -type tclobj}
}
*/
static int
NsfCSuperclassMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *superclassesObj) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  return NsfRelationSetCmd(interp, &class->object, RelationtypeSuperclassIdx, superclassesObj);
}

/***********************************************************************
 * End Class Methods
 ***********************************************************************/

static MethodtypeIdx_t
AggregatedMethodType(MethodtypeIdx_t methodType) {
  MethodtypeIdx_t result;

  if (methodType == MethodtypeNULL) {
    result = MethodtypeAllIdx;
  } else if (methodType == MethodtypeBuiltinIdx) {
    result = NSF_METHODTYPE_BUILTIN|NSF_METHODTYPE_OBJECT;
  } else {
    result = methodType;
  }
  //fprintf(stderr, "AggregatedMethodType input %.4x output %.4x\n", methodType, result);
  return result;
}

/***********************************************************************
 * Begin Object Info Methods
 ***********************************************************************/
/*
objectInfoMethod baseclass NsfObjInfoBaseclassMethod {
}
*/

static int
NsfObjInfoBaseclassMethod(Tcl_Interp *interp, NsfObject *object) {
  NsfObjectSystem *osPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  osPtr = GetObjectSystem(object);
  assert(osPtr != NULL);

  Tcl_SetObjResult(interp, osPtr->rootClass->object.cmdName);

  return TCL_OK;
}
/*
objectInfoMethod children NsfObjInfoChildrenMethod {
  {-argName "-type" -required 0 -nrargs 1 -type class}
  {-argName "pattern" -required 0}
}
*/
static int
NsfObjInfoChildrenMethod(Tcl_Interp *interp, NsfObject *object, NsfClass *typeClass, const char *pattern) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  return ListChildren(interp, object, pattern, NSF_FALSE, typeClass);
}

/*
objectInfoMethod class NsfObjInfoClassMethod {
}
*/
static int
NsfObjInfoClassMethod(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  Tcl_SetObjResult(interp, object->cl->object.cmdName);
  return TCL_OK;
}

/*
objectInfoMethod filterguard NsfObjInfoFilterguardMethod {
  {-argName "filter" -required 1}
}
*/
static int
NsfObjInfoFilterguardMethod(Tcl_Interp *interp, NsfObject *object, const char *filter) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(filter != NULL);

  return (object->opt != NULL) ? GuardList(interp, object->opt->objFilters, filter) : TCL_OK;
}

/*
objectInfoMethod filters NsfObjInfoFiltersMethod {
  {-argName "-guards" -nrargs 0 -type switch}
  {-argName "pattern"}
}
*/
static int
NsfObjInfoFiltersMethod(Tcl_Interp *interp, NsfObject *object, int withGuards,
                        const char *pattern) {
  NsfObjectOpt *opt;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  opt = object->opt;
  return (opt != NULL) ? FilterInfo(interp, opt->objFilters, pattern, (withGuards == 1), NSF_FALSE) : TCL_OK;
}

/*
objectInfoMethod forward NsfObjInfoForwardMethod {
  {-argName "-definition"}
  {-argName "pattern"}
}
*/
static int
NsfObjInfoForwardMethod(Tcl_Interp *interp, NsfObject *object, int withDefinition, const char *pattern) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  return (object->nsPtr != NULL) ?
    ListForward(interp, Tcl_Namespace_cmdTablePtr(object->nsPtr), pattern, withDefinition) :
    TCL_OK;
}

/*
objectInfoMethod hasmixin NsfObjInfoHasMixinMethod {
  {-argName "class" -required 1 -type class}
}
*/
static int
NsfObjInfoHasMixinMethod(Tcl_Interp *interp, NsfObject *object, NsfClass *class) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(class != NULL);

  Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (int)(HasMixin(interp, object, class)));
  return TCL_OK;
}

/*
objectInfoMethod hasnamespace NsfObjInfoHasnamespaceMethod {
}
*/
static int
NsfObjInfoHasnamespaceMethod(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  Tcl_SetBooleanObj(Tcl_GetObjResult(interp), object->nsPtr != NULL);
  return TCL_OK;
}

/*
objectInfoMethod hastype NsfObjInfoHasTypeMethod {
  {-argName "class" -required 1 -type class}
}
*/
static int
NsfObjInfoHasTypeMethod(Tcl_Interp *interp, NsfObject *object, NsfClass *class) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(class != NULL);

  Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (int)(IsSubType(object->cl, class)));
  return TCL_OK;
}

/*
objectInfoMethod lookupfilter NsfObjInfoLookupFilterMethod {
  {-argName "filter" -required 1}
}
*/
static int
NsfObjInfoLookupFilterMethod(Tcl_Interp *interp, NsfObject *object, const char *filter) {
  const char *filterName;
  NsfCmdList *cmdList;
  NsfClass *fcl;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(filter != NULL);

  /*
   * Searches for filter on [self] and returns fully qualified name if it is
   * not found it returns an empty string.
   */
  Tcl_ResetResult(interp);

  if ((object->flags & NSF_FILTER_ORDER_VALID) == 0u) {
    FilterComputeDefined(interp, object);
  }
  if ((object->flags & NSF_FILTER_ORDER_DEFINED) == 0u) {
    return TCL_OK;
  }
  for (cmdList = object->filterOrder; cmdList;  cmdList = cmdList->nextPtr) {
    filterName = Tcl_GetCommandName(interp, cmdList->cmdPtr);
    if (filterName[0] == filter[0] && !strcmp(filterName, filter)) {
      break;
    }
  }

  if (cmdList == NULL) {
    return TCL_OK;
  }
  fcl = cmdList->clorobj;
  Tcl_SetObjResult(interp, MethodHandleObj((NsfObject *)fcl, !NsfObjectIsClass(&fcl->object), filterName));
  return TCL_OK;
}


/*
objectInfoMethod lookupfilters NsfObjInfoLookupFiltersMethod {
  {-argName "-guards" -nrargs 0 -type switch}
  {-argName "pattern"}
}
*/
static int
NsfObjInfoLookupFiltersMethod(Tcl_Interp *interp, NsfObject *object, int withGuards, const char *pattern) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if ((object->flags & NSF_FILTER_ORDER_VALID) == 0u) {
    FilterComputeDefined(interp, object);
  }
  return FilterInfo(interp, object->filterOrder, pattern, (withGuards == 1), NSF_TRUE);
}

/*
objectInfoMethod lookupmethod NsfObjInfoLookupMethodMethod {
  {-argName "name" -required 1 -type tclobj}
}
*/
static int
NsfObjInfoLookupMethodMethod(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *nameObj) {
  NsfClass *classPtr = NULL;
  Tcl_Command cmd;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(nameObj != NULL);

  cmd = ObjectFindMethod(interp, object, nameObj, &classPtr);
  if (likely(cmd != NULL)) {
    NsfObject *pobj = (classPtr != NULL) ? &classPtr->object : object;
    int perObject = (classPtr == NULL);

    ListMethod(interp, pobj, pobj, ObjStr(nameObj), cmd,
               InfomethodsubcmdRegistrationhandleIdx,
               NULL, NULL, (perObject == 1));
  }
  return TCL_OK;
}


static int ListMethodKeysClassList(Tcl_Interp *interp, NsfClasses *classListPtr,
                        DefinitionsourceIdx_t withSource, const char *pattern,
                        MethodtypeIdx_t methodType, CallprotectionIdx_t withCallprotection,
                        bool withPath, Tcl_HashTable *dups,
                        NsfObject *object, bool withPer_object)
  nonnull(1) nonnull(8) nonnull(9);

static int
ListMethodKeysClassList(Tcl_Interp *interp, NsfClasses *classListPtr,
                        DefinitionsourceIdx_t withSource, const char *pattern,
                        MethodtypeIdx_t methodType, CallprotectionIdx_t withCallprotection,
                        bool withPath, Tcl_HashTable *dups,
                        NsfObject *object, bool withPer_object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(dups != NULL);
  nonnull_assert(object != NULL);

  /*
   * Append method keys from inheritance order
   */
  for (; classListPtr != NULL; classListPtr = classListPtr->nextPtr) {
    Tcl_HashTable *cmdTablePtr = Tcl_Namespace_cmdTablePtr(classListPtr->cl->nsPtr);

    if (!MethodSourceMatches(withSource, classListPtr->cl, NULL)) {
      continue;
    }

    ListMethodKeys(interp, cmdTablePtr, NULL, pattern, methodType,
                   withCallprotection, withPath,
                   dups, object, withPer_object);
  }
  return TCL_OK;
}

/*
objectInfoMethod lookupmethods NsfObjInfoLookupMethodsMethod {
  {-argName "-callprotection" -type "all|public|protected|private" -default all}
  {-argName "-incontext" -nrargs 0}
  {-argName "-type" -typeName "methodtype" -type "all|scripted|builtin|alias|forwarder|object|setter|nsfproc"}
  {-argName "-nomixins" -nrargs 0}
  {-argName "-path" -nrargs 0}
  {-argName "-source" -type "all|application|system" -default all}
  {-argName "pattern" -required 0}
}
*/
static int
NsfObjInfoLookupMethodsMethod(Tcl_Interp *interp, NsfObject *object,
                              CallprotectionIdx_t withCallprotection,
                              int withIncontext,
                              MethodtypeIdx_t withType,
                              int withNomixins,
                              int withPath,
                              DefinitionsourceIdx_t withSource,
                              const char *pattern) {
  int             result;
  bool            withPer_object = NSF_TRUE;
  Tcl_HashTable   dupsTable, *dups = &dupsTable;
  MethodtypeIdx_t methodType = AggregatedMethodType(withType);

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  /*
   * TODO: We could make this faster for patterns without meta-chars by
   * letting ListMethodKeys() to signal us when an entry was found.  we
   * wait, until the we decided about "info methods defined" vs. "info
   * method search" vs. "info defined" etc.
   */
  if (withCallprotection == CallprotectionNULL) {
    withCallprotection = CallprotectionPublicIdx;
  }
  if (withSource == DefinitionsourceNULL) {
    withSource = DefinitionsourceAllIdx;
  }

  Tcl_InitHashTable(dups, TCL_STRING_KEYS);
  if (object->nsPtr != NULL) {
    Tcl_HashTable *cmdTablePtr = Tcl_Namespace_cmdTablePtr(object->nsPtr);

    if (MethodSourceMatches(withSource, NULL, object)) {
      ListMethodKeys(interp, cmdTablePtr, NULL, pattern, methodType,
                     withCallprotection, (withPath == 1),
                     dups, object, withPer_object);
    }
  }

  if (withNomixins == 0) {
    if ((object->flags & NSF_MIXIN_ORDER_VALID) == 0u) {
      MixinComputeDefined(interp, object);
    }
    if ((object->flags & NSF_MIXIN_ORDER_DEFINED_AND_VALID) != 0u) {
      NsfCmdList *ml;

      for (ml = object->mixinOrder; ml; ml = ml->nextPtr) {
        int guardOk = TCL_OK;
        NsfClass *mixin = NsfGetClassFromCmdPtr(ml->cmdPtr);

        assert(mixin != NULL);
        if (withIncontext != 0) {
          if (!RUNTIME_STATE(interp)->guardCount && ml->clientData) {
            guardOk = GuardCall(object, interp, ml->clientData, NULL);
          }
        }
        if (mixin && guardOk == TCL_OK) {
          Tcl_HashTable *cmdTablePtr = Tcl_Namespace_cmdTablePtr(mixin->nsPtr);
          if (!MethodSourceMatches(withSource, mixin, NULL)) {
            continue;
          }
          ListMethodKeys(interp, cmdTablePtr, NULL, pattern, methodType,
                         withCallprotection, withPath,
                         dups, object, withPer_object);
        }
      }
    }
  }

  result = ListMethodKeysClassList(interp, PrecedenceOrder(object->cl),
                                   withSource, pattern,
                                   methodType, withCallprotection,
                                   (withPath == 1), dups, object, withPer_object);

  Tcl_DeleteHashTable(dups);
  return result;
}

/*
objectInfoMethod lookupmixins NsfObjInfoLookupMixinsMethod {
  {-argName "-guards" -nrargs 0 -type switch}
  {-argName "pattern" -type objpattern}
}
*/
static int
NsfObjInfoLookupMixinsMethod(Tcl_Interp *interp, NsfObject *object, int withGuards,
                             const char *patternString, NsfObject *patternObject) {
  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if ((object->flags & NSF_MIXIN_ORDER_VALID) == 0u) {
    MixinComputeDefined(interp, object);
  }
  return MixinInfo(interp, object->mixinOrder, patternString, (withGuards == 1), patternObject);
}


/*
objectInfoMethod lookupslots NsfObjInfoLookupSlotsMethod {
  {-argName "-source" -nrargs 1 -type "all|application|system" -default all}
  {-argName "-type" -required 0 -nrargs 1 -type class}
  {-argName "pattern" -required 0}
}
*/
static int
NsfObjInfoLookupSlotsMethod(Tcl_Interp *interp, NsfObject *object,
                            DefinitionsourceIdx_t withSource,
                            NsfClass *typeClass,
                            const char *pattern) {
  Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
  NsfClasses *precedenceList, *clPtr;
  Tcl_HashTable slotTable;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  precedenceList = ComputePrecedenceList(interp, object, NULL /* pattern*/,
                                         NSF_TRUE, NSF_TRUE);
  assert(precedenceList != NULL);

  if (withSource == 0) {
    withSource = 1;
  }

  Tcl_InitHashTable(&slotTable, TCL_STRING_KEYS);
  MEM_COUNT_ALLOC("Tcl_InitHashTable", &slotTable);

  /*
   * First add the per-object slot objects.
   */
  if (MethodSourceMatches(withSource, NULL, object)) {
    AddSlotObjects(interp, object, "::per-object-slot", &slotTable,
                   typeClass, pattern, listObj);
  }

  /*
   * Then add the class provided slot objects.
   */
  for (clPtr = precedenceList; likely(clPtr != NULL); clPtr = clPtr->nextPtr) {
    if (MethodSourceMatches(withSource, clPtr->cl, NULL)) {
      AddSlotObjects(interp, &clPtr->cl->object, "::slot", &slotTable,
                     typeClass, pattern, listObj);
    }
  }

  Tcl_DeleteHashTable(&slotTable);
  MEM_COUNT_FREE("Tcl_InitHashTable", &slotTable);

  NsfClassListFree(precedenceList);
  Tcl_SetObjResult(interp, listObj);

  return TCL_OK;
}

/*
objectInfoMethod method NsfObjInfoMethodMethod {
  {-argName "infomethodsubcmd" -type "args|body|definition|exists|registrationhandle|definitionhandle|origin|parameter|syntax|type|precondition|postcondition|submethods"}
  {-argName "name" -required 1 -type tclobj}
}
*/
static int
NsfObjInfoMethodMethod(Tcl_Interp *interp, NsfObject *object,
                       InfomethodsubcmdIdx_t subcmd, Tcl_Obj *nameObj) {
  return ListMethodResolve(interp, subcmd, NULL, NULL, object->nsPtr, object, nameObj, NSF_FALSE);
}

/*
objectInfoMethod methods NsfObjInfoMethodsMethod {
  {-argName "-callprotection" -type "all|public|protected|private" -default all}
  {-argName "-type" -nrargs 1 -typeName "methodtype" -type "all|scripted|builtin|alias|forwarder|object|setter"}
  {-argName "-path" -nrargs 0}
  {-argName "pattern"}
}
*/
static int
NsfObjInfoMethodsMethod(Tcl_Interp *interp, NsfObject *object,
                        CallprotectionIdx_t withCallprotection,
                        MethodtypeIdx_t withType,
                        int withPath,
                        const char *pattern) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  return ListDefinedMethods(interp, object, pattern, 1 /* per-object */,
                            AggregatedMethodType(withType), withCallprotection,
                            withPath);
}

/*
objectInfoMethod mixins NsfObjInfoMixinsMethod {
  {-argName "-guards" -nrargs 0 -type switch}
  {-argName "pattern" -type objpattern}
}
*/
static int
NsfObjInfoMixinsMethod(Tcl_Interp *interp, NsfObject *object, int withGuards,
                       const char *patternString, NsfObject *patternObject) {
  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  return (object->opt != NULL) ?
    MixinInfo(interp, object->opt->objMixins, patternString, (withGuards == 1), patternObject) :
    TCL_OK;
}

/*
objectInfoMethod mixinguard NsfObjInfoMixinguardMethod {
  {-argName "mixin"  -required 1}
}
*/
static int
NsfObjInfoMixinguardMethod(Tcl_Interp *interp, NsfObject *object, const char *mixin) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);
  nonnull_assert(mixin != NULL);

  return (object->opt != NULL) ? GuardList(interp, object->opt->objMixins, mixin) : TCL_OK;
}

/*
objectInfoMethod name NsfObjInfoNameMethod {
}
*/
static int
NsfObjInfoNameMethod(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  Tcl_SetObjResult(interp,  Tcl_NewStringObj(Tcl_GetCommandName(interp, object->id), -1));
  return TCL_OK;
}

/*
objectInfoMethod parent NsfObjInfoParentMethod {
}
*/
static int
NsfObjInfoParentMethod(Tcl_Interp *interp, NsfObject *object) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  if (object->id != NULL) {
    Tcl_Namespace *nsPtr = Tcl_Command_nsPtr(object->id);
    Tcl_SetObjResult(interp, Tcl_NewStringObj((nsPtr != NULL) ? nsPtr->fullName : "", -1));
  }
  return TCL_OK;
}

/*
objectInfoMethod precedence NsfObjInfoPrecedenceMethod {
  {-argName "-intrinsic"}
  {-argName "pattern" -required 0}
}
*/
static int
NsfObjInfoPrecedenceMethod(Tcl_Interp *interp, NsfObject *object,
                           int withIntrinsic, const char *pattern) {
  NsfClasses *precedenceList, *pl;
  Tcl_Obj    *resultObj = Tcl_NewObj();

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  precedenceList = ComputePrecedenceList(interp, object, pattern,
                                         (withIntrinsic == 0), NSF_TRUE);
  for (pl = precedenceList; pl != NULL; pl = pl->nextPtr) {
    assert(pl->cl != NULL);
    Tcl_ListObjAppendElement(interp, resultObj, pl->cl->object.cmdName);
  }
  if (precedenceList != NULL) {
    NsfClassListFree(precedenceList);
  }

  Tcl_SetObjResult(interp, resultObj);
  return TCL_OK;
}

/*
objectInfoMethod slotobjects NsfObjInfoSlotobjectsMethod {
  {-argName "-type" -required 0 -nrargs 1 -type class}
  {-argName "pattern" -required 0}
}
*/
static int
NsfObjInfoSlotobjectsMethod(Tcl_Interp *interp, NsfObject *object,
                      NsfClass *typeClass, const char *pattern) {
  Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  AddSlotObjects(interp, object, "::per-object-slot", NULL,
                 typeClass, pattern, listObj);

  Tcl_SetObjResult(interp, listObj);
  return TCL_OK;
}


/*
objectInfoMethod vars NsfObjInfoVarsMethod {
  {-argName "pattern" -required 0}
}
*/
static int
NsfObjInfoVarsMethod(Tcl_Interp *interp, NsfObject *object, const char *pattern) {
  Tcl_Obj         *okList;
  TclVarHashTable *varTablePtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  okList = Tcl_NewListObj(0, NULL);

  varTablePtr = (object->nsPtr != NULL) ?
    Tcl_Namespace_varTablePtr(object->nsPtr) :
    object->varTablePtr;

  /*
   * It is possible, that both, object->nsPtr and object->varTablePtr are
   * NULL.
   */
  if (likely(varTablePtr != NULL)) {
    Tcl_Obj  *varList, *element;
    int       i, length;

    ListVarKeys(interp, TclVarHashTablePtr(varTablePtr), pattern);
    varList = Tcl_GetObjResult(interp);

    Tcl_ListObjLength(interp, varList, &length);
    for (i = 0; i < length; i++) {
      Tcl_ListObjIndex(interp, varList, i, &element);
      if (VarExists(interp, object, ObjStr(element), NULL, NSF_VAR_REQUIRE_DEFINED)) {
        Tcl_ListObjAppendElement(interp, okList, element);
      } else {
        /*fprintf(stderr, "must ignore '%s' %d\n", ObjStr(element), i);*/
        /*Tcl_ListObjReplace(interp, varList, i, 1, 0, NULL);*/
      }
    }
  }

  Tcl_SetObjResult(interp, okList);
  return TCL_OK;
}
/***********************************************************************
 * End Object Info Methods
 ***********************************************************************/

/***********************************************************************
 * Begin Class Info methods
 ***********************************************************************/

/*
classInfoMethod filterguard NsfClassInfoFilterguardMethod {
  {-argName "filter" -required 1}
  }
*/
static int
NsfClassInfoFilterguardMethod(Tcl_Interp *interp, NsfClass *class, const char *filter) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(filter != NULL);

  return (class->opt != NULL) ? GuardList(interp, class->opt->classFilters, filter) : TCL_OK;
}

/*
classInfoMethod filters NsfClassInfoFiltersMethod {
  {-argName "-guards" -nrargs 0 -type switch}
  {-argName "pattern"}
}
*/
static int
NsfClassInfoFiltersMethod(Tcl_Interp *interp, NsfClass *class,
                          int withGuards, const char *pattern) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  return (class->opt != NULL) ?
    FilterInfo(interp, class->opt->classFilters, pattern, (withGuards == 1), NSF_FALSE) : TCL_OK;
}

/*
classInfoMethod forward NsfClassInfoForwardMethod {
  {-argName "-definition"}
  {-argName "pattern"}
}
*/
static int
NsfClassInfoForwardMethod(Tcl_Interp *interp, NsfClass *class,
                          int withDefinition, const char *pattern) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  return ListForward(interp, Tcl_Namespace_cmdTablePtr(class->nsPtr), pattern, withDefinition);
}

/*
classInfoMethod heritage NsfClassInfoHeritageMethod {
  {-argName "pattern"}
}
*/
static int
NsfClassInfoHeritageMethod(Tcl_Interp *interp, NsfClass *class, const char *pattern) {
  NsfClasses *pl, *intrinsic, *checkList = NULL, *mixinClasses = NULL;
  Tcl_Obj *resultObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  resultObj = Tcl_NewObj();
  intrinsic = PrecedenceOrder(class);

  NsfClassListAddPerClassMixins(interp, class, &mixinClasses, &checkList);
  for (pl = mixinClasses; pl != NULL; pl = pl->nextPtr) {
    if (NsfClassListFind(pl->nextPtr, pl->cl) == NULL &&
        NsfClassListFind(intrinsic, pl->cl) == NULL) {
      AppendMatchingElement(interp, resultObj, pl->cl->object.cmdName, pattern);
    }
  }

  if (intrinsic != NULL) {
    for (pl = intrinsic->nextPtr; pl != NULL; pl = pl->nextPtr) {
      AppendMatchingElement(interp, resultObj, pl->cl->object.cmdName, pattern);
    }
  }

  if (mixinClasses != NULL) {
    NsfClassListFree(mixinClasses);
  }
  if (checkList != NULL) {
    NsfClassListFree(checkList);
  }

  Tcl_SetObjResult(interp, resultObj);
  return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * InstancesFromClassList --
 *
 *      Collect all instances of the classes of the provided class list in the
 *      returned result object.
 *
 * Results:
 *      Tcl_Obj containing a list of instances or a single instance
 *
 * Side effects:
 *      Updated resultObj.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *InstancesFromClassList(
    Tcl_Interp *interp, NsfClasses *subClasses,
    const char *pattern, NsfObject *matchObject
) nonnull(1) nonnull(2) returns_nonnull;

static Tcl_Obj *
InstancesFromClassList(
    Tcl_Interp *interp, NsfClasses *subClasses,
    const char *pattern, NsfObject *matchObject
) {
  Tcl_Obj *resultObj = Tcl_NewObj();

  nonnull_assert(interp != NULL);
  nonnull_assert(subClasses != NULL);

  do {
    Tcl_HashTable *tablePtr = &subClasses->cl->instances;
    const Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&search)) {
      NsfObject *inst = (NsfObject *) Tcl_GetHashKey(tablePtr, hPtr);

      if (matchObject != NULL && inst == matchObject) {
        Tcl_SetStringObj(resultObj, ObjStr(matchObject->cmdName), -1);
        return resultObj;
      }
      AppendMatchingElement(interp, resultObj, inst->cmdName, pattern);
    }
    subClasses = subClasses->nextPtr;
  } while (subClasses != NULL);

  return resultObj;
}

/*
classInfoMethod instances NsfClassInfoInstancesMethod {
  {-argName "-closure" -nrargs 0}
  {-argName "pattern" -type objpattern}
}
*/
static int
NsfClassInfoInstancesMethod(
    Tcl_Interp *interp, NsfClass *class,
    int withClosure, const char *patternString,
    NsfObject *patternObject
) {
  NsfClasses clElement, *subClasses;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  if (withClosure != 0) {
    subClasses = TransitiveSubClasses(class);
  } else {
    subClasses = &clElement;
    clElement.cl = class;
    clElement.nextPtr = NULL;
  }

  Tcl_SetObjResult(interp, InstancesFromClassList(interp, subClasses, patternString, patternObject));

  if (withClosure != 0) {
    NsfClassListFree(subClasses);
  }

  return TCL_OK;
}

/*
classInfoMethod method NsfClassInfoMethodMethod {
  {-argName "infomethodsubcmd" -type "args|body|definition|exists|registrationhandle|definitionhandle|origin|parameter|syntax|type|precondition|postcondition|submethods|returns"}
  {-argName "name" -required 1 -type tclobj}
}
*/
static int
NsfClassInfoMethodMethod(
    Tcl_Interp *interp, NsfClass *class,
    InfomethodsubcmdIdx_t subcmd, Tcl_Obj *nameObj
) {
  return ListMethodResolve(interp, subcmd, NULL, NULL, class->nsPtr, &class->object, nameObj, NSF_TRUE);
}

/*
classInfoMethod methods NsfClassInfoMethodsMethod {
  {-argName "-callprotection" -type "all|public|protected|private" -default all}
  {-argName "-closure" -nrargs 0}
  {-argName "-type" -typeName "methodtype" -nrargs 1 -type "all|scripted|builtin|alias|forwarder|object|setter"}
  {-argName "-path" -nrargs 0}
  {-argName "-source" -nrargs 1 -type "all|application|system"}
  {-argName "pattern"}
}
*/
static int
NsfClassInfoMethodsMethod(
    Tcl_Interp *interp, NsfClass *class,
    CallprotectionIdx_t withCallprotection,
    int withClosure,
    MethodtypeIdx_t withType,
    int withPath,
    DefinitionsourceIdx_t withSource,
    const char *pattern
) {
  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  if (withClosure != 0) {
    NsfClasses *checkList = NULL, *mixinClasses = NULL;
    Tcl_HashTable dupsTable, *dups = &dupsTable;
    int result;

#if 0
    if (withCallprotection == CallprotectionNULL) {
      withCallprotection = CallprotectionPublicIdx;
    }
#endif
    if (withSource == DefinitionsourceNULL) {
      withSource = DefinitionsourceAllIdx;
    }

    Tcl_InitHashTable(dups, TCL_STRING_KEYS);
    /*
     * Guards are ignored.
     */
    NsfClassListAddPerClassMixins(interp, class, &mixinClasses, &checkList);
    (void) ListMethodKeysClassList(interp, mixinClasses,
                                   withSource, pattern,
                                   AggregatedMethodType(withType), withCallprotection,
                                   withPath, dups, &class->object, NSF_FALSE);
    if (checkList != NULL) {
      NsfClassListFree(checkList);
    }
    if (mixinClasses != NULL) {
      NsfClassListFree(mixinClasses);
    }

    result = ListMethodKeysClassList(interp, PrecedenceOrder(class),
                                     withSource, pattern,
                                     AggregatedMethodType(withType), withCallprotection,
                                     withPath, dups, &class->object, NSF_FALSE);

    Tcl_DeleteHashTable(dups);
    return result;
  } else {
    if (withSource != 0) {
      return NsfPrintError(interp, "-source cannot be used without -closure\n");
    }
    return ListDefinedMethods(interp, &class->object, pattern, 0 /* per-object */,
                              AggregatedMethodType(withType), withCallprotection,
                              withPath);
  }
}

/*
classInfoMethod mixins NsfClassInfoMixinsMethod {
  {-argName "-closure" -nrargs 0 -type switch}
  {-argName "-guards" -nrargs 0 -type switch}
  {-argName "-heritage" -nrargs 0 -type switch}
  {-argName "pattern" -type objpattern}
}
*/
static int
NsfClassInfoMixinsMethod(
    Tcl_Interp *interp, NsfClass *class,
    int withClosure, int withGuards, int withHeritage,
    const char *patternString, NsfObject *patternObject
) {
  NsfClassOpt *opt;
  Tcl_Obj *resultObj;
  int result = TCL_OK;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  opt = class->opt;
  Tcl_ResetResult(interp);
  resultObj = Tcl_GetObjResult(interp);

  if (withHeritage != 0) {
    NsfClasses *checkList = NULL, *mixinClasses = NULL, *clPtr;

    if (withGuards != 0) {
      return NsfPrintError(interp, "-guards cannot be used together with -heritage\n");
    }

    NsfClassListAddPerClassMixins(interp, class, &mixinClasses, &checkList);
    for (clPtr = mixinClasses; clPtr != NULL; clPtr = clPtr->nextPtr) {
      if (NsfClassListFind(clPtr->nextPtr, clPtr->cl)) {
        continue;
      }
      AppendMatchingElement(interp, resultObj, clPtr->cl->object.cmdName, patternString);
    }

    if (checkList != NULL) {
      NsfClassListFree(checkList);
    }
    if (mixinClasses != NULL) {
      NsfClassListFree(mixinClasses);
    }

  } else if (withClosure != 0) {
    Tcl_HashTable objTable, *commandTable = &objTable;
    bool          done;

    MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable);
    Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS);
    done = GetAllClassMixins(interp, commandTable, resultObj,
                             class, (withGuards == 1),
                             patternString, patternObject);
    if (patternObject != NULL && done && !withGuards) {
      Tcl_SetObjResult(interp, patternObject->cmdName);
    }
    Tcl_DeleteHashTable(commandTable);
    MEM_COUNT_FREE("Tcl_InitHashTable", commandTable);

  } else {
    result = (opt != NULL) ?
      MixinInfo(interp, opt->classMixins, patternString, (withGuards == 1), patternObject) : TCL_OK;
  }

  return result;
}

/*
classInfoMethod mixinguard NsfClassInfoMixinguardMethod {
  {-argName "mixin"  -required 1}
}
*/
static int
NsfClassInfoMixinguardMethod(Tcl_Interp *interp, NsfClass *class, const char *mixin) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);
  nonnull_assert(mixin != NULL);

  return (class->opt != NULL) ? GuardList(interp, class->opt->classMixins, mixin) : TCL_OK;
}

/*
classInfoMethod mixinof  NsfClassInfoMixinOfMethod {
  {-argName "-closure" -nrargs 0}
  {-argName "-scope" -required 0 -nrargs 1 -type "all|class|object"}
  {-argName "pattern" -type objpattern}
}
*/
static int
NsfClassInfoMixinOfMethod(
    Tcl_Interp *interp, NsfClass *class,
    int withClosure,
    MixinscopeIdx_t withScope,
    const char *patternString,
    NsfObject *patternObject
) {
  NsfClassOpt *opt;
  bool         perClass, perObject, done = NSF_FALSE;
  Tcl_Obj     *resultObj;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  opt = class->opt;
  Tcl_ResetResult(interp);
  resultObj = Tcl_GetObjResult(interp);

  if (withScope == MixinscopeNULL || withScope == MixinscopeAllIdx) {
    perClass  = NSF_TRUE;
    perObject = NSF_TRUE;
  } else if (withScope == MixinscopeClassIdx) {
    perClass  = NSF_TRUE;
    perObject = NSF_FALSE;
  } else {
    perClass  = NSF_FALSE;
    perObject = NSF_TRUE;
  }

  if (opt != NULL && !withClosure) {
    if (perClass && opt->isClassMixinOf != NULL) {
      done = AppendMatchingElementsFromCmdList(interp, opt->isClassMixinOf, resultObj,
                                             patternString, patternObject);
      if (done && (patternObject != NULL)) {
        goto finished;
      }
    }
    if (perObject && opt->isObjectMixinOf) {
      done = AppendMatchingElementsFromCmdList(interp, opt->isObjectMixinOf, resultObj,
                                               patternString, patternObject);
    }
  } else if (withClosure != 0) {
    Tcl_HashTable objTable, *commandTable = &objTable;

    MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable);
    Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS);
    if (perClass) {
      done = GetAllClassMixinsOf(interp, commandTable, resultObj,
                                 class, NSF_FALSE, NSF_TRUE, patternString, patternObject);
      if (done && (patternObject != NULL)) {
        goto finished;
      }
    }
    if (perObject) {
      done = GetAllObjectMixinsOf(interp, commandTable, resultObj,
                                  class, NSF_FALSE, NSF_TRUE, patternString, patternObject);
    }
    Tcl_DeleteHashTable(commandTable);
    MEM_COUNT_FREE("Tcl_InitHashTable", commandTable);
  }

 finished:
  if (patternObject != NULL) {
    Tcl_SetObjResult(interp, done ? patternObject->cmdName : NsfGlobalObjs[NSF_EMPTY]);
  } else {
    Tcl_SetObjResult(interp, resultObj);
  }
  return TCL_OK;
}

/*
classInfoMethod slots NsfClassInfoSlotobjectsMethod {
  {-argName "-closure" -nrargs 0}
  {-argName "-source" -nrargs 1 -type "all|application|system"}
  {-argName "-type" -required 0 -nrargs 1 -type class}
  {-argName "pattern" -required 0}
}
*/
static int
NsfClassInfoSlotobjectsMethod(Tcl_Interp *interp,
                              NsfClass *class,
                              int withClosure,
                              DefinitionsourceIdx_t withSource,
                              NsfClass *typeClass,
                              const char *pattern) {
  NsfClasses    *clPtr, *intrinsicClasses, *precedenceList = NULL;
  Tcl_Obj       *listObj = Tcl_NewListObj(0, NULL);
  Tcl_HashTable  slotTable;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  Tcl_ResetResult(interp);
  intrinsicClasses = PrecedenceOrder(class);

  if (withClosure != 0) {
    NsfClasses *checkList = NULL, *mixinClasses = NULL;
    /*
     * Compute the closure: first the transitive mixin-classes...
     */
    NsfClassListAddPerClassMixins(interp, class, &mixinClasses, &checkList);
    for (clPtr = mixinClasses; clPtr != NULL; clPtr = clPtr->nextPtr) {
      if (NsfClassListFind(clPtr->nextPtr, clPtr->cl) == NULL &&
          NsfClassListFind(intrinsicClasses, clPtr->cl) == NULL) {
        NsfClassListAdd(&precedenceList, clPtr->cl, NULL);
      }
    }
    /*
     * ... followed by the intrinsic classes.
     */
    NsfClassListAdd(&precedenceList, class, NULL);
    for (clPtr = intrinsicClasses->nextPtr; clPtr != NULL; clPtr = clPtr->nextPtr) {
      NsfClassListAdd(&precedenceList, clPtr->cl, NULL);
    }
    if (checkList != NULL) {
      NsfClassListFree(checkList);
    }
    if (mixinClasses != NULL) {
      NsfClassListFree(mixinClasses);
    }

  } else {
    NsfClassListAdd(&precedenceList, class, NULL);
  }
  /* NsfClassListPrint("precedence", precedenceList); */
  if (withSource == 0) {
    withSource = 1;
  }

  /*
   * Use a hash-table to eliminate potential duplicates.
   */
  Tcl_InitHashTable(&slotTable, TCL_STRING_KEYS);
  MEM_COUNT_ALLOC("Tcl_InitHashTable", &slotTable);

  for (clPtr = precedenceList; clPtr != NULL; clPtr = clPtr->nextPtr) {
    if (MethodSourceMatches(withSource, clPtr->cl, NULL)) {
      AddSlotObjects(interp, &clPtr->cl->object, "::slot", &slotTable,
                     typeClass, pattern, listObj);
    }
  }

  Tcl_DeleteHashTable(&slotTable);
  MEM_COUNT_FREE("Tcl_InitHashTable", &slotTable);

  if (precedenceList != NULL) {
    NsfClassListFree(precedenceList);
  }
  Tcl_SetObjResult(interp, listObj);

  return TCL_OK;
}


/*
classInfoMethod subclass NsfClassInfoSubclassMethod {
  {-argName "-closure" -nrargs 0 -type switch}
  {-argName "-dependent" -nrargs 0 -type switch}
  {-argName "pattern" -type objpattern}
}
*/
static int
NsfClassInfoSubclassMethod(Tcl_Interp *interp, NsfClass *class,
                           int withClosure, int withDependent,
                           const char *patternString, NsfObject *patternObject) {
  bool found = NSF_FALSE;

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  if (withClosure && withDependent) {
    return NsfPrintError(interp, "only -closure or -dependent can be specified, not both");
  }

  if (withClosure || withDependent) {
    NsfClasses *subClasses = (withClosure != 0) ? TransitiveSubClasses(class) : DependentSubClasses(class);

    if (subClasses != NULL) {
      found = AppendMatchingElementsFromClasses(interp, subClasses, patternString, patternObject);
      NsfClassListFree(subClasses);
    }
  } else if (class->sub != NULL) {
    found = AppendMatchingElementsFromClasses(interp, class->sub, patternString, patternObject);
  }

  if (patternObject != NULL) {
    Tcl_SetObjResult(interp, found ? patternObject->cmdName : NsfGlobalObjs[NSF_EMPTY]);
  }

  return TCL_OK;
}

/*
classInfoMethod superclass NsfClassInfoSuperclassMethod {
  {-argName "-closure" -nrargs 0}
  {-argName "pattern" -type tclobj}
}
*/
static int
NsfClassInfoSuperclassMethod(Tcl_Interp *interp, NsfClass *class, int withClosure, Tcl_Obj *patternObj) {

  nonnull_assert(interp != NULL);
  nonnull_assert(class != NULL);

  return ListSuperClasses(interp, class, patternObj, (withClosure == 1));
}

/***********************************************************************
 * End Class Info methods
 ***********************************************************************/

/*
 * Initialization and Exit handlers
 */

#ifdef DO_FULL_CLEANUP
/*
 * Delete global variables and procs.
 */
static void DeleteProcsAndVars(
    Tcl_Interp *interp, Tcl_Namespace *nsPtr, bool withKeepvars
) nonnull(1) nonnull(2);

static void
DeleteProcsAndVars(
    Tcl_Interp *interp, Tcl_Namespace *nsPtr, bool withKeepvars
) {
  Tcl_HashTable *varTablePtr, *cmdTablePtr, *childTablePtr;
  Tcl_HashSearch search;
  Tcl_Command cmd;
  register Tcl_HashEntry *entryPtr;

  nonnull_assert(interp != NULL);
  nonnull_assert(nsPtr != NULL);

  /* fprintf(stderr, "DeleteProcsAndVars in %s\n", nsPtr->fullName); */

  varTablePtr = (Tcl_HashTable *)Tcl_Namespace_varTablePtr(nsPtr);
  cmdTablePtr = Tcl_Namespace_cmdTablePtr(nsPtr);
  childTablePtr = Tcl_Namespace_childTablePtr(nsPtr);

  /*
   * Deleting the procs and vars in the child namespaces does not seem to be
   * necessary, but we do it anyway.
   */
  for (entryPtr = Tcl_FirstHashEntry(childTablePtr, &search);
       entryPtr != NULL;
       entryPtr = Tcl_NextHashEntry(&search)) {
    Tcl_Namespace *childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
    DeleteProcsAndVars(interp, childNsPtr, withKeepvars);
  }

  if (!withKeepvars) {
    for (entryPtr = Tcl_FirstHashEntry(varTablePtr, &search);
         entryPtr != NULL;
         entryPtr = Tcl_NextHashEntry(&search)) {
      Tcl_Obj *nameObj;
      Var *varPtr;

      GetVarAndNameFromHash(entryPtr, &varPtr, &nameObj);
      if (!TclIsVarUndefined(varPtr) || TclIsVarNamespaceVar(varPtr)) {
        /* fprintf(stderr, "unsetting var %s\n", ObjStr(nameObj));*/
        Tcl_UnsetVar2(interp, ObjStr(nameObj), (char *)NULL, TCL_GLOBAL_ONLY);
      }
    }
  }

  for (entryPtr = Tcl_FirstHashEntry(cmdTablePtr, &search);
       entryPtr != NULL;
       entryPtr = Tcl_NextHashEntry(&search)) {
    cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);

    if (Tcl_Command_objProc(cmd) == RUNTIME_STATE(interp)->objInterpProc) {
      /*fprintf(stderr, "cmdname = %s cmd %p proc %p objProc %p %d\n",
        Tcl_GetHashKey(cmdTablePtr, entryPtr), cmd, Tcl_Command_proc(cmd), Tcl_Command_objProc(cmd),
        Tcl_Command_proc(cmd)==RUNTIME_STATE(interp)->objInterpProc);*/

      Tcl_DeleteCommandFromToken(interp, cmd);
    }
  }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * FinalObjectDeletion --
 *
 *      The method is to be called, when an object is finally deleted,
 *      which happens typically during the final cleanup. It tests as
 *      well the activation count of the object.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletion of the objects.
 *
 *----------------------------------------------------------------------
 */
static void
FinalObjectDeletion(
    Tcl_Interp *interp, NsfObject *object
) {

  nonnull_assert(interp != NULL);
  nonnull_assert(object != NULL);

  /*
   * If a call to exit happens from a higher stack frame, the object
   * refCount might not be decremented correctly. If we are in the
   * physical destroy round, we can set the counter to an appropriate
   * value to ensure deletion.
   */
#if defined(NSF_DEVELOPMENT_TEST)
  if (unlikely(object->refCount != 1)) {
    if (object->refCount > 1) {
      NsfLog(interp, NSF_LOG_WARN,  "RefCount for obj %p %d (name %s) > 1",
             (void *)object, object->refCount, ObjectName_(object));
    } else {
      NsfLog(interp, NSF_LOG_WARN,  "Refcount for obj %p %d > 1",
             (void *)object, object->refCount);
    }
    /*object->refCount = 1;*/
  }
#endif

#if !defined(NDEBUG)
  if (RUNTIME_STATE(interp)->exitHandlerDestroyRound != NSF_EXITHANDLER_ON_PHYSICAL_DESTROY) {
    assert(object->activationCount == 0);
  } else if (object->activationCount != 0) {
    NsfLog(interp, NSF_LOG_WARN, "FinalObjectDeletion obj %p activationcount %d\n",
           (void *)object, object->activationCount);
  }
#endif

  if (likely(object->id != NULL)) {
    /*fprintf(stderr, "  ... cmd dealloc %p final delete refCount %d\n",
      object->id, Tcl_Command_refCount(object->id));*/

    if (NSF_DTRACE_OBJECT_FREE_ENABLED()) {
      NSF_DTRACE_OBJECT_FREE(ObjectName(object), ClassName(object->cl));
    }

    Tcl_DeleteCommandFromToken(interp, object->id);
  }
}

#ifdef DO_CLEANUP
/*
 *----------------------------------------------------------------------
 *
 * DeleteNsfProcs --
 *
 *      Delete all nsfprocs in the namespaces rooted by the second
 *      argument. If the provided nsPtr is NULL, the global namespace is
 *      used as root of the namespace tree. The function is necessary to
 *      trigger the freeing of the parameter definitions.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletion of nsfprocs.
 *
 *----------------------------------------------------------------------
 */
static void DeleteNsfProcs(
    Tcl_Interp *interp, Tcl_Namespace *nsPtr
) nonnull(1);

static void
DeleteNsfProcs(
    Tcl_Interp *interp, Tcl_Namespace *nsPtr
) {
  Tcl_HashTable *cmdTablePtr, *childTablePtr;
  register Tcl_HashEntry *entryPtr;
  Tcl_HashSearch search;

  nonnull_assert(interp != NULL);

  if (nsPtr == NULL) {
    nsPtr = Tcl_GetGlobalNamespace(interp);
  }

  nonnull_assert(nsPtr != NULL);
  /*fprintf(stderr, "### DeleteNsfProcs current namespace '%s'\n", (nsPtr != NULL) ? nsPtr->fullName : "NULL");*/

  cmdTablePtr = Tcl_Namespace_cmdTablePtr(nsPtr);
  childTablePtr = Tcl_Namespace_childTablePtr(nsPtr);

  for (entryPtr = Tcl_FirstHashEntry(cmdTablePtr, &search);
       entryPtr != NULL;
       entryPtr = Tcl_NextHashEntry(&search)) {
    Tcl_Command cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);

    if (Tcl_Command_objProc(cmd) == NsfProcStub) {
      /*fprintf(stderr, "cmdname = %s cmd %p\n",
        Tcl_GetHashKey(cmdTablePtr, entryPtr), cmd);*/
      Tcl_DeleteCommandFromToken(interp, cmd);
    }
  }
  for (entryPtr = Tcl_FirstHashEntry(childTablePtr, &search);
       entryPtr != NULL;
       entryPtr = Tcl_NextHashEntry(&search)) {
    Tcl_Namespace *childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);

    DeleteNsfProcs(interp, childNsPtr);
  }
}

/*
 *----------------------------------------------------------------------
 *
 * ClassHasSubclasses --
 *
 *      Check, whether the given class has subclasses.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool ClassHasSubclasses(
    const NsfClass *class
) nonnull(1) NSF_pure;

static bool
ClassHasSubclasses(
    const NsfClass *class
) {
  nonnull_assert(class != NULL);

  return (class->sub != NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * ClassHasInstances --
 *
 *      Check, whether the given class has instances.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool ClassHasInstances(
    NsfClass *class
) nonnull(1) NSF_pure;

static bool
ClassHasInstances(
    NsfClass *class
) {
  Tcl_HashSearch hSrch;

  nonnull_assert(class != NULL);

  return (Tcl_FirstHashEntry(&class->instances, &hSrch) != NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * ObjectHasChildren --
 *
 *      Check, whether the given object has children.
 *
 * Results:
 *      A Boolean value.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static bool ObjectHasChildren(
    const NsfObject *object
) nonnull(1) NSF_pure;

static bool
ObjectHasChildren(
    const NsfObject *object
) {
  const Tcl_Namespace *ns;
  bool                 result = NSF_FALSE;

  nonnull_assert(object != NULL);

  ns = object->nsPtr;
  if (ns != NULL) {
    const Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSrch;
    Tcl_HashTable *cmdTablePtr = Tcl_Namespace_cmdTablePtr(ns);

    for (hPtr = Tcl_FirstHashEntry(cmdTablePtr, &hSrch);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&hSrch)) {
      Tcl_Command cmd = Tcl_GetHashValue(hPtr);
      const NsfObject *childObject = NsfGetObjectFromCmdPtr(cmd);

      if (childObject != NULL) {
        result = NSF_TRUE;
        break;
      }
    }
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeAllNsfObjectsAndClasses --
 *
 *      Destroy and free all objects and classes defined in the interp.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Freeing memory.
 *
 *----------------------------------------------------------------------
 */
static void FreeAllNsfObjectsAndClasses(
    Tcl_Interp *interp, NsfCmdList **instances
) nonnull(1) nonnull(2);

static void
FreeAllNsfObjectsAndClasses(
    Tcl_Interp *interp, NsfCmdList **instances
) {
  NsfCmdList *entry, *lastEntry;
  int nrDeleted = 0;

  nonnull_assert(interp != NULL);
  nonnull_assert(instances != NULL);

  /*fprintf(stderr, "FreeAllNsfObjectsAndClasses in %p\n", interp);*/

  RUNTIME_STATE(interp)->exitHandlerDestroyRound = NSF_EXITHANDLER_ON_PHYSICAL_DESTROY;

  /*
   * First delete all child commands of all objects, which are not
   * objects themselves. This will for example delete namespace
   * imported commands and objects and will resolve potential loops in
   * the dependency graph. The result is a plain object/class tree.
   */

  for (entry = *instances; entry != NULL; entry = entry->nextPtr) {
    NsfObject *object = (NsfObject *)entry->clorobj;

    /*
     * Delete per-object methods.
     */
    if (object != NULL && object->nsPtr != NULL) {
      const Tcl_HashEntry *hPtr;
      Tcl_HashSearch hSrch;

      for (hPtr = Tcl_FirstHashEntry(Tcl_Namespace_cmdTablePtr(object->nsPtr), &hSrch);
           hPtr != NULL;
           hPtr = Tcl_NextHashEntry(&hSrch)) {
        Tcl_Command cmd = Tcl_GetHashValue(hPtr);

        if (cmd != NULL) {
          if (CmdIsNsfObject(cmd)) {
            AliasDeleteObjectReference(interp, cmd);
            continue;
          }
          Tcl_DeleteCommandFromToken(interp, cmd);
          nrDeleted ++;
        }
      }
    }

    /*
     * Delete class methods; these methods might have aliases (dependencies) to
     * objects, which will be resolved this way.
     */
    if (object != NULL && NsfObjectIsClass(object)) {
      const Tcl_HashEntry *hPtr;
      Tcl_HashSearch hSrch;

      for (hPtr = Tcl_FirstHashEntry(Tcl_Namespace_cmdTablePtr(((NsfClass *)object)->nsPtr),
                                      &hSrch);
           hPtr != NULL;
           hPtr = Tcl_NextHashEntry(&hSrch)) {
        Tcl_Command cmd = Tcl_GetHashValue(hPtr);

        if ((cmd != NULL) && CmdIsNsfObject(cmd)) {
          AliasDeleteObjectReference(interp, cmd);
          continue;
        }
      }
    }
  }

  /*fprintf(stderr, "deleted %d cmds\n", nrDeleted);*/

  /*
   * Finally delete the object/class tree in a bottom up manner,
   * deleting all objects without dependencies first. Finally, only
   * the root-classes of the object system will remain, which are
   * deleted separately.
   */

  while (1) {
    /*
     * Delete all plain objects without dependencies.
     */
    nrDeleted = 0;
    for (entry = *instances, lastEntry = NULL;
         entry != NULL;
         lastEntry = entry, entry = entry->nextPtr) {
      NsfObject *object = (NsfObject *)entry->clorobj;

      /*
       * The list of the instances should contain only alive objects, without
       * duplicates. We would recognize duplicates since a deletion of one
       * object would trigger the CMD_IS_DELETED flag of the cmdPtr of the
       * duplicate.
       */
      assert(((unsigned int)Tcl_Command_flags(entry->cmdPtr) & CMD_IS_DELETED) == 0u);

      if (object != NULL && !NsfObjectIsClass(object) && !ObjectHasChildren(object)) {
        /*fprintf(stderr, "check %p obj->flags %.6x cmd %p deleted %d\n",
                object, object->flags, entry->cmdPtr,
                Tcl_Command_flags(entry->cmdPtr) & CMD_IS_DELETED); */
        assert(object->id != NULL);
        /*fprintf(stderr, "  ... delete object %s %p, class=%s id %p ns %p\n",
          ObjectName(object), object,
          ClassName(object->cl), object->id, object->nsPtr);*/

        FreeUnsetTraceVariable(interp, object);
        FinalObjectDeletion(interp, object);

        if (entry == *instances) {
          *instances = entry->nextPtr;
          CmdListDeleteCmdListEntry(entry, NULL);
          entry = *instances;
        } else {
          lastEntry->nextPtr = entry->nextPtr;
          CmdListDeleteCmdListEntry(entry, NULL);
          entry = lastEntry;
        }
        assert(entry != NULL);

        nrDeleted++;
      }
    }
    /*fprintf(stderr, "deleted %d Objects without dependencies\n", nrDeleted);*/

    if (nrDeleted > 0) {
      continue;
    }

    /*
     * Delete all classes without dependencies.
     */
    for (entry = *instances, lastEntry = NULL;
         entry != NULL;
         (entry != NULL ? (lastEntry = entry, entry = entry->nextPtr) : NULL)) {
      NsfClass *class = entry->clorobj;

      assert(class != NULL);

      if (!NsfObjectIsClass(&class->object)) {
        continue;
      }

      /*fprintf(stderr, "### cl key = %s %p\n", ClassName(class), class); */

      /*
       * Remove manually mixinRegObjs to achieve correct deletion
       * order. Otherwise, refcount checking for NsfObjects complains during
       * shutdown (and dangling references would be a consequence).
       */
      if (class->opt != NULL && class->opt->mixinRegObjs != NULL) {
        NsfMixinregInvalidate(interp, class->opt->mixinRegObjs);
        DECR_REF_COUNT2("mixinRegObjs", class->opt->mixinRegObjs);
        class->opt->mixinRegObjs = NULL;
      }

      if (!ObjectHasChildren((NsfObject *)class)
          && !ClassHasInstances(class)
          && !ClassHasSubclasses(class)
          && !IsBaseClass(&class->object)
          ) {
        /*fprintf(stderr, "  ... delete class %s %p\n", ClassName(class), class); */
        assert(class->object.id);

        FreeUnsetTraceVariable(interp, &class->object);
        FinalObjectDeletion(interp, &class->object);

        if (entry == *instances) {
          *instances = entry->nextPtr;
          /*fprintf(stderr, "... delete first entry %p\n", entry);*/
          CmdListDeleteCmdListEntry(entry, NULL);
          entry = *instances;
        } else {
          /*fprintf(stderr, "... delete entry %p\n", entry);*/
          lastEntry->nextPtr = entry->nextPtr;
          CmdListDeleteCmdListEntry(entry, NULL);
          entry = lastEntry;
        }

        nrDeleted++;
      }
    }

    /*fprintf(stderr, "deleted %d Classes\n", nrDeleted);*/

    if (nrDeleted == 0) {
      int nrReclassed = 0;

      /*
       * Final check. If there are no cyclical dependencies, we should have
       * now just the base classes left. If this is not the case, reclass
       * the remaining objects to their base classes, and set the superClasses
       * to the most general superclass.
       */
      for (entry = *instances;
           entry != NULL;
           entry = entry->nextPtr) {
        NsfObject       *object = (NsfObject *)entry->clorobj;
        NsfClass        *baseClass;
        NsfObjectSystem *osPtr;

        if (NsfObjectIsClass(object) && IsBaseClass(object)) {
          continue;
        }

        osPtr = GetObjectSystem(object);

        /*
         * For classes, check the superclass hierarchy.
         */
        if (NsfObjectIsClass(object)) {
          NsfClass   *cl = (NsfClass *)object;
          NsfClasses *sc;

          for (sc = cl->super; sc != NULL; sc = sc->nextPtr) {
            if (sc->cl != osPtr->rootClass) {
              Tcl_Obj *objectName = osPtr->rootClass->object.cmdName;

              SuperclassAdd(interp, cl, 1, &objectName, objectName);
              nrReclassed ++;
              break;
            }
          }
        }

        /*
         * In all cases, straighten the class to the base case.
         */
        baseClass = NsfObjectIsClass(object) ? osPtr->rootMetaClass : osPtr->rootClass;
        if (object->cl != baseClass) {
          ChangeClass(interp, object, baseClass);
          nrReclassed ++;
        }
      }
      /*fprintf(stderr, "We have reclassed %d objects\n", nrReclassed);*/

      if (nrReclassed == 0) {
        break;
      }
    }
  }
}

#endif /* DO_CLEANUP */

/*
 *----------------------------------------------------------------------
 *
 * ExitHandler --
 *
 *      The exit handler is called on thread exit and application
 *      exit. It is responsible to free all resources to avoid memory
 *      leaks, especially in multi-threaded applications, when threads
 *      exit.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Freeing memory.
 *
 *----------------------------------------------------------------------
 */

static void
ExitHandler(ClientData clientData) {
  Tcl_Interp      *interp = (Tcl_Interp *)clientData;
  int              flags;
  NsfRuntimeState *rst;

  nonnull_assert(clientData != NULL);

  rst = RUNTIME_STATE(interp);
  /*fprintf(stderr, "+++ (%lx) ExitHandler interp %p deleted %d exitHandlerDestroyRound %d\n",
          (long)(void*)pthread_self(), interp, (Tcl_Interp_flags(interp) & DELETED),
          rst->exitHandlerDestroyRound);*/

  /*
   * Don't use exit handler, if the interpreter is already destroyed.
   * Call to exit handler comes after freeing namespaces, commands, etc.
   * e.g. TK calls Tcl_DeleteInterp directly, if Window is killed.
   */

  /*
   * Ahem ...
   *
   * Since we *must* be sure that our destroy methods will run
   * we must *cheat* (I mean CHEAT) here: we flip the interp
   * flag, saying, "hey boy, you're not deleted any more".
   * After our handlers are done, we restore the old state...
   * All this is needed so we can do an eval in the interp which
   * is potentially marked for delete when we start working here.
   *
   * I know, I know, this is not really elegant. But...  I'd need a
   * standard way of invoking some code at interpreter delete time
   * but JUST BEFORE the actual deletion process starts. Sadly,
   * there is no such hook in Tcl as of Tcl8.4.*, that I know of.
   *
   * So, for the rest of procedure, assume the interp is alive !
   */
  flags = Tcl_Interp_flags(interp);
  Tcl_Interp_flags(interp) &= ~DELETED;

  CallStackPopAll(interp);

#if defined(NSF_MEM_COUNT)
  /* The Tcl history list (which internally stores commands and scripts in the
   * array ::tcl::history) can retain Tcl_Obj references beyond the scope of
   * our shutdown procedures (::nsf::finalize, ExitHandler). Therefore, on
   * MEM_COUNT_RELEASE(), we might see unbalanced refcounts which are false
   * positives. Therefore, we aim at clearing the history list at this point.
   *
   * See also Tcl bug report 1ae12987cb.
  */

  if (unlikely(Tcl_Eval(interp, "::history clear") != TCL_OK)) {
    NsfLog(interp, NSF_LOG_WARN, "Clearing the Tcl history list failed! "
           "Memcounts could be reported as unbalanced on MEM_COUNT_RELEASE(). "
           "Error: %s\n",
           ObjStr(Tcl_GetObjResult(interp)));
  }
#endif

  if (rst->exitHandlerDestroyRound == NSF_EXITHANDLER_OFF) {
    NsfFinalizeCmd(interp, NSF_FALSE);
  }

  /*
   * Must be before freeing of NsfGlobalObjs.
   */
  NsfShadowTclCommands(interp, SHADOW_UNLOAD);

  MEM_COUNT_FREE("Tcl_InitHashTable", &rst->activeFilterTablePtr);
  Tcl_DeleteHashTable(&rst->activeFilterTablePtr);

  /*
   * Free "global" (per main interp) objects.
   */
  {
    int i;

    for (i = 0; i < nr_elements(NsfGlobalStrings); i++) {
      DECR_REF_COUNT(NsfGlobalObjs[i]);
    }
  }
  NsfStringIncrFree(&rst->iss);

  /*
   * Free all data in the hash tables managing pointer converters,
   * enumerations, and method definitions.
   */
  Nsf_PointerExit(interp);
  Nsf_EnumerationTypeRelease();
  Nsf_CmdDefinitionRelease();

#if defined(NSF_PROFILE)
  NsfProfileFree(interp);
#endif

  FREE(Tcl_Obj**, NsfGlobalObjs);

#if defined(TCL_MEM_DEBUG)
  TclDumpMemoryInfo((ClientData) stderr, 0);
  Tcl_DumpActiveMemory("./nsfActiveMem");
  /* Tcl_Eval(interp, "puts {checkmem to checkmemFile};
     checkmem checkmemFile"); */
#endif

  /*
   * Free run time state.
   */
  /*fprintf(stderr, "+++ ExiHandler frees run time state of interp %p\n", interp);*/
  ckfree((char *) rst);
#if defined(USE_ASSOC_DATA)
  Tcl_DeleteAssocData(interp, "NsfRuntimeState");
#else
  Tcl_Interp_globalNsPtr(interp)->clientData = NULL;
#endif

#if defined(NSF_MEM_COUNT) && !defined(PRE86)
  /*
   * When raising an error, the Tcl_Objs on the error stack and in the
   * inner context are refCount-incremented. When Tcl exits, it does normally
   * not perform the according decrementing. We perform here a manual
   * decrementing and reset these lists.
   */
  {
    Interp *iPtr = (Interp *) interp;

    if (iPtr->innerContext != NULL) {
      Tcl_DecrRefCount(iPtr->errorStack);
      iPtr->errorStack = Tcl_NewListObj(0, NULL);
      Tcl_IncrRefCount(iPtr->errorStack);
      Tcl_DecrRefCount(iPtr->innerContext);
      iPtr->innerContext = Tcl_NewListObj(0, NULL);
      Tcl_IncrRefCount(iPtr->innerContext);
    }
  }
#endif

  Tcl_Interp_flags(interp) = flags;
  Tcl_Release(interp);

  MEM_COUNT_RELEASE();
}


#if defined(TCL_THREADS)
/*
 * Gets activated at thread-exit
 */

static void
Nsf_ThreadExitProc(ClientData clientData) {

  nonnull_assert(clientData != NULL);

  /*fprintf(stderr, "+++ (%lx) Nsf_ThreadExitProc %p\n", (long)(void*)pthread_self(), clientData);*/

  Tcl_DeleteThreadExitHandler(Nsf_ThreadExitProc, clientData);
  Tcl_DeleteExitHandler(Nsf_ExitProc, clientData);
  ExitHandler(clientData);
}
#endif

/*
 * Gets activated at application-exit
 */

static void
Nsf_ExitProc(ClientData clientData) {

  nonnull_assert(clientData != NULL);

  /*fprintf(stderr, "+++ (%lx) Nsf_ExitProc %p\n", (long)(void*)pthread_self(), clientData);*/
#if defined(TCL_THREADS)
  Tcl_DeleteExitHandler(Nsf_ExitProc, clientData);
  Tcl_DeleteThreadExitHandler(Nsf_ThreadExitProc, clientData);
#endif
  ExitHandler(clientData);
}

/*
 * Registers thread/application exit handlers.
 */
static void RegisterExitHandlers(ClientData clientData)
  nonnull(1);

static void
RegisterExitHandlers(ClientData clientData) {

  nonnull_assert(clientData != NULL);

  Tcl_Preserve(clientData);
#if defined(TCL_THREADS)
  Tcl_CreateThreadExitHandler(Nsf_ThreadExitProc, clientData);
#endif
  Tcl_CreateExitHandler(Nsf_ExitProc, clientData);
}

/*
 * Tcl extension initialization routine
 */

#if 0
#include <google/profiler.h>
#endif


int
Nsf_Init(
    Tcl_Interp *interp
) {
  static NsfMutex  initMutex = 0;
  ClientData       runtimeState;
  NsfRuntimeState *rst;
  int              result, i;
  Tcl_Obj         *tmpObj;
#ifdef NSF_BYTECODE
  /*NsfCompEnv *interpstructions = NsfGetCompEnv();*/
#endif
#ifdef USE_TCL_STUBS
  static int stubsInitialized = 0;
#endif

  nonnull_assert(interp != NULL);

#if 0
  ProfilerStart("profiler");
#endif

#ifdef USE_TCL_STUBS
  /*
   * Since the stub-tables are initialized globally (not per interp), we want
   * to initialize these only once.  The read operation on "stubsInitialized"
   * is a potentially dirty read. However, we can't use a mutex lock around
   * this, since Tcl_MutexLock() requires (at least on some platforms)
   * initialized stub-tables. The dirty read of stubsInitialized is not so
   * invasive as the dirty reads caused by overwriting the stub tables.
   *
   * NsfMutexLock(&stubFlagMutex);
   * ...
   * NsfMutexUnlock(&stubFlagMutex);
   */

  if (stubsInitialized == 0) {
    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
      return TCL_ERROR;
    }
# if TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
    /* Tcl_TomMath_InitStubs() not needed */
# else
    if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) {
      return TCL_ERROR;
    }
# endif
    stubsInitialized = 1;
  }
#endif

#if defined(TCL_MEM_DEBUG)
  TclDumpMemoryInfo((ClientData) stderr, 0);
#endif

  /*
   * Runtime State stored in the client data of the Interp's global namespace
   * in order to avoid global state information. All fields are per default
   * set to zero.
   */
  runtimeState = ckalloc((int)sizeof(NsfRuntimeState));
  memset(runtimeState, 0, sizeof(NsfRuntimeState));

#if defined(USE_ASSOC_DATA)
  Tcl_SetAssocData(interp, "NsfRuntimeState", NULL, runtimeState);
#else
  Tcl_Interp_globalNsPtr(interp)->clientData = runtimeState;
#endif

  /*
   * If MEM_COUNT is activated, the tables have to be initialized before the
   * first call to the MEM_COUNT macros (including e.g. INCR_REF_COUNT), but
   * it requires that the runtimeState is already associated with the interp.
   */
  MEM_COUNT_INIT();

  /*
   * Init global variables for Tcl_Obj types.
   */
  NsfMutexLock(&initMutex);
  Nsf_OT_byteCodeType = Tcl_GetObjType("bytecode");
  assert(Nsf_OT_byteCodeType != NULL);

  Nsf_OT_tclCmdNameType = Tcl_GetObjType("cmdName");
  assert(Nsf_OT_tclCmdNameType != NULL);

  Nsf_OT_listType = Tcl_GetObjType("list");
  assert(Nsf_OT_listType != NULL);

  Nsf_OT_doubleType = Tcl_GetObjType("double");
  assert(Nsf_OT_doubleType != NULL);

  /*
   * Type "int" and "wideInt" are a moving target in Tcl 8.7a+.  So, get the
   * type from the Tcl_Obj directly, which will continue to work.
   */
  tmpObj = Tcl_NewIntObj(0);
  Nsf_OT_intType = tmpObj->typePtr;
  Tcl_DecrRefCount(tmpObj);
  assert(Nsf_OT_intType != NULL);

  Nsf_OT_byteArrayType = Tcl_GetObjType("bytearray");
  assert(Nsf_OT_byteArrayType != NULL);

  { mp_int bignumValue;

    tmpObj = Tcl_NewStringObj("10000000000000000000000", -1);
    Tcl_GetBignumFromObj(NULL, tmpObj, &bignumValue);
    Nsf_OT_bignumType =  tmpObj->typePtr;
    assert(Nsf_OT_bignumType != NULL);
    Tcl_DecrRefCount(tmpObj);
  }

  /*
   * Get bytearray and proper bytearray from Tcl (latter if available,
   * introduced in Tcl 8.7a+)
   */
  tmpObj = Tcl_NewByteArrayObj(NULL, 0);
  Nsf_OT_properByteArrayType = tmpObj->typePtr;
  if (Nsf_OT_properByteArrayType == Nsf_OT_byteArrayType) {
    /*
     * When both values are the same, we are in a Tcl version before 8.7,
     * where we have no properByteArrayTypePtr. So set it to an invalid
     * value to avoid potential confusions. Without this stunt, we would
     * need several ifdefs.
     */
    Nsf_OT_properByteArrayType = (Tcl_ObjType *)0xffffff;
  }
  Tcl_DecrRefCount(tmpObj);
  assert(Nsf_OT_properByteArrayType != NULL);

  NsfMutexUnlock(&initMutex);

  /*
   * Initialize the pointer converter, the enumeration types and cmd
   * definitions tables and load it with the generated information for
   * introspection.
   */
  Nsf_PointerInit();

  Nsf_EnumerationTypeInit();
  result = Nsf_EnumerationTypeRegister(interp, enumeratorConverterEntries);
  if (unlikely(result != TCL_OK)) {
    return result;
  }

  Nsf_CmdDefinitionInit();
  Nsf_CmdDefinitionRegister(interp, method_definitions);

  /*
    fprintf(stderr, "SIZES: obj=%d, tcl_obj=%d, DString=%d, class=%d, namespace=%d, command=%d, HashTable=%d\n",
    sizeof(NsfObject), sizeof(Tcl_Obj), sizeof(Tcl_DString), sizeof(NsfClass),
    sizeof(Namespace), sizeof(Command), sizeof(Tcl_HashTable));
  */

#if defined(NSF_PROFILE)
  NsfProfileInit(interp);
#endif
  rst = RUNTIME_STATE(interp);
  rst->logSeverity = NSF_LOG_NOTICE;
  rst->doFilters = 1;
  rst->doCheckResults = 1;
  rst->doCheckArguments = NSF_ARGPARSE_CHECK;
  NsfDListInit(&rst->freeDList);

#if defined(NSF_STACKCHECK)
  { int someVar;
    /*
     * Note that Nsf_Init() is called typically via a package require, which
     * is therefore not really the bottom of the stack, but just a first
     * approximation.
     */
    rst->bottomOfStack = &someVar;
    rst->maxStack = rst->bottomOfStack;
  }
#endif

  /*
   * Check whether the namespace exists, otherwise create it.
   */
  rst->NsfNS = Tcl_FindNamespace(interp, "::nsf", NULL, TCL_GLOBAL_ONLY);
  if (rst->NsfNS == NULL) {
    rst->NsfNS = Tcl_CreateNamespace(interp, "::nsf", NULL,
                                     (Tcl_NamespaceDeleteProc *)NULL);
  }
  MEM_COUNT_ALLOC("TclNamespace", rst->NsfNS);

  /*
   * Init an empty, faked proc structure in the RUNTIME state.
   */
  rst->fakeProc.iPtr = (Interp *)interp;
  rst->fakeProc.refCount = 1;
  rst->fakeProc.cmdPtr = NULL;
  rst->fakeProc.bodyPtr = NULL;
  rst->fakeProc.numArgs = 0;
  rst->fakeProc.numCompiledLocals = 0;
  rst->fakeProc.firstLocalPtr = NULL;
  rst->fakeProc.lastLocalPtr = NULL;

  /*
   * NsfClasses in separate Namespace / Objects
   */
  rst->NsfClassesNS =
    Tcl_CreateNamespace(interp, nsfClassesPrefix, NULL,
                        (Tcl_NamespaceDeleteProc *)NULL);

#if !defined(PRE86)
  ((Namespace *)rst->NsfClassesNS)->flags |= NS_SUPPRESS_COMPILATION;
#endif

  MEM_COUNT_ALLOC("TclNamespace", rst->NsfClassesNS);

  /*
   * Cache interpreters proc interpretation functions
   */
  rst->objInterpProc = TclGetObjInterpProc();
  rst->exitHandlerDestroyRound = NSF_EXITHANDLER_OFF;

  RegisterExitHandlers(interp);
  NsfStringIncrInit(&RUNTIME_STATE(interp)->iss);
  /*
   * initialize global Tcl_Obj
   */
  NsfGlobalObjs = NEW_ARRAY(Tcl_Obj*, nr_elements(NsfGlobalStrings));

  for (i = 0; i < nr_elements(NsfGlobalStrings); i++) {
    NsfGlobalObjs[i] = Tcl_NewStringObj(NsfGlobalStrings[i], -1);
    INCR_REF_COUNT(NsfGlobalObjs[i]);
  }

  Tcl_InitHashTable(&rst->activeFilterTablePtr, TCL_STRING_KEYS);
  MEM_COUNT_ALLOC("Tcl_InitHashTable", &rst->activeFilterTablePtr);

  /*
   * Create namespaces for the different command types.
   */
  Tcl_CreateNamespace(interp, "::nsf::cmd", 0, (Tcl_NamespaceDeleteProc *)NULL);
  for (i = 0; i < nr_elements(method_command_namespace_names); i++) {
    Tcl_CreateNamespace(interp, method_command_namespace_names[i], 0, (Tcl_NamespaceDeleteProc *)NULL);
  }

  /*
   * Create all method commands (will use the namespaces above).
   */
  for (i = 0; i < nr_elements(method_definitions)-1; i++) {
    Tcl_CreateObjCommand(interp, method_definitions[i].methodName, method_definitions[i].proc, 0, 0);
  }

  /*
   * Create Shadowed Tcl cmds:
   */
  result = NsfShadowTclCommands(interp, SHADOW_LOAD);
  if (unlikely(result != TCL_OK)) {
    return result;
  }
  /*
   * Create new Tcl cmds:
   */
#ifdef NSF_BYTECODE
  instructions[INST_NEXT].cmdPtr = (Command *)
#endif
    Tcl_CreateObjCommand(interp, "::nsf::xotclnext", NsfNextObjCmd, 0, 0);
#ifdef NSF_BYTECODE
  instructions[INST_SELF].cmdPtr =
    (Command *)Tcl_FindCommand(interp, "::nsf::current", NULL, TCL_GLOBAL_ONLY);
#endif
  /*Tcl_CreateObjCommand(interp, "::nsf::K", NsfKObjCmd, 0, 0);*/

#ifdef NSF_BYTECODE
  NsfBytecodeInit();
#endif
  NsfInitPkgConfig(interp);

  Tcl_AddInterpResolvers(interp, "nsf",
                         (Tcl_ResolveCmdProc *)InterpColonCmdResolver,
                         InterpColonVarResolver,
                         (Tcl_ResolveCompiledVarProc *)InterpCompiledColonVarResolver);
  rst->colonCmd = Tcl_FindCommand(interp, "::nsf::colon", NULL, TCL_GLOBAL_ONLY);

  /*
   *  Tcl occasionally resolves a proc's cmd structure (e.g., in
   *  [info frame /number/] or TclInfoFrame()) without
   *  verification. However, NSF non-proc frames, in particular
   *  initcmd blocks, point to the fakeProc structure which does not
   *  contain an initialized Command pointer. For now, we default to
   *  an internal command. However, we might have to revisit this decision
   *  as non-proc frames (e.g., initcmds) report a "proc" entry
   *  for c-based functions with a proc scope, such as "::nsf::colon"),
   *  which can lead to confusions. "proc" does not mean "tcp proc",
   *  but an entry with a proc frame for local vars.
  */
  rst->fakeProc.cmdPtr = (Command *)RUNTIME_STATE(interp)->colonCmd;

  {
    /*
     * The file "predefined.h" contains some methods and library procs
     * implemented in Tcl - they could go in .tcl file, but they are embedded
     * here with Tcl_Eval to avoid the need to carry around a separate file at
     * run time.
     */

#include "predefined.h"

    /* fprintf(stderr, "predefined=<<%s>>\n", cmd);*/
    if (
        (Tcl_Eval(interp, predefined_part1) != TCL_OK)
        || (Tcl_Eval(interp, predefined_part2) != TCL_OK)
        ) {
      static char reportingCmd[] =
        "puts stderr \"Error in predefined code\n\
         $::errorInfo\"";
      Tcl_EvalEx(interp, reportingCmd, -1, 0);
      return TCL_ERROR;
    }
  }

#ifndef AOL_SERVER
  /*
   * The AOL server uses a different package loading mechanism.
   */
# ifdef COMPILE_NSF_STUBS
  Tcl_PkgProvideEx(interp, "nsf", PACKAGE_VERSION, &nsfStubs);
# else
  Tcl_PkgProvide(interp, "nsf", PACKAGE_VERSION);
# endif
#endif

  /*
   * Obtain type for parsed var name.
   */
  if (Nsf_OT_parsedVarNameType == NULL) {
    Tcl_Obj *varNameObj = Tcl_NewStringObj("::nsf::version", -1);
    Var *arrayPtr;

    INCR_REF_COUNT(varNameObj);
    TclObjLookupVar(interp, varNameObj, NULL, 0, "access",
                    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    Nsf_OT_parsedVarNameType = varNameObj->typePtr;
    assert(Nsf_OT_parsedVarNameType != NULL);
    DECR_REF_COUNT(varNameObj);
  }

#if !defined(TCL_THREADS)
  if ((Tcl_GetVar2(interp, "tcl_platform", "threaded", TCL_GLOBAL_ONLY) != NULL)) {
    /*
     * A non-threaded version of NSF is loaded into a threaded environment.
     */
    fprintf(stderr, "\n A non threaded version of the Next Scripting Framework "
            "is loaded into threaded environment.\n"
            "Please reconfigure nsf with --enable-threads!\n\n\n");
  }
#endif

  Tcl_ResetResult(interp);
  Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);

  return TCL_OK;
}

EXTERN int
Nsf_SafeInit(Tcl_Interp *interp) {

  nonnull_assert(interp != NULL);

  /*** dummy for now **/
  return Nsf_Init(interp);
}



/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 2
 * fill-column: 78
 * indent-tabs-mode: nil
 * eval: (c-guess)
 * End:
 */
