/* -*- Mode: c++ -*-
 *  $Id: s.xotclInt.h 1.11 01/04/18 21:24:34+02:00 neumann@mohegan.wu-wien.ac.at $
 *  Extended Object Tcl (XOTcl)
 *
 *  Copyright (C) 1999-2000 Gustaf Neumann, Uwe Zdun
 *
 *  xotclInt.h --
 *
 *  Mostly internally used API Functions
 */

#ifndef _xotcl_int_h_
#define _xotcl_int_h_

#include "tclInt.h"
#include "xotcl.h"

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

#if defined(PROFILE)
#  include <sys/time.h>
#endif

#ifdef DMALLOC
#  include "dmalloc.h"
#endif

/*
#define XOTCL_METADATA
*/

/*
 * Makros
 */

#define RUNTIME_STATE(in) \
    ((XOTclRuntimeState*)((Interp*) in)->globalNsPtr->clientData)

#define ALLOC_NAME_NS(DSP, NS, NAME) \
     Tcl_DStringInit(DSP),\
     Tcl_DStringAppend(DSP, NS, -1),\
     Tcl_DStringAppend(DSP, "::", 2),\
     Tcl_DStringAppend(DSP, NAME, -1)
#define ALLOC_TOP_NS(DSP, NAME) \
     Tcl_DStringInit(DSP),\
     Tcl_DStringAppend(DSP, "::", 2),\
     Tcl_DStringAppend(DSP, NAME, -1)
#define ALLOC_DSTRING(DSP,ENTRY) \
     Tcl_DStringInit(DSP),\
     Tcl_DStringAppend(DSP, ENTRY, -1)

#define nr_elements(arr)  ((int) (sizeof(arr) / sizeof(arr[0])))

#define optionSet(options,bitToChange)          (options |= bitToChange)
#define optionRemove(value,options,bitToChange) (options &= ~bitToChange)

#define isArgsString(m) (\
	*m   == 'a' && m[1] == 'r' && m[2] == 'g' && m[3] == 's' && \
	m[4] == '\0')
#define isAutoString(m) (\
	*m   == 'a' && m[1] == 'u' && m[2] == 't' && m[3] == 'o' && \
	m[4] == '\0')
#define isClassString(m) (\
	*m   == 'c' && m[1] == 'l' && m[2] == 'a' && m[3] == 's' && \
	m[4] == 's' && m[5] == '\0')
#define isCheckString(m) (\
	*m   == 'c' && m[1] == 'h' && m[2] == 'e' && m[3] == 'c' && \
	m[4] == 'k' && m[5] == '\0')
#define isCreateString(m) (\
	*m   == 'c' && m[1] == 'r' && m[2] == 'e' && m[3] == 'a' && \
	m[4] == 't' && m[5] == 'e' && m[6] == '\0')
#define isDecrString(m) (\
	*m   == 'd' && m[1] == 'e' && m[2] == 'c' && m[3] == 'r' && \
	m[4] == '\0')
#define isAllocString(m) (\
	*m   == 'a' && m[1] == 'l' && m[2] == 'l' && m[3] == 'o' && \
	m[4] == 'c' && m[5] == '\0')
#define isDestroyString(m) (\
	*m   == 'd' && m[1] == 'e' && m[2] == 's' && m[3] == 't' && \
	m[4] == 'r' && m[5] == 'o' && m[6] == 'y' && m[7] == '\0')
#define isInstDestroyString(m) (\
        *m   == 'i' && m[1] == 'n' && m[2] == 's' && m[3] == 't' && \
	m[4] == 'd' && m[5] == 'e' && m[6] == 's' && m[7] == 't' && \
	m[8] == 'r' && m[9] == 'o' && m[10] == 'y' && m[11] == '\0')
#define isInitString(m) (\
	*m   == 'i' && m[1] == 'n' && m[2] == 'i' && m[3] == 't' && \
	m[4] == '\0')
#define isIncrString(m) (\
	*m   == 'i' && m[1] == 'n' && m[2] == 'c' && m[3] == 'r' && \
	m[4] == '\0')
#define isInfoString(m) (\
	*m   == 'i' && m[1] == 'n' && m[2] == 'f' && m[3] == 'o' && \
	m[4] == '\0')
#define isLevelString(m) (\
	*m   == 'l' && m[1] == 'e' && m[2] == 'v' && m[3] == 'e' && \
	m[4] == 'l' && m[5] == '\0')
#define isNextString(m) (\
	*m   == 'n' && m[1] == 'e' && m[2] == 'x' && m[3] == 't' && \
	m[4] == '\0')
#define isInstinvarString(m) (\
        *m   == 'i' && m[1] == 'n' && m[2] == 's' && m[3] == 't' && \
	m[4] == 'i' && m[5] == 'n' && m[6] == 'v' && m[7] == 'a' && \
	m[8] == 'r' && m[9] == '\0')
#define isInvarString(m) (\
	*m   == 'i' && m[1] == 'n' && m[2] == 'v' && m[3] == 'a' && \
	m[4] == 'r' && m[5] == '\0')
#define isInstprocString(m) (\
	*m   == 'i' && m[1] == 'n' && m[2] == 's' && m[3] == 't' && \
	m[4] == 'p' && m[5] == 'r' && m[6] == 'o' && m[7] == 'c' && \
        m[8] == '\0')
#define isProcString(m) (\
	*m   == 'p' && m[1] == 'r' && m[2] == 'o' && m[3] == 'c' && \
	m[4] == '\0')
#define isEmptyString(m) (\
        *m == '\0')

#define isDashArg(flag) (*flag == '-' && isalpha((int)*(flag+1)))

/*
 * prevent old TCL-versions
 */

#if TCL_MAJOR_VERSION < 8
# error Tcl distribution is TOO OLD, we require at least tcl8.0
#endif

#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<1
# define PRE81
#else
# if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION==1
#  define V81
# endif
#endif
#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<2
# define PRE82
#endif
#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<3
# define PRE83
#endif
#if TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION<4
# define PRE84
#endif

#if defined(sun)
#  define USE_ALLOCA
#endif

#if _IBMC__ >= 0x0306
#  define USE_MALLOC
#  define USE_ALLOCA
#endif

#if defined(VISUAL_CC)
#  define USE_MALLOC
#endif

#if defined(USE_MALLOC)
#  define DEFINE_NEW_TCL_OBJECTS_ON_STACK(oc,ov) \
    Tcl_Obj** ov = (Tcl_Obj**) ckalloc(oc*sizeof(Tcl_Obj*))
#  define FREE_TCL_OBJECTS_ON_STACK(ov) ckfree((char*) ov)
#  define DEFINE_NEW_CHAR_ARRAY(c,v) \
    char** v = (char**) ckalloc(c*sizeof(char*))
#  define FREE_CHAR_ARRAY(v) ckfree((char*) v)
#elif defined(USE_ALLOCA)
#  define DEFINE_NEW_TCL_OBJECTS_ON_STACK(oc,ov) \
    Tcl_Obj** ov = (Tcl_Obj**) alloca(oc*sizeof(Tcl_Obj*))
#  define FREE_TCL_OBJECTS_ON_STACK(ov)
#  define DEFINE_NEW_CHAR_ARRAY(c,v) \
    char** v = (char**) alloca(c*sizeof(char*))
#  define FREE_CHAR_ARRAY(v)
#else
#  define DEFINE_NEW_TCL_OBJECTS_ON_STACK(oc,ov) \
    Tcl_Obj* ov[oc]
#  define FREE_TCL_OBJECTS_ON_STACK(ov)
#  define DEFINE_NEW_CHAR_ARRAY(c,v) \
    char* v[c]
#  define FREE_CHAR_ARRAY(v)
#endif

#ifdef USE_ALLOCA
# include <alloca.h>
#endif

#ifdef  __WIN32__
#       define XOTCLINLINE
#       define XOTclNewObj(A) A=Tcl_NewObj()
#	define DECR_REF_COUNT(A) Tcl_DecrRefCount(A)
#else
# if defined(sun) || __IBMC__ >= 0x0306
#       define XOTCLINLINE
# else
#       define XOTCLINLINE inline
# endif
# ifdef USE_TCL_STUBS
#       define XOTclNewObj(A) A=Tcl_NewObj()
#	define DECR_REF_COUNT(A) Tcl_DecrRefCount(A)
# else
#       define XOTclNewObj(A) TclNewObj(A)
#	define DECR_REF_COUNT(A) TclDecrRefCount(A)
# endif
#endif

#if !defined(PRE83)
# if defined(TCL_THREADS)
#  define XOTclMutex Tcl_Mutex 
#  define XOTclMutexLock(a) Tcl_MutexLock(a)
#  define XOTclMutexUnlock(a) Tcl_MutexUnlock(a)
# else
#  define XOTclMutex int
#  define XOTclMutexLock(a)   (*(a))++
#  define XOTclMutexUnlock(a) (*(a))--
# endif /*defined(TCL_THREADS)*/
#endif

#if defined(PRE81)
# define ObjStr(obj) Tcl_GetStringFromObj(obj, ((int*)NULL))
#else
# define ObjStr(obj) Tcl_GetString(obj)
#endif

#ifdef V81
# define EvalObj(in,cmd) Tcl_EvalObj (in,cmd,0)
# define TclIsVarArgument(args) (args->isArg)
# define Tcl_ObjSetVar2(in,p1,p2,newval,flags) \
	Tcl_SetObjVar2(in,ObjStr(p1),p2,newval,flags)
#else
# if defined(PRE83)
#   define EvalObj(in,cmd) Tcl_EvalObj (in,cmd)
# else
#   define EvalObj(in,cmd) Tcl_EvalObjEx (in,cmd,0)
# endif
# if defined(PRE81) && TCL_RELEASE_SERIAL<3
#  define TclIsVarArgument(args) (args->isArg)
# endif
#endif

#define VarFrameDecls CallFrame frame, *oldFramePtr
#define VarFrameSwitchToObj(in,obj) \
	oldFramePtr = ((Interp *)in)->varFramePtr; \
     frame.nsPtr = obj->nsPtr; \
     frame.isProcCallFrame = 0; \
     ((Interp *)in)->varFramePtr = &frame

#define VarFrameRestore(in) \
     ((Interp *)in)->varFramePtr = oldFramePtr

#define INCR_REF_COUNT(A) Tcl_IncrRefCount(A)

#ifdef OBJDELETION_TRACE
# define PRINTOBJ(ctx,obj) \
  fprintf(stderr, "  %s %p %s oid=%p teardown=%p destroyCalled=%d\n", \
	  ctx,obj,ObjStr(obj->cmdName), obj->id, obj->teardown, obj->destroyCalled)
#else
# define PRINTOBJ(ctx,obj) 
#endif

#define xobjName(obj) (obj ? ObjStr(obj->cmdName) : "")
#define className(cl) (cl ? ObjStr(cl->object.cmdName) : "")
#define classXObj(cl) (cl ? &cl->object : NULL)

/* TCL_CONTINUE is defined as 4, from 5 on we can
   use app-specific return codes */
#define XOTCL_UNKNOWN 5
#define XOTCL_NOT_FILTERED 6
#define XOTCL_STDARGS_COMPUTED 7
#define XOTCL_USE_TCL_COMMAND 8

#define XOTCL_CM_NO_FILTERS 1
#define XOTCL_CM_NO_UNKNOWN 2


/*
 *
 * XOTcl Structures
 *
 */

/*
 * Filter:  list and info-structure for the objects/classes
 */
typedef struct XOTclFilter {
  Tcl_Obj* simpleName;
  Command* cmdPtr;
  struct XOTclClass* filterClass;
  struct XOTclFilter* next;
} XOTclFilter;

typedef struct XOTclObjList {
  struct XOTclObject* objPtr;
  struct XOTclObjList* next;
} XOTclObjList;

typedef struct XOTclFilterChainInfo {
  XOTclFilter* filterPtr;
  Tcl_Obj* calledProc;
  Tcl_Obj* callingProc;
  Tcl_Obj* callingClass;
  Tcl_Obj* callingObject;
  CallFrame* procVarFramePtr;
  struct XOTclClass* regClass;
  struct XOTclFilterChainInfo* next;
  int refCount;
} XOTclFilterChainInfo;

typedef struct XOTclFilterInfo {
  int valid;
  int doFilters;
  struct XOTclFilterChainInfo* chains;
} XOTclFilterInfo;

typedef struct XOTclFilterListEntry {
  struct XOTclObjList* activeObjs;
  int count;
} XOTclFilterListEntry;

/*
 * Assertion structures
 */
typedef struct XOTclAssertion {
  Tcl_Obj* content;
  struct XOTclAssertion* next;
} XOTclAssertion;

typedef struct XOTclProcAssertion {
  XOTclAssertion* pre;
  XOTclAssertion* post;
} XOTclProcAssertion;

typedef struct XOTclAssertionStore {
  XOTclAssertion* invariants;
  Tcl_HashTable procs;
} XOTclAssertionStore;

typedef enum { /* powers of 2; add to ALL, if default; */
  CHECK_NONE  = 0, CHECK_CLINVAR = 1, CHECK_OBJINVAR = 2,
  CHECK_PRE   = 4, CHECK_POST = 8,
  CHECK_INVAR = CHECK_CLINVAR + CHECK_OBJINVAR,
  CHECK_ALL   = CHECK_INVAR   + CHECK_PRE + CHECK_POST
} CheckOptions;

/*
 * mixins
 */
typedef struct XOTclMixin {
  Command* cmdPtr;
  struct XOTclMixin* next;
} XOTclMixin;

typedef struct XOTclMixinStack {
  Command* currentCmdPtr;
  int mixinChainOn;
  int mixinInit;
  struct XOTclMixinStack* next;
} XOTclMixinStack;

/*
 * Generic command pointer list
 */
typedef struct XOTclCmdList {
  Command* cmdPtr;
  struct XOTclCmdList* next;
} XOTclCmdList;

/* the mixin order is either 
 *   DEFINED (there are mixins on the instance), 
 *   NONE    (there are no mixins for the instance),
 *   or INVALID (a class re-strucuturing has occured, thus it is not clear
 *               whether mixins are defined or not). 
 */
#define XOTCL_MIXINS_INVALID 0
#define XOTCL_MIXINS_NONE 1
#define XOTCL_MIXINS_DEFINED 2

/*
 * object and class internals
 */
typedef struct XOTclObject {
  Tcl_Obj* cmdName;
  Tcl_Command id;
  int destroyCalled;
  Tcl_Interp* teardown;
  struct XOTclClass* cl;
  struct XOTclClass* type;
  Namespace *nsPtr;
  XOTclAssertionStore *assertions;
#ifdef OBJ_REFERENCES
  Tcl_HashTable references;
  Tcl_HashTable referencedBy;
#endif
  int checkoptions;
  XOTclFilterInfo filterinfo;
  XOTclMixin* mixins;
  struct XOTclCmdList* mixinOrder;
  int mixinDefined;
  XOTclMixinStack* mixinStack;
#ifdef XOTCL_METADATA
  Tcl_HashTable metaData;
#endif
  ClientData clientData;
} XOTclObject;

typedef struct XOTclClass {
  struct XOTclObject object;
  struct XOTclClasses* super;
  struct XOTclClasses* sub;
  int color;
  struct XOTclClasses* order;
  struct XOTclClass* parent;
  Tcl_HashTable instances;
  Tcl_HashTable* objectdata;
  Namespace *nsPtr;
  XOTclMixin* instmixins;
  XOTclFilter* filters;
  XOTclAssertionStore *assertions;
  Tcl_Obj* parameterClass;
  Tcl_Obj* parameters;
  ClientData clientData;
} XOTclClass;

typedef struct XOTclClasses {
  struct XOTclClass* cl;
  struct XOTclClasses* next;
} XOTclClasses;

/*
 * XOTcl CallStack
 */
typedef struct XOTclCallStackContent {
  XOTclObject* self;
  Command* destroyedCmd;
  XOTclClass* cl;
  char* procName;
  int objc; Tcl_Obj *CONST*objv;
  short frameCut;
  char isFilterEntry;
  char isMixinEntry;
} XOTclCallStackContent;

typedef struct XOTclCallStack {
  XOTclCallStackContent content[MAX_NESTING_DEPTH];
  XOTclCallStackContent *top;
  XOTclCallStackContent *topFrameCache;
  short frameCutRound;
} XOTclCallStack;

#if defined(PROFILE)
typedef struct XOTclProfile {
  long int overallTime;
  Tcl_HashTable objectData;
  Tcl_HashTable methodData;
} XOTclProfile;
#endif

typedef struct XOTclRuntimeState {
  XOTclCallStack cs;
  Tcl_HashTable filterList;
  /*
   * definitions of the main xotcl objects
   */
  Namespace* XOTclClassesNS;
  XOTclClass* theObject;
  XOTclClass* theClass;
  Tcl_CmdProc* interpProc;
  Tcl_ObjCmdProc* objInterpProc;
  Tcl_Obj **methodObjNames;
  int errorCount;
  int callDestroy;
  int callIsDestroy;
  int exitHandlerDestroyRound;
  int returnCode;
#if defined(PROFILE)
  XOTclProfile profile;
#endif
  ClientData clientData;
} XOTclRuntimeState;

#define XOTCL_EXITHANDLER_OFF 0
#define XOTCL_EXITHANDLER_ON_SOFT_DESTROY 1
#define XOTCL_EXITHANDLER_ON_PHYSICAL_DESTROY 2

/*
 *
 *  Mostly internally used API functions
 *
 */

/*
 *  error return functions
 */
extern int
XOTclErrMsg(Tcl_Interp *in, char* msg, Tcl_FreeProc* type);
extern int
XOTclVarErrMsg TCL_VARARGS_DEF (Tcl_Interp *,arg1);
extern int
XOTclErrInProc (Tcl_Interp *in, Tcl_Obj* objName, 
		Tcl_Obj* clName, char* procName);
extern int
XOTclObjErrArgCnt(Tcl_Interp *in, Tcl_Obj *cmdname, char *arglist);
extern int
XOTclErrBadVal(Tcl_Interp *in, char *expected, char *value);
extern int
XOTclObjErrType(Tcl_Interp *in, Tcl_Obj *nm, char* wt);

/*
 * trace functions
 */
extern void
XOTclStackTrace (Tcl_Interp* in);
extern void
XOTclCallStackTrace (Tcl_Interp* in);
extern void
XOTclFilterTrace (Tcl_Interp* in);

/*
 * typing functions
 */
extern XOTCLINLINE int
XOTclIsType(XOTclObject* obj, XOTclClass* type);

extern void 
XOTclRemoveClasses(XOTclClasses* sl);
extern void
XOTclAddClass(XOTclClasses** cList, XOTclClass* cl);


/*
 * class/instance hierarchy (re-)structuring
 */
extern XOTclClasses*
XOTclComputePrecedence(register XOTclClass* cl);
extern XOTclClasses*
XOTclComputeDependents(register XOTclClass* cl);


/*
 * Misc
 */
extern void
XOTclDeprecatedMsg(char* oldCmd, char* newCmd);

/*
 * Profiling functions
 */

#if defined(PROFILE)
extern void
XOTclProfileFillTable(Tcl_HashTable* table, Tcl_DString* key,
		 double totalMicroSec);
extern void
XOTclProfileEvaluateData(Tcl_Interp* in, long int startSec, long int startUsec,
		    XOTclObject* obj, XOTclClass *cl, char *methodName);
extern void
XOTclProfilePrintTable(Tcl_HashTable* table);

extern void
XOTclProfilePrintData(Tcl_Interp* in);

extern void 
XOTclProfileInit(Tcl_Interp* in);
#endif

/*
 * experimental object references
 */
#if defined(OBJ_REFERENCES)
extern void
XOTclReferenceAddRef(Tcl_Interp* in, XOTclObject* obj, 
		     XOTclObject *referenced);

extern int
XOTclIsReferencedBy(XOTclObject* obj, XOTclObject* refObj);

extern void
XOTclReferenceDestroy(Tcl_Interp* in, XOTclObject* obj);

extern void
XOTclReferenceInit(XOTclObject* obj);
#endif

/*
 * old, deprecated meta-data command
 */
#if defined(XOTCL_METADATA)
extern void
XOTclMetaDataDestroy(XOTclObject* obj);
extern void
XOTclMetaDataInit(XOTclObject* obj);
extern int
XOTclOMetaDataMethod (ClientData cd, Tcl_Interp* in, 
		      int objc, Tcl_Obj *objv[]);
#endif /* XOTCL_METADATA */

#endif /* _xotcl_int_h_ */
