1/* 2 * tclCompile.h -- 3 * 4 * Copyright (c) 1996-1998 Sun Microsystems, Inc. 5 * Copyright (c) 1998-2000 by Scriptics Corporation. 6 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. 7 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> 8 * 9 * See the file "license.terms" for information on usage and redistribution 10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 * 12 * RCS: @(#) $Id: tclCompile.h,v 1.33.2.2 2007/09/13 15:28:11 das Exp $ 13 */ 14 15#ifndef _TCLCOMPILATION 16#define _TCLCOMPILATION 1 17 18#ifndef _TCLINT 19#include "tclInt.h" 20#endif /* _TCLINT */ 21 22#ifdef BUILD_tcl 23# undef TCL_STORAGE_CLASS 24# define TCL_STORAGE_CLASS DLLEXPORT 25#endif 26 27/* 28 *------------------------------------------------------------------------ 29 * Variables related to compilation. These are used in tclCompile.c, 30 * tclExecute.c, tclBasic.c, and their clients. 31 *------------------------------------------------------------------------ 32 */ 33 34#ifdef TCL_COMPILE_DEBUG 35/* 36 * Variable that controls whether compilation tracing is enabled and, if so, 37 * what level of tracing is desired: 38 * 0: no compilation tracing 39 * 1: summarize compilation of top level cmds and proc bodies 40 * 2: display all instructions of each ByteCode compiled 41 * This variable is linked to the Tcl variable "tcl_traceCompile". 42 */ 43 44extern int tclTraceCompile; 45#endif 46 47#ifdef TCL_COMPILE_DEBUG 48/* 49 * Variable that controls whether execution tracing is enabled and, if so, 50 * what level of tracing is desired: 51 * 0: no execution tracing 52 * 1: trace invocations of Tcl procs only 53 * 2: trace invocations of all (not compiled away) commands 54 * 3: display each instruction executed 55 * This variable is linked to the Tcl variable "tcl_traceExec". 56 */ 57 58extern int tclTraceExec; 59#endif 60 61/* 62 *------------------------------------------------------------------------ 63 * Data structures related to compilation. 64 *------------------------------------------------------------------------ 65 */ 66 67/* 68 * The structure used to implement Tcl "exceptions" (exceptional returns): 69 * for example, those generated in loops by the break and continue commands, 70 * and those generated by scripts and caught by the catch command. This 71 * ExceptionRange structure describes a range of code (e.g., a loop body), 72 * the kind of exceptions (e.g., a break or continue) that might occur, and 73 * the PC offsets to jump to if a matching exception does occur. Exception 74 * ranges can nest so this structure includes a nesting level that is used 75 * at runtime to find the closest exception range surrounding a PC. For 76 * example, when a break command is executed, the ExceptionRange structure 77 * for the most deeply nested loop, if any, is found and used. These 78 * structures are also generated for the "next" subcommands of for loops 79 * since a break there terminates the for command. This means a for command 80 * actually generates two LoopInfo structures. 81 */ 82 83typedef enum { 84 LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. 85 * Break and continue "exceptions" cause 86 * jumps to appropriate PC offsets. */ 87 CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a 88 * catch command. Errors in the range cause 89 * a jump to a catch PC offset. */ 90} ExceptionRangeType; 91 92typedef struct ExceptionRange { 93 ExceptionRangeType type; /* The kind of ExceptionRange. */ 94 int nestingLevel; /* Static depth of the exception range. 95 * Used to find the most deeply-nested 96 * range surrounding a PC at runtime. */ 97 int codeOffset; /* Offset of the first instruction byte of 98 * the code range. */ 99 int numCodeBytes; /* Number of bytes in the code range. */ 100 int breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC 101 * offset for a break command in the range. */ 102 int continueOffset; /* If LOOP_EXCEPTION_RANGE and not -1, the 103 * target PC offset for a continue command in 104 * the code range. Otherwise, ignore this range 105 * when processing a continue command. */ 106 int catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC 107 * offset for any "exception" in range. */ 108} ExceptionRange; 109 110/* 111 * Structure used to map between instruction pc and source locations. It 112 * defines for each compiled Tcl command its code's starting offset and 113 * its source's starting offset and length. Note that the code offset 114 * increases monotonically: that is, the table is sorted in code offset 115 * order. The source offset is not monotonic. 116 */ 117 118typedef struct CmdLocation { 119 int codeOffset; /* Offset of first byte of command code. */ 120 int numCodeBytes; /* Number of bytes for command's code. */ 121 int srcOffset; /* Offset of first char of the command. */ 122 int numSrcBytes; /* Number of command source chars. */ 123} CmdLocation; 124 125#ifdef TCL_TIP280 126/* 127 * TIP #280 128 * Structure to record additional location information for byte code. 129 * This information is internal and not saved. I.e. tbcload'ed code 130 * will not have this information. It records the lines for all words 131 * of all commands found in the byte code. The association with a 132 * ByteCode structure BC is done through the 'lineBCPtr' HashTable in 133 * Interp, keyed by the address of BC. Also recorded is information 134 * coming from the context, i.e. type of the frame and associated 135 * information, like the path of a sourced file. 136 */ 137 138typedef struct ECL { 139 int srcOffset; /* cmd location to find the entry */ 140 int nline; /* Number of words in the command */ 141 int* line; /* line information for all words in the command */ 142 int** next; /* Transient information during compile, ICL tracking */ 143} ECL; 144 145typedef struct ExtCmdLoc { 146 int type; /* Context type */ 147 Tcl_Obj* path; /* Path of the sourced file the command is in */ 148 ECL* loc; /* Command word locations (lines) */ 149 int nloc; /* Number of allocated entries in 'loc' */ 150 int nuloc; /* Number of used entries in 'loc' */ 151 Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the 152 * information accessible per command and 153 * argument, not per whole bytecode. Value is 154 * index of command in 'loc', giving us the 155 * literals to associate with line 156 * information as command argument, see 157 * TclArgumentBCEnter() */ 158} ExtCmdLoc; 159#endif 160 161/* 162 * CompileProcs need the ability to record information during compilation 163 * that can be used by bytecode instructions during execution. The AuxData 164 * structure provides this "auxiliary data" mechanism. An arbitrary number 165 * of these structures can be stored in the ByteCode record (during 166 * compilation they are stored in a CompileEnv structure). Each AuxData 167 * record holds one word of client-specified data (often a pointer) and is 168 * given an index that instructions can later use to look up the structure 169 * and its data. 170 * 171 * The following definitions declare the types of procedures that are called 172 * to duplicate or free this auxiliary data when the containing ByteCode 173 * objects are duplicated and freed. Pointers to these procedures are kept 174 * in the AuxData structure. 175 */ 176 177typedef ClientData (AuxDataDupProc) _ANSI_ARGS_((ClientData clientData)); 178typedef void (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData)); 179 180/* 181 * We define a separate AuxDataType struct to hold type-related information 182 * for the AuxData structure. This separation makes it possible for clients 183 * outside of the TCL core to manipulate (in a limited fashion!) AuxData; 184 * for example, it makes it possible to pickle and unpickle AuxData structs. 185 */ 186 187typedef struct AuxDataType { 188 char *name; /* the name of the type. Types can be 189 * registered and found by name */ 190 AuxDataDupProc *dupProc; /* Callback procedure to invoke when the 191 * aux data is duplicated (e.g., when the 192 * ByteCode structure containing the aux 193 * data is duplicated). NULL means just 194 * copy the source clientData bits; no 195 * proc need be called. */ 196 AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the 197 * aux data is freed. NULL means no 198 * proc need be called. */ 199} AuxDataType; 200 201/* 202 * The definition of the AuxData structure that holds information created 203 * during compilation by CompileProcs and used by instructions during 204 * execution. 205 */ 206 207typedef struct AuxData { 208 AuxDataType *type; /* pointer to the AuxData type associated with 209 * this ClientData. */ 210 ClientData clientData; /* The compilation data itself. */ 211} AuxData; 212 213/* 214 * Structure defining the compilation environment. After compilation, fields 215 * describing bytecode instructions are copied out into the more compact 216 * ByteCode structure defined below. 217 */ 218 219#define COMPILEENV_INIT_CODE_BYTES 250 220#define COMPILEENV_INIT_NUM_OBJECTS 60 221#define COMPILEENV_INIT_EXCEPT_RANGES 5 222#define COMPILEENV_INIT_CMD_MAP_SIZE 40 223#define COMPILEENV_INIT_AUX_DATA_SIZE 5 224 225typedef struct CompileEnv { 226 Interp *iPtr; /* Interpreter containing the code being 227 * compiled. Commands and their compile 228 * procs are specific to an interpreter so 229 * the code emitted will depend on the 230 * interpreter. */ 231 char *source; /* The source string being compiled by 232 * SetByteCodeFromAny. This pointer is not 233 * owned by the CompileEnv and must not be 234 * freed or changed by it. */ 235 int numSrcBytes; /* Number of bytes in source. */ 236 Proc *procPtr; /* If a procedure is being compiled, a 237 * pointer to its Proc structure; otherwise 238 * NULL. Used to compile local variables. 239 * Set from information provided by 240 * ObjInterpProc in tclProc.c. */ 241 int numCommands; /* Number of commands compiled. */ 242 int exceptDepth; /* Current exception range nesting level; 243 * -1 if not in any range currently. */ 244 int maxExceptDepth; /* Max nesting level of exception ranges; 245 * -1 if no ranges have been compiled. */ 246 int maxStackDepth; /* Maximum number of stack elements needed 247 * to execute the code. Set by compilation 248 * procedures before returning. */ 249 int currStackDepth; /* Current stack depth. */ 250 LiteralTable localLitTable; /* Contains LiteralEntry's describing 251 * all Tcl objects referenced by this 252 * compiled code. Indexed by the string 253 * representations of the literals. Used to 254 * avoid creating duplicate objects. */ 255 unsigned char *codeStart; /* Points to the first byte of the code. */ 256 unsigned char *codeNext; /* Points to next code array byte to use. */ 257 unsigned char *codeEnd; /* Points just after the last allocated 258 * code array byte. */ 259 int mallocedCodeArray; /* Set 1 if code array was expanded 260 * and codeStart points into the heap.*/ 261 LiteralEntry *literalArrayPtr; 262 /* Points to start of LiteralEntry array. */ 263 int literalArrayNext; /* Index of next free object array entry. */ 264 int literalArrayEnd; /* Index just after last obj array entry. */ 265 int mallocedLiteralArray; /* 1 if object array was expanded and 266 * objArray points into the heap, else 0. */ 267 ExceptionRange *exceptArrayPtr; 268 /* Points to start of the ExceptionRange 269 * array. */ 270 int exceptArrayNext; /* Next free ExceptionRange array index. 271 * exceptArrayNext is the number of ranges 272 * and (exceptArrayNext-1) is the index of 273 * the current range's array entry. */ 274 int exceptArrayEnd; /* Index after the last ExceptionRange 275 * array entry. */ 276 int mallocedExceptArray; /* 1 if ExceptionRange array was expanded 277 * and exceptArrayPtr points in heap, 278 * else 0. */ 279 CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array. 280 * numCommands is the index of the next 281 * entry to use; (numCommands-1) is the 282 * entry index for the last command. */ 283 int cmdMapEnd; /* Index after last CmdLocation entry. */ 284 int mallocedCmdMap; /* 1 if command map array was expanded and 285 * cmdMapPtr points in the heap, else 0. */ 286 AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */ 287 int auxDataArrayNext; /* Next free compile aux data array index. 288 * auxDataArrayNext is the number of aux 289 * data items and (auxDataArrayNext-1) is 290 * index of current aux data array entry. */ 291 int auxDataArrayEnd; /* Index after last aux data array entry. */ 292 int mallocedAuxDataArray; /* 1 if aux data array was expanded and 293 * auxDataArrayPtr points in heap else 0. */ 294 unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES]; 295 /* Initial storage for code. */ 296 LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS]; 297 /* Initial storage of LiteralEntry array. */ 298 ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; 299 /* Initial ExceptionRange array storage. */ 300 CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE]; 301 /* Initial storage for cmd location map. */ 302 AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE]; 303 /* Initial storage for aux data array. */ 304#ifdef TCL_TIP280 305 /* TIP #280 */ 306 ExtCmdLoc* extCmdMapPtr; /* Extended command location information 307 * for 'info frame'. */ 308 int line; /* First line of the script, based on the 309 * invoking context, then the line of the 310 * command currently compiled. */ 311 ContLineLoc* clLoc; /* If not NULL, the table holding the 312 * locations of the invisible continuation 313 * lines in the input script, to adjust the 314 * line counter. */ 315 int* clNext; /* If not NULL, it refers to the next slot in 316 * clLoc to check for an invisible 317 * continuation line. */ 318#endif 319} CompileEnv; 320 321/* 322 * The structure defining the bytecode instructions resulting from compiling 323 * a Tcl script. Note that this structure is variable length: a single heap 324 * object is allocated to hold the ByteCode structure immediately followed 325 * by the code bytes, the literal object array, the ExceptionRange array, 326 * the CmdLocation map, and the compilation AuxData array. 327 */ 328 329/* 330 * A PRECOMPILED bytecode struct is one that was generated from a compiled 331 * image rather than implicitly compiled from source 332 */ 333#define TCL_BYTECODE_PRECOMPILED 0x0001 334 335typedef struct ByteCode { 336 TclHandle interpHandle; /* Handle for interpreter containing the 337 * compiled code. Commands and their compile 338 * procs are specific to an interpreter so the 339 * code emitted will depend on the 340 * interpreter. */ 341 int compileEpoch; /* Value of iPtr->compileEpoch when this 342 * ByteCode was compiled. Used to invalidate 343 * code when, e.g., commands with compile 344 * procs are redefined. */ 345 Namespace *nsPtr; /* Namespace context in which this code 346 * was compiled. If the code is executed 347 * if a different namespace, it must be 348 * recompiled. */ 349 int nsEpoch; /* Value of nsPtr->resolverEpoch when this 350 * ByteCode was compiled. Used to invalidate 351 * code when new namespace resolution rules 352 * are put into effect. */ 353 int refCount; /* Reference count: set 1 when created 354 * plus 1 for each execution of the code 355 * currently active. This structure can be 356 * freed when refCount becomes zero. */ 357 unsigned int flags; /* flags describing state for the codebyte. 358 * this variable holds ORed values from the 359 * TCL_BYTECODE_ masks defined above */ 360 char *source; /* The source string from which this 361 * ByteCode was compiled. Note that this 362 * pointer is not owned by the ByteCode and 363 * must not be freed or modified by it. */ 364 Proc *procPtr; /* If the ByteCode was compiled from a 365 * procedure body, this is a pointer to its 366 * Proc structure; otherwise NULL. This 367 * pointer is also not owned by the ByteCode 368 * and must not be freed by it. */ 369 size_t structureSize; /* Number of bytes in the ByteCode structure 370 * itself. Does not include heap space for 371 * literal Tcl objects or storage referenced 372 * by AuxData entries. */ 373 int numCommands; /* Number of commands compiled. */ 374 int numSrcBytes; /* Number of source bytes compiled. */ 375 int numCodeBytes; /* Number of code bytes. */ 376 int numLitObjects; /* Number of objects in literal array. */ 377 int numExceptRanges; /* Number of ExceptionRange array elems. */ 378 int numAuxDataItems; /* Number of AuxData items. */ 379 int numCmdLocBytes; /* Number of bytes needed for encoded 380 * command location information. */ 381 int maxExceptDepth; /* Maximum nesting level of ExceptionRanges; 382 * -1 if no ranges were compiled. */ 383 int maxStackDepth; /* Maximum number of stack elements needed 384 * to execute the code. */ 385 unsigned char *codeStart; /* Points to the first byte of the code. 386 * This is just after the final ByteCode 387 * member cmdMapPtr. */ 388 Tcl_Obj **objArrayPtr; /* Points to the start of the literal 389 * object array. This is just after the 390 * last code byte. */ 391 ExceptionRange *exceptArrayPtr; 392 /* Points to the start of the ExceptionRange 393 * array. This is just after the last 394 * object in the object array. */ 395 AuxData *auxDataArrayPtr; /* Points to the start of the auxiliary data 396 * array. This is just after the last entry 397 * in the ExceptionRange array. */ 398 unsigned char *codeDeltaStart; 399 /* Points to the first of a sequence of 400 * bytes that encode the change in the 401 * starting offset of each command's code. 402 * If -127<=delta<=127, it is encoded as 1 403 * byte, otherwise 0xFF (128) appears and 404 * the delta is encoded by the next 4 bytes. 405 * Code deltas are always positive. This 406 * sequence is just after the last entry in 407 * the AuxData array. */ 408 unsigned char *codeLengthStart; 409 /* Points to the first of a sequence of 410 * bytes that encode the length of each 411 * command's code. The encoding is the same 412 * as for code deltas. Code lengths are 413 * always positive. This sequence is just 414 * after the last entry in the code delta 415 * sequence. */ 416 unsigned char *srcDeltaStart; 417 /* Points to the first of a sequence of 418 * bytes that encode the change in the 419 * starting offset of each command's source. 420 * The encoding is the same as for code 421 * deltas. Source deltas can be negative. 422 * This sequence is just after the last byte 423 * in the code length sequence. */ 424 unsigned char *srcLengthStart; 425 /* Points to the first of a sequence of 426 * bytes that encode the length of each 427 * command's source. The encoding is the 428 * same as for code deltas. Source lengths 429 * are always positive. This sequence is 430 * just after the last byte in the source 431 * delta sequence. */ 432#ifdef TCL_COMPILE_STATS 433 Tcl_Time createTime; /* Absolute time when the ByteCode was 434 * created. */ 435#endif /* TCL_COMPILE_STATS */ 436} ByteCode; 437 438/* 439 * Opcodes for the Tcl bytecode instructions. These must correspond to 440 * the entries in the table of instruction descriptions, 441 * tclInstructionTable, in tclCompile.c. Also, the order and number of 442 * the expression opcodes (e.g., INST_LOR) must match the entries in 443 * the array operatorStrings in tclExecute.c. 444 */ 445 446/* Opcodes 0 to 9 */ 447#define INST_DONE 0 448#define INST_PUSH1 1 449#define INST_PUSH4 2 450#define INST_POP 3 451#define INST_DUP 4 452#define INST_CONCAT1 5 453#define INST_INVOKE_STK1 6 454#define INST_INVOKE_STK4 7 455#define INST_EVAL_STK 8 456#define INST_EXPR_STK 9 457 458/* Opcodes 10 to 23 */ 459#define INST_LOAD_SCALAR1 10 460#define INST_LOAD_SCALAR4 11 461#define INST_LOAD_SCALAR_STK 12 462#define INST_LOAD_ARRAY1 13 463#define INST_LOAD_ARRAY4 14 464#define INST_LOAD_ARRAY_STK 15 465#define INST_LOAD_STK 16 466#define INST_STORE_SCALAR1 17 467#define INST_STORE_SCALAR4 18 468#define INST_STORE_SCALAR_STK 19 469#define INST_STORE_ARRAY1 20 470#define INST_STORE_ARRAY4 21 471#define INST_STORE_ARRAY_STK 22 472#define INST_STORE_STK 23 473 474/* Opcodes 24 to 33 */ 475#define INST_INCR_SCALAR1 24 476#define INST_INCR_SCALAR_STK 25 477#define INST_INCR_ARRAY1 26 478#define INST_INCR_ARRAY_STK 27 479#define INST_INCR_STK 28 480#define INST_INCR_SCALAR1_IMM 29 481#define INST_INCR_SCALAR_STK_IMM 30 482#define INST_INCR_ARRAY1_IMM 31 483#define INST_INCR_ARRAY_STK_IMM 32 484#define INST_INCR_STK_IMM 33 485 486/* Opcodes 34 to 39 */ 487#define INST_JUMP1 34 488#define INST_JUMP4 35 489#define INST_JUMP_TRUE1 36 490#define INST_JUMP_TRUE4 37 491#define INST_JUMP_FALSE1 38 492#define INST_JUMP_FALSE4 39 493 494/* Opcodes 40 to 64 */ 495#define INST_LOR 40 496#define INST_LAND 41 497#define INST_BITOR 42 498#define INST_BITXOR 43 499#define INST_BITAND 44 500#define INST_EQ 45 501#define INST_NEQ 46 502#define INST_LT 47 503#define INST_GT 48 504#define INST_LE 49 505#define INST_GE 50 506#define INST_LSHIFT 51 507#define INST_RSHIFT 52 508#define INST_ADD 53 509#define INST_SUB 54 510#define INST_MULT 55 511#define INST_DIV 56 512#define INST_MOD 57 513#define INST_UPLUS 58 514#define INST_UMINUS 59 515#define INST_BITNOT 60 516#define INST_LNOT 61 517#define INST_CALL_BUILTIN_FUNC1 62 518#define INST_CALL_FUNC1 63 519#define INST_TRY_CVT_TO_NUMERIC 64 520 521/* Opcodes 65 to 66 */ 522#define INST_BREAK 65 523#define INST_CONTINUE 66 524 525/* Opcodes 67 to 68 */ 526#define INST_FOREACH_START4 67 527#define INST_FOREACH_STEP4 68 528 529/* Opcodes 69 to 72 */ 530#define INST_BEGIN_CATCH4 69 531#define INST_END_CATCH 70 532#define INST_PUSH_RESULT 71 533#define INST_PUSH_RETURN_CODE 72 534 535/* Opcodes 73 to 78 */ 536#define INST_STR_EQ 73 537#define INST_STR_NEQ 74 538#define INST_STR_CMP 75 539#define INST_STR_LEN 76 540#define INST_STR_INDEX 77 541#define INST_STR_MATCH 78 542 543/* Opcodes 78 to 81 */ 544#define INST_LIST 79 545#define INST_LIST_INDEX 80 546#define INST_LIST_LENGTH 81 547 548/* Opcodes 82 to 87 */ 549#define INST_APPEND_SCALAR1 82 550#define INST_APPEND_SCALAR4 83 551#define INST_APPEND_ARRAY1 84 552#define INST_APPEND_ARRAY4 85 553#define INST_APPEND_ARRAY_STK 86 554#define INST_APPEND_STK 87 555 556/* Opcodes 88 to 93 */ 557#define INST_LAPPEND_SCALAR1 88 558#define INST_LAPPEND_SCALAR4 89 559#define INST_LAPPEND_ARRAY1 90 560#define INST_LAPPEND_ARRAY4 91 561#define INST_LAPPEND_ARRAY_STK 92 562#define INST_LAPPEND_STK 93 563 564/* TIP #22 - LINDEX operator with flat arg list */ 565 566#define INST_LIST_INDEX_MULTI 94 567 568/* 569 * TIP #33 - 'lset' command. Code gen also required a Forth-like 570 * OVER operation. 571 */ 572 573#define INST_OVER 95 574#define INST_LSET_LIST 96 575#define INST_LSET_FLAT 97 576 577/* The last opcode */ 578#define LAST_INST_OPCODE 97 579 580/* 581 * Table describing the Tcl bytecode instructions: their name (for 582 * displaying code), total number of code bytes required (including 583 * operand bytes), and a description of the type of each operand. 584 * These operand types include signed and unsigned integers of length 585 * one and four bytes. The unsigned integers are used for indexes or 586 * for, e.g., the count of objects to push in a "push" instruction. 587 */ 588 589#define MAX_INSTRUCTION_OPERANDS 2 590 591typedef enum InstOperandType { 592 OPERAND_NONE, 593 OPERAND_INT1, /* One byte signed integer. */ 594 OPERAND_INT4, /* Four byte signed integer. */ 595 OPERAND_UINT1, /* One byte unsigned integer. */ 596 OPERAND_UINT4 /* Four byte unsigned integer. */ 597} InstOperandType; 598 599typedef struct InstructionDesc { 600 char *name; /* Name of instruction. */ 601 int numBytes; /* Total number of bytes for instruction. */ 602 int stackEffect; /* The worst-case balance stack effect of the 603 * instruction, used for stack requirements 604 * computations. The value INT_MIN signals 605 * that the instruction's worst case effect 606 * is (1-opnd1). 607 */ 608 int numOperands; /* Number of operands. */ 609 InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS]; 610 /* The type of each operand. */ 611} InstructionDesc; 612 613extern InstructionDesc tclInstructionTable[]; 614 615/* 616 * Definitions of the values of the INST_CALL_BUILTIN_FUNC instruction's 617 * operand byte. Each value denotes a builtin Tcl math function. These 618 * values must correspond to the entries in the tclBuiltinFuncTable array 619 * below and to the values stored in the tclInt.h MathFunc structure's 620 * builtinFuncIndex field. 621 */ 622 623#define BUILTIN_FUNC_ACOS 0 624#define BUILTIN_FUNC_ASIN 1 625#define BUILTIN_FUNC_ATAN 2 626#define BUILTIN_FUNC_ATAN2 3 627#define BUILTIN_FUNC_CEIL 4 628#define BUILTIN_FUNC_COS 5 629#define BUILTIN_FUNC_COSH 6 630#define BUILTIN_FUNC_EXP 7 631#define BUILTIN_FUNC_FLOOR 8 632#define BUILTIN_FUNC_FMOD 9 633#define BUILTIN_FUNC_HYPOT 10 634#define BUILTIN_FUNC_LOG 11 635#define BUILTIN_FUNC_LOG10 12 636#define BUILTIN_FUNC_POW 13 637#define BUILTIN_FUNC_SIN 14 638#define BUILTIN_FUNC_SINH 15 639#define BUILTIN_FUNC_SQRT 16 640#define BUILTIN_FUNC_TAN 17 641#define BUILTIN_FUNC_TANH 18 642#define BUILTIN_FUNC_ABS 19 643#define BUILTIN_FUNC_DOUBLE 20 644#define BUILTIN_FUNC_INT 21 645#define BUILTIN_FUNC_RAND 22 646#define BUILTIN_FUNC_ROUND 23 647#define BUILTIN_FUNC_SRAND 24 648#define BUILTIN_FUNC_WIDE 25 649 650#define LAST_BUILTIN_FUNC 25 651 652/* 653 * Table describing the built-in math functions. Entries in this table are 654 * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's 655 * operand byte. 656 */ 657 658typedef int (CallBuiltinFuncProc) _ANSI_ARGS_((Tcl_Interp *interp, 659 ExecEnv *eePtr, ClientData clientData)); 660 661typedef struct { 662 char *name; /* Name of function. */ 663 int numArgs; /* Number of arguments for function. */ 664 Tcl_ValueType argTypes[MAX_MATH_ARGS]; 665 /* Acceptable types for each argument. */ 666 CallBuiltinFuncProc *proc; /* Procedure implementing this function. */ 667 ClientData clientData; /* Additional argument to pass to the 668 * function when invoking it. */ 669} BuiltinFunc; 670 671extern BuiltinFunc tclBuiltinFuncTable[]; 672 673/* 674 * Compilation of some Tcl constructs such as if commands and the logical or 675 * (||) and logical and (&&) operators in expressions requires the 676 * generation of forward jumps. Since the PC target of these jumps isn't 677 * known when the jumps are emitted, we record the offset of each jump in an 678 * array of JumpFixup structures. There is one array for each sequence of 679 * jumps to one target PC. When we learn the target PC, we update the jumps 680 * with the correct distance. Also, if the distance is too great (> 127 681 * bytes), we replace the single-byte jump with a four byte jump 682 * instruction, move the instructions after the jump down, and update the 683 * code offsets for any commands between the jump and the target. 684 */ 685 686typedef enum { 687 TCL_UNCONDITIONAL_JUMP, 688 TCL_TRUE_JUMP, 689 TCL_FALSE_JUMP 690} TclJumpType; 691 692typedef struct JumpFixup { 693 TclJumpType jumpType; /* Indicates the kind of jump. */ 694 int codeOffset; /* Offset of the first byte of the one-byte 695 * forward jump's code. */ 696 int cmdIndex; /* Index of the first command after the one 697 * for which the jump was emitted. Used to 698 * update the code offsets for subsequent 699 * commands if the two-byte jump at jumpPc 700 * must be replaced with a five-byte one. */ 701 int exceptIndex; /* Index of the first range entry in the 702 * ExceptionRange array after the current 703 * one. This field is used to adjust the 704 * code offsets in subsequent ExceptionRange 705 * records when a jump is grown from 2 bytes 706 * to 5 bytes. */ 707} JumpFixup; 708 709#define JUMPFIXUP_INIT_ENTRIES 10 710 711typedef struct JumpFixupArray { 712 JumpFixup *fixup; /* Points to start of jump fixup array. */ 713 int next; /* Index of next free array entry. */ 714 int end; /* Index of last usable entry in array. */ 715 int mallocedArray; /* 1 if array was expanded and fixups points 716 * into the heap, else 0. */ 717 JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES]; 718 /* Initial storage for jump fixup array. */ 719} JumpFixupArray; 720 721/* 722 * The structure describing one variable list of a foreach command. Note 723 * that only foreach commands inside procedure bodies are compiled inline so 724 * a ForeachVarList structure always describes local variables. Furthermore, 725 * only scalar variables are supported for inline-compiled foreach loops. 726 */ 727 728typedef struct ForeachVarList { 729 int numVars; /* The number of variables in the list. */ 730 int varIndexes[1]; /* An array of the indexes ("slot numbers") 731 * for each variable in the procedure's 732 * array of local variables. Only scalar 733 * variables are supported. The actual 734 * size of this field will be large enough 735 * to numVars indexes. THIS MUST BE THE 736 * LAST FIELD IN THE STRUCTURE! */ 737} ForeachVarList; 738 739/* 740 * Structure used to hold information about a foreach command that is needed 741 * during program execution. These structures are stored in CompileEnv and 742 * ByteCode structures as auxiliary data. 743 */ 744 745typedef struct ForeachInfo { 746 int numLists; /* The number of both the variable and value 747 * lists of the foreach command. */ 748 int firstValueTemp; /* Index of the first temp var in a proc 749 * frame used to point to a value list. */ 750 int loopCtTemp; /* Index of temp var in a proc frame 751 * holding the loop's iteration count. Used 752 * to determine next value list element to 753 * assign each loop var. */ 754 ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList 755 * structures describing each var list. The 756 * actual size of this field will be large 757 * enough to numVars indexes. THIS MUST BE 758 * THE LAST FIELD IN THE STRUCTURE! */ 759} ForeachInfo; 760 761extern AuxDataType tclForeachInfoType; 762 763 764/* 765 *---------------------------------------------------------------- 766 * Procedures exported by tclBasic.c to be used within the engine. 767 *---------------------------------------------------------------- 768 */ 769 770EXTERN int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc, 771 Tcl_Obj *CONST objv[], CONST char *command, int length, 772 int flags)); 773EXTERN int TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp)); 774 775 776/* 777 *---------------------------------------------------------------- 778 * Procedures exported by the engine to be used by tclBasic.c 779 *---------------------------------------------------------------- 780 */ 781 782#ifndef TCL_TIP280 783EXTERN int TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp, 784 Tcl_Obj *objPtr)); 785#else 786EXTERN int TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp, 787 Tcl_Obj *objPtr, CONST CmdFrame* invoker, 788 int word)); 789#endif 790 791/* 792 *---------------------------------------------------------------- 793 * Procedures shared among Tcl bytecode compilation and execution 794 * modules but not used outside: 795 *---------------------------------------------------------------- 796 */ 797 798EXTERN void TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr)); 799EXTERN int TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp, 800 Tcl_Token *tokenPtr, int count, 801 CompileEnv *envPtr)); 802EXTERN int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp, 803 CONST char *script, int numBytes, 804 CompileEnv *envPtr)); 805EXTERN int TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp, 806 Tcl_Token *tokenPtr, int numWords, 807 CompileEnv *envPtr)); 808EXTERN int TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp, 809 CONST char *script, int numBytes, int nested, 810 CompileEnv *envPtr)); 811EXTERN int TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp, 812 Tcl_Token *tokenPtr, int count, 813 CompileEnv *envPtr)); 814EXTERN int TclCreateAuxData _ANSI_ARGS_((ClientData clientData, 815 AuxDataType *typePtr, CompileEnv *envPtr)); 816EXTERN int TclCreateExceptRange _ANSI_ARGS_(( 817 ExceptionRangeType type, CompileEnv *envPtr)); 818EXTERN ExecEnv * TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp)); 819EXTERN void TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr)); 820EXTERN void TclDeleteLiteralTable _ANSI_ARGS_(( 821 Tcl_Interp *interp, LiteralTable *tablePtr)); 822EXTERN void TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr, 823 TclJumpType jumpType, JumpFixup *jumpFixupPtr)); 824EXTERN ExceptionRange * TclGetExceptionRangeForPc _ANSI_ARGS_(( 825 unsigned char *pc, int catchOnly, 826 ByteCode* codePtr)); 827EXTERN void TclExpandJumpFixupArray _ANSI_ARGS_(( 828 JumpFixupArray *fixupArrayPtr)); 829EXTERN void TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void)); 830EXTERN int TclFindCompiledLocal _ANSI_ARGS_((CONST char *name, 831 int nameChars, int create, int flags, 832 Proc *procPtr)); 833EXTERN LiteralEntry * TclLookupLiteralEntry _ANSI_ARGS_(( 834 Tcl_Interp *interp, Tcl_Obj *objPtr)); 835EXTERN int TclFixupForwardJump _ANSI_ARGS_(( 836 CompileEnv *envPtr, JumpFixup *jumpFixupPtr, 837 int jumpDist, int distThreshold)); 838EXTERN void TclFreeCompileEnv _ANSI_ARGS_((CompileEnv *envPtr)); 839EXTERN void TclFreeJumpFixupArray _ANSI_ARGS_(( 840 JumpFixupArray *fixupArrayPtr)); 841EXTERN void TclInitAuxDataTypeTable _ANSI_ARGS_((void)); 842EXTERN void TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr, 843 CompileEnv *envPtr)); 844EXTERN void TclInitCompilation _ANSI_ARGS_((void)); 845#ifndef TCL_TIP280 846EXTERN void TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp, 847 CompileEnv *envPtr, char *string, 848 int numBytes)); 849#else 850EXTERN void TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp, 851 CompileEnv *envPtr, char *string, 852 int numBytes, CONST CmdFrame* invoker, int word)); 853#endif 854EXTERN void TclInitJumpFixupArray _ANSI_ARGS_(( 855 JumpFixupArray *fixupArrayPtr)); 856EXTERN void TclInitLiteralTable _ANSI_ARGS_(( 857 LiteralTable *tablePtr)); 858#ifdef TCL_COMPILE_STATS 859EXTERN char * TclLiteralStats _ANSI_ARGS_(( 860 LiteralTable *tablePtr)); 861EXTERN int TclLog2 _ANSI_ARGS_((int value)); 862#endif 863#ifdef TCL_COMPILE_DEBUG 864EXTERN void TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp, 865 Tcl_Obj *objPtr)); 866#endif 867EXTERN int TclPrintInstruction _ANSI_ARGS_((ByteCode* codePtr, 868 unsigned char *pc)); 869EXTERN void TclPrintObject _ANSI_ARGS_((FILE *outFile, 870 Tcl_Obj *objPtr, int maxChars)); 871EXTERN void TclPrintSource _ANSI_ARGS_((FILE *outFile, 872 CONST char *string, int maxChars)); 873EXTERN void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr)); 874EXTERN int TclRegisterLiteral _ANSI_ARGS_((CompileEnv *envPtr, 875 char *bytes, int length, int onHeap)); 876EXTERN void TclReleaseLiteral _ANSI_ARGS_((Tcl_Interp *interp, 877 Tcl_Obj *objPtr)); 878EXTERN void TclSetCmdNameObj _ANSI_ARGS_((Tcl_Interp *interp, 879 Tcl_Obj *objPtr, Command *cmdPtr)); 880#ifdef TCL_COMPILE_DEBUG 881EXTERN void TclVerifyGlobalLiteralTable _ANSI_ARGS_(( 882 Interp *iPtr)); 883EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_(( 884 CompileEnv *envPtr)); 885#endif 886EXTERN int TclCompileVariableCmd _ANSI_ARGS_(( 887 Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr)); 888 889/* 890 *---------------------------------------------------------------- 891 * Macros used by Tcl bytecode compilation and execution modules 892 * inside the Tcl core but not used outside. 893 *---------------------------------------------------------------- 894 */ 895 896/* 897 * Form of TclRegisterLiteral with onHeap == 0. 898 * In that case, it is safe to cast away CONSTness, and it 899 * is cleanest to do that here, all in one place. 900 */ 901 902#define TclRegisterNewLiteral(envPtr, bytes, length) \ 903 TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0) 904 905/* 906 * Macro used to update the stack requirements. 907 * It is called by the macros TclEmitOpCode, TclEmitInst1 and 908 * TclEmitInst4. 909 * Remark that the very last instruction of a bytecode always 910 * reduces the stack level: INST_DONE or INST_POP, so that the 911 * maxStackdepth is always updated. 912 */ 913 914#define TclUpdateStackReqs(op, i, envPtr) \ 915 {\ 916 int delta = tclInstructionTable[(op)].stackEffect;\ 917 if (delta) {\ 918 if (delta < 0) {\ 919 if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\ 920 (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\ 921 }\ 922 if (delta == INT_MIN) {\ 923 delta = 1 - (i);\ 924 }\ 925 }\ 926 (envPtr)->currStackDepth += delta;\ 927 }\ 928 } 929 930/* 931 * Macro to emit an opcode byte into a CompileEnv's code array. 932 * The ANSI C "prototype" for this macro is: 933 * 934 * EXTERN void TclEmitOpcode _ANSI_ARGS_((unsigned char op, 935 * CompileEnv *envPtr)); 936 */ 937 938#define TclEmitOpcode(op, envPtr) \ 939 if ((envPtr)->codeNext == (envPtr)->codeEnd) \ 940 TclExpandCodeArray(envPtr); \ 941 *(envPtr)->codeNext++ = (unsigned char) (op);\ 942 TclUpdateStackReqs(op, 0, envPtr) 943 944/* 945 * Macro to emit an integer operand. 946 * The ANSI C "prototype" for this macro is: 947 * 948 * EXTERN void TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr)); 949 */ 950 951#define TclEmitInt1(i, envPtr) \ 952 if ((envPtr)->codeNext == (envPtr)->codeEnd) \ 953 TclExpandCodeArray(envPtr); \ 954 *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)) 955 956/* 957 * Macros to emit an instruction with signed or unsigned integer operands. 958 * Four byte integers are stored in "big-endian" order with the high order 959 * byte stored at the lowest address. 960 * The ANSI C "prototypes" for these macros are: 961 * 962 * EXTERN void TclEmitInstInt1 _ANSI_ARGS_((unsigned char op, int i, 963 * CompileEnv *envPtr)); 964 * EXTERN void TclEmitInstInt4 _ANSI_ARGS_((unsigned char op, int i, 965 * CompileEnv *envPtr)); 966 */ 967 968 969#define TclEmitInstInt1(op, i, envPtr) \ 970 if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \ 971 TclExpandCodeArray(envPtr); \ 972 } \ 973 *(envPtr)->codeNext++ = (unsigned char) (op); \ 974 *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\ 975 TclUpdateStackReqs(op, i, envPtr) 976 977#define TclEmitInstInt4(op, i, envPtr) \ 978 if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ 979 TclExpandCodeArray(envPtr); \ 980 } \ 981 *(envPtr)->codeNext++ = (unsigned char) (op); \ 982 *(envPtr)->codeNext++ = \ 983 (unsigned char) ((unsigned int) (i) >> 24); \ 984 *(envPtr)->codeNext++ = \ 985 (unsigned char) ((unsigned int) (i) >> 16); \ 986 *(envPtr)->codeNext++ = \ 987 (unsigned char) ((unsigned int) (i) >> 8); \ 988 *(envPtr)->codeNext++ = \ 989 (unsigned char) ((unsigned int) (i) );\ 990 TclUpdateStackReqs(op, i, envPtr) 991 992/* 993 * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the 994 * object's one or four byte array index into the CompileEnv's code 995 * array. These support, respectively, a maximum of 256 (2**8) and 2**32 996 * objects in a CompileEnv. The ANSI C "prototype" for this macro is: 997 * 998 * EXTERN void TclEmitPush _ANSI_ARGS_((int objIndex, CompileEnv *envPtr)); 999 */ 1000 1001#define TclEmitPush(objIndex, envPtr) \ 1002 {\ 1003 register int objIndexCopy = (objIndex);\ 1004 if (objIndexCopy <= 255) { \ 1005 TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \ 1006 } else { \ 1007 TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \ 1008 }\ 1009 } 1010 1011/* 1012 * Macros to update a (signed or unsigned) integer starting at a pointer. 1013 * The two variants depend on the number of bytes. The ANSI C "prototypes" 1014 * for these macros are: 1015 * 1016 * EXTERN void TclStoreInt1AtPtr _ANSI_ARGS_((int i, unsigned char *p)); 1017 * EXTERN void TclStoreInt4AtPtr _ANSI_ARGS_((int i, unsigned char *p)); 1018 */ 1019 1020#define TclStoreInt1AtPtr(i, p) \ 1021 *(p) = (unsigned char) ((unsigned int) (i)) 1022 1023#define TclStoreInt4AtPtr(i, p) \ 1024 *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ 1025 *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ 1026 *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ 1027 *(p+3) = (unsigned char) ((unsigned int) (i) ) 1028 1029/* 1030 * Macros to update instructions at a particular pc with a new op code 1031 * and a (signed or unsigned) int operand. The ANSI C "prototypes" for 1032 * these macros are: 1033 * 1034 * EXTERN void TclUpdateInstInt1AtPc _ANSI_ARGS_((unsigned char op, int i, 1035 * unsigned char *pc)); 1036 * EXTERN void TclUpdateInstInt4AtPc _ANSI_ARGS_((unsigned char op, int i, 1037 * unsigned char *pc)); 1038 */ 1039 1040#define TclUpdateInstInt1AtPc(op, i, pc) \ 1041 *(pc) = (unsigned char) (op); \ 1042 TclStoreInt1AtPtr((i), ((pc)+1)) 1043 1044#define TclUpdateInstInt4AtPc(op, i, pc) \ 1045 *(pc) = (unsigned char) (op); \ 1046 TclStoreInt4AtPtr((i), ((pc)+1)) 1047 1048/* 1049 * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int 1050 * (GET_UINT{1,2}) from a pointer. There are two variants for each 1051 * return type that depend on the number of bytes fetched. 1052 * The ANSI C "prototypes" for these macros are: 1053 * 1054 * EXTERN int TclGetInt1AtPtr _ANSI_ARGS_((unsigned char *p)); 1055 * EXTERN int TclGetInt4AtPtr _ANSI_ARGS_((unsigned char *p)); 1056 * EXTERN unsigned int TclGetUInt1AtPtr _ANSI_ARGS_((unsigned char *p)); 1057 * EXTERN unsigned int TclGetUInt4AtPtr _ANSI_ARGS_((unsigned char *p)); 1058 */ 1059 1060/* 1061 * The TclGetInt1AtPtr macro is tricky because we want to do sign 1062 * extension on the 1-byte value. Unfortunately the "char" type isn't 1063 * signed on all platforms so sign-extension doesn't always happen 1064 * automatically. Sometimes we can explicitly declare the pointer to be 1065 * signed, but other times we have to explicitly sign-extend the value 1066 * in software. 1067 */ 1068 1069#ifndef __CHAR_UNSIGNED__ 1070# define TclGetInt1AtPtr(p) ((int) *((char *) p)) 1071#else 1072# ifdef HAVE_SIGNED_CHAR 1073# define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) 1074# else 1075# define TclGetInt1AtPtr(p) (((int) *((char *) p)) \ 1076 | ((*(p) & 0200) ? (-256) : 0)) 1077# endif 1078#endif 1079 1080#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \ 1081 (*((p)+1) << 16) | \ 1082 (*((p)+2) << 8) | \ 1083 (*((p)+3))) 1084 1085#define TclGetUInt1AtPtr(p) ((unsigned int) *(p)) 1086#define TclGetUInt4AtPtr(p) ((unsigned int) (*(p) << 24) | \ 1087 (*((p)+1) << 16) | \ 1088 (*((p)+2) << 8) | \ 1089 (*((p)+3))) 1090 1091/* 1092 * Macros used to compute the minimum and maximum of two integers. 1093 * The ANSI C "prototypes" for these macros are: 1094 * 1095 * EXTERN int TclMin _ANSI_ARGS_((int i, int j)); 1096 * EXTERN int TclMax _ANSI_ARGS_((int i, int j)); 1097 */ 1098 1099#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j)) 1100#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j)) 1101 1102/* 1103 * DTrace probe macros (NOPs if DTrace support is not enabled). 1104 */ 1105 1106/* 1107 * Define the following macros to enable debug logging of the DTrace proc, 1108 * cmd, and inst probes. Note that this does _not_ require a platform with 1109 * DTrace, it simply logs all probe output to /tmp/tclDTraceDebug-[pid].log. 1110 * 1111 * If the second macro is defined, logging to file starts immediately, 1112 * otherwise only after the first call to [tcl::dtrace]. Note that the debug 1113 * probe data is always computed, even when it is not logged to file. 1114 * 1115 * Defining the third macro enables debug logging of inst probes (disabled 1116 * by default due to the significant performance impact). 1117 */ 1118 1119/* 1120#define TCL_DTRACE_DEBUG 1 1121#define TCL_DTRACE_DEBUG_LOG_ENABLED 1 1122#define TCL_DTRACE_DEBUG_INST_PROBES 1 1123*/ 1124 1125#if !(defined(TCL_DTRACE_DEBUG) && defined(__GNUC__)) 1126 1127#ifdef USE_DTRACE 1128 1129#include "tclDTrace.h" 1130 1131#if defined(__GNUC__) && __GNUC__ > 2 1132/* Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks. */ 1133#define unlikely(x) (__builtin_expect((x), 0)) 1134#else 1135#define unlikely(x) (x) 1136#endif 1137 1138#define TCL_DTRACE_PROC_ENTRY_ENABLED() unlikely(TCL_PROC_ENTRY_ENABLED()) 1139#define TCL_DTRACE_PROC_RETURN_ENABLED() unlikely(TCL_PROC_RETURN_ENABLED()) 1140#define TCL_DTRACE_PROC_RESULT_ENABLED() unlikely(TCL_PROC_RESULT_ENABLED()) 1141#define TCL_DTRACE_PROC_ARGS_ENABLED() unlikely(TCL_PROC_ARGS_ENABLED()) 1142#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) TCL_PROC_ENTRY(a0, a1, a2) 1143#define TCL_DTRACE_PROC_RETURN(a0, a1) TCL_PROC_RETURN(a0, a1) 1144#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3) 1145#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ 1146 TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) 1147 1148#define TCL_DTRACE_CMD_ENTRY_ENABLED() unlikely(TCL_CMD_ENTRY_ENABLED()) 1149#define TCL_DTRACE_CMD_RETURN_ENABLED() unlikely(TCL_CMD_RETURN_ENABLED()) 1150#define TCL_DTRACE_CMD_RESULT_ENABLED() unlikely(TCL_CMD_RESULT_ENABLED()) 1151#define TCL_DTRACE_CMD_ARGS_ENABLED() unlikely(TCL_CMD_ARGS_ENABLED()) 1152#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) TCL_CMD_ENTRY(a0, a1, a2) 1153#define TCL_DTRACE_CMD_RETURN(a0, a1) TCL_CMD_RETURN(a0, a1) 1154#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3) 1155#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ 1156 TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) 1157 1158#define TCL_DTRACE_INST_START_ENABLED() unlikely(TCL_INST_START_ENABLED()) 1159#define TCL_DTRACE_INST_DONE_ENABLED() unlikely(TCL_INST_DONE_ENABLED()) 1160#define TCL_DTRACE_INST_START(a0, a1, a2) TCL_INST_START(a0, a1, a2) 1161#define TCL_DTRACE_INST_DONE(a0, a1, a2) TCL_INST_DONE(a0, a1, a2) 1162 1163#define TCL_DTRACE_TCL_PROBE_ENABLED() unlikely(TCL_TCL_PROBE_ENABLED()) 1164#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ 1165 TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) 1166 1167#define TCL_DTRACE_DEBUG_LOG() 1168 1169#else /* USE_DTRACE */ 1170 1171#define TCL_DTRACE_PROC_ENTRY_ENABLED() 0 1172#define TCL_DTRACE_PROC_RETURN_ENABLED() 0 1173#define TCL_DTRACE_PROC_RESULT_ENABLED() 0 1174#define TCL_DTRACE_PROC_ARGS_ENABLED() 0 1175#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) {} 1176#define TCL_DTRACE_PROC_RETURN(a0, a1) {} 1177#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {} 1178#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} 1179 1180#define TCL_DTRACE_CMD_ENTRY_ENABLED() 0 1181#define TCL_DTRACE_CMD_RETURN_ENABLED() 0 1182#define TCL_DTRACE_CMD_RESULT_ENABLED() 0 1183#define TCL_DTRACE_CMD_ARGS_ENABLED() 0 1184#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) {} 1185#define TCL_DTRACE_CMD_RETURN(a0, a1) {} 1186#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {} 1187#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} 1188 1189#define TCL_DTRACE_INST_START_ENABLED() 0 1190#define TCL_DTRACE_INST_DONE_ENABLED() 0 1191#define TCL_DTRACE_INST_START(a0, a1, a2) {} 1192#define TCL_DTRACE_INST_DONE(a0, a1, a2) {} 1193 1194#define TCL_DTRACE_TCL_PROBE_ENABLED() 0 1195#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {} 1196 1197#endif /* USE_DTRACE */ 1198 1199#else /* TCL_DTRACE_DEBUG */ 1200 1201#define USE_DTRACE 1 1202 1203#if !defined(TCL_DTRACE_DEBUG_LOG_ENABLED) || !(TCL_DTRACE_DEBUG_LOG_ENABLED) 1204#undef TCL_DTRACE_DEBUG_LOG_ENABLED 1205#define TCL_DTRACE_DEBUG_LOG_ENABLED 0 1206#endif 1207 1208#if !defined(TCL_DTRACE_DEBUG_INST_PROBES) || !(TCL_DTRACE_DEBUG_INST_PROBES) 1209#undef TCL_DTRACE_DEBUG_INST_PROBES 1210#define TCL_DTRACE_DEBUG_INST_PROBES 0 1211#endif 1212 1213MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent; 1214MODULE_SCOPE FILE *tclDTraceDebugLog; 1215MODULE_SCOPE void TclDTraceOpenDebugLog(void); 1216MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi); 1217 1218#define TCL_DTRACE_DEBUG_LOG() \ 1219 int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;\ 1220 int tclDTraceDebugIndent = 0; \ 1221 FILE *tclDTraceDebugLog = NULL; \ 1222 void TclDTraceOpenDebugLog(void) { char n[35]; \ 1223 sprintf(n, "/tmp/tclDTraceDebug-%lu.log", (unsigned long) getpid()); \ 1224 tclDTraceDebugLog = fopen(n, "a"); } \ 1225 1226#define TclDTraceDbgMsg(p, m, ...) do { if (tclDTraceDebugEnabled) { \ 1227 int _l, _t = 0; if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \ 1228 fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", strrchr(__FILE__, '/') + \ 1229 1, __LINE__, &_l); _t += _l; \ 1230 fprintf(tclDTraceDebugLog, " %.*s():%n", (_t < 18 ? 18 - _t : 0) + \ 1231 18, __func__, &_l); _t += _l; \ 1232 fprintf(tclDTraceDebugLog, "%*s" p "%n", (_t < 40 ? 40 - _t : 0) + \ 1233 2 * tclDTraceDebugIndent, "", &_l); _t += _l; \ 1234 fprintf(tclDTraceDebugLog, "%*s" m "\n", (_t < 64 ? 64 - _t : 1), "", \ 1235 ##__VA_ARGS__); fflush(tclDTraceDebugLog); \ 1236 } } while (0) 1237 1238#define TCL_DTRACE_PROC_ENTRY_ENABLED() 1 1239#define TCL_DTRACE_PROC_RETURN_ENABLED() 1 1240#define TCL_DTRACE_PROC_RESULT_ENABLED() 1 1241#define TCL_DTRACE_PROC_ARGS_ENABLED() 1 1242#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \ 1243 tclDTraceDebugIndent++; \ 1244 TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2) 1245#define TCL_DTRACE_PROC_RETURN(a0, a1) \ 1246 TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ 1247 tclDTraceDebugIndent-- 1248#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \ 1249 TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3) 1250#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ 1251 TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \ 1252 a1, a2, a3, a4, a5, a6, a7, a8, a9) 1253 1254#define TCL_DTRACE_CMD_ENTRY_ENABLED() 1 1255#define TCL_DTRACE_CMD_RETURN_ENABLED() 1 1256#define TCL_DTRACE_CMD_RESULT_ENABLED() 1 1257#define TCL_DTRACE_CMD_ARGS_ENABLED() 1 1258#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \ 1259 tclDTraceDebugIndent++; \ 1260 TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2) 1261#define TCL_DTRACE_CMD_RETURN(a0, a1) \ 1262 TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ 1263 tclDTraceDebugIndent-- 1264#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \ 1265 TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3) 1266#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ 1267 TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \ 1268 a1, a2, a3, a4, a5, a6, a7, a8, a9) 1269 1270#define TCL_DTRACE_INST_START_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES 1271#define TCL_DTRACE_INST_DONE_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES 1272#define TCL_DTRACE_INST_START(a0, a1, a2) \ 1273 TclDTraceDbgMsg(" | inst-start", "%s %d %p", a0, a1, a2) 1274#define TCL_DTRACE_INST_DONE(a0, a1, a2) \ 1275 TclDTraceDbgMsg(" | inst-end", "%s %d %p", a0, a1, a2) 1276 1277#define TCL_DTRACE_TCL_PROBE_ENABLED() 1 1278#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ 1279 tclDTraceDebugEnabled = 1; \ 1280 TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \ 1281 a1, a2, a3, a4, a5, a6, a7, a8, a9) 1282 1283#endif /* TCL_DTRACE_DEBUG */ 1284 1285# undef TCL_STORAGE_CLASS 1286# define TCL_STORAGE_CLASS DLLIMPORT 1287 1288#endif /* _TCLCOMPILATION */ 1289