1/* -*- Mode: c++ -*-
2 *  $Id: xotclInt.h,v 1.27 2007/10/12 19:53:32 neumann Exp $
3 *  Extended Object Tcl (XOTcl)
4 *
5 *  Copyright (C) 1999-2008 Gustaf Neumann, Uwe Zdun
6 *
7 *  xotclInt.h --
8 *
9 *  Mostly internally used API Functions
10 */
11
12#ifndef _xotcl_int_h_
13#define _xotcl_int_h_
14
15#include <tclInt.h>
16#include "xotcl.h"
17
18#include <stdlib.h>
19#include <string.h>
20#include <assert.h>
21
22#if defined(PROFILE)
23#  include <sys/time.h>
24#endif
25
26#ifdef DMALLOC
27#  include "dmalloc.h"
28#endif
29
30#ifdef BUILD_xotcl
31# undef TCL_STORAGE_CLASS
32# define TCL_STORAGE_CLASS DLLEXPORT
33#endif
34
35/*
36#define XOTCL_METADATA
37*/
38
39/*
40 * Makros
41 */
42#if defined(PRE85)
43# define TclVarHashTable Tcl_HashTable
44#endif
45
46#ifdef XOTCL_MEM_COUNT
47Tcl_HashTable xotclMemCount;
48extern int xotclMemCountInterpCounter;
49typedef struct XOTclMemCounter {
50  int peak;
51  int count;
52} XOTclMemCounter;
53#  define MEM_COUNT_ALLOC(id,p) XOTclMemCountAlloc(id,p)
54#  define MEM_COUNT_FREE(id,p) XOTclMemCountFree(id,p)
55#  define MEM_COUNT_INIT() \
56      if (xotclMemCountInterpCounter == 0) { \
57        Tcl_InitHashTable(&xotclMemCount, TCL_STRING_KEYS); \
58        xotclMemCountInterpCounter = 1; \
59      }
60#  define MEM_COUNT_DUMP() XOTclMemCountDump(interp)
61#  define MEM_COUNT_OPEN_FRAME()
62/*if (obj->varTable) noTableBefore = 0*/
63#  define MEM_COUNT_CLOSE_FRAME()
64/*      if (obj->varTable && noTableBefore) \
65	XOTclMemCountAlloc("obj->varTable",NULL)*/
66#else
67#  define MEM_COUNT_ALLOC(id,p)
68#  define MEM_COUNT_FREE(id,p)
69#  define MEM_COUNT_INIT()
70#  define MEM_COUNT_DUMP()
71#  define MEM_COUNT_OPEN_FRAME()
72#  define MEM_COUNT_CLOSE_FRAME()
73#endif
74
75#define DSTRING_INIT(D) Tcl_DStringInit(D); MEM_COUNT_ALLOC("DString",D)
76#define DSTRING_FREE(D) Tcl_DStringFree(D); MEM_COUNT_FREE("DString",D)
77
78#if USE_ASSOC_DATA
79# define RUNTIME_STATE(interp) ((XOTclRuntimeState*)Tcl_GetAssocData((interp), "XOTclRuntimeState", NULL))
80#else
81# define RUNTIME_STATE(interp) ((XOTclRuntimeState*)((Interp*)interp)->globalNsPtr->clientData)
82#endif
83
84
85#define ALLOC_NAME_NS(DSP, NS, NAME) \
86     DSTRING_INIT(DSP);\
87     Tcl_DStringAppend(DSP, NS, -1),\
88     Tcl_DStringAppend(DSP, "::", 2),\
89     Tcl_DStringAppend(DSP, NAME, -1)
90#define ALLOC_TOP_NS(DSP, NAME) \
91     DSTRING_INIT(DSP);\
92     Tcl_DStringAppend(DSP, "::", 2),\
93     Tcl_DStringAppend(DSP, NAME, -1)
94#define ALLOC_DSTRING(DSP,ENTRY) \
95     DSTRING_INIT(DSP);\
96     Tcl_DStringAppend(DSP, ENTRY, -1)
97
98#define nr_elements(arr)  ((int) (sizeof(arr) / sizeof(arr[0])))
99
100# define NEW(type) \
101	(type *)ckalloc(sizeof(type)); MEM_COUNT_ALLOC(#type, NULL)
102# define NEW_ARRAY(type,n) \
103	(type *)ckalloc(sizeof(type)*(n)); MEM_COUNT_ALLOC(#type "*", NULL)
104# define FREE(type, var) \
105	ckfree((char*) var); MEM_COUNT_FREE(#type,var)
106
107#define isAbsolutePath(m) (*m == ':' && m[1] == ':')
108#define isArgsString(m) (\
109	*m   == 'a' && m[1] == 'r' && m[2] == 'g' && m[3] == 's' && \
110	m[4] == '\0')
111#define isDoubleDashString(m) (\
112	*m   == '-' && m[1] == '-' && m[2] == '\0')
113#define isBodyString(m) (\
114	*m   == 'b' && m[1] == 'o' && m[2] == 'd' && m[3] == 'y' && \
115	m[4] == '\0')
116#define isClassString(m) (\
117	*m   == 'c' && m[1] == 'l' && m[2] == 'a' && m[3] == 's' && \
118	m[4] == 's' && m[5] == '\0')
119#define isCheckString(m) (\
120	*m   == 'c' && m[1] == 'h' && m[2] == 'e' && m[3] == 'c' && \
121	m[4] == 'k' && m[5] == '\0')
122#define isCheckObjString(m) (\
123        *m   == 'c' && m[1] == 'h' && m[2] == 'e' && m[3] == 'c' && \
124	m[4] == 'k' && m[5] == 'o' && m[6] == 'b' && m[7] == 'j' && \
125	m[8] == '\0')
126#define isCreateString(m) (\
127	*m   == 'c' && m[1] == 'r' && m[2] == 'e' && m[3] == 'a' && \
128	m[4] == 't' && m[5] == 'e' && m[6] == '\0')
129#define isAllocString(m) (\
130	*m   == 'a' && m[1] == 'l' && m[2] == 'l' && m[3] == 'o' && \
131	m[4] == 'c' && m[5] == '\0')
132#define isDestroyString(m) (\
133	*m   == 'd' && m[1] == 'e' && m[2] == 's' && m[3] == 't' && \
134	m[4] == 'r' && m[5] == 'o' && m[6] == 'y' && m[7] == '\0')
135#define isInstDestroyString(m) (\
136        *m   == 'i' && m[1] == 'n' && m[2] == 's' && m[3] == 't' && \
137	m[4] == 'd' && m[5] == 'e' && m[6] == 's' && m[7] == 't' && \
138	m[8] == 'r' && m[9] == 'o' && m[10] == 'y' && m[11] == '\0')
139#define isInitString(m) (\
140	*m   == 'i' && m[1] == 'n' && m[2] == 'i' && m[3] == 't' && \
141	m[4] == '\0')
142#define isInfoString(m) (\
143	*m   == 'i' && m[1] == 'n' && m[2] == 'f' && m[3] == 'o' && \
144	m[4] == '\0')
145#ifdef AUTOVARS
146# define isNextString(m) (\
147	*m   == 'n' && m[1] == 'e' && m[2] == 'x' && m[3] == 't' && \
148	m[4] == '\0')
149#endif
150#define isInstinvarString(m) (\
151        *m   == 'i' && m[1] == 'n' && m[2] == 's' && m[3] == 't' && \
152	m[4] == 'i' && m[5] == 'n' && m[6] == 'v' && m[7] == 'a' && \
153	m[8] == 'r' && m[9] == '\0')
154#define isInvarString(m) (\
155	*m   == 'i' && m[1] == 'n' && m[2] == 'v' && m[3] == 'a' && \
156	m[4] == 'r' && m[5] == '\0')
157#define isInstprocString(m) (\
158	*m   == 'i' && m[1] == 'n' && m[2] == 's' && m[3] == 't' && \
159	m[4] == 'p' && m[5] == 'r' && m[6] == 'o' && m[7] == 'c' && \
160        m[8] == '\0')
161#define isProcString(m) (\
162	*m   == 'p' && m[1] == 'r' && m[2] == 'o' && m[3] == 'c' && \
163	m[4] == '\0')
164
165#if (defined(sun) || defined(__hpux)) && !defined(__GNUC__)
166#  define USE_ALLOCA
167#endif
168
169#if defined(__IBMC__) && !defined(__GNUC__)
170# if __IBMC__ >= 0x0306
171#  define USE_ALLOCA
172# else
173#  define USE_MALLOC
174# endif
175#endif
176
177#if defined(VISUAL_CC)
178#  define USE_MALLOC
179#endif
180
181#if defined(__GNUC__) && !defined(USE_ALLOCA) && !defined(USE_MALLOC)
182# if !defined(NDEBUG)
183#  define ALLOC_ON_STACK(type,n,var) \
184    int __##var##_count = (n); type __##var[n+2]; \
185    type *var = __##var + 1; var[-1] = var[__##var##_count] = (type)0xdeadbeaf
186#  define FREE_ON_STACK(type,var)                                       \
187    assert(var[-1] == var[__##var##_count] && var[-1] == (type)0xdeadbeaf)
188# else
189#  define ALLOC_ON_STACK(type,n,var) type var[(n)]
190#  define FREE_ON_STACK(type,var)
191# endif
192#elif defined(USE_ALLOCA)
193#  define ALLOC_ON_STACK(type,n,var) type *var = (type *)alloca((n)*sizeof(type))
194#  define FREE_ON_STACK(type,var)
195#else
196#  define ALLOC_ON_STACK(type,n,var) type *var = (type *)ckalloc((n)*sizeof(type))
197#  define FREE_ON_STACK(type,var) ckfree((char*)var)
198#endif
199
200#ifdef USE_ALLOCA
201# include <alloca.h>
202#endif
203
204#ifdef  __WIN32__
205# define XOTCLINLINE
206# define XOTclNewObj(A) A=Tcl_NewObj()
207# define DECR_REF_COUNT(A) \
208	MEM_COUNT_FREE("INCR_REF_COUNT",A); Tcl_DecrRefCount(A)
209#else
210/*
211 * This was defined to be inline for anything !sun or __IBMC__ >= 0x0306,
212 * but __hpux should also be checked - switched to only allow in gcc - JH
213 */
214# if defined(__GNUC__)
215#  define XOTCLINLINE inline
216# else
217#  define XOTCLINLINE
218# endif
219# ifdef USE_TCL_STUBS
220#  define XOTclNewObj(A) A=Tcl_NewObj()
221#  define DECR_REF_COUNT(A) \
222	MEM_COUNT_FREE("INCR_REF_COUNT",A); assert((A)->refCount > -1); \
223        Tcl_DecrRefCount(A)
224# else
225#  define XOTclNewObj(A) TclNewObj(A)
226#  define DECR_REF_COUNT(A) \
227	MEM_COUNT_FREE("INCR_REF_COUNT",A); TclDecrRefCount(A)
228# endif
229#endif
230
231#if !defined(PRE83) && defined(TCL_THREADS)
232# define XOTclMutex Tcl_Mutex
233# define XOTclMutexLock(a) Tcl_MutexLock(a)
234# define XOTclMutexUnlock(a) Tcl_MutexUnlock(a)
235#else
236# define XOTclMutex int
237# define XOTclMutexLock(a)   (*(a))++
238# define XOTclMutexUnlock(a) (*(a))--
239#endif
240
241#if !defined(CONST84)
242# if defined(PRE84)
243#  define CONST84
244# else
245#  define CONST84 CONST
246# endif
247#endif
248
249#if defined(PRE81)
250# define ObjStr(obj) Tcl_GetStringFromObj(obj, ((int*)NULL))
251#else
252# define ObjStr(obj) (obj)->bytes ? (obj)->bytes : Tcl_GetString(obj)
253/*# define ObjStr(obj) Tcl_GetString(obj) */
254#endif
255
256#ifdef V81
257# define EvalObj(interp,cmd) Tcl_EvalObj(interp, cmd, 0)
258# define TclIsVarArgument(args) (args->isArg)
259# define Tcl_ObjSetVar2(interp,p1,p2,newval,flags) \
260	Tcl_SetObjVar2(interp,ObjStr(p1),p2,newval,flags)
261#define Tcl_ObjGetVar2(interp,name1,name2,flgs) \
262  Tcl_GetObjVar2(interp, ObjStr(name1), \
263		((name2==NULL) ? (char*)NULL : ObjStr(name2)), flgs)
264#else
265# if defined(PRE83)
266#  define EvalObj(interp, cmd) Tcl_EvalObj(interp,cmd)
267# else
268#  define EvalObj(interp, cmd) Tcl_EvalObjEx(interp,cmd,0)
269# endif
270# if defined(PRE81) && TCL_RELEASE_SERIAL<3
271#  define TclIsVarArgument(args) (args->isArg)
272# endif
273#endif
274
275#if 0
276#define XOTcl_FrameDecls CallFrame *oldFramePtr = 0, frame, *newFramePtr = &frame
277#define XOTcl_PushFrame(interp, obj) \
278     memset(newFramePtr, 0, sizeof(CallFrame)); \
279     oldFramePtr = ((Interp *)interp)->varFramePtr; \
280     if ((obj)->nsPtr) {				     \
281       newFramePtr->nsPtr = (Namespace*) (obj)->nsPtr;	     \
282     } else { \
283       newFramePtr->nsPtr = (Namespace*) RUNTIME_STATE(interp)->fakeNS; \
284       newFramePtr->isProcCallFrame = 1; \
285       newFramePtr->procPtr = &RUNTIME_STATE(interp)->fakeProc; \
286       newFramePtr->varTablePtr = (obj)->varTable;	    \
287     } \
288     ((Interp *)interp)->varFramePtr = newFramePtr; \
289     MEM_COUNT_OPEN_FRAME()
290#define XOTcl_PopFrame(interp, obj) \
291  if (!(obj)->nsPtr && (obj)->varTable == 0)	 \
292      (obj)->varTable = newFramePtr->varTablePtr;	 \
293     ((Interp *)interp)->varFramePtr = oldFramePtr; \
294     MEM_COUNT_CLOSE_FRAME()
295
296#else
297/* slightly slower version based on Tcl_PushCallFrame.
298   Note that it is possible that between push and pop
299   a obj->nsPtr can be created (e.g. during a read trace)
300*/
301#define XOTcl_FrameDecls TclCallFrame frame, *framePtr = &frame; int frame_constructed = 1
302#define XOTcl_PushFrame(interp,obj) \
303     if ((obj)->nsPtr) {				     \
304       frame_constructed = 0; \
305       Tcl_PushCallFrame(interp, (Tcl_CallFrame*)framePtr, (obj)->nsPtr, 0); \
306     } else { \
307       CallFrame *myframe = (CallFrame *)framePtr;		\
308       Tcl_PushCallFrame(interp, (Tcl_CallFrame*)framePtr, RUNTIME_STATE(interp)->fakeNS, 1);	\
309       Tcl_CallFrame_procPtr(myframe) = &RUNTIME_STATE(interp)->fakeProc;	\
310       Tcl_CallFrame_varTablePtr(myframe) = (obj)->varTable;	\
311     }
312#define XOTcl_PopFrame(interp,obj) \
313     if (!(obj)->nsPtr) {	       \
314       CallFrame *myframe = (CallFrame *)framePtr;		\
315       if ((obj)->varTable == 0)			    \
316         (obj)->varTable = Tcl_CallFrame_varTablePtr(myframe);	\
317     } \
318     if (frame_constructed) { \
319       Interp *iPtr = (Interp *) interp;  \
320       register CallFrame *myframe = iPtr->framePtr; \
321       Tcl_CallFrame_varTablePtr(myframe) = 0; \
322       Tcl_CallFrame_procPtr(myframe) = 0; \
323     } \
324     Tcl_PopCallFrame(interp)
325#endif
326
327
328#define INCR_REF_COUNT(A) MEM_COUNT_ALLOC("INCR_REF_COUNT",A); Tcl_IncrRefCount(A)
329
330#ifdef OBJDELETION_TRACE
331# define PRINTOBJ(ctx,obj) \
332  fprintf(stderr, "  %s %p %s oid=%p teardown=%p destroyCalled=%d\n", \
333	  ctx,obj,ObjStr(obj->cmdName), obj->id, obj->teardown, \
334	  (obj->flags & XOTCL_DESTROY_CALLED))
335#else
336# define PRINTOBJ(ctx,obj)
337#endif
338
339#define className(cl) (cl ? ObjStr(cl->object.cmdName) : "")
340
341
342#define LONG_AS_STRING 32
343
344/* TCL_CONTINUE is defined as 4, from 5 on we can
345   use app-specific return codes */
346#define XOTCL_CHECK_FAILED 6
347
348/* flags for call method */
349#define XOTCL_CM_NO_FILTERS 1
350#define XOTCL_CM_NO_UNKNOWN 2
351
352/*
353 *
354 * XOTcl Structures
355 *
356 */
357
358/*
359 * Filter structures
360 */
361typedef struct XOTclFilterStack {
362  Tcl_Command currentCmdPtr;
363  Tcl_Obj* calledProc;
364  struct XOTclFilterStack* next;
365} XOTclFilterStack;
366
367typedef struct XOTclTclObjList {
368  Tcl_Obj* content;
369  struct XOTclTclObjList* next;
370} XOTclTclObjList;
371
372/*
373 * Assertion structures
374 */
375
376typedef struct XOTclProcAssertion {
377  XOTclTclObjList* pre;
378  XOTclTclObjList* post;
379} XOTclProcAssertion;
380
381typedef struct XOTclAssertionStore {
382  XOTclTclObjList* invariants;
383  Tcl_HashTable procs;
384} XOTclAssertionStore;
385
386typedef enum { /* powers of 2; add to ALL, if default; */
387  CHECK_NONE  = 0, CHECK_CLINVAR = 1, CHECK_OBJINVAR = 2,
388  CHECK_PRE   = 4, CHECK_POST = 8,
389  CHECK_INVAR = CHECK_CLINVAR + CHECK_OBJINVAR,
390  CHECK_ALL   = CHECK_INVAR   + CHECK_PRE + CHECK_POST
391} CheckOptions;
392
393void XOTclAssertionRename(Tcl_Interp* interp, Tcl_Command cmd,
394			  XOTclAssertionStore *as,
395			  char *oldSimpleCmdName, char *newName);
396/*
397 * mixins
398 */
399typedef struct XOTclMixinStack {
400  Tcl_Command currentCmdPtr;
401  struct XOTclMixinStack* next;
402} XOTclMixinStack;
403
404/*
405 * Generic command pointer list
406 */
407typedef struct XOTclCmdList {
408  Tcl_Command cmdPtr;
409  ClientData clientData;
410  struct XOTclClass *clorobj;
411  struct XOTclCmdList* next;
412} XOTclCmdList;
413
414typedef void (XOTclFreeCmdListClientData) _ANSI_ARGS_((XOTclCmdList*));
415
416/* for incr string */
417typedef struct XOTclStringIncrStruct {
418  char *buffer;
419  char *start;
420  size_t bufSize;
421  int length;
422} XOTclStringIncrStruct;
423
424/*
425 * object flags ...
426 */
427
428/* DESTROY_CALLED indicates that destroy was called on obj */
429#define XOTCL_DESTROY_CALLED                 0x0001
430/* INIT_CALLED indicates that init was called on obj */
431#define XOTCL_INIT_CALLED                    0x0002
432/* MIXIN_ORDER_VALID set when mixin order is valid */
433#define XOTCL_MIXIN_ORDER_VALID              0x0004
434/* MIXIN_ORDER_DEFINED set, when mixins are defined for obj */
435#define XOTCL_MIXIN_ORDER_DEFINED            0x0008
436#define XOTCL_MIXIN_ORDER_DEFINED_AND_VALID  0x000c
437/* FILTER_ORDER_VALID set, when filter order is valid */
438#define XOTCL_FILTER_ORDER_VALID             0x0010
439/* FILTER_ORDER_DEFINED set, when filters are defined for obj */
440#define XOTCL_FILTER_ORDER_DEFINED           0x0020
441#define XOTCL_FILTER_ORDER_DEFINED_AND_VALID 0x0030
442/* IS_CLASS set, when object is a class */
443#define XOTCL_IS_CLASS                       0x0040
444/* DESTROYED set, when object is physically destroyed with PrimitiveODestroy  */
445#define XOTCL_DESTROYED                      0x0080
446#define XOTCL_REFCOUNTED                     0x0100
447#define XOTCL_RECREATE                       0x0200
448#define XOTCL_NS_DESTROYED                   0x0400
449#define XOTCL_TCL_DELETE                     0x0200
450#define XOTCL_FREE_TRACE_VAR_CALLED          0x2000
451
452#define XOTclObjectSetClass(obj) \
453	(obj)->flags |= XOTCL_IS_CLASS
454#define XOTclObjectClearClass(obj) \
455	(obj)->flags &= ~XOTCL_IS_CLASS
456#define XOTclObjectIsClass(obj) \
457	((obj)->flags & XOTCL_IS_CLASS)
458#define XOTclObjectToClass(obj) \
459	(XOTclClass*)((((XOTclObject*)obj)->flags & XOTCL_IS_CLASS)?obj:0)
460
461
462/*
463 * object and class internals
464 */
465
466typedef struct XOTclNonposArgs {
467  Tcl_Obj* nonposArgs;
468  Tcl_Obj* ordinaryArgs;
469} XOTclNonposArgs;
470
471typedef struct XOTclObjectOpt {
472  XOTclAssertionStore *assertions;
473  XOTclCmdList* filters;
474  XOTclCmdList* mixins;
475#ifdef XOTCL_METADATA
476  Tcl_HashTable metaData;
477#endif
478  ClientData clientData;
479  CONST char *volatileVarName;
480  short checkoptions;
481} XOTclObjectOpt;
482
483typedef struct XOTclObject {
484  Tcl_Obj *cmdName;
485  Tcl_Command id;
486  Tcl_Interp *teardown;
487  struct XOTclClass *cl;
488  TclVarHashTable *varTable;
489  Tcl_Namespace *nsPtr;
490  XOTclObjectOpt *opt;
491  struct XOTclCmdList *filterOrder;
492  struct XOTclCmdList *mixinOrder;
493  XOTclFilterStack *filterStack;
494  XOTclMixinStack *mixinStack;
495  int refCount;
496  short flags;
497  Tcl_HashTable *nonposArgsTable;
498} XOTclObject;
499
500typedef struct XOTclClassOpt {
501  XOTclCmdList* instfilters;
502  XOTclCmdList* instmixins;
503  XOTclCmdList* isObjectMixinOf;
504  XOTclCmdList* isClassMixinOf;
505  XOTclAssertionStore *assertions;
506  Tcl_Obj* parameterClass;
507#ifdef XOTCL_OBJECTDATA
508  Tcl_HashTable* objectdata;
509#endif
510  Tcl_Command id;
511  ClientData clientData;
512} XOTclClassOpt;
513
514typedef struct XOTclClass {
515  struct XOTclObject object;
516  struct XOTclClasses* super;
517  struct XOTclClasses* sub;
518  short color;
519  struct XOTclClasses* order;
520    /*struct XOTclClass* parent;*/
521  Tcl_HashTable instances;
522  Tcl_Namespace *nsPtr;
523  Tcl_Obj* parameters;
524  XOTclClassOpt* opt;
525  Tcl_HashTable *nonposArgsTable;
526} XOTclClass;
527
528typedef struct XOTclClasses {
529  struct XOTclClass* cl;
530  ClientData clientData;
531  struct XOTclClasses* next;
532} XOTclClasses;
533
534/* XOTcl global names and strings */
535/* these are names and contents for global (corresponding) Tcl_Objs
536   and Strings - otherwise these "constants" would have to be built
537   every time they are used; now they are built once in XOTcl_Init */
538typedef enum {
539    XOTE_EMPTY, XOTE_UNKNOWN, XOTE_CREATE, XOTE_DESTROY, XOTE_INSTDESTROY,
540    XOTE_ALLOC, XOTE_INIT, XOTE_INSTVAR, XOTE_INTERP, XOTE_AUTONAMES,
541    XOTE_ZERO, XOTE_ONE, XOTE_MOVE, XOTE_SELF, XOTE_CLASS, XOTE_RECREATE,
542    XOTE_SELF_CLASS, XOTE_SELF_PROC, XOTE_PARAM_CL,
543    XOTE_SEARCH_DEFAULTS, XOTE_EXIT_HANDLER,
544    XOTE_NON_POS_ARGS_CL, XOTE_NON_POS_ARGS_OBJ,
545    XOTE_CLEANUP, XOTE_CONFIGURE, XOTE_FILTER, XOTE_INSTFILTER,
546    XOTE_INSTPROC, XOTE_PROC, XOTE_INSTFORWARD, XOTE_FORWARD,
547    XOTE_INSTCMD, XOTE_CMD, XOTE_INSTPARAMETERCMD, XOTE_PARAMETERCMD,
548    XOTE_MKGETTERSETTER, XOTE_FORMAT,
549    XOTE_NEWOBJ, XOTE_GUARD_OPTION, XOTE_DEFAULTMETHOD,
550    XOTE___UNKNOWN, XOTE_ARGS, XOTE_SPLIT, XOTE_COMMA,
551    /** these are the redefined tcl commands; leave them
552	together at the end */
553    XOTE_EXPR, XOTE_INFO, XOTE_RENAME, XOTE_SUBST
554} XOTclGlobalNames;
555#if !defined(XOTCL_C)
556extern char *XOTclGlobalStrings[];
557#else
558char *XOTclGlobalStrings[] = {
559  "", "unknown", "create", "destroy", "instdestroy",
560  "alloc", "init", "instvar", "interp", "__autonames",
561  "0", "1", "move", "self", "class", "recreate",
562  "self class", "self proc", "::xotcl::Class::Parameter",
563  "searchDefaults", "__exitHandler",
564  "::xotcl::NonposArgs", "::xotcl::nonposArgs",
565  "cleanup", "configure", "filter", "instfilter",
566  "instproc", "proc", "instforward", "forward",
567  "instcmd", "cmd", "instparametercmd", "parametercmd",
568  "mkGetterSetter", "format",
569  "__#", "-guard", "defaultmethod",
570  "__unknown", "args", "split", ",",
571  "expr", "info", "rename", "subst",
572};
573#endif
574
575#define XOTclGlobalObjects RUNTIME_STATE(interp)->methodObjNames
576
577/* XOTcl ShadowTclCommands */
578typedef struct XOTclShadowTclCommandInfo {
579  TclObjCmdProcType proc;
580  ClientData cd;
581} XOTclShadowTclCommandInfo;
582typedef enum {SHADOW_LOAD=1, SHADOW_UNLOAD=0, SHADOW_REFETCH=2} XOTclShadowOperations;
583
584int XOTclCallCommand(Tcl_Interp* interp, XOTclGlobalNames name,
585		     int objc, Tcl_Obj *CONST objv[]);
586int XOTclShadowTclCommands(Tcl_Interp* interp, XOTclShadowOperations load);
587
588
589/*
590 * XOTcl CallStack
591 */
592typedef struct XOTclCallStackContent {
593  XOTclObject *self;
594  XOTclClass *cl;
595  Tcl_Command cmdPtr;
596  Tcl_Command destroyedCmd;
597  Tcl_CallFrame *currentFramePtr;
598  unsigned short frameType;
599  unsigned short callType;
600  XOTclFilterStack *filterStackEntry;
601} XOTclCallStackContent;
602
603#define XOTCL_CSC_TYPE_PLAIN 0
604#define XOTCL_CSC_TYPE_ACTIVE_MIXIN 1
605#define XOTCL_CSC_TYPE_ACTIVE_FILTER 2
606#define XOTCL_CSC_TYPE_INACTIVE 4
607#define XOTCL_CSC_TYPE_INACTIVE_MIXIN 5
608#define XOTCL_CSC_TYPE_INACTIVE_FILTER 6
609#define XOTCL_CSC_TYPE_GUARD 16
610
611#define XOTCL_CSC_CALL_IS_NEXT 1
612#define XOTCL_CSC_CALL_IS_DESTROY 2
613#define XOTCL_CSC_CALL_IS_GUARD 4
614
615typedef struct XOTclCallStack {
616  XOTclCallStackContent content[MAX_NESTING_DEPTH];
617  XOTclCallStackContent *top;
618  short guardCount;
619} XOTclCallStack;
620
621#if defined(PROFILE)
622typedef struct XOTclProfile {
623  long int overallTime;
624  Tcl_HashTable objectData;
625  Tcl_HashTable methodData;
626} XOTclProfile;
627#endif
628
629typedef struct XOTclRuntimeState {
630  XOTclCallStack cs;
631  Tcl_Namespace *XOTclClassesNS;
632  Tcl_Namespace *XOTclNS;
633  /*
634   * definitions of the main xotcl objects
635   */
636  XOTclClass *theObject;
637  XOTclClass *theClass;
638#if USE_INTERP_PROC
639  Tcl_CmdProc *interpProc;
640#endif
641  Tcl_ObjCmdProc *objInterpProc;
642  Tcl_Obj **methodObjNames;
643  struct XOTclShadowTclCommandInfo *tclCommands;
644  int errorCount;
645  /* these flags could move into a bitarray, but are used only once per interp*/
646  int callDestroy;
647  int callIsDestroy;
648  int unknown;
649  int doFilters;
650  int doSoftrecreate;
651  int exitHandlerDestroyRound;
652  int returnCode;
653  long newCounter;
654  XOTclStringIncrStruct iss;
655  Proc fakeProc;
656  Tcl_Namespace *fakeNS;
657  XotclStubs *xotclStubs;
658  Tcl_CallFrame *varFramePtr;
659  Command *cmdPtr;
660#if defined(PROFILE)
661  XOTclProfile profile;
662#endif
663  ClientData clientData;
664} XOTclRuntimeState;
665
666#define XOTCL_EXITHANDLER_OFF 0
667#define XOTCL_EXITHANDLER_ON_SOFT_DESTROY 1
668#define XOTCL_EXITHANDLER_ON_PHYSICAL_DESTROY 2
669
670
671#ifdef XOTCL_OBJECTDATA
672extern void
673XOTclSetObjectData(struct XOTclObject* obj, struct XOTclClass* cl,
674		  ClientData data);
675extern int
676XOTclGetObjectData(struct XOTclObject* obj, struct XOTclClass* cl,
677		  ClientData* data);
678extern int
679XOTclUnsetObjectData(struct XOTclObject* obj, struct XOTclClass* cl);
680extern void
681XOTclFreeObjectData(XOTclClass* cl);
682#endif
683
684/*
685 *
686 *  internally used API functions
687 *
688 */
689
690#include "xotclIntDecls.h"
691
692/*
693 * Profiling functions
694 */
695
696#if defined(PROFILE)
697extern void
698XOTclProfileFillTable(Tcl_HashTable* table, Tcl_DString* key,
699		 double totalMicroSec);
700extern void
701XOTclProfileEvaluateData(Tcl_Interp* interp, long int startSec, long int startUsec,
702		    XOTclObject* obj, XOTclClass *cl, char *methodName);
703extern void
704XOTclProfilePrintTable(Tcl_HashTable* table);
705
706extern void
707XOTclProfilePrintData(Tcl_Interp* interp);
708
709extern void
710XOTclProfileInit(Tcl_Interp* interp);
711#endif
712
713/*
714 * MEM Counting
715 */
716#ifdef XOTCL_MEM_COUNT
717void XOTclMemCountAlloc(char* id, void *);
718void XOTclMemCountFree(char* id, void *);
719void XOTclMemCountDump();
720#endif /* XOTCL_MEM_COUNT */
721/*
722 * old, deprecated meta-data command
723 */
724#if defined(XOTCL_METADATA)
725extern void
726XOTclMetaDataDestroy(XOTclObject* obj);
727extern void
728XOTclMetaDataInit(XOTclObject* obj);
729extern int
730XOTclOMetaDataMethod (ClientData cd, Tcl_Interp* interp,
731		      int objc, Tcl_Obj *objv[]);
732#endif /* XOTCL_METADATA */
733
734
735/*
736 * bytecode support
737 */
738#ifdef XOTCL_BYTECODE
739typedef struct XOTclCompEnv {
740  int bytecode;
741  Command *cmdPtr;
742  CompileProc *compileProc;
743  Tcl_ObjCmdProc *callProc;
744} XOTclCompEnv;
745
746typedef enum {INST_INITPROC, INST_NEXT, INST_SELF, INST_SELF_DISPATCH,
747	      LAST_INSTRUCTION} XOTclByteCodeInstructions;
748
749
750extern XOTclCompEnv *XOTclGetCompEnv();
751
752Tcl_ObjCmdProc XOTclInitProcNSCmd, XOTclSelfDispatchCmd,
753  XOTclNextObjCmd, XOTclGetSelfObjCmd;
754
755int XOTclDirectSelfDispatch(ClientData cd, Tcl_Interp* interp,
756		     int objc, Tcl_Obj *CONST objv[]);
757#endif
758
759int
760XOTclObjDispatch(ClientData cd, Tcl_Interp* interp,
761		 int objc, Tcl_Obj *CONST objv[]);
762
763XOTclCallStackContent *
764XOTclCallStackFindActiveFrame(Tcl_Interp* interp, int offset);
765
766XOTclCallStackContent *
767XOTclCallStackFindLastInvocation(Tcl_Interp* interp, int offset);
768
769/* functions from xotclUtil.c */
770char *XOTcl_ltoa(char *buf, long i, int *len);
771char *XOTclStringIncr(XOTclStringIncrStruct *iss);
772void XOTclStringIncrInit(XOTclStringIncrStruct *iss);
773void XOTclStringIncrFree(XOTclStringIncrStruct *iss);
774
775
776#if !defined(NDEBUG)
777/*# define XOTCLINLINE*/
778#endif
779
780
781/*** common win sermon ***/
782#undef TCL_STORAGE_CLASS
783#define TCL_STORAGE_CLASS DLLIMPORT
784
785#endif /* _xotcl_int_h_ */
786