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