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 of
10 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 */
12
13 #ifndef _TCLCOMPILATION
14 #define _TCLCOMPILATION 1
15
16 #include "tclInt.h"
17
18 struct ByteCode; /* Forward declaration. */
19
20 /*
21 *------------------------------------------------------------------------
22 * Variables related to compilation. These are used in tclCompile.c,
23 * tclExecute.c, tclBasic.c, and their clients.
24 *------------------------------------------------------------------------
25 */
26
27 #ifdef TCL_COMPILE_DEBUG
28 /*
29 * Variable that controls whether compilation tracing is enabled and, if so,
30 * what level of tracing is desired:
31 * 0: no compilation tracing
32 * 1: summarize compilation of top level cmds and proc bodies
33 * 2: display all instructions of each ByteCode compiled
34 * This variable is linked to the Tcl variable "tcl_traceCompile".
35 */
36
37 MODULE_SCOPE int tclTraceCompile;
38
39 /*
40 * Variable that controls whether execution tracing is enabled and, if so,
41 * what level of tracing is desired:
42 * 0: no execution tracing
43 * 1: trace invocations of Tcl procs only
44 * 2: trace invocations of all (not compiled away) commands
45 * 3: display each instruction executed
46 * This variable is linked to the Tcl variable "tcl_traceExec".
47 */
48
49 MODULE_SCOPE int tclTraceExec;
50 #endif
51
52 /*
53 * The type of lambda expressions. Note that every lambda will *always* have a
54 * string representation.
55 */
56
57 MODULE_SCOPE const Tcl_ObjType tclLambdaType;
58
59 /*
60 *------------------------------------------------------------------------
61 * Data structures related to compilation.
62 *------------------------------------------------------------------------
63 */
64
65 /*
66 * The structure used to implement Tcl "exceptions" (exceptional returns): for
67 * example, those generated in loops by the break and continue commands, and
68 * those generated by scripts and caught by the catch command. This
69 * ExceptionRange structure describes a range of code (e.g., a loop body), the
70 * kind of exceptions (e.g., a break or continue) that might occur, and the PC
71 * offsets to jump to if a matching exception does occur. Exception ranges can
72 * nest so this structure includes a nesting level that is used at runtime to
73 * find the closest exception range surrounding a PC. For example, when a
74 * break command is executed, the ExceptionRange structure for the most deeply
75 * nested loop, if any, is found and used. These structures are also generated
76 * for the "next" subcommands of for loops since a break there terminates the
77 * for command. This means a for command actually generates two LoopInfo
78 * structures.
79 */
80
81 typedef enum {
82 LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. Break
83 * and continue "exceptions" cause jumps to
84 * appropriate PC offsets. */
85 CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch
86 * command. Errors in the range cause a jump
87 * to a catch PC offset. */
88 } ExceptionRangeType;
89
90 typedef struct ExceptionRange {
91 ExceptionRangeType type; /* The kind of ExceptionRange. */
92 int nestingLevel; /* Static depth of the exception range. Used
93 * to find the most deeply-nested range
94 * surrounding a PC at runtime. */
95 int codeOffset; /* Offset of the first instruction byte of the
96 * code range. */
97 int numCodeBytes; /* Number of bytes in the code range. */
98 int breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC
99 * offset for a break command in the range. */
100 int continueOffset; /* If LOOP_EXCEPTION_RANGE and not -1, the
101 * target PC offset for a continue command in
102 * the code range. Otherwise, ignore this
103 * range when processing a continue
104 * command. */
105 int catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC
106 * offset for any "exception" in range. */
107 } ExceptionRange;
108
109 /*
110 * Auxiliary data used when issuing (currently just loop) exception ranges,
111 * but which is not required during execution.
112 */
113
114 typedef struct ExceptionAux {
115 int supportsContinue; /* Whether this exception range will have a
116 * continueOffset created for it; if it is a
117 * loop exception range that *doesn't* have
118 * one (see [for] next-clause) then we must
119 * not pick up the range when scanning for a
120 * target to continue to. */
121 int stackDepth; /* The stack depth at the point where the
122 * exception range was created. This is used
123 * to calculate the number of POPs required to
124 * restore the stack to its prior state. */
125 int expandTarget; /* The number of expansions expected on the
126 * auxData stack at the time the loop starts;
127 * we can't currently discard them except by
128 * doing INST_INVOKE_EXPANDED; this is a known
129 * problem. */
130 int expandTargetDepth; /* The stack depth expected at the outermost
131 * expansion within the loop. Not meaningful
132 * if there are no open expansions between the
133 * looping level and the point of jump
134 * issue. */
135 int numBreakTargets; /* The number of [break]s that want to be
136 * targeted to the place where this loop
137 * exception will be bound to. */
138 unsigned int *breakTargets; /* The offsets of the INST_JUMP4 instructions
139 * issued by the [break]s that we must
140 * update. Note that resizing a jump (via
141 * TclFixupForwardJump) can cause the contents
142 * of this array to be updated. When
143 * numBreakTargets==0, this is NULL. */
144 int allocBreakTargets; /* The size of the breakTargets array. */
145 int numContinueTargets; /* The number of [continue]s that want to be
146 * targeted to the place where this loop
147 * exception will be bound to. */
148 unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
149 * issued by the [continue]s that we must
150 * update. Note that resizing a jump (via
151 * TclFixupForwardJump) can cause the contents
152 * of this array to be updated. When
153 * numContinueTargets==0, this is NULL. */
154 int allocContinueTargets; /* The size of the continueTargets array. */
155 } ExceptionAux;
156
157 /*
158 * Structure used to map between instruction pc and source locations. It
159 * defines for each compiled Tcl command its code's starting offset and its
160 * source's starting offset and length. Note that the code offset increases
161 * monotonically: that is, the table is sorted in code offset order. The
162 * source offset is not monotonic.
163 */
164
165 typedef struct CmdLocation {
166 int codeOffset; /* Offset of first byte of command code. */
167 int numCodeBytes; /* Number of bytes for command's code. */
168 int srcOffset; /* Offset of first char of the command. */
169 int numSrcBytes; /* Number of command source chars. */
170 } CmdLocation;
171
172 /*
173 * TIP #280
174 * Structure to record additional location information for byte code. This
175 * information is internal and not saved. i.e. tbcload'ed code will not have
176 * this information. It records the lines for all words of all commands found
177 * in the byte code. The association with a ByteCode structure BC is done
178 * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
179 * Also recorded is information coming from the context, i.e. type of the
180 * frame and associated information, like the path of a sourced file.
181 */
182
183 typedef struct ECL {
184 int srcOffset; /* Command location to find the entry. */
185 int nline; /* Number of words in the command */
186 int *line; /* Line information for all words in the
187 * command. */
188 int **next; /* Transient information used by the compiler
189 * for tracking of hidden continuation
190 * lines. */
191 } ECL;
192
193 typedef struct ExtCmdLoc {
194 int type; /* Context type. */
195 int start; /* Starting line for compiled script. Needed
196 * for the extended recompile check in
197 * tclCompileObj. */
198 Tcl_Obj *path; /* Path of the sourced file the command is
199 * in. */
200 ECL *loc; /* Command word locations (lines). */
201 int nloc; /* Number of allocated entries in 'loc'. */
202 int nuloc; /* Number of used entries in 'loc'. */
203 } ExtCmdLoc;
204
205 /*
206 * CompileProcs need the ability to record information during compilation that
207 * can be used by bytecode instructions during execution. The AuxData
208 * structure provides this "auxiliary data" mechanism. An arbitrary number of
209 * these structures can be stored in the ByteCode record (during compilation
210 * they are stored in a CompileEnv structure). Each AuxData record holds one
211 * word of client-specified data (often a pointer) and is given an index that
212 * instructions can later use to look up the structure and its data.
213 *
214 * The following definitions declare the types of procedures that are called
215 * to duplicate or free this auxiliary data when the containing ByteCode
216 * objects are duplicated and freed. Pointers to these procedures are kept in
217 * the AuxData structure.
218 */
219
220 typedef ClientData (AuxDataDupProc) (ClientData clientData);
221 typedef void (AuxDataFreeProc) (ClientData clientData);
222 typedef void (AuxDataPrintProc)(ClientData clientData,
223 Tcl_Obj *appendObj, struct ByteCode *codePtr,
224 unsigned int pcOffset);
225
226 /*
227 * We define a separate AuxDataType struct to hold type-related information
228 * for the AuxData structure. This separation makes it possible for clients
229 * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for
230 * example, it makes it possible to pickle and unpickle AuxData structs.
231 */
232
233 typedef struct AuxDataType {
234 const char *name; /* The name of the type. Types can be
235 * registered and found by name */
236 AuxDataDupProc *dupProc; /* Callback procedure to invoke when the aux
237 * data is duplicated (e.g., when the ByteCode
238 * structure containing the aux data is
239 * duplicated). NULL means just copy the
240 * source clientData bits; no proc need be
241 * called. */
242 AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the aux
243 * data is freed. NULL means no proc need be
244 * called. */
245 AuxDataPrintProc *printProc;/* Callback function to invoke when printing
246 * the aux data as part of debugging. NULL
247 * means that the data can't be printed. */
248 AuxDataPrintProc *disassembleProc;
249 /* Callback function to invoke when doing a
250 * disassembly of the aux data (like the
251 * printProc, except that the output is
252 * intended to be script-readable). The
253 * appendObj argument should be filled in with
254 * a descriptive dictionary; it will start out
255 * with "name" mapped to the content of the
256 * name field. NULL means that the printProc
257 * should be used instead. */
258 } AuxDataType;
259
260 /*
261 * The definition of the AuxData structure that holds information created
262 * during compilation by CompileProcs and used by instructions during
263 * execution.
264 */
265
266 typedef struct AuxData {
267 const AuxDataType *type; /* Pointer to the AuxData type associated with
268 * this ClientData. */
269 ClientData clientData; /* The compilation data itself. */
270 } AuxData;
271
272 /*
273 * Structure defining the compilation environment. After compilation, fields
274 * describing bytecode instructions are copied out into the more compact
275 * ByteCode structure defined below.
276 */
277
278 #define COMPILEENV_INIT_CODE_BYTES 250
279 #define COMPILEENV_INIT_NUM_OBJECTS 60
280 #define COMPILEENV_INIT_EXCEPT_RANGES 5
281 #define COMPILEENV_INIT_CMD_MAP_SIZE 40
282 #define COMPILEENV_INIT_AUX_DATA_SIZE 5
283
284 typedef struct CompileEnv {
285 Interp *iPtr; /* Interpreter containing the code being
286 * compiled. Commands and their compile procs
287 * are specific to an interpreter so the code
288 * emitted will depend on the interpreter. */
289 const char *source; /* The source string being compiled by
290 * SetByteCodeFromAny. This pointer is not
291 * owned by the CompileEnv and must not be
292 * freed or changed by it. */
293 int numSrcBytes; /* Number of bytes in source. */
294 Proc *procPtr; /* If a procedure is being compiled, a pointer
295 * to its Proc structure; otherwise NULL. Used
296 * to compile local variables. Set from
297 * information provided by ObjInterpProc in
298 * tclProc.c. */
299 int numCommands; /* Number of commands compiled. */
300 int exceptDepth; /* Current exception range nesting level; -1
301 * if not in any range currently. */
302 int maxExceptDepth; /* Max nesting level of exception ranges; -1
303 * if no ranges have been compiled. */
304 int maxStackDepth; /* Maximum number of stack elements needed to
305 * execute the code. Set by compilation
306 * procedures before returning. */
307 int currStackDepth; /* Current stack depth. */
308 LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl
309 * objects referenced by this compiled code.
310 * Indexed by the string representations of
311 * the literals. Used to avoid creating
312 * duplicate objects. */
313 unsigned char *codeStart; /* Points to the first byte of the code. */
314 unsigned char *codeNext; /* Points to next code array byte to use. */
315 unsigned char *codeEnd; /* Points just after the last allocated code
316 * array byte. */
317 int mallocedCodeArray; /* Set 1 if code array was expanded and
318 * codeStart points into the heap.*/
319 LiteralEntry *literalArrayPtr;
320 /* Points to start of LiteralEntry array. */
321 int literalArrayNext; /* Index of next free object array entry. */
322 int literalArrayEnd; /* Index just after last obj array entry. */
323 int mallocedLiteralArray; /* 1 if object array was expanded and objArray
324 * points into the heap, else 0. */
325 ExceptionRange *exceptArrayPtr;
326 /* Points to start of the ExceptionRange
327 * array. */
328 int exceptArrayNext; /* Next free ExceptionRange array index.
329 * exceptArrayNext is the number of ranges and
330 * (exceptArrayNext-1) is the index of the
331 * current range's array entry. */
332 int exceptArrayEnd; /* Index after the last ExceptionRange array
333 * entry. */
334 int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
335 * exceptArrayPtr points in heap, else 0. */
336 ExceptionAux *exceptAuxArrayPtr;
337 /* Array of information used to restore the
338 * state when processing BREAK/CONTINUE
339 * exceptions. Must be the same size as the
340 * exceptArrayPtr. */
341 CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array.
342 * numCommands is the index of the next entry
343 * to use; (numCommands-1) is the entry index
344 * for the last command. */
345 int cmdMapEnd; /* Index after last CmdLocation entry. */
346 int mallocedCmdMap; /* 1 if command map array was expanded and
347 * cmdMapPtr points in the heap, else 0. */
348 AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */
349 int auxDataArrayNext; /* Next free compile aux data array index.
350 * auxDataArrayNext is the number of aux data
351 * items and (auxDataArrayNext-1) is index of
352 * current aux data array entry. */
353 int auxDataArrayEnd; /* Index after last aux data array entry. */
354 int mallocedAuxDataArray; /* 1 if aux data array was expanded and
355 * auxDataArrayPtr points in heap else 0. */
356 unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
357 /* Initial storage for code. */
358 LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
359 /* Initial storage of LiteralEntry array. */
360 ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
361 /* Initial ExceptionRange array storage. */
362 ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
363 /* Initial static except auxiliary info array
364 * storage. */
365 CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
366 /* Initial storage for cmd location map. */
367 AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
368 /* Initial storage for aux data array. */
369 /* TIP #280 */
370 ExtCmdLoc *extCmdMapPtr; /* Extended command location information for
371 * 'info frame'. */
372 int line; /* First line of the script, based on the
373 * invoking context, then the line of the
374 * command currently compiled. */
375 int atCmdStart; /* Flag to say whether an INST_START_CMD
376 * should be issued; they should never be
377 * issued repeatedly, as that is significantly
378 * inefficient. If set to 2, that instruction
379 * should not be issued at all (by the generic
380 * part of the command compiler). */
381 int expandCount; /* Number of INST_EXPAND_START instructions
382 * encountered that have not yet been paired
383 * with a corresponding
384 * INST_INVOKE_EXPANDED. */
385 int *clNext; /* If not NULL, it refers to the next slot in
386 * clLoc to check for an invisible
387 * continuation line. */
388 } CompileEnv;
389
390 /*
391 * The structure defining the bytecode instructions resulting from compiling a
392 * Tcl script. Note that this structure is variable length: a single heap
393 * object is allocated to hold the ByteCode structure immediately followed by
394 * the code bytes, the literal object array, the ExceptionRange array, the
395 * CmdLocation map, and the compilation AuxData array.
396 */
397
398 /*
399 * A PRECOMPILED bytecode struct is one that was generated from a compiled
400 * image rather than implicitly compiled from source
401 */
402
403 #define TCL_BYTECODE_PRECOMPILED 0x0001
404
405 /*
406 * When a bytecode is compiled, interp or namespace resolvers have not been
407 * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
408 */
409
410 #define TCL_BYTECODE_RESOLVE_VARS 0x0002
411
412 #define TCL_BYTECODE_RECOMPILE 0x0004
413
414 typedef struct ByteCode {
415 TclHandle interpHandle; /* Handle for interpreter containing the
416 * compiled code. Commands and their compile
417 * procs are specific to an interpreter so the
418 * code emitted will depend on the
419 * interpreter. */
420 int compileEpoch; /* Value of iPtr->compileEpoch when this
421 * ByteCode was compiled. Used to invalidate
422 * code when, e.g., commands with compile
423 * procs are redefined. */
424 Namespace *nsPtr; /* Namespace context in which this code was
425 * compiled. If the code is executed if a
426 * different namespace, it must be
427 * recompiled. */
428 int nsEpoch; /* Value of nsPtr->resolverEpoch when this
429 * ByteCode was compiled. Used to invalidate
430 * code when new namespace resolution rules
431 * are put into effect. */
432 int refCount; /* Reference count: set 1 when created plus 1
433 * for each execution of the code currently
434 * active. This structure can be freed when
435 * refCount becomes zero. */
436 unsigned int flags; /* flags describing state for the codebyte.
437 * this variable holds ORed values from the
438 * TCL_BYTECODE_ masks defined above */
439 const char *source; /* The source string from which this ByteCode
440 * was compiled. Note that this pointer is not
441 * owned by the ByteCode and must not be freed
442 * or modified by it. */
443 Proc *procPtr; /* If the ByteCode was compiled from a
444 * procedure body, this is a pointer to its
445 * Proc structure; otherwise NULL. This
446 * pointer is also not owned by the ByteCode
447 * and must not be freed by it. */
448 size_t structureSize; /* Number of bytes in the ByteCode structure
449 * itself. Does not include heap space for
450 * literal Tcl objects or storage referenced
451 * by AuxData entries. */
452 int numCommands; /* Number of commands compiled. */
453 int numSrcBytes; /* Number of source bytes compiled. */
454 int numCodeBytes; /* Number of code bytes. */
455 int numLitObjects; /* Number of objects in literal array. */
456 int numExceptRanges; /* Number of ExceptionRange array elems. */
457 int numAuxDataItems; /* Number of AuxData items. */
458 int numCmdLocBytes; /* Number of bytes needed for encoded command
459 * location information. */
460 int maxExceptDepth; /* Maximum nesting level of ExceptionRanges;
461 * -1 if no ranges were compiled. */
462 int maxStackDepth; /* Maximum number of stack elements needed to
463 * execute the code. */
464 unsigned char *codeStart; /* Points to the first byte of the code. This
465 * is just after the final ByteCode member
466 * cmdMapPtr. */
467 Tcl_Obj **objArrayPtr; /* Points to the start of the literal object
468 * array. This is just after the last code
469 * byte. */
470 ExceptionRange *exceptArrayPtr;
471 /* Points to the start of the ExceptionRange
472 * array. This is just after the last object
473 * in the object array. */
474 AuxData *auxDataArrayPtr; /* Points to the start of the auxiliary data
475 * array. This is just after the last entry in
476 * the ExceptionRange array. */
477 unsigned char *codeDeltaStart;
478 /* Points to the first of a sequence of bytes
479 * that encode the change in the starting
480 * offset of each command's code. If -127 <=
481 * delta <= 127, it is encoded as 1 byte,
482 * otherwise 0xFF (128) appears and the delta
483 * is encoded by the next 4 bytes. Code deltas
484 * are always positive. This sequence is just
485 * after the last entry in the AuxData
486 * array. */
487 unsigned char *codeLengthStart;
488 /* Points to the first of a sequence of bytes
489 * that encode the length of each command's
490 * code. The encoding is the same as for code
491 * deltas. Code lengths are always positive.
492 * This sequence is just after the last entry
493 * in the code delta sequence. */
494 unsigned char *srcDeltaStart;
495 /* Points to the first of a sequence of bytes
496 * that encode the change in the starting
497 * offset of each command's source. The
498 * encoding is the same as for code deltas.
499 * Source deltas can be negative. This
500 * sequence is just after the last byte in the
501 * code length sequence. */
502 unsigned char *srcLengthStart;
503 /* Points to the first of a sequence of bytes
504 * that encode the length of each command's
505 * source. The encoding is the same as for
506 * code deltas. Source lengths are always
507 * positive. This sequence is just after the
508 * last byte in the source delta sequence. */
509 LocalCache *localCachePtr; /* Pointer to the start of the cached variable
510 * names and initialisation data for local
511 * variables. */
512 #ifdef TCL_COMPILE_STATS
513 Tcl_Time createTime; /* Absolute time when the ByteCode was
514 * created. */
515 #endif /* TCL_COMPILE_STATS */
516 } ByteCode;
517
518 /*
519 * Opcodes for the Tcl bytecode instructions. These must correspond to the
520 * entries in the table of instruction descriptions, tclInstructionTable, in
521 * tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
522 * INST_LOR) must match the entries in the array operatorStrings in
523 * tclExecute.c.
524 */
525
526 /* Opcodes 0 to 9 */
527 #define INST_DONE 0
528 #define INST_PUSH1 1
529 #define INST_PUSH4 2
530 #define INST_POP 3
531 #define INST_DUP 4
532 #define INST_STR_CONCAT1 5
533 #define INST_INVOKE_STK1 6
534 #define INST_INVOKE_STK4 7
535 #define INST_EVAL_STK 8
536 #define INST_EXPR_STK 9
537
538 /* Opcodes 10 to 23 */
539 #define INST_LOAD_SCALAR1 10
540 #define INST_LOAD_SCALAR4 11
541 #define INST_LOAD_SCALAR_STK 12
542 #define INST_LOAD_ARRAY1 13
543 #define INST_LOAD_ARRAY4 14
544 #define INST_LOAD_ARRAY_STK 15
545 #define INST_LOAD_STK 16
546 #define INST_STORE_SCALAR1 17
547 #define INST_STORE_SCALAR4 18
548 #define INST_STORE_SCALAR_STK 19
549 #define INST_STORE_ARRAY1 20
550 #define INST_STORE_ARRAY4 21
551 #define INST_STORE_ARRAY_STK 22
552 #define INST_STORE_STK 23
553
554 /* Opcodes 24 to 33 */
555 #define INST_INCR_SCALAR1 24
556 #define INST_INCR_SCALAR_STK 25
557 #define INST_INCR_ARRAY1 26
558 #define INST_INCR_ARRAY_STK 27
559 #define INST_INCR_STK 28
560 #define INST_INCR_SCALAR1_IMM 29
561 #define INST_INCR_SCALAR_STK_IMM 30
562 #define INST_INCR_ARRAY1_IMM 31
563 #define INST_INCR_ARRAY_STK_IMM 32
564 #define INST_INCR_STK_IMM 33
565
566 /* Opcodes 34 to 39 */
567 #define INST_JUMP1 34
568 #define INST_JUMP4 35
569 #define INST_JUMP_TRUE1 36
570 #define INST_JUMP_TRUE4 37
571 #define INST_JUMP_FALSE1 38
572 #define INST_JUMP_FALSE4 39
573
574 /* Opcodes 40 to 64 */
575 #define INST_LOR 40
576 #define INST_LAND 41
577 #define INST_BITOR 42
578 #define INST_BITXOR 43
579 #define INST_BITAND 44
580 #define INST_EQ 45
581 #define INST_NEQ 46
582 #define INST_LT 47
583 #define INST_GT 48
584 #define INST_LE 49
585 #define INST_GE 50
586 #define INST_LSHIFT 51
587 #define INST_RSHIFT 52
588 #define INST_ADD 53
589 #define INST_SUB 54
590 #define INST_MULT 55
591 #define INST_DIV 56
592 #define INST_MOD 57
593 #define INST_UPLUS 58
594 #define INST_UMINUS 59
595 #define INST_BITNOT 60
596 #define INST_LNOT 61
597 #define INST_CALL_BUILTIN_FUNC1 62
598 #define INST_CALL_FUNC1 63
599 #define INST_TRY_CVT_TO_NUMERIC 64
600
601 /* Opcodes 65 to 66 */
602 #define INST_BREAK 65
603 #define INST_CONTINUE 66
604
605 /* Opcodes 67 to 68 */
606 #define INST_FOREACH_START4 67 /* DEPRECATED */
607 #define INST_FOREACH_STEP4 68 /* DEPRECATED */
608
609 /* Opcodes 69 to 72 */
610 #define INST_BEGIN_CATCH4 69
611 #define INST_END_CATCH 70
612 #define INST_PUSH_RESULT 71
613 #define INST_PUSH_RETURN_CODE 72
614
615 /* Opcodes 73 to 78 */
616 #define INST_STR_EQ 73
617 #define INST_STR_NEQ 74
618 #define INST_STR_CMP 75
619 #define INST_STR_LEN 76
620 #define INST_STR_INDEX 77
621 #define INST_STR_MATCH 78
622
623 /* Opcodes 78 to 81 */
624 #define INST_LIST 79
625 #define INST_LIST_INDEX 80
626 #define INST_LIST_LENGTH 81
627
628 /* Opcodes 82 to 87 */
629 #define INST_APPEND_SCALAR1 82
630 #define INST_APPEND_SCALAR4 83
631 #define INST_APPEND_ARRAY1 84
632 #define INST_APPEND_ARRAY4 85
633 #define INST_APPEND_ARRAY_STK 86
634 #define INST_APPEND_STK 87
635
636 /* Opcodes 88 to 93 */
637 #define INST_LAPPEND_SCALAR1 88
638 #define INST_LAPPEND_SCALAR4 89
639 #define INST_LAPPEND_ARRAY1 90
640 #define INST_LAPPEND_ARRAY4 91
641 #define INST_LAPPEND_ARRAY_STK 92
642 #define INST_LAPPEND_STK 93
643
644 /* TIP #22 - LINDEX operator with flat arg list */
645
646 #define INST_LIST_INDEX_MULTI 94
647
648 /*
649 * TIP #33 - 'lset' command. Code gen also required a Forth-like
650 * OVER operation.
651 */
652
653 #define INST_OVER 95
654 #define INST_LSET_LIST 96
655 #define INST_LSET_FLAT 97
656
657 /* TIP#90 - 'return' command. */
658
659 #define INST_RETURN_IMM 98
660
661 /* TIP#123 - exponentiation operator. */
662
663 #define INST_EXPON 99
664
665 /* TIP #157 - {*}... (word expansion) language syntax support. */
666
667 #define INST_EXPAND_START 100
668 #define INST_EXPAND_STKTOP 101
669 #define INST_INVOKE_EXPANDED 102
670
671 /*
672 * TIP #57 - 'lassign' command. Code generation requires immediate
673 * LINDEX and LRANGE operators.
674 */
675
676 #define INST_LIST_INDEX_IMM 103
677 #define INST_LIST_RANGE_IMM 104
678
679 #define INST_START_CMD 105
680
681 #define INST_LIST_IN 106
682 #define INST_LIST_NOT_IN 107
683
684 #define INST_PUSH_RETURN_OPTIONS 108
685 #define INST_RETURN_STK 109
686
687 /*
688 * Dictionary (TIP#111) related commands.
689 */
690
691 #define INST_DICT_GET 110
692 #define INST_DICT_SET 111
693 #define INST_DICT_UNSET 112
694 #define INST_DICT_INCR_IMM 113
695 #define INST_DICT_APPEND 114
696 #define INST_DICT_LAPPEND 115
697 #define INST_DICT_FIRST 116
698 #define INST_DICT_NEXT 117
699 #define INST_DICT_DONE 118
700 #define INST_DICT_UPDATE_START 119
701 #define INST_DICT_UPDATE_END 120
702
703 /*
704 * Instruction to support jumps defined by tables (instead of the classic
705 * [switch] technique of chained comparisons).
706 */
707
708 #define INST_JUMP_TABLE 121
709
710 /*
711 * Instructions to support compilation of global, variable, upvar and
712 * [namespace upvar].
713 */
714
715 #define INST_UPVAR 122
716 #define INST_NSUPVAR 123
717 #define INST_VARIABLE 124
718
719 /* Instruction to support compiling syntax error to bytecode */
720
721 #define INST_SYNTAX 125
722
723 /* Instruction to reverse N items on top of stack */
724
725 #define INST_REVERSE 126
726
727 /* regexp instruction */
728
729 #define INST_REGEXP 127
730
731 /* For [info exists] compilation */
732 #define INST_EXIST_SCALAR 128
733 #define INST_EXIST_ARRAY 129
734 #define INST_EXIST_ARRAY_STK 130
735 #define INST_EXIST_STK 131
736
737 /* For [subst] compilation */
738 #define INST_NOP 132
739 #define INST_RETURN_CODE_BRANCH 133
740
741 /* For [unset] compilation */
742 #define INST_UNSET_SCALAR 134
743 #define INST_UNSET_ARRAY 135
744 #define INST_UNSET_ARRAY_STK 136
745 #define INST_UNSET_STK 137
746
747 /* For [dict with], [dict exists], [dict create] and [dict merge] */
748 #define INST_DICT_EXPAND 138
749 #define INST_DICT_RECOMBINE_STK 139
750 #define INST_DICT_RECOMBINE_IMM 140
751 #define INST_DICT_EXISTS 141
752 #define INST_DICT_VERIFY 142
753
754 /* For [string map] and [regsub] compilation */
755 #define INST_STR_MAP 143
756 #define INST_STR_FIND 144
757 #define INST_STR_FIND_LAST 145
758 #define INST_STR_RANGE_IMM 146
759 #define INST_STR_RANGE 147
760
761 /* For operations to do with coroutines and other NRE-manipulators */
762 #define INST_YIELD 148
763 #define INST_COROUTINE_NAME 149
764 #define INST_TAILCALL 150
765
766 /* For compilation of basic information operations */
767 #define INST_NS_CURRENT 151
768 #define INST_INFO_LEVEL_NUM 152
769 #define INST_INFO_LEVEL_ARGS 153
770 #define INST_RESOLVE_COMMAND 154
771
772 /* For compilation relating to TclOO */
773 #define INST_TCLOO_SELF 155
774 #define INST_TCLOO_CLASS 156
775 #define INST_TCLOO_NS 157
776 #define INST_TCLOO_IS_OBJECT 158
777
778 /* For compilation of [array] subcommands */
779 #define INST_ARRAY_EXISTS_STK 159
780 #define INST_ARRAY_EXISTS_IMM 160
781 #define INST_ARRAY_MAKE_STK 161
782 #define INST_ARRAY_MAKE_IMM 162
783
784 #define INST_INVOKE_REPLACE 163
785
786 #define INST_LIST_CONCAT 164
787
788 #define INST_EXPAND_DROP 165
789
790 /* New foreach implementation */
791 #define INST_FOREACH_START 166
792 #define INST_FOREACH_STEP 167
793 #define INST_FOREACH_END 168
794 #define INST_LMAP_COLLECT 169
795
796 /* For compilation of [string trim] and related */
797 #define INST_STR_TRIM 170
798 #define INST_STR_TRIM_LEFT 171
799 #define INST_STR_TRIM_RIGHT 172
800
801 #define INST_CONCAT_STK 173
802
803 #define INST_STR_UPPER 174
804 #define INST_STR_LOWER 175
805 #define INST_STR_TITLE 176
806 #define INST_STR_REPLACE 177
807
808 #define INST_ORIGIN_COMMAND 178
809
810 #define INST_TCLOO_NEXT 179
811 #define INST_TCLOO_NEXT_CLASS 180
812
813 #define INST_YIELD_TO_INVOKE 181
814
815 #define INST_NUM_TYPE 182
816 #define INST_TRY_CVT_TO_BOOLEAN 183
817 #define INST_STR_CLASS 184
818
819 #define INST_LAPPEND_LIST 185
820 #define INST_LAPPEND_LIST_ARRAY 186
821 #define INST_LAPPEND_LIST_ARRAY_STK 187
822 #define INST_LAPPEND_LIST_STK 188
823
824 #define INST_CLOCK_READ 189
825
826 /* The last opcode */
827 #define LAST_INST_OPCODE 189
828
829 /*
830 * Table describing the Tcl bytecode instructions: their name (for displaying
831 * code), total number of code bytes required (including operand bytes), and a
832 * description of the type of each operand. These operand types include signed
833 * and unsigned integers of length one and four bytes. The unsigned integers
834 * are used for indexes or for, e.g., the count of objects to push in a "push"
835 * instruction.
836 */
837
838 #define MAX_INSTRUCTION_OPERANDS 2
839
840 typedef enum InstOperandType {
841 OPERAND_NONE,
842 OPERAND_INT1, /* One byte signed integer. */
843 OPERAND_INT4, /* Four byte signed integer. */
844 OPERAND_UINT1, /* One byte unsigned integer. */
845 OPERAND_UINT4, /* Four byte unsigned integer. */
846 OPERAND_IDX4, /* Four byte signed index (actually an
847 * integer, but displayed differently.) */
848 OPERAND_LVT1, /* One byte unsigned index into the local
849 * variable table. */
850 OPERAND_LVT4, /* Four byte unsigned index into the local
851 * variable table. */
852 OPERAND_AUX4, /* Four byte unsigned index into the aux data
853 * table. */
854 OPERAND_OFFSET1, /* One byte signed jump offset. */
855 OPERAND_OFFSET4, /* Four byte signed jump offset. */
856 OPERAND_LIT1, /* One byte unsigned index into table of
857 * literals. */
858 OPERAND_LIT4, /* Four byte unsigned index into table of
859 * literals. */
860 OPERAND_SCLS1 /* Index into tclStringClassTable. */
861 } InstOperandType;
862
863 typedef struct InstructionDesc {
864 const char *name; /* Name of instruction. */
865 int numBytes; /* Total number of bytes for instruction. */
866 int stackEffect; /* The worst-case balance stack effect of the
867 * instruction, used for stack requirements
868 * computations. The value INT_MIN signals
869 * that the instruction's worst case effect is
870 * (1-opnd1). */
871 int numOperands; /* Number of operands. */
872 InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
873 /* The type of each operand. */
874 } InstructionDesc;
875
876 MODULE_SCOPE InstructionDesc const tclInstructionTable[];
877
878 /*
879 * Constants used by INST_STRING_CLASS to indicate character classes. These
880 * correspond closely by name with what [string is] can support, but there is
881 * no requirement to keep the values the same.
882 */
883
884 typedef enum InstStringClassType {
885 STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */
886 STR_CLASS_ALPHA, /* Unicode alphabet characters. */
887 STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */
888 STR_CLASS_CONTROL, /* Unicode control characters. */
889 STR_CLASS_DIGIT, /* Unicode digit characters. */
890 STR_CLASS_GRAPH, /* Unicode printing characters, excluding
891 * space. */
892 STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */
893 STR_CLASS_PRINT, /* Unicode printing characters, including
894 * spaces. */
895 STR_CLASS_PUNCT, /* Unicode punctuation characters. */
896 STR_CLASS_SPACE, /* Unicode space characters. */
897 STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
898 STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
899 * punctuation) characters. */
900 STR_CLASS_XDIGIT /* Characters that can be used as digits in
901 * hexadecimal numbers ([0-9A-Fa-f]). */
902 } InstStringClassType;
903
904 typedef struct StringClassDesc {
905 const char *name; /* Name of the class. */
906 int (*comparator)(int); /* Function to test if a single unicode
907 * character is a member of the class. */
908 } StringClassDesc;
909
910 MODULE_SCOPE StringClassDesc const tclStringClassTable[];
911
912 /*
913 * Compilation of some Tcl constructs such as if commands and the logical or
914 * (||) and logical and (&&) operators in expressions requires the generation
915 * of forward jumps. Since the PC target of these jumps isn't known when the
916 * jumps are emitted, we record the offset of each jump in an array of
917 * JumpFixup structures. There is one array for each sequence of jumps to one
918 * target PC. When we learn the target PC, we update the jumps with the
919 * correct distance. Also, if the distance is too great (> 127 bytes), we
920 * replace the single-byte jump with a four byte jump instruction, move the
921 * instructions after the jump down, and update the code offsets for any
922 * commands between the jump and the target.
923 */
924
925 typedef enum {
926 TCL_UNCONDITIONAL_JUMP,
927 TCL_TRUE_JUMP,
928 TCL_FALSE_JUMP
929 } TclJumpType;
930
931 typedef struct JumpFixup {
932 TclJumpType jumpType; /* Indicates the kind of jump. */
933 unsigned int codeOffset; /* Offset of the first byte of the one-byte
934 * forward jump's code. */
935 int cmdIndex; /* Index of the first command after the one
936 * for which the jump was emitted. Used to
937 * update the code offsets for subsequent
938 * commands if the two-byte jump at jumpPc
939 * must be replaced with a five-byte one. */
940 int exceptIndex; /* Index of the first range entry in the
941 * ExceptionRange array after the current one.
942 * This field is used to adjust the code
943 * offsets in subsequent ExceptionRange
944 * records when a jump is grown from 2 bytes
945 * to 5 bytes. */
946 } JumpFixup;
947
948 #define JUMPFIXUP_INIT_ENTRIES 10
949
950 typedef struct JumpFixupArray {
951 JumpFixup *fixup; /* Points to start of jump fixup array. */
952 int next; /* Index of next free array entry. */
953 int end; /* Index of last usable entry in array. */
954 int mallocedArray; /* 1 if array was expanded and fixups points
955 * into the heap, else 0. */
956 JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES];
957 /* Initial storage for jump fixup array. */
958 } JumpFixupArray;
959
960 /*
961 * The structure describing one variable list of a foreach command. Note that
962 * only foreach commands inside procedure bodies are compiled inline so a
963 * ForeachVarList structure always describes local variables. Furthermore,
964 * only scalar variables are supported for inline-compiled foreach loops.
965 */
966
967 typedef struct ForeachVarList {
968 int numVars; /* The number of variables in the list. */
969 int varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers")
970 * for each variable in the procedure's array
971 * of local variables. Only scalar variables
972 * are supported. The actual size of this
973 * field will be large enough to numVars
974 * indexes. THIS MUST BE THE LAST FIELD IN THE
975 * STRUCTURE! */
976 } ForeachVarList;
977
978 /*
979 * Structure used to hold information about a foreach command that is needed
980 * during program execution. These structures are stored in CompileEnv and
981 * ByteCode structures as auxiliary data.
982 */
983
984 typedef struct ForeachInfo {
985 int numLists; /* The number of both the variable and value
986 * lists of the foreach command. */
987 int firstValueTemp; /* Index of the first temp var in a proc frame
988 * used to point to a value list. */
989 int loopCtTemp; /* Index of temp var in a proc frame holding
990 * the loop's iteration count. Used to
991 * determine next value list element to assign
992 * each loop var. */
993 ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList
994 * structures describing each var list. The
995 * actual size of this field will be large
996 * enough to numVars indexes. THIS MUST BE THE
997 * LAST FIELD IN THE STRUCTURE! */
998 } ForeachInfo;
999
1000 /*
1001 * Structure used to hold information about a switch command that is needed
1002 * during program execution. These structures are stored in CompileEnv and
1003 * ByteCode structures as auxiliary data.
1004 */
1005
1006 typedef struct JumptableInfo {
1007 Tcl_HashTable hashTable; /* Hash that maps strings to signed ints (PC
1008 * offsets). */
1009 } JumptableInfo;
1010
1011 MODULE_SCOPE const AuxDataType tclJumptableInfoType;
1012
1013 #define JUMPTABLEINFO(envPtr, index) \
1014 ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
1015
1016 /*
1017 * Structure used to hold information about a [dict update] command that is
1018 * needed during program execution. These structures are stored in CompileEnv
1019 * and ByteCode structures as auxiliary data.
1020 */
1021
1022 typedef struct {
1023 int length; /* Size of array */
1024 int varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when
1025 * processing the start and end of a [dict
1026 * update]. There is really more than one
1027 * entry, and the structure is allocated to
1028 * take account of this. MUST BE LAST FIELD IN
1029 * STRUCTURE. */
1030 } DictUpdateInfo;
1031
1032 /*
1033 * ClientData type used by the math operator commands.
1034 */
1035
1036 typedef struct {
1037 const char *op; /* Do not call it 'operator': C++ reserved */
1038 const char *expected;
1039 union {
1040 int numArgs;
1041 int identity;
1042 } i;
1043 } TclOpCmdClientData;
1044
1045 /*
1046 *----------------------------------------------------------------
1047 * Procedures exported by tclBasic.c to be used within the engine.
1048 *----------------------------------------------------------------
1049 */
1050
1051 MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
1052
1053 /*
1054 *----------------------------------------------------------------
1055 * Procedures exported by the engine to be used by tclBasic.c
1056 *----------------------------------------------------------------
1057 */
1058
1059 MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
1060 const CmdFrame *invoker, int word);
1061
1062 /*
1063 *----------------------------------------------------------------
1064 * Procedures shared among Tcl bytecode compilation and execution modules but
1065 * not used outside:
1066 *----------------------------------------------------------------
1067 */
1068
1069 MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp,
1070 Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
1071 CompileEnv *envPtr);
1072 MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr);
1073 MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr,
1074 ExceptionAux *auxPtr);
1075 MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp,
1076 Tcl_Token *tokenPtr, int count,
1077 CompileEnv *envPtr);
1078 MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script,
1079 int numBytes, CompileEnv *envPtr, int optimize);
1080 MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp,
1081 Tcl_Token *tokenPtr, int numWords,
1082 CompileEnv *envPtr);
1083 MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp,
1084 Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
1085 CompileEnv *envPtr);
1086 MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp,
1087 const char *script, int numBytes,
1088 CompileEnv *envPtr);
1089 MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp,
1090 CompileEnv *envPtr);
1091 MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp,
1092 Tcl_Token *tokenPtr, int count,
1093 CompileEnv *envPtr);
1094 MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp,
1095 Tcl_Token *tokenPtr, CompileEnv *envPtr);
1096 MODULE_SCOPE int TclCreateAuxData(ClientData clientData,
1097 const AuxDataType *typePtr, CompileEnv *envPtr);
1098 MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type,
1099 CompileEnv *envPtr);
1100 MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size);
1101 MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes,
1102 int length, unsigned int hash, int *newPtr,
1103 Namespace *nsPtr, int flags,
1104 LiteralEntry **globalPtrPtr);
1105 MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr);
1106 MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp,
1107 LiteralTable *tablePtr);
1108 MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr,
1109 TclJumpType jumpType, JumpFixup *jumpFixupPtr);
1110 MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
1111 MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
1112 int catchOnly, ByteCode *codePtr);
1113 MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
1114 MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp,
1115 ByteCode *codePtr);
1116 MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
1117 MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
1118 int create, CompileEnv *envPtr);
1119 MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
1120 JumpFixup *jumpFixupPtr, int jumpDist,
1121 int distThreshold);
1122 MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
1123 MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
1124 MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr,
1125 int before, int after, int *indexPtr);
1126 MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
1127 CompileEnv *envPtr);
1128 MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
1129 CompileEnv *envPtr, const char *string,
1130 int numBytes, const CmdFrame *invoker, int word);
1131 MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
1132 MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr);
1133 MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
1134 int returnCode, ExceptionAux **auxPtrPtr);
1135 MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr,
1136 ExceptionAux *auxPtr);
1137 MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr,
1138 ExceptionAux *auxPtr);
1139 MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
1140 int range);
1141 #ifdef TCL_COMPILE_STATS
1142 MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
1143 MODULE_SCOPE int TclLog2(int value);
1144 #endif
1145 MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes,
1146 CompileEnv *envPtr);
1147 MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
1148 CompileEnv *envPtr);
1149 MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
1150 #ifdef TCL_COMPILE_DEBUG
1151 MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
1152 Tcl_Obj *objPtr);
1153 #endif
1154 MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr,
1155 const unsigned char *pc);
1156 MODULE_SCOPE void TclPrintObject(FILE *outFile,
1157 Tcl_Obj *objPtr, int maxChars);
1158 MODULE_SCOPE void TclPrintSource(FILE *outFile,
1159 const char *string, int maxChars);
1160 MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
1161 Tcl_Token *varTokenPtr, CompileEnv *envPtr,
1162 int flags, int *localIndexPtr,
1163 int *isScalarPtr);
1164
1165 static inline void
TclPreserveByteCode(ByteCode * codePtr)1166 TclPreserveByteCode(
1167 ByteCode *codePtr)
1168 {
1169 codePtr->refCount++;
1170 }
1171
1172 static inline void
TclReleaseByteCode(ByteCode * codePtr)1173 TclReleaseByteCode(
1174 ByteCode *codePtr)
1175 {
1176 if (codePtr->refCount-- > 1) {
1177 return;
1178 }
1179 /* Just dropped to refcount==0. Clean up. */
1180 TclCleanupByteCode(codePtr);
1181 }
1182
1183 MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
1184 MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
1185 const char *name, Namespace *nsPtr);
1186 MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
1187 Tcl_Interp *interp, int objc,
1188 Tcl_Obj *const objv[]);
1189 MODULE_SCOPE int TclSortingOpCmd(ClientData clientData,
1190 Tcl_Interp *interp, int objc,
1191 Tcl_Obj *const objv[]);
1192 MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData,
1193 Tcl_Interp *interp, int objc,
1194 Tcl_Obj *const objv[]);
1195 MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData,
1196 Tcl_Interp *interp, int objc,
1197 Tcl_Obj *const objv[]);
1198 #ifdef TCL_COMPILE_DEBUG
1199 MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr);
1200 MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
1201 #endif
1202 MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
1203 Tcl_Obj *valuePtr);
1204 MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
1205 const char *script, const char *command,
1206 int length, const unsigned char *pc,
1207 Tcl_Obj **tosPtr);
1208 MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
1209 const unsigned char *pc, Tcl_Obj **tosPtr);
1210 MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
1211 MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
1212 Tcl_Interp *interp, int objc,
1213 Tcl_Obj *const objv[], int isLambda);
1214
1215
1216 /*
1217 *----------------------------------------------------------------
1218 * Macros and flag values used by Tcl bytecode compilation and execution
1219 * modules inside the Tcl core but not used outside.
1220 *----------------------------------------------------------------
1221 */
1222
1223 /*
1224 * Simplified form to access AuxData.
1225 *
1226 * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
1227 */
1228
1229 #define TclFetchAuxData(envPtr, index) \
1230 (envPtr)->auxDataArrayPtr[(index)].clientData
1231
1232 #define LITERAL_ON_HEAP 0x01
1233 #define LITERAL_CMD_NAME 0x02
1234 #define LITERAL_UNSHARED 0x04
1235
1236 /*
1237 * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
1238 * cast away constness, and it is cleanest to do that here, all in one place.
1239 *
1240 * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
1241 * int length);
1242 */
1243
1244 #define TclRegisterNewLiteral(envPtr, bytes, length) \
1245 TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
1246
1247 /*
1248 * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it
1249 * is safe to cast away constness, and it is cleanest to do that here, all in
1250 * one place.
1251 *
1252 * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
1253 * int length);
1254 */
1255
1256 #define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
1257 TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)
1258
1259 /*
1260 * Macro used to manually adjust the stack requirements; used in cases where
1261 * the stack effect cannot be computed from the opcode and its operands, but
1262 * is still known at compile time.
1263 *
1264 * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
1265 */
1266
1267 #define TclAdjustStackDepth(delta, envPtr) \
1268 do { \
1269 if ((delta) < 0) { \
1270 if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) { \
1271 (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \
1272 } \
1273 } \
1274 (envPtr)->currStackDepth += (delta); \
1275 } while (0)
1276
1277 #define TclGetStackDepth(envPtr) \
1278 ((envPtr)->currStackDepth)
1279
1280 #define TclSetStackDepth(depth, envPtr) \
1281 (envPtr)->currStackDepth = (depth)
1282
1283 #define TclCheckStackDepth(depth, envPtr) \
1284 do { \
1285 int _dd = (depth); \
1286 if (_dd != (envPtr)->currStackDepth) { \
1287 Tcl_Panic("bad stack depth computations: is %i, should be %i", \
1288 (envPtr)->currStackDepth, _dd); \
1289 } \
1290 } while (0)
1291
1292 /*
1293 * Macro used to update the stack requirements. It is called by the macros
1294 * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
1295 * Remark that the very last instruction of a bytecode always reduces the
1296 * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always
1297 * updated.
1298 *
1299 * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr);
1300 */
1301
1302 #define TclUpdateStackReqs(op, i, envPtr) \
1303 do { \
1304 int _delta = tclInstructionTable[(op)].stackEffect; \
1305 if (_delta) { \
1306 if (_delta == INT_MIN) { \
1307 _delta = 1 - (i); \
1308 } \
1309 TclAdjustStackDepth(_delta, envPtr); \
1310 } \
1311 } while (0)
1312
1313 /*
1314 * Macros used to update the flag that indicates if we are at the start of a
1315 * command, based on whether the opcode is INST_START_COMMAND.
1316 *
1317 * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
1318 */
1319
1320 #define TclUpdateAtCmdStart(op, envPtr) \
1321 if ((envPtr)->atCmdStart < 2) { \
1322 (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \
1323 }
1324
1325 /*
1326 * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
1327 * "prototype" for this macro is:
1328 *
1329 * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
1330 */
1331
1332 #define TclEmitOpcode(op, envPtr) \
1333 do { \
1334 if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
1335 TclExpandCodeArray(envPtr); \
1336 } \
1337 *(envPtr)->codeNext++ = (unsigned char) (op); \
1338 TclUpdateAtCmdStart(op, envPtr); \
1339 TclUpdateStackReqs(op, 0, envPtr); \
1340 } while (0)
1341
1342 /*
1343 * Macros to emit an integer operand. The ANSI C "prototype" for these macros
1344 * are:
1345 *
1346 * void TclEmitInt1(int i, CompileEnv *envPtr);
1347 * void TclEmitInt4(int i, CompileEnv *envPtr);
1348 */
1349
1350 #define TclEmitInt1(i, envPtr) \
1351 do { \
1352 if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
1353 TclExpandCodeArray(envPtr); \
1354 } \
1355 *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \
1356 } while (0)
1357
1358 #define TclEmitInt4(i, envPtr) \
1359 do { \
1360 if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
1361 TclExpandCodeArray(envPtr); \
1362 } \
1363 *(envPtr)->codeNext++ = \
1364 (unsigned char) ((unsigned int) (i) >> 24); \
1365 *(envPtr)->codeNext++ = \
1366 (unsigned char) ((unsigned int) (i) >> 16); \
1367 *(envPtr)->codeNext++ = \
1368 (unsigned char) ((unsigned int) (i) >> 8); \
1369 *(envPtr)->codeNext++ = \
1370 (unsigned char) ((unsigned int) (i) ); \
1371 } while (0)
1372
1373 /*
1374 * Macros to emit an instruction with signed or unsigned integer operands.
1375 * Four byte integers are stored in "big-endian" order with the high order
1376 * byte stored at the lowest address. The ANSI C "prototypes" for these macros
1377 * are:
1378 *
1379 * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
1380 * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
1381 */
1382
1383 #define TclEmitInstInt1(op, i, envPtr) \
1384 do { \
1385 if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
1386 TclExpandCodeArray(envPtr); \
1387 } \
1388 *(envPtr)->codeNext++ = (unsigned char) (op); \
1389 *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \
1390 TclUpdateAtCmdStart(op, envPtr); \
1391 TclUpdateStackReqs(op, i, envPtr); \
1392 } while (0)
1393
1394 #define TclEmitInstInt4(op, i, envPtr) \
1395 do { \
1396 if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
1397 TclExpandCodeArray(envPtr); \
1398 } \
1399 *(envPtr)->codeNext++ = (unsigned char) (op); \
1400 *(envPtr)->codeNext++ = \
1401 (unsigned char) ((unsigned int) (i) >> 24); \
1402 *(envPtr)->codeNext++ = \
1403 (unsigned char) ((unsigned int) (i) >> 16); \
1404 *(envPtr)->codeNext++ = \
1405 (unsigned char) ((unsigned int) (i) >> 8); \
1406 *(envPtr)->codeNext++ = \
1407 (unsigned char) ((unsigned int) (i) ); \
1408 TclUpdateAtCmdStart(op, envPtr); \
1409 TclUpdateStackReqs(op, i, envPtr); \
1410 } while (0)
1411
1412 /*
1413 * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
1414 * object's one or four byte array index into the CompileEnv's code array.
1415 * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a
1416 * CompileEnv. The ANSI C "prototype" for this macro is:
1417 *
1418 * void TclEmitPush(int objIndex, CompileEnv *envPtr);
1419 */
1420
1421 #define TclEmitPush(objIndex, envPtr) \
1422 do { \
1423 int _objIndexCopy = (objIndex); \
1424 if (_objIndexCopy <= 255) { \
1425 TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \
1426 } else { \
1427 TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \
1428 } \
1429 } while (0)
1430
1431 /*
1432 * Macros to update a (signed or unsigned) integer starting at a pointer. The
1433 * two variants depend on the number of bytes. The ANSI C "prototypes" for
1434 * these macros are:
1435 *
1436 * void TclStoreInt1AtPtr(int i, unsigned char *p);
1437 * void TclStoreInt4AtPtr(int i, unsigned char *p);
1438 */
1439
1440 #define TclStoreInt1AtPtr(i, p) \
1441 *(p) = (unsigned char) ((unsigned int) (i))
1442
1443 #define TclStoreInt4AtPtr(i, p) \
1444 do { \
1445 *(p) = (unsigned char) ((unsigned int) (i) >> 24); \
1446 *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
1447 *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \
1448 *(p+3) = (unsigned char) ((unsigned int) (i) ); \
1449 } while (0)
1450
1451 /*
1452 * Macros to update instructions at a particular pc with a new op code and a
1453 * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros
1454 * are:
1455 *
1456 * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc);
1457 * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc);
1458 */
1459
1460 #define TclUpdateInstInt1AtPc(op, i, pc) \
1461 do { \
1462 *(pc) = (unsigned char) (op); \
1463 TclStoreInt1AtPtr((i), ((pc)+1)); \
1464 } while (0)
1465
1466 #define TclUpdateInstInt4AtPc(op, i, pc) \
1467 do { \
1468 *(pc) = (unsigned char) (op); \
1469 TclStoreInt4AtPtr((i), ((pc)+1)); \
1470 } while (0)
1471
1472 /*
1473 * Macro to fix up a forward jump to point to the current code-generation
1474 * position in the bytecode being created (the most common case). The ANSI C
1475 * "prototypes" for this macro is:
1476 *
1477 * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr,
1478 * int threshold);
1479 */
1480
1481 #define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
1482 TclFixupForwardJump((envPtr), (fixupPtr), \
1483 (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \
1484 (threshold))
1485
1486 /*
1487 * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
1488 * (GET_UINT{1,2}) from a pointer. There are two variants for each return type
1489 * that depend on the number of bytes fetched. The ANSI C "prototypes" for
1490 * these macros are:
1491 *
1492 * int TclGetInt1AtPtr(unsigned char *p);
1493 * int TclGetInt4AtPtr(unsigned char *p);
1494 * unsigned int TclGetUInt1AtPtr(unsigned char *p);
1495 * unsigned int TclGetUInt4AtPtr(unsigned char *p);
1496 */
1497
1498 /*
1499 * The TclGetInt1AtPtr macro is tricky because we want to do sign extension on
1500 * the 1-byte value. Unfortunately the "char" type isn't signed on all
1501 * platforms so sign-extension doesn't always happen automatically. Sometimes
1502 * we can explicitly declare the pointer to be signed, but other times we have
1503 * to explicitly sign-extend the value in software.
1504 */
1505
1506 #ifndef __CHAR_UNSIGNED__
1507 # define TclGetInt1AtPtr(p) ((int) *((char *) p))
1508 #elif defined(HAVE_SIGNED_CHAR)
1509 # define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
1510 #else
1511 # define TclGetInt1AtPtr(p) \
1512 (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
1513 #endif
1514
1515 #define TclGetInt4AtPtr(p) \
1516 (((int) (TclGetUInt1AtPtr(p) << 24)) | \
1517 (*((p)+1) << 16) | \
1518 (*((p)+2) << 8) | \
1519 (*((p)+3)))
1520
1521 #define TclGetUInt1AtPtr(p) \
1522 ((unsigned int) *(p))
1523 #define TclGetUInt4AtPtr(p) \
1524 ((unsigned int) (*(p) << 24) | \
1525 (*((p)+1) << 16) | \
1526 (*((p)+2) << 8) | \
1527 (*((p)+3)))
1528
1529 /*
1530 * Macros used to compute the minimum and maximum of two integers. The ANSI C
1531 * "prototypes" for these macros are:
1532 *
1533 * int TclMin(int i, int j);
1534 * int TclMax(int i, int j);
1535 */
1536
1537 #define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j))
1538 #define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j))
1539
1540 /*
1541 * Convenience macros for use when compiling bodies of commands. The ANSI C
1542 * "prototype" for these macros are:
1543 *
1544 * static void BODY(Tcl_Token *tokenPtr, int word);
1545 */
1546
1547 #define BODY(tokenPtr, word) \
1548 SetLineInformation((word)); \
1549 TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \
1550 envPtr)
1551
1552 /*
1553 * Convenience macro for use when compiling tokens to be pushed. The ANSI C
1554 * "prototype" for this macro is:
1555 *
1556 * static void CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
1557 * Tcl_Interp *interp);
1558 */
1559
1560 #define CompileTokens(envPtr, tokenPtr, interp) \
1561 TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
1562 (envPtr));
1563 /*
1564 * Convenience macros for use when pushing literals. The ANSI C "prototype" for
1565 * these macros are:
1566 *
1567 * static void PushLiteral(CompileEnv *envPtr,
1568 * const char *string, int length);
1569 * static void PushStringLiteral(CompileEnv *envPtr,
1570 * const char *string);
1571 */
1572
1573 #define PushLiteral(envPtr, string, length) \
1574 TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
1575 #define PushStringLiteral(envPtr, string) \
1576 PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))
1577
1578 /*
1579 * Macro to advance to the next token; it is more mnemonic than the address
1580 * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
1581 *
1582 * static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr);
1583 */
1584
1585 #define TokenAfter(tokenPtr) \
1586 ((tokenPtr) + ((tokenPtr)->numComponents + 1))
1587
1588 /*
1589 * Macro to get the offset to the next instruction to be issued. The ANSI C
1590 * "prototype" for this macro is:
1591 *
1592 * static int CurrentOffset(CompileEnv *envPtr);
1593 */
1594
1595 #define CurrentOffset(envPtr) \
1596 ((envPtr)->codeNext - (envPtr)->codeStart)
1597
1598 /*
1599 * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
1600 * maximal depth of nested CATCH ranges in order to alloc runtime
1601 * memory. These macros should compute precisely that? OTOH, the nesting depth
1602 * of LOOP ranges is an interesting datum for debugging purposes, and that is
1603 * what we compute now.
1604 *
1605 * static int ExceptionRangeStarts(CompileEnv *envPtr, int index);
1606 * static void ExceptionRangeEnds(CompileEnv *envPtr, int index);
1607 * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
1608 */
1609
1610 #define ExceptionRangeStarts(envPtr, index) \
1611 (((envPtr)->exceptDepth++), \
1612 ((envPtr)->maxExceptDepth = \
1613 TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
1614 ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
1615 #define ExceptionRangeEnds(envPtr, index) \
1616 (((envPtr)->exceptDepth--), \
1617 ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
1618 CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
1619 #define ExceptionRangeTarget(envPtr, index, targetType) \
1620 ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
1621
1622 /*
1623 * Check if there is an LVT for compiled locals
1624 */
1625
1626 #define EnvHasLVT(envPtr) \
1627 (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)
1628
1629 /*
1630 * Macros for making it easier to deal with tokens and DStrings.
1631 */
1632
1633 #define TclDStringAppendToken(dsPtr, tokenPtr) \
1634 Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
1635 #define TclRegisterDStringLiteral(envPtr, dsPtr) \
1636 TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
1637 Tcl_DStringLength(dsPtr), /*flags*/ 0)
1638
1639 /*
1640 * Macro that encapsulates an efficiency trick that avoids a function call for
1641 * the simplest of compiles. The ANSI C "prototype" for this macro is:
1642 *
1643 * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
1644 * Tcl_Interp *interp, int word);
1645 */
1646
1647 #define CompileWord(envPtr, tokenPtr, interp, word) \
1648 if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
1649 PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size); \
1650 } else { \
1651 SetLineInformation((word)); \
1652 CompileTokens((envPtr), (tokenPtr), (interp)); \
1653 }
1654
1655 /*
1656 * TIP #280: Remember the per-word line information of the current command. An
1657 * index is used instead of a pointer as recursive compilation may reallocate,
1658 * i.e. move, the array. This is also the reason to save the nuloc now, it may
1659 * change during the course of the function.
1660 *
1661 * Macro to encapsulate the variable definition and setup.
1662 */
1663
1664 #define DefineLineInformation \
1665 ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
1666 int eclIndex = mapPtr->nuloc - 1
1667
1668 #define SetLineInformation(word) \
1669 envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \
1670 envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
1671
1672 #define PushVarNameWord(i,v,e,f,l,sc,word) \
1673 SetLineInformation(word); \
1674 TclPushVarName(i,v,e,f,l,sc)
1675
1676 /*
1677 * Often want to issue one of two versions of an instruction based on whether
1678 * the argument will fit in a single byte or not. This makes it much clearer.
1679 */
1680
1681 #define Emit14Inst(nm,idx,envPtr) \
1682 if (idx <= 255) { \
1683 TclEmitInstInt1(nm##1,idx,envPtr); \
1684 } else { \
1685 TclEmitInstInt4(nm##4,idx,envPtr); \
1686 }
1687
1688 /*
1689 * How to get an anonymous local variable (used for holding temporary values
1690 * off the stack) or a local simple scalar.
1691 */
1692
1693 #define AnonymousLocal(envPtr) \
1694 (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
1695 #define LocalScalar(chars,len,envPtr) \
1696 TclLocalScalar(chars, len, envPtr)
1697 #define LocalScalarFromToken(tokenPtr,envPtr) \
1698 TclLocalScalarFromToken(tokenPtr, envPtr)
1699
1700 /*
1701 * Flags bits used by TclPushVarName.
1702 */
1703
1704 #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
1705 #define TCL_NO_ELEMENT 2 /* Do not push the array element. */
1706
1707 /*
1708 * DTrace probe macros (NOPs if DTrace support is not enabled).
1709 */
1710
1711 /*
1712 * Define the following macros to enable debug logging of the DTrace proc,
1713 * cmd, and inst probes. Note that this does _not_ require a platform with
1714 * DTrace, it simply logs all probe output to /tmp/tclDTraceDebug-[pid].log.
1715 *
1716 * If the second macro is defined, logging to file starts immediately,
1717 * otherwise only after the first call to [tcl::dtrace]. Note that the debug
1718 * probe data is always computed, even when it is not logged to file.
1719 *
1720 * Defining the third macro enables debug logging of inst probes (disabled
1721 * by default due to the significant performance impact).
1722 */
1723
1724 /*
1725 #define TCL_DTRACE_DEBUG 1
1726 #define TCL_DTRACE_DEBUG_LOG_ENABLED 1
1727 #define TCL_DTRACE_DEBUG_INST_PROBES 1
1728 */
1729
1730 #if !(defined(TCL_DTRACE_DEBUG) && defined(__GNUC__))
1731
1732 #ifdef USE_DTRACE
1733
1734 #if defined(__GNUC__) && __GNUC__ > 2
1735 /*
1736 * Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks.
1737 */
1738 #define unlikely(x) (__builtin_expect((x), 0))
1739 #else
1740 #define unlikely(x) (x)
1741 #endif
1742
1743 #define TCL_DTRACE_PROC_ENTRY_ENABLED() unlikely(TCL_PROC_ENTRY_ENABLED())
1744 #define TCL_DTRACE_PROC_RETURN_ENABLED() unlikely(TCL_PROC_RETURN_ENABLED())
1745 #define TCL_DTRACE_PROC_RESULT_ENABLED() unlikely(TCL_PROC_RESULT_ENABLED())
1746 #define TCL_DTRACE_PROC_ARGS_ENABLED() unlikely(TCL_PROC_ARGS_ENABLED())
1747 #define TCL_DTRACE_PROC_INFO_ENABLED() unlikely(TCL_PROC_INFO_ENABLED())
1748 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) TCL_PROC_ENTRY(a0, a1, a2)
1749 #define TCL_DTRACE_PROC_RETURN(a0, a1) TCL_PROC_RETURN(a0, a1)
1750 #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3)
1751 #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
1752 TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
1753 #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
1754 TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
1755
1756 #define TCL_DTRACE_CMD_ENTRY_ENABLED() unlikely(TCL_CMD_ENTRY_ENABLED())
1757 #define TCL_DTRACE_CMD_RETURN_ENABLED() unlikely(TCL_CMD_RETURN_ENABLED())
1758 #define TCL_DTRACE_CMD_RESULT_ENABLED() unlikely(TCL_CMD_RESULT_ENABLED())
1759 #define TCL_DTRACE_CMD_ARGS_ENABLED() unlikely(TCL_CMD_ARGS_ENABLED())
1760 #define TCL_DTRACE_CMD_INFO_ENABLED() unlikely(TCL_CMD_INFO_ENABLED())
1761 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) TCL_CMD_ENTRY(a0, a1, a2)
1762 #define TCL_DTRACE_CMD_RETURN(a0, a1) TCL_CMD_RETURN(a0, a1)
1763 #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3)
1764 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
1765 TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
1766 #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
1767 TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
1768
1769 #define TCL_DTRACE_INST_START_ENABLED() unlikely(TCL_INST_START_ENABLED())
1770 #define TCL_DTRACE_INST_DONE_ENABLED() unlikely(TCL_INST_DONE_ENABLED())
1771 #define TCL_DTRACE_INST_START(a0, a1, a2) TCL_INST_START(a0, a1, a2)
1772 #define TCL_DTRACE_INST_DONE(a0, a1, a2) TCL_INST_DONE(a0, a1, a2)
1773
1774 #define TCL_DTRACE_TCL_PROBE_ENABLED() unlikely(TCL_TCL_PROBE_ENABLED())
1775 #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
1776 TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
1777
1778 #define TCL_DTRACE_DEBUG_LOG()
1779
1780 MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args,
1781 int *argsi);
1782
1783 #else /* USE_DTRACE */
1784
1785 #define TCL_DTRACE_PROC_ENTRY_ENABLED() 0
1786 #define TCL_DTRACE_PROC_RETURN_ENABLED() 0
1787 #define TCL_DTRACE_PROC_RESULT_ENABLED() 0
1788 #define TCL_DTRACE_PROC_ARGS_ENABLED() 0
1789 #define TCL_DTRACE_PROC_INFO_ENABLED() 0
1790 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) {if (a0) {}}
1791 #define TCL_DTRACE_PROC_RETURN(a0, a1) {if (a0) {}}
1792 #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {if (a0) {}; if (a3) {}}
1793 #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
1794 #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
1795
1796 #define TCL_DTRACE_CMD_ENTRY_ENABLED() 0
1797 #define TCL_DTRACE_CMD_RETURN_ENABLED() 0
1798 #define TCL_DTRACE_CMD_RESULT_ENABLED() 0
1799 #define TCL_DTRACE_CMD_ARGS_ENABLED() 0
1800 #define TCL_DTRACE_CMD_INFO_ENABLED() 0
1801 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) {}
1802 #define TCL_DTRACE_CMD_RETURN(a0, a1) {}
1803 #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {}
1804 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
1805 #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
1806
1807 #define TCL_DTRACE_INST_START_ENABLED() 0
1808 #define TCL_DTRACE_INST_DONE_ENABLED() 0
1809 #define TCL_DTRACE_INST_START(a0, a1, a2) {}
1810 #define TCL_DTRACE_INST_DONE(a0, a1, a2) {}
1811
1812 #define TCL_DTRACE_TCL_PROBE_ENABLED() 0
1813 #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
1814
1815 #define TclDTraceInfo(info, args, argsi) {*args = ""; *argsi = 0;}
1816
1817 #endif /* USE_DTRACE */
1818
1819 #else /* TCL_DTRACE_DEBUG */
1820
1821 #define USE_DTRACE 1
1822
1823 #if !defined(TCL_DTRACE_DEBUG_LOG_ENABLED) || !(TCL_DTRACE_DEBUG_LOG_ENABLED)
1824 #undef TCL_DTRACE_DEBUG_LOG_ENABLED
1825 #define TCL_DTRACE_DEBUG_LOG_ENABLED 0
1826 #endif
1827
1828 #if !defined(TCL_DTRACE_DEBUG_INST_PROBES) || !(TCL_DTRACE_DEBUG_INST_PROBES)
1829 #undef TCL_DTRACE_DEBUG_INST_PROBES
1830 #define TCL_DTRACE_DEBUG_INST_PROBES 0
1831 #endif
1832
1833 MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent;
1834 MODULE_SCOPE FILE *tclDTraceDebugLog;
1835 MODULE_SCOPE void TclDTraceOpenDebugLog(void);
1836 MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi);
1837
1838 #define TCL_DTRACE_DEBUG_LOG() \
1839 int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \
1840 int tclDTraceDebugIndent = 0; \
1841 FILE *tclDTraceDebugLog = NULL; \
1842 void TclDTraceOpenDebugLog(void) { \
1843 char n[35]; \
1844 sprintf(n, "/tmp/tclDTraceDebug-%lu.log", \
1845 (unsigned long) getpid()); \
1846 tclDTraceDebugLog = fopen(n, "a"); \
1847 }
1848
1849 #define TclDTraceDbgMsg(p, m, ...) \
1850 do { \
1851 if (tclDTraceDebugEnabled) { \
1852 int _l, _t = 0; \
1853 if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \
1854 fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", \
1855 strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \
1856 fprintf(tclDTraceDebugLog, " %.*s():%n", \
1857 (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \
1858 fprintf(tclDTraceDebugLog, "%*s" p "%n", \
1859 (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \
1860 "", &_l); _t += _l; \
1861 fprintf(tclDTraceDebugLog, "%*s" m "\n", \
1862 (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__); \
1863 fflush(tclDTraceDebugLog); \
1864 } \
1865 } while (0)
1866
1867 #define TCL_DTRACE_PROC_ENTRY_ENABLED() 1
1868 #define TCL_DTRACE_PROC_RETURN_ENABLED() 1
1869 #define TCL_DTRACE_PROC_RESULT_ENABLED() 1
1870 #define TCL_DTRACE_PROC_ARGS_ENABLED() 1
1871 #define TCL_DTRACE_PROC_INFO_ENABLED() 1
1872 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \
1873 tclDTraceDebugIndent++; \
1874 TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2)
1875 #define TCL_DTRACE_PROC_RETURN(a0, a1) \
1876 TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \
1877 tclDTraceDebugIndent--
1878 #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \
1879 TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3)
1880 #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
1881 TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
1882 a1, a2, a3, a4, a5, a6, a7, a8, a9)
1883 #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
1884 TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \
1885 a2, a3, a4, a5, a6, a7)
1886
1887 #define TCL_DTRACE_CMD_ENTRY_ENABLED() 1
1888 #define TCL_DTRACE_CMD_RETURN_ENABLED() 1
1889 #define TCL_DTRACE_CMD_RESULT_ENABLED() 1
1890 #define TCL_DTRACE_CMD_ARGS_ENABLED() 1
1891 #define TCL_DTRACE_CMD_INFO_ENABLED() 1
1892 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \
1893 tclDTraceDebugIndent++; \
1894 TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2)
1895 #define TCL_DTRACE_CMD_RETURN(a0, a1) \
1896 TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \
1897 tclDTraceDebugIndent--
1898 #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \
1899 TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3)
1900 #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
1901 TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
1902 a1, a2, a3, a4, a5, a6, a7, a8, a9)
1903 #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
1904 TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \
1905 a2, a3, a4, a5, a6, a7)
1906
1907 #define TCL_DTRACE_INST_START_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES
1908 #define TCL_DTRACE_INST_DONE_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES
1909 #define TCL_DTRACE_INST_START(a0, a1, a2) \
1910 TclDTraceDbgMsg(" | inst-start", "%s %d %p", a0, a1, a2)
1911 #define TCL_DTRACE_INST_DONE(a0, a1, a2) \
1912 TclDTraceDbgMsg(" | inst-end", "%s %d %p", a0, a1, a2)
1913
1914 #define TCL_DTRACE_TCL_PROBE_ENABLED() 1
1915 #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
1916 do { \
1917 tclDTraceDebugEnabled = 1; \
1918 TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \
1919 a1, a2, a3, a4, a5, a6, a7, a8, a9); \
1920 } while (0)
1921
1922 #endif /* TCL_DTRACE_DEBUG */
1923
1924 #endif /* _TCLCOMPILATION */
1925
1926 /*
1927 * Local Variables:
1928 * mode: c
1929 * c-basic-offset: 4
1930 * fill-column: 78
1931 * End:
1932 */
1933