123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932 |
- /*
- * tclCompile.h --
- *
- * Copyright (c) 1996-1998 Sun Microsystems, Inc.
- * Copyright (c) 1998-2000 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
- * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
- #ifndef _TCLCOMPILATION
- #define _TCLCOMPILATION 1
- #include "tclInt.h"
- struct ByteCode; /* Forward declaration. */
- /*
- *------------------------------------------------------------------------
- * Variables related to compilation. These are used in tclCompile.c,
- * tclExecute.c, tclBasic.c, and their clients.
- *------------------------------------------------------------------------
- */
- #ifdef TCL_COMPILE_DEBUG
- /*
- * Variable that controls whether compilation tracing is enabled and, if so,
- * what level of tracing is desired:
- * 0: no compilation tracing
- * 1: summarize compilation of top level cmds and proc bodies
- * 2: display all instructions of each ByteCode compiled
- * This variable is linked to the Tcl variable "tcl_traceCompile".
- */
- MODULE_SCOPE int tclTraceCompile;
- /*
- * Variable that controls whether execution tracing is enabled and, if so,
- * what level of tracing is desired:
- * 0: no execution tracing
- * 1: trace invocations of Tcl procs only
- * 2: trace invocations of all (not compiled away) commands
- * 3: display each instruction executed
- * This variable is linked to the Tcl variable "tcl_traceExec".
- */
- MODULE_SCOPE int tclTraceExec;
- #endif
- /*
- * The type of lambda expressions. Note that every lambda will *always* have a
- * string representation.
- */
- MODULE_SCOPE const Tcl_ObjType tclLambdaType;
- /*
- *------------------------------------------------------------------------
- * Data structures related to compilation.
- *------------------------------------------------------------------------
- */
- /*
- * The structure used to implement Tcl "exceptions" (exceptional returns): for
- * example, those generated in loops by the break and continue commands, and
- * those generated by scripts and caught by the catch command. This
- * ExceptionRange structure describes a range of code (e.g., a loop body), the
- * kind of exceptions (e.g., a break or continue) that might occur, and the PC
- * offsets to jump to if a matching exception does occur. Exception ranges can
- * nest so this structure includes a nesting level that is used at runtime to
- * find the closest exception range surrounding a PC. For example, when a
- * break command is executed, the ExceptionRange structure for the most deeply
- * nested loop, if any, is found and used. These structures are also generated
- * for the "next" subcommands of for loops since a break there terminates the
- * for command. This means a for command actually generates two LoopInfo
- * structures.
- */
- typedef enum {
- LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop. Break
- * and continue "exceptions" cause jumps to
- * appropriate PC offsets. */
- CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a catch
- * command. Errors in the range cause a jump
- * to a catch PC offset. */
- } ExceptionRangeType;
- typedef struct ExceptionRange {
- ExceptionRangeType type; /* The kind of ExceptionRange. */
- int nestingLevel; /* Static depth of the exception range. Used
- * to find the most deeply-nested range
- * surrounding a PC at runtime. */
- int codeOffset; /* Offset of the first instruction byte of the
- * code range. */
- int numCodeBytes; /* Number of bytes in the code range. */
- int breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC
- * offset for a break command in the range. */
- int continueOffset; /* If LOOP_EXCEPTION_RANGE and not -1, the
- * target PC offset for a continue command in
- * the code range. Otherwise, ignore this
- * range when processing a continue
- * command. */
- int catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC
- * offset for any "exception" in range. */
- } ExceptionRange;
- /*
- * Auxiliary data used when issuing (currently just loop) exception ranges,
- * but which is not required during execution.
- */
- typedef struct ExceptionAux {
- int supportsContinue; /* Whether this exception range will have a
- * continueOffset created for it; if it is a
- * loop exception range that *doesn't* have
- * one (see [for] next-clause) then we must
- * not pick up the range when scanning for a
- * target to continue to. */
- int stackDepth; /* The stack depth at the point where the
- * exception range was created. This is used
- * to calculate the number of POPs required to
- * restore the stack to its prior state. */
- int expandTarget; /* The number of expansions expected on the
- * auxData stack at the time the loop starts;
- * we can't currently discard them except by
- * doing INST_INVOKE_EXPANDED; this is a known
- * problem. */
- int expandTargetDepth; /* The stack depth expected at the outermost
- * expansion within the loop. Not meaningful
- * if there are no open expansions between the
- * looping level and the point of jump
- * issue. */
- int numBreakTargets; /* The number of [break]s that want to be
- * targeted to the place where this loop
- * exception will be bound to. */
- unsigned int *breakTargets; /* The offsets of the INST_JUMP4 instructions
- * issued by the [break]s that we must
- * update. Note that resizing a jump (via
- * TclFixupForwardJump) can cause the contents
- * of this array to be updated. When
- * numBreakTargets==0, this is NULL. */
- int allocBreakTargets; /* The size of the breakTargets array. */
- int numContinueTargets; /* The number of [continue]s that want to be
- * targeted to the place where this loop
- * exception will be bound to. */
- unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
- * issued by the [continue]s that we must
- * update. Note that resizing a jump (via
- * TclFixupForwardJump) can cause the contents
- * of this array to be updated. When
- * numContinueTargets==0, this is NULL. */
- int allocContinueTargets; /* The size of the continueTargets array. */
- } ExceptionAux;
- /*
- * Structure used to map between instruction pc and source locations. It
- * defines for each compiled Tcl command its code's starting offset and its
- * source's starting offset and length. Note that the code offset increases
- * monotonically: that is, the table is sorted in code offset order. The
- * source offset is not monotonic.
- */
- typedef struct CmdLocation {
- int codeOffset; /* Offset of first byte of command code. */
- int numCodeBytes; /* Number of bytes for command's code. */
- int srcOffset; /* Offset of first char of the command. */
- int numSrcBytes; /* Number of command source chars. */
- } CmdLocation;
- /*
- * TIP #280
- * Structure to record additional location information for byte code. This
- * information is internal and not saved. i.e. tbcload'ed code will not have
- * this information. It records the lines for all words of all commands found
- * in the byte code. The association with a ByteCode structure BC is done
- * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
- * Also recorded is information coming from the context, i.e. type of the
- * frame and associated information, like the path of a sourced file.
- */
- typedef struct ECL {
- int srcOffset; /* Command location to find the entry. */
- int nline; /* Number of words in the command */
- int *line; /* Line information for all words in the
- * command. */
- int **next; /* Transient information used by the compiler
- * for tracking of hidden continuation
- * lines. */
- } ECL;
- typedef struct ExtCmdLoc {
- int type; /* Context type. */
- int start; /* Starting line for compiled script. Needed
- * for the extended recompile check in
- * tclCompileObj. */
- Tcl_Obj *path; /* Path of the sourced file the command is
- * in. */
- ECL *loc; /* Command word locations (lines). */
- int nloc; /* Number of allocated entries in 'loc'. */
- int nuloc; /* Number of used entries in 'loc'. */
- } ExtCmdLoc;
- /*
- * CompileProcs need the ability to record information during compilation that
- * can be used by bytecode instructions during execution. The AuxData
- * structure provides this "auxiliary data" mechanism. An arbitrary number of
- * these structures can be stored in the ByteCode record (during compilation
- * they are stored in a CompileEnv structure). Each AuxData record holds one
- * word of client-specified data (often a pointer) and is given an index that
- * instructions can later use to look up the structure and its data.
- *
- * The following definitions declare the types of procedures that are called
- * to duplicate or free this auxiliary data when the containing ByteCode
- * objects are duplicated and freed. Pointers to these procedures are kept in
- * the AuxData structure.
- */
- typedef ClientData (AuxDataDupProc) (ClientData clientData);
- typedef void (AuxDataFreeProc) (ClientData clientData);
- typedef void (AuxDataPrintProc)(ClientData clientData,
- Tcl_Obj *appendObj, struct ByteCode *codePtr,
- unsigned int pcOffset);
- /*
- * We define a separate AuxDataType struct to hold type-related information
- * for the AuxData structure. This separation makes it possible for clients
- * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for
- * example, it makes it possible to pickle and unpickle AuxData structs.
- */
- typedef struct AuxDataType {
- const char *name; /* The name of the type. Types can be
- * registered and found by name */
- AuxDataDupProc *dupProc; /* Callback procedure to invoke when the aux
- * data is duplicated (e.g., when the ByteCode
- * structure containing the aux data is
- * duplicated). NULL means just copy the
- * source clientData bits; no proc need be
- * called. */
- AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the aux
- * data is freed. NULL means no proc need be
- * called. */
- AuxDataPrintProc *printProc;/* Callback function to invoke when printing
- * the aux data as part of debugging. NULL
- * means that the data can't be printed. */
- AuxDataPrintProc *disassembleProc;
- /* Callback function to invoke when doing a
- * disassembly of the aux data (like the
- * printProc, except that the output is
- * intended to be script-readable). The
- * appendObj argument should be filled in with
- * a descriptive dictionary; it will start out
- * with "name" mapped to the content of the
- * name field. NULL means that the printProc
- * should be used instead. */
- } AuxDataType;
- /*
- * The definition of the AuxData structure that holds information created
- * during compilation by CompileProcs and used by instructions during
- * execution.
- */
- typedef struct AuxData {
- const AuxDataType *type; /* Pointer to the AuxData type associated with
- * this ClientData. */
- ClientData clientData; /* The compilation data itself. */
- } AuxData;
- /*
- * Structure defining the compilation environment. After compilation, fields
- * describing bytecode instructions are copied out into the more compact
- * ByteCode structure defined below.
- */
- #define COMPILEENV_INIT_CODE_BYTES 250
- #define COMPILEENV_INIT_NUM_OBJECTS 60
- #define COMPILEENV_INIT_EXCEPT_RANGES 5
- #define COMPILEENV_INIT_CMD_MAP_SIZE 40
- #define COMPILEENV_INIT_AUX_DATA_SIZE 5
- typedef struct CompileEnv {
- Interp *iPtr; /* Interpreter containing the code being
- * compiled. Commands and their compile procs
- * are specific to an interpreter so the code
- * emitted will depend on the interpreter. */
- const char *source; /* The source string being compiled by
- * SetByteCodeFromAny. This pointer is not
- * owned by the CompileEnv and must not be
- * freed or changed by it. */
- int numSrcBytes; /* Number of bytes in source. */
- Proc *procPtr; /* If a procedure is being compiled, a pointer
- * to its Proc structure; otherwise NULL. Used
- * to compile local variables. Set from
- * information provided by ObjInterpProc in
- * tclProc.c. */
- int numCommands; /* Number of commands compiled. */
- int exceptDepth; /* Current exception range nesting level; -1
- * if not in any range currently. */
- int maxExceptDepth; /* Max nesting level of exception ranges; -1
- * if no ranges have been compiled. */
- int maxStackDepth; /* Maximum number of stack elements needed to
- * execute the code. Set by compilation
- * procedures before returning. */
- int currStackDepth; /* Current stack depth. */
- LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl
- * objects referenced by this compiled code.
- * Indexed by the string representations of
- * the literals. Used to avoid creating
- * duplicate objects. */
- unsigned char *codeStart; /* Points to the first byte of the code. */
- unsigned char *codeNext; /* Points to next code array byte to use. */
- unsigned char *codeEnd; /* Points just after the last allocated code
- * array byte. */
- int mallocedCodeArray; /* Set 1 if code array was expanded and
- * codeStart points into the heap.*/
- LiteralEntry *literalArrayPtr;
- /* Points to start of LiteralEntry array. */
- int literalArrayNext; /* Index of next free object array entry. */
- int literalArrayEnd; /* Index just after last obj array entry. */
- int mallocedLiteralArray; /* 1 if object array was expanded and objArray
- * points into the heap, else 0. */
- ExceptionRange *exceptArrayPtr;
- /* Points to start of the ExceptionRange
- * array. */
- int exceptArrayNext; /* Next free ExceptionRange array index.
- * exceptArrayNext is the number of ranges and
- * (exceptArrayNext-1) is the index of the
- * current range's array entry. */
- int exceptArrayEnd; /* Index after the last ExceptionRange array
- * entry. */
- int mallocedExceptArray; /* 1 if ExceptionRange array was expanded and
- * exceptArrayPtr points in heap, else 0. */
- ExceptionAux *exceptAuxArrayPtr;
- /* Array of information used to restore the
- * state when processing BREAK/CONTINUE
- * exceptions. Must be the same size as the
- * exceptArrayPtr. */
- CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array.
- * numCommands is the index of the next entry
- * to use; (numCommands-1) is the entry index
- * for the last command. */
- int cmdMapEnd; /* Index after last CmdLocation entry. */
- int mallocedCmdMap; /* 1 if command map array was expanded and
- * cmdMapPtr points in the heap, else 0. */
- AuxData *auxDataArrayPtr; /* Points to auxiliary data array start. */
- int auxDataArrayNext; /* Next free compile aux data array index.
- * auxDataArrayNext is the number of aux data
- * items and (auxDataArrayNext-1) is index of
- * current aux data array entry. */
- int auxDataArrayEnd; /* Index after last aux data array entry. */
- int mallocedAuxDataArray; /* 1 if aux data array was expanded and
- * auxDataArrayPtr points in heap else 0. */
- unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
- /* Initial storage for code. */
- LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
- /* Initial storage of LiteralEntry array. */
- ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
- /* Initial ExceptionRange array storage. */
- ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
- /* Initial static except auxiliary info array
- * storage. */
- CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
- /* Initial storage for cmd location map. */
- AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
- /* Initial storage for aux data array. */
- /* TIP #280 */
- ExtCmdLoc *extCmdMapPtr; /* Extended command location information for
- * 'info frame'. */
- int line; /* First line of the script, based on the
- * invoking context, then the line of the
- * command currently compiled. */
- int atCmdStart; /* Flag to say whether an INST_START_CMD
- * should be issued; they should never be
- * issued repeatedly, as that is significantly
- * inefficient. If set to 2, that instruction
- * should not be issued at all (by the generic
- * part of the command compiler). */
- int expandCount; /* Number of INST_EXPAND_START instructions
- * encountered that have not yet been paired
- * with a corresponding
- * INST_INVOKE_EXPANDED. */
- int *clNext; /* If not NULL, it refers to the next slot in
- * clLoc to check for an invisible
- * continuation line. */
- } CompileEnv;
- /*
- * The structure defining the bytecode instructions resulting from compiling a
- * Tcl script. Note that this structure is variable length: a single heap
- * object is allocated to hold the ByteCode structure immediately followed by
- * the code bytes, the literal object array, the ExceptionRange array, the
- * CmdLocation map, and the compilation AuxData array.
- */
- /*
- * A PRECOMPILED bytecode struct is one that was generated from a compiled
- * image rather than implicitly compiled from source
- */
- #define TCL_BYTECODE_PRECOMPILED 0x0001
- /*
- * When a bytecode is compiled, interp or namespace resolvers have not been
- * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
- */
- #define TCL_BYTECODE_RESOLVE_VARS 0x0002
- #define TCL_BYTECODE_RECOMPILE 0x0004
- typedef struct ByteCode {
- TclHandle interpHandle; /* Handle for interpreter containing the
- * compiled code. Commands and their compile
- * procs are specific to an interpreter so the
- * code emitted will depend on the
- * interpreter. */
- int compileEpoch; /* Value of iPtr->compileEpoch when this
- * ByteCode was compiled. Used to invalidate
- * code when, e.g., commands with compile
- * procs are redefined. */
- Namespace *nsPtr; /* Namespace context in which this code was
- * compiled. If the code is executed if a
- * different namespace, it must be
- * recompiled. */
- int nsEpoch; /* Value of nsPtr->resolverEpoch when this
- * ByteCode was compiled. Used to invalidate
- * code when new namespace resolution rules
- * are put into effect. */
- int refCount; /* Reference count: set 1 when created plus 1
- * for each execution of the code currently
- * active. This structure can be freed when
- * refCount becomes zero. */
- unsigned int flags; /* flags describing state for the codebyte.
- * this variable holds ORed values from the
- * TCL_BYTECODE_ masks defined above */
- const char *source; /* The source string from which this ByteCode
- * was compiled. Note that this pointer is not
- * owned by the ByteCode and must not be freed
- * or modified by it. */
- Proc *procPtr; /* If the ByteCode was compiled from a
- * procedure body, this is a pointer to its
- * Proc structure; otherwise NULL. This
- * pointer is also not owned by the ByteCode
- * and must not be freed by it. */
- size_t structureSize; /* Number of bytes in the ByteCode structure
- * itself. Does not include heap space for
- * literal Tcl objects or storage referenced
- * by AuxData entries. */
- int numCommands; /* Number of commands compiled. */
- int numSrcBytes; /* Number of source bytes compiled. */
- int numCodeBytes; /* Number of code bytes. */
- int numLitObjects; /* Number of objects in literal array. */
- int numExceptRanges; /* Number of ExceptionRange array elems. */
- int numAuxDataItems; /* Number of AuxData items. */
- int numCmdLocBytes; /* Number of bytes needed for encoded command
- * location information. */
- int maxExceptDepth; /* Maximum nesting level of ExceptionRanges;
- * -1 if no ranges were compiled. */
- int maxStackDepth; /* Maximum number of stack elements needed to
- * execute the code. */
- unsigned char *codeStart; /* Points to the first byte of the code. This
- * is just after the final ByteCode member
- * cmdMapPtr. */
- Tcl_Obj **objArrayPtr; /* Points to the start of the literal object
- * array. This is just after the last code
- * byte. */
- ExceptionRange *exceptArrayPtr;
- /* Points to the start of the ExceptionRange
- * array. This is just after the last object
- * in the object array. */
- AuxData *auxDataArrayPtr; /* Points to the start of the auxiliary data
- * array. This is just after the last entry in
- * the ExceptionRange array. */
- unsigned char *codeDeltaStart;
- /* Points to the first of a sequence of bytes
- * that encode the change in the starting
- * offset of each command's code. If -127 <=
- * delta <= 127, it is encoded as 1 byte,
- * otherwise 0xFF (128) appears and the delta
- * is encoded by the next 4 bytes. Code deltas
- * are always positive. This sequence is just
- * after the last entry in the AuxData
- * array. */
- unsigned char *codeLengthStart;
- /* Points to the first of a sequence of bytes
- * that encode the length of each command's
- * code. The encoding is the same as for code
- * deltas. Code lengths are always positive.
- * This sequence is just after the last entry
- * in the code delta sequence. */
- unsigned char *srcDeltaStart;
- /* Points to the first of a sequence of bytes
- * that encode the change in the starting
- * offset of each command's source. The
- * encoding is the same as for code deltas.
- * Source deltas can be negative. This
- * sequence is just after the last byte in the
- * code length sequence. */
- unsigned char *srcLengthStart;
- /* Points to the first of a sequence of bytes
- * that encode the length of each command's
- * source. The encoding is the same as for
- * code deltas. Source lengths are always
- * positive. This sequence is just after the
- * last byte in the source delta sequence. */
- LocalCache *localCachePtr; /* Pointer to the start of the cached variable
- * names and initialisation data for local
- * variables. */
- #ifdef TCL_COMPILE_STATS
- Tcl_Time createTime; /* Absolute time when the ByteCode was
- * created. */
- #endif /* TCL_COMPILE_STATS */
- } ByteCode;
- /*
- * Opcodes for the Tcl bytecode instructions. These must correspond to the
- * entries in the table of instruction descriptions, tclInstructionTable, in
- * tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
- * INST_LOR) must match the entries in the array operatorStrings in
- * tclExecute.c.
- */
- /* Opcodes 0 to 9 */
- #define INST_DONE 0
- #define INST_PUSH1 1
- #define INST_PUSH4 2
- #define INST_POP 3
- #define INST_DUP 4
- #define INST_STR_CONCAT1 5
- #define INST_INVOKE_STK1 6
- #define INST_INVOKE_STK4 7
- #define INST_EVAL_STK 8
- #define INST_EXPR_STK 9
- /* Opcodes 10 to 23 */
- #define INST_LOAD_SCALAR1 10
- #define INST_LOAD_SCALAR4 11
- #define INST_LOAD_SCALAR_STK 12
- #define INST_LOAD_ARRAY1 13
- #define INST_LOAD_ARRAY4 14
- #define INST_LOAD_ARRAY_STK 15
- #define INST_LOAD_STK 16
- #define INST_STORE_SCALAR1 17
- #define INST_STORE_SCALAR4 18
- #define INST_STORE_SCALAR_STK 19
- #define INST_STORE_ARRAY1 20
- #define INST_STORE_ARRAY4 21
- #define INST_STORE_ARRAY_STK 22
- #define INST_STORE_STK 23
- /* Opcodes 24 to 33 */
- #define INST_INCR_SCALAR1 24
- #define INST_INCR_SCALAR_STK 25
- #define INST_INCR_ARRAY1 26
- #define INST_INCR_ARRAY_STK 27
- #define INST_INCR_STK 28
- #define INST_INCR_SCALAR1_IMM 29
- #define INST_INCR_SCALAR_STK_IMM 30
- #define INST_INCR_ARRAY1_IMM 31
- #define INST_INCR_ARRAY_STK_IMM 32
- #define INST_INCR_STK_IMM 33
- /* Opcodes 34 to 39 */
- #define INST_JUMP1 34
- #define INST_JUMP4 35
- #define INST_JUMP_TRUE1 36
- #define INST_JUMP_TRUE4 37
- #define INST_JUMP_FALSE1 38
- #define INST_JUMP_FALSE4 39
- /* Opcodes 40 to 64 */
- #define INST_LOR 40
- #define INST_LAND 41
- #define INST_BITOR 42
- #define INST_BITXOR 43
- #define INST_BITAND 44
- #define INST_EQ 45
- #define INST_NEQ 46
- #define INST_LT 47
- #define INST_GT 48
- #define INST_LE 49
- #define INST_GE 50
- #define INST_LSHIFT 51
- #define INST_RSHIFT 52
- #define INST_ADD 53
- #define INST_SUB 54
- #define INST_MULT 55
- #define INST_DIV 56
- #define INST_MOD 57
- #define INST_UPLUS 58
- #define INST_UMINUS 59
- #define INST_BITNOT 60
- #define INST_LNOT 61
- #define INST_CALL_BUILTIN_FUNC1 62
- #define INST_CALL_FUNC1 63
- #define INST_TRY_CVT_TO_NUMERIC 64
- /* Opcodes 65 to 66 */
- #define INST_BREAK 65
- #define INST_CONTINUE 66
- /* Opcodes 67 to 68 */
- #define INST_FOREACH_START4 67 /* DEPRECATED */
- #define INST_FOREACH_STEP4 68 /* DEPRECATED */
- /* Opcodes 69 to 72 */
- #define INST_BEGIN_CATCH4 69
- #define INST_END_CATCH 70
- #define INST_PUSH_RESULT 71
- #define INST_PUSH_RETURN_CODE 72
- /* Opcodes 73 to 78 */
- #define INST_STR_EQ 73
- #define INST_STR_NEQ 74
- #define INST_STR_CMP 75
- #define INST_STR_LEN 76
- #define INST_STR_INDEX 77
- #define INST_STR_MATCH 78
- /* Opcodes 78 to 81 */
- #define INST_LIST 79
- #define INST_LIST_INDEX 80
- #define INST_LIST_LENGTH 81
- /* Opcodes 82 to 87 */
- #define INST_APPEND_SCALAR1 82
- #define INST_APPEND_SCALAR4 83
- #define INST_APPEND_ARRAY1 84
- #define INST_APPEND_ARRAY4 85
- #define INST_APPEND_ARRAY_STK 86
- #define INST_APPEND_STK 87
- /* Opcodes 88 to 93 */
- #define INST_LAPPEND_SCALAR1 88
- #define INST_LAPPEND_SCALAR4 89
- #define INST_LAPPEND_ARRAY1 90
- #define INST_LAPPEND_ARRAY4 91
- #define INST_LAPPEND_ARRAY_STK 92
- #define INST_LAPPEND_STK 93
- /* TIP #22 - LINDEX operator with flat arg list */
- #define INST_LIST_INDEX_MULTI 94
- /*
- * TIP #33 - 'lset' command. Code gen also required a Forth-like
- * OVER operation.
- */
- #define INST_OVER 95
- #define INST_LSET_LIST 96
- #define INST_LSET_FLAT 97
- /* TIP#90 - 'return' command. */
- #define INST_RETURN_IMM 98
- /* TIP#123 - exponentiation operator. */
- #define INST_EXPON 99
- /* TIP #157 - {*}... (word expansion) language syntax support. */
- #define INST_EXPAND_START 100
- #define INST_EXPAND_STKTOP 101
- #define INST_INVOKE_EXPANDED 102
- /*
- * TIP #57 - 'lassign' command. Code generation requires immediate
- * LINDEX and LRANGE operators.
- */
- #define INST_LIST_INDEX_IMM 103
- #define INST_LIST_RANGE_IMM 104
- #define INST_START_CMD 105
- #define INST_LIST_IN 106
- #define INST_LIST_NOT_IN 107
- #define INST_PUSH_RETURN_OPTIONS 108
- #define INST_RETURN_STK 109
- /*
- * Dictionary (TIP#111) related commands.
- */
- #define INST_DICT_GET 110
- #define INST_DICT_SET 111
- #define INST_DICT_UNSET 112
- #define INST_DICT_INCR_IMM 113
- #define INST_DICT_APPEND 114
- #define INST_DICT_LAPPEND 115
- #define INST_DICT_FIRST 116
- #define INST_DICT_NEXT 117
- #define INST_DICT_DONE 118
- #define INST_DICT_UPDATE_START 119
- #define INST_DICT_UPDATE_END 120
- /*
- * Instruction to support jumps defined by tables (instead of the classic
- * [switch] technique of chained comparisons).
- */
- #define INST_JUMP_TABLE 121
- /*
- * Instructions to support compilation of global, variable, upvar and
- * [namespace upvar].
- */
- #define INST_UPVAR 122
- #define INST_NSUPVAR 123
- #define INST_VARIABLE 124
- /* Instruction to support compiling syntax error to bytecode */
- #define INST_SYNTAX 125
- /* Instruction to reverse N items on top of stack */
- #define INST_REVERSE 126
- /* regexp instruction */
- #define INST_REGEXP 127
- /* For [info exists] compilation */
- #define INST_EXIST_SCALAR 128
- #define INST_EXIST_ARRAY 129
- #define INST_EXIST_ARRAY_STK 130
- #define INST_EXIST_STK 131
- /* For [subst] compilation */
- #define INST_NOP 132
- #define INST_RETURN_CODE_BRANCH 133
- /* For [unset] compilation */
- #define INST_UNSET_SCALAR 134
- #define INST_UNSET_ARRAY 135
- #define INST_UNSET_ARRAY_STK 136
- #define INST_UNSET_STK 137
- /* For [dict with], [dict exists], [dict create] and [dict merge] */
- #define INST_DICT_EXPAND 138
- #define INST_DICT_RECOMBINE_STK 139
- #define INST_DICT_RECOMBINE_IMM 140
- #define INST_DICT_EXISTS 141
- #define INST_DICT_VERIFY 142
- /* For [string map] and [regsub] compilation */
- #define INST_STR_MAP 143
- #define INST_STR_FIND 144
- #define INST_STR_FIND_LAST 145
- #define INST_STR_RANGE_IMM 146
- #define INST_STR_RANGE 147
- /* For operations to do with coroutines and other NRE-manipulators */
- #define INST_YIELD 148
- #define INST_COROUTINE_NAME 149
- #define INST_TAILCALL 150
- /* For compilation of basic information operations */
- #define INST_NS_CURRENT 151
- #define INST_INFO_LEVEL_NUM 152
- #define INST_INFO_LEVEL_ARGS 153
- #define INST_RESOLVE_COMMAND 154
- /* For compilation relating to TclOO */
- #define INST_TCLOO_SELF 155
- #define INST_TCLOO_CLASS 156
- #define INST_TCLOO_NS 157
- #define INST_TCLOO_IS_OBJECT 158
- /* For compilation of [array] subcommands */
- #define INST_ARRAY_EXISTS_STK 159
- #define INST_ARRAY_EXISTS_IMM 160
- #define INST_ARRAY_MAKE_STK 161
- #define INST_ARRAY_MAKE_IMM 162
- #define INST_INVOKE_REPLACE 163
- #define INST_LIST_CONCAT 164
- #define INST_EXPAND_DROP 165
- /* New foreach implementation */
- #define INST_FOREACH_START 166
- #define INST_FOREACH_STEP 167
- #define INST_FOREACH_END 168
- #define INST_LMAP_COLLECT 169
- /* For compilation of [string trim] and related */
- #define INST_STR_TRIM 170
- #define INST_STR_TRIM_LEFT 171
- #define INST_STR_TRIM_RIGHT 172
- #define INST_CONCAT_STK 173
- #define INST_STR_UPPER 174
- #define INST_STR_LOWER 175
- #define INST_STR_TITLE 176
- #define INST_STR_REPLACE 177
- #define INST_ORIGIN_COMMAND 178
- #define INST_TCLOO_NEXT 179
- #define INST_TCLOO_NEXT_CLASS 180
- #define INST_YIELD_TO_INVOKE 181
- #define INST_NUM_TYPE 182
- #define INST_TRY_CVT_TO_BOOLEAN 183
- #define INST_STR_CLASS 184
- #define INST_LAPPEND_LIST 185
- #define INST_LAPPEND_LIST_ARRAY 186
- #define INST_LAPPEND_LIST_ARRAY_STK 187
- #define INST_LAPPEND_LIST_STK 188
- #define INST_CLOCK_READ 189
- /* The last opcode */
- #define LAST_INST_OPCODE 189
- /*
- * Table describing the Tcl bytecode instructions: their name (for displaying
- * code), total number of code bytes required (including operand bytes), and a
- * description of the type of each operand. These operand types include signed
- * and unsigned integers of length one and four bytes. The unsigned integers
- * are used for indexes or for, e.g., the count of objects to push in a "push"
- * instruction.
- */
- #define MAX_INSTRUCTION_OPERANDS 2
- typedef enum InstOperandType {
- OPERAND_NONE,
- OPERAND_INT1, /* One byte signed integer. */
- OPERAND_INT4, /* Four byte signed integer. */
- OPERAND_UINT1, /* One byte unsigned integer. */
- OPERAND_UINT4, /* Four byte unsigned integer. */
- OPERAND_IDX4, /* Four byte signed index (actually an
- * integer, but displayed differently.) */
- OPERAND_LVT1, /* One byte unsigned index into the local
- * variable table. */
- OPERAND_LVT4, /* Four byte unsigned index into the local
- * variable table. */
- OPERAND_AUX4, /* Four byte unsigned index into the aux data
- * table. */
- OPERAND_OFFSET1, /* One byte signed jump offset. */
- OPERAND_OFFSET4, /* Four byte signed jump offset. */
- OPERAND_LIT1, /* One byte unsigned index into table of
- * literals. */
- OPERAND_LIT4, /* Four byte unsigned index into table of
- * literals. */
- OPERAND_SCLS1 /* Index into tclStringClassTable. */
- } InstOperandType;
- typedef struct InstructionDesc {
- const char *name; /* Name of instruction. */
- int numBytes; /* Total number of bytes for instruction. */
- int stackEffect; /* The worst-case balance stack effect of the
- * instruction, used for stack requirements
- * computations. The value INT_MIN signals
- * that the instruction's worst case effect is
- * (1-opnd1). */
- int numOperands; /* Number of operands. */
- InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
- /* The type of each operand. */
- } InstructionDesc;
- MODULE_SCOPE InstructionDesc const tclInstructionTable[];
- /*
- * Constants used by INST_STRING_CLASS to indicate character classes. These
- * correspond closely by name with what [string is] can support, but there is
- * no requirement to keep the values the same.
- */
- typedef enum InstStringClassType {
- STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */
- STR_CLASS_ALPHA, /* Unicode alphabet characters. */
- STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */
- STR_CLASS_CONTROL, /* Unicode control characters. */
- STR_CLASS_DIGIT, /* Unicode digit characters. */
- STR_CLASS_GRAPH, /* Unicode printing characters, excluding
- * space. */
- STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */
- STR_CLASS_PRINT, /* Unicode printing characters, including
- * spaces. */
- STR_CLASS_PUNCT, /* Unicode punctuation characters. */
- STR_CLASS_SPACE, /* Unicode space characters. */
- STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
- STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
- * punctuation) characters. */
- STR_CLASS_XDIGIT /* Characters that can be used as digits in
- * hexadecimal numbers ([0-9A-Fa-f]). */
- } InstStringClassType;
- typedef struct StringClassDesc {
- const char *name; /* Name of the class. */
- int (*comparator)(int); /* Function to test if a single unicode
- * character is a member of the class. */
- } StringClassDesc;
- MODULE_SCOPE StringClassDesc const tclStringClassTable[];
- /*
- * Compilation of some Tcl constructs such as if commands and the logical or
- * (||) and logical and (&&) operators in expressions requires the generation
- * of forward jumps. Since the PC target of these jumps isn't known when the
- * jumps are emitted, we record the offset of each jump in an array of
- * JumpFixup structures. There is one array for each sequence of jumps to one
- * target PC. When we learn the target PC, we update the jumps with the
- * correct distance. Also, if the distance is too great (> 127 bytes), we
- * replace the single-byte jump with a four byte jump instruction, move the
- * instructions after the jump down, and update the code offsets for any
- * commands between the jump and the target.
- */
- typedef enum {
- TCL_UNCONDITIONAL_JUMP,
- TCL_TRUE_JUMP,
- TCL_FALSE_JUMP
- } TclJumpType;
- typedef struct JumpFixup {
- TclJumpType jumpType; /* Indicates the kind of jump. */
- unsigned int codeOffset; /* Offset of the first byte of the one-byte
- * forward jump's code. */
- int cmdIndex; /* Index of the first command after the one
- * for which the jump was emitted. Used to
- * update the code offsets for subsequent
- * commands if the two-byte jump at jumpPc
- * must be replaced with a five-byte one. */
- int exceptIndex; /* Index of the first range entry in the
- * ExceptionRange array after the current one.
- * This field is used to adjust the code
- * offsets in subsequent ExceptionRange
- * records when a jump is grown from 2 bytes
- * to 5 bytes. */
- } JumpFixup;
- #define JUMPFIXUP_INIT_ENTRIES 10
- typedef struct JumpFixupArray {
- JumpFixup *fixup; /* Points to start of jump fixup array. */
- int next; /* Index of next free array entry. */
- int end; /* Index of last usable entry in array. */
- int mallocedArray; /* 1 if array was expanded and fixups points
- * into the heap, else 0. */
- JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES];
- /* Initial storage for jump fixup array. */
- } JumpFixupArray;
- /*
- * The structure describing one variable list of a foreach command. Note that
- * only foreach commands inside procedure bodies are compiled inline so a
- * ForeachVarList structure always describes local variables. Furthermore,
- * only scalar variables are supported for inline-compiled foreach loops.
- */
- typedef struct ForeachVarList {
- int numVars; /* The number of variables in the list. */
- int varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers")
- * for each variable in the procedure's array
- * of local variables. Only scalar variables
- * are supported. The actual size of this
- * field will be large enough to numVars
- * indexes. THIS MUST BE THE LAST FIELD IN THE
- * STRUCTURE! */
- } ForeachVarList;
- /*
- * Structure used to hold information about a foreach command that is needed
- * during program execution. These structures are stored in CompileEnv and
- * ByteCode structures as auxiliary data.
- */
- typedef struct ForeachInfo {
- int numLists; /* The number of both the variable and value
- * lists of the foreach command. */
- int firstValueTemp; /* Index of the first temp var in a proc frame
- * used to point to a value list. */
- int loopCtTemp; /* Index of temp var in a proc frame holding
- * the loop's iteration count. Used to
- * determine next value list element to assign
- * each loop var. */
- ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList
- * structures describing each var list. The
- * actual size of this field will be large
- * enough to numVars indexes. THIS MUST BE THE
- * LAST FIELD IN THE STRUCTURE! */
- } ForeachInfo;
- /*
- * Structure used to hold information about a switch command that is needed
- * during program execution. These structures are stored in CompileEnv and
- * ByteCode structures as auxiliary data.
- */
- typedef struct JumptableInfo {
- Tcl_HashTable hashTable; /* Hash that maps strings to signed ints (PC
- * offsets). */
- } JumptableInfo;
- MODULE_SCOPE const AuxDataType tclJumptableInfoType;
- #define JUMPTABLEINFO(envPtr, index) \
- ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
- /*
- * Structure used to hold information about a [dict update] command that is
- * needed during program execution. These structures are stored in CompileEnv
- * and ByteCode structures as auxiliary data.
- */
- typedef struct {
- int length; /* Size of array */
- int varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when
- * processing the start and end of a [dict
- * update]. There is really more than one
- * entry, and the structure is allocated to
- * take account of this. MUST BE LAST FIELD IN
- * STRUCTURE. */
- } DictUpdateInfo;
- /*
- * ClientData type used by the math operator commands.
- */
- typedef struct {
- const char *op; /* Do not call it 'operator': C++ reserved */
- const char *expected;
- union {
- int numArgs;
- int identity;
- } i;
- } TclOpCmdClientData;
- /*
- *----------------------------------------------------------------
- * Procedures exported by tclBasic.c to be used within the engine.
- *----------------------------------------------------------------
- */
- MODULE_SCOPE Tcl_ObjCmdProc TclNRInterpCoroutine;
- /*
- *----------------------------------------------------------------
- * Procedures exported by the engine to be used by tclBasic.c
- *----------------------------------------------------------------
- */
- MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- const CmdFrame *invoker, int word);
- /*
- *----------------------------------------------------------------
- * Procedures shared among Tcl bytecode compilation and execution modules but
- * not used outside:
- *----------------------------------------------------------------
- */
- MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr);
- MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr,
- ExceptionAux *auxPtr);
- MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp,
- Tcl_Token *tokenPtr, int count,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script,
- int numBytes, CompileEnv *envPtr, int optimize);
- MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp,
- Tcl_Token *tokenPtr, int numWords,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp,
- Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp,
- const char *script, int numBytes,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp,
- Tcl_Token *tokenPtr, int count,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp,
- Tcl_Token *tokenPtr, CompileEnv *envPtr);
- MODULE_SCOPE int TclCreateAuxData(ClientData clientData,
- const AuxDataType *typePtr, CompileEnv *envPtr);
- MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type,
- CompileEnv *envPtr);
- MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size);
- MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes,
- int length, unsigned int hash, int *newPtr,
- Namespace *nsPtr, int flags,
- LiteralEntry **globalPtrPtr);
- MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr);
- MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp,
- LiteralTable *tablePtr);
- MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr,
- TclJumpType jumpType, JumpFixup *jumpFixupPtr);
- MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
- MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
- int catchOnly, ByteCode *codePtr);
- MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
- MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp,
- ByteCode *codePtr);
- MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
- MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
- int create, CompileEnv *envPtr);
- MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
- JumpFixup *jumpFixupPtr, int jumpDist,
- int distThreshold);
- MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
- MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
- MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr,
- int before, int after, int *indexPtr);
- MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
- CompileEnv *envPtr, const char *string,
- int numBytes, const CmdFrame *invoker, int word);
- MODULE_SCOPE void TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
- MODULE_SCOPE void TclInitLiteralTable(LiteralTable *tablePtr);
- MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
- int returnCode, ExceptionAux **auxPtrPtr);
- MODULE_SCOPE void TclAddLoopBreakFixup(CompileEnv *envPtr,
- ExceptionAux *auxPtr);
- MODULE_SCOPE void TclAddLoopContinueFixup(CompileEnv *envPtr,
- ExceptionAux *auxPtr);
- MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
- int range);
- #ifdef TCL_COMPILE_STATS
- MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
- MODULE_SCOPE int TclLog2(int value);
- #endif
- MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes,
- CompileEnv *envPtr);
- MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
- CompileEnv *envPtr);
- MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
- #ifdef TCL_COMPILE_DEBUG
- MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
- #endif
- MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr,
- const unsigned char *pc);
- MODULE_SCOPE void TclPrintObject(FILE *outFile,
- Tcl_Obj *objPtr, int maxChars);
- MODULE_SCOPE void TclPrintSource(FILE *outFile,
- const char *string, int maxChars);
- MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
- Tcl_Token *varTokenPtr, CompileEnv *envPtr,
- int flags, int *localIndexPtr,
- int *isScalarPtr);
- static inline void
- TclPreserveByteCode(
- ByteCode *codePtr)
- {
- codePtr->refCount++;
- }
- static inline void
- TclReleaseByteCode(
- ByteCode *codePtr)
- {
- if (codePtr->refCount-- > 1) {
- return;
- }
- /* Just dropped to refcount==0. Clean up. */
- TclCleanupByteCode(codePtr);
- }
- MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
- MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
- const char *name, Namespace *nsPtr);
- MODULE_SCOPE int TclSingleOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
- MODULE_SCOPE int TclSortingOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
- MODULE_SCOPE int TclVariadicOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
- MODULE_SCOPE int TclNoIdentOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
- #ifdef TCL_COMPILE_DEBUG
- MODULE_SCOPE void TclVerifyGlobalLiteralTable(Interp *iPtr);
- MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr);
- #endif
- MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
- Tcl_Obj *valuePtr);
- MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
- const char *script, const char *command,
- int length, const unsigned char *pc,
- Tcl_Obj **tosPtr);
- MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
- const unsigned char *pc, Tcl_Obj **tosPtr);
- MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
- MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[], int isLambda);
- /*
- *----------------------------------------------------------------
- * Macros and flag values used by Tcl bytecode compilation and execution
- * modules inside the Tcl core but not used outside.
- *----------------------------------------------------------------
- */
- /*
- * Simplified form to access AuxData.
- *
- * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
- */
- #define TclFetchAuxData(envPtr, index) \
- (envPtr)->auxDataArrayPtr[(index)].clientData
- #define LITERAL_ON_HEAP 0x01
- #define LITERAL_CMD_NAME 0x02
- #define LITERAL_UNSHARED 0x04
- /*
- * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
- * cast away constness, and it is cleanest to do that here, all in one place.
- *
- * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
- * int length);
- */
- #define TclRegisterNewLiteral(envPtr, bytes, length) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
- /*
- * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it
- * is safe to cast away constness, and it is cleanest to do that here, all in
- * one place.
- *
- * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
- * int length);
- */
- #define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)
- /*
- * Macro used to manually adjust the stack requirements; used in cases where
- * the stack effect cannot be computed from the opcode and its operands, but
- * is still known at compile time.
- *
- * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
- */
- #define TclAdjustStackDepth(delta, envPtr) \
- do { \
- if ((delta) < 0) { \
- if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) { \
- (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \
- } \
- } \
- (envPtr)->currStackDepth += (delta); \
- } while (0)
- #define TclGetStackDepth(envPtr) \
- ((envPtr)->currStackDepth)
- #define TclSetStackDepth(depth, envPtr) \
- (envPtr)->currStackDepth = (depth)
- #define TclCheckStackDepth(depth, envPtr) \
- do { \
- int _dd = (depth); \
- if (_dd != (envPtr)->currStackDepth) { \
- Tcl_Panic("bad stack depth computations: is %i, should be %i", \
- (envPtr)->currStackDepth, _dd); \
- } \
- } while (0)
- /*
- * Macro used to update the stack requirements. It is called by the macros
- * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
- * Remark that the very last instruction of a bytecode always reduces the
- * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always
- * updated.
- *
- * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr);
- */
- #define TclUpdateStackReqs(op, i, envPtr) \
- do { \
- int _delta = tclInstructionTable[(op)].stackEffect; \
- if (_delta) { \
- if (_delta == INT_MIN) { \
- _delta = 1 - (i); \
- } \
- TclAdjustStackDepth(_delta, envPtr); \
- } \
- } while (0)
- /*
- * Macros used to update the flag that indicates if we are at the start of a
- * command, based on whether the opcode is INST_START_COMMAND.
- *
- * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
- */
- #define TclUpdateAtCmdStart(op, envPtr) \
- if ((envPtr)->atCmdStart < 2) { \
- (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \
- }
- /*
- * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
- * "prototype" for this macro is:
- *
- * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
- */
- #define TclEmitOpcode(op, envPtr) \
- do { \
- if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
- TclExpandCodeArray(envPtr); \
- } \
- *(envPtr)->codeNext++ = (unsigned char) (op); \
- TclUpdateAtCmdStart(op, envPtr); \
- TclUpdateStackReqs(op, 0, envPtr); \
- } while (0)
- /*
- * Macros to emit an integer operand. The ANSI C "prototype" for these macros
- * are:
- *
- * void TclEmitInt1(int i, CompileEnv *envPtr);
- * void TclEmitInt4(int i, CompileEnv *envPtr);
- */
- #define TclEmitInt1(i, envPtr) \
- do { \
- if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
- TclExpandCodeArray(envPtr); \
- } \
- *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \
- } while (0)
- #define TclEmitInt4(i, envPtr) \
- do { \
- if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
- TclExpandCodeArray(envPtr); \
- } \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 24); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 16); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 8); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) ); \
- } while (0)
- /*
- * Macros to emit an instruction with signed or unsigned integer operands.
- * Four byte integers are stored in "big-endian" order with the high order
- * byte stored at the lowest address. The ANSI C "prototypes" for these macros
- * are:
- *
- * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
- * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
- */
- #define TclEmitInstInt1(op, i, envPtr) \
- do { \
- if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
- TclExpandCodeArray(envPtr); \
- } \
- *(envPtr)->codeNext++ = (unsigned char) (op); \
- *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i)); \
- TclUpdateAtCmdStart(op, envPtr); \
- TclUpdateStackReqs(op, i, envPtr); \
- } while (0)
- #define TclEmitInstInt4(op, i, envPtr) \
- do { \
- if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
- TclExpandCodeArray(envPtr); \
- } \
- *(envPtr)->codeNext++ = (unsigned char) (op); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 24); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 16); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 8); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) ); \
- TclUpdateAtCmdStart(op, envPtr); \
- TclUpdateStackReqs(op, i, envPtr); \
- } while (0)
- /*
- * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
- * object's one or four byte array index into the CompileEnv's code array.
- * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a
- * CompileEnv. The ANSI C "prototype" for this macro is:
- *
- * void TclEmitPush(int objIndex, CompileEnv *envPtr);
- */
- #define TclEmitPush(objIndex, envPtr) \
- do { \
- int _objIndexCopy = (objIndex); \
- if (_objIndexCopy <= 255) { \
- TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \
- } else { \
- TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \
- } \
- } while (0)
- /*
- * Macros to update a (signed or unsigned) integer starting at a pointer. The
- * two variants depend on the number of bytes. The ANSI C "prototypes" for
- * these macros are:
- *
- * void TclStoreInt1AtPtr(int i, unsigned char *p);
- * void TclStoreInt4AtPtr(int i, unsigned char *p);
- */
- #define TclStoreInt1AtPtr(i, p) \
- *(p) = (unsigned char) ((unsigned int) (i))
- #define TclStoreInt4AtPtr(i, p) \
- do { \
- *(p) = (unsigned char) ((unsigned int) (i) >> 24); \
- *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
- *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \
- *(p+3) = (unsigned char) ((unsigned int) (i) ); \
- } while (0)
- /*
- * Macros to update instructions at a particular pc with a new op code and a
- * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros
- * are:
- *
- * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc);
- * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc);
- */
- #define TclUpdateInstInt1AtPc(op, i, pc) \
- do { \
- *(pc) = (unsigned char) (op); \
- TclStoreInt1AtPtr((i), ((pc)+1)); \
- } while (0)
- #define TclUpdateInstInt4AtPc(op, i, pc) \
- do { \
- *(pc) = (unsigned char) (op); \
- TclStoreInt4AtPtr((i), ((pc)+1)); \
- } while (0)
- /*
- * Macro to fix up a forward jump to point to the current code-generation
- * position in the bytecode being created (the most common case). The ANSI C
- * "prototypes" for this macro is:
- *
- * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr,
- * int threshold);
- */
- #define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
- TclFixupForwardJump((envPtr), (fixupPtr), \
- (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \
- (threshold))
- /*
- * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
- * (GET_UINT{1,2}) from a pointer. There are two variants for each return type
- * that depend on the number of bytes fetched. The ANSI C "prototypes" for
- * these macros are:
- *
- * int TclGetInt1AtPtr(unsigned char *p);
- * int TclGetInt4AtPtr(unsigned char *p);
- * unsigned int TclGetUInt1AtPtr(unsigned char *p);
- * unsigned int TclGetUInt4AtPtr(unsigned char *p);
- */
- /*
- * The TclGetInt1AtPtr macro is tricky because we want to do sign extension on
- * the 1-byte value. Unfortunately the "char" type isn't signed on all
- * platforms so sign-extension doesn't always happen automatically. Sometimes
- * we can explicitly declare the pointer to be signed, but other times we have
- * to explicitly sign-extend the value in software.
- */
- #ifndef __CHAR_UNSIGNED__
- # define TclGetInt1AtPtr(p) ((int) *((char *) p))
- #elif defined(HAVE_SIGNED_CHAR)
- # define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
- #else
- # define TclGetInt1AtPtr(p) \
- (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
- #endif
- #define TclGetInt4AtPtr(p) \
- (((int) (TclGetUInt1AtPtr(p) << 24)) | \
- (*((p)+1) << 16) | \
- (*((p)+2) << 8) | \
- (*((p)+3)))
- #define TclGetUInt1AtPtr(p) \
- ((unsigned int) *(p))
- #define TclGetUInt4AtPtr(p) \
- ((unsigned int) (*(p) << 24) | \
- (*((p)+1) << 16) | \
- (*((p)+2) << 8) | \
- (*((p)+3)))
- /*
- * Macros used to compute the minimum and maximum of two integers. The ANSI C
- * "prototypes" for these macros are:
- *
- * int TclMin(int i, int j);
- * int TclMax(int i, int j);
- */
- #define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j))
- #define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j))
- /*
- * Convenience macros for use when compiling bodies of commands. The ANSI C
- * "prototype" for these macros are:
- *
- * static void BODY(Tcl_Token *tokenPtr, int word);
- */
- #define BODY(tokenPtr, word) \
- SetLineInformation((word)); \
- TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \
- envPtr)
- /*
- * Convenience macro for use when compiling tokens to be pushed. The ANSI C
- * "prototype" for this macro is:
- *
- * static void CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- * Tcl_Interp *interp);
- */
- #define CompileTokens(envPtr, tokenPtr, interp) \
- TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
- (envPtr));
- /*
- * Convenience macros for use when pushing literals. The ANSI C "prototype" for
- * these macros are:
- *
- * static void PushLiteral(CompileEnv *envPtr,
- * const char *string, int length);
- * static void PushStringLiteral(CompileEnv *envPtr,
- * const char *string);
- */
- #define PushLiteral(envPtr, string, length) \
- TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
- #define PushStringLiteral(envPtr, string) \
- PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))
- /*
- * Macro to advance to the next token; it is more mnemonic than the address
- * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
- *
- * static Tcl_Token * TokenAfter(Tcl_Token *tokenPtr);
- */
- #define TokenAfter(tokenPtr) \
- ((tokenPtr) + ((tokenPtr)->numComponents + 1))
- /*
- * Macro to get the offset to the next instruction to be issued. The ANSI C
- * "prototype" for this macro is:
- *
- * static int CurrentOffset(CompileEnv *envPtr);
- */
- #define CurrentOffset(envPtr) \
- ((envPtr)->codeNext - (envPtr)->codeStart)
- /*
- * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
- * maximal depth of nested CATCH ranges in order to alloc runtime
- * memory. These macros should compute precisely that? OTOH, the nesting depth
- * of LOOP ranges is an interesting datum for debugging purposes, and that is
- * what we compute now.
- *
- * static int ExceptionRangeStarts(CompileEnv *envPtr, int index);
- * static void ExceptionRangeEnds(CompileEnv *envPtr, int index);
- * static void ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
- */
- #define ExceptionRangeStarts(envPtr, index) \
- (((envPtr)->exceptDepth++), \
- ((envPtr)->maxExceptDepth = \
- TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
- ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
- #define ExceptionRangeEnds(envPtr, index) \
- (((envPtr)->exceptDepth--), \
- ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
- CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
- #define ExceptionRangeTarget(envPtr, index, targetType) \
- ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
- /*
- * Check if there is an LVT for compiled locals
- */
- #define EnvHasLVT(envPtr) \
- (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)
- /*
- * Macros for making it easier to deal with tokens and DStrings.
- */
- #define TclDStringAppendToken(dsPtr, tokenPtr) \
- Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
- #define TclRegisterDStringLiteral(envPtr, dsPtr) \
- TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
- Tcl_DStringLength(dsPtr), /*flags*/ 0)
- /*
- * Macro that encapsulates an efficiency trick that avoids a function call for
- * the simplest of compiles. The ANSI C "prototype" for this macro is:
- *
- * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- * Tcl_Interp *interp, int word);
- */
- #define CompileWord(envPtr, tokenPtr, interp, word) \
- if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
- PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size); \
- } else { \
- SetLineInformation((word)); \
- CompileTokens((envPtr), (tokenPtr), (interp)); \
- }
- /*
- * TIP #280: Remember the per-word line information of the current command. An
- * index is used instead of a pointer as recursive compilation may reallocate,
- * i.e. move, the array. This is also the reason to save the nuloc now, it may
- * change during the course of the function.
- *
- * Macro to encapsulate the variable definition and setup.
- */
- #define DefineLineInformation \
- ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
- int eclIndex = mapPtr->nuloc - 1
- #define SetLineInformation(word) \
- envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \
- envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
- #define PushVarNameWord(i,v,e,f,l,sc,word) \
- SetLineInformation(word); \
- TclPushVarName(i,v,e,f,l,sc)
- /*
- * Often want to issue one of two versions of an instruction based on whether
- * the argument will fit in a single byte or not. This makes it much clearer.
- */
- #define Emit14Inst(nm,idx,envPtr) \
- if (idx <= 255) { \
- TclEmitInstInt1(nm##1,idx,envPtr); \
- } else { \
- TclEmitInstInt4(nm##4,idx,envPtr); \
- }
- /*
- * How to get an anonymous local variable (used for holding temporary values
- * off the stack) or a local simple scalar.
- */
- #define AnonymousLocal(envPtr) \
- (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
- #define LocalScalar(chars,len,envPtr) \
- TclLocalScalar(chars, len, envPtr)
- #define LocalScalarFromToken(tokenPtr,envPtr) \
- TclLocalScalarFromToken(tokenPtr, envPtr)
- /*
- * Flags bits used by TclPushVarName.
- */
- #define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
- #define TCL_NO_ELEMENT 2 /* Do not push the array element. */
- /*
- * DTrace probe macros (NOPs if DTrace support is not enabled).
- */
- /*
- * Define the following macros to enable debug logging of the DTrace proc,
- * cmd, and inst probes. Note that this does _not_ require a platform with
- * DTrace, it simply logs all probe output to /tmp/tclDTraceDebug-[pid].log.
- *
- * If the second macro is defined, logging to file starts immediately,
- * otherwise only after the first call to [tcl::dtrace]. Note that the debug
- * probe data is always computed, even when it is not logged to file.
- *
- * Defining the third macro enables debug logging of inst probes (disabled
- * by default due to the significant performance impact).
- */
- /*
- #define TCL_DTRACE_DEBUG 1
- #define TCL_DTRACE_DEBUG_LOG_ENABLED 1
- #define TCL_DTRACE_DEBUG_INST_PROBES 1
- */
- #if !(defined(TCL_DTRACE_DEBUG) && defined(__GNUC__))
- #ifdef USE_DTRACE
- #if defined(__GNUC__) && __GNUC__ > 2
- /*
- * Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks.
- */
- #define unlikely(x) (__builtin_expect((x), 0))
- #else
- #define unlikely(x) (x)
- #endif
- #define TCL_DTRACE_PROC_ENTRY_ENABLED() unlikely(TCL_PROC_ENTRY_ENABLED())
- #define TCL_DTRACE_PROC_RETURN_ENABLED() unlikely(TCL_PROC_RETURN_ENABLED())
- #define TCL_DTRACE_PROC_RESULT_ENABLED() unlikely(TCL_PROC_RESULT_ENABLED())
- #define TCL_DTRACE_PROC_ARGS_ENABLED() unlikely(TCL_PROC_ARGS_ENABLED())
- #define TCL_DTRACE_PROC_INFO_ENABLED() unlikely(TCL_PROC_INFO_ENABLED())
- #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) TCL_PROC_ENTRY(a0, a1, a2)
- #define TCL_DTRACE_PROC_RETURN(a0, a1) TCL_PROC_RETURN(a0, a1)
- #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3)
- #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
- TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
- #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
- TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
- #define TCL_DTRACE_CMD_ENTRY_ENABLED() unlikely(TCL_CMD_ENTRY_ENABLED())
- #define TCL_DTRACE_CMD_RETURN_ENABLED() unlikely(TCL_CMD_RETURN_ENABLED())
- #define TCL_DTRACE_CMD_RESULT_ENABLED() unlikely(TCL_CMD_RESULT_ENABLED())
- #define TCL_DTRACE_CMD_ARGS_ENABLED() unlikely(TCL_CMD_ARGS_ENABLED())
- #define TCL_DTRACE_CMD_INFO_ENABLED() unlikely(TCL_CMD_INFO_ENABLED())
- #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) TCL_CMD_ENTRY(a0, a1, a2)
- #define TCL_DTRACE_CMD_RETURN(a0, a1) TCL_CMD_RETURN(a0, a1)
- #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3)
- #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
- TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
- #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
- TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
- #define TCL_DTRACE_INST_START_ENABLED() unlikely(TCL_INST_START_ENABLED())
- #define TCL_DTRACE_INST_DONE_ENABLED() unlikely(TCL_INST_DONE_ENABLED())
- #define TCL_DTRACE_INST_START(a0, a1, a2) TCL_INST_START(a0, a1, a2)
- #define TCL_DTRACE_INST_DONE(a0, a1, a2) TCL_INST_DONE(a0, a1, a2)
- #define TCL_DTRACE_TCL_PROBE_ENABLED() unlikely(TCL_TCL_PROBE_ENABLED())
- #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
- TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
- #define TCL_DTRACE_DEBUG_LOG()
- MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args,
- int *argsi);
- #else /* USE_DTRACE */
- #define TCL_DTRACE_PROC_ENTRY_ENABLED() 0
- #define TCL_DTRACE_PROC_RETURN_ENABLED() 0
- #define TCL_DTRACE_PROC_RESULT_ENABLED() 0
- #define TCL_DTRACE_PROC_ARGS_ENABLED() 0
- #define TCL_DTRACE_PROC_INFO_ENABLED() 0
- #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) {if (a0) {}}
- #define TCL_DTRACE_PROC_RETURN(a0, a1) {if (a0) {}}
- #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {if (a0) {}; if (a3) {}}
- #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
- #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
- #define TCL_DTRACE_CMD_ENTRY_ENABLED() 0
- #define TCL_DTRACE_CMD_RETURN_ENABLED() 0
- #define TCL_DTRACE_CMD_RESULT_ENABLED() 0
- #define TCL_DTRACE_CMD_ARGS_ENABLED() 0
- #define TCL_DTRACE_CMD_INFO_ENABLED() 0
- #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) {}
- #define TCL_DTRACE_CMD_RETURN(a0, a1) {}
- #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {}
- #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
- #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
- #define TCL_DTRACE_INST_START_ENABLED() 0
- #define TCL_DTRACE_INST_DONE_ENABLED() 0
- #define TCL_DTRACE_INST_START(a0, a1, a2) {}
- #define TCL_DTRACE_INST_DONE(a0, a1, a2) {}
- #define TCL_DTRACE_TCL_PROBE_ENABLED() 0
- #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
- #define TclDTraceInfo(info, args, argsi) {*args = ""; *argsi = 0;}
- #endif /* USE_DTRACE */
- #else /* TCL_DTRACE_DEBUG */
- #define USE_DTRACE 1
- #if !defined(TCL_DTRACE_DEBUG_LOG_ENABLED) || !(TCL_DTRACE_DEBUG_LOG_ENABLED)
- #undef TCL_DTRACE_DEBUG_LOG_ENABLED
- #define TCL_DTRACE_DEBUG_LOG_ENABLED 0
- #endif
- #if !defined(TCL_DTRACE_DEBUG_INST_PROBES) || !(TCL_DTRACE_DEBUG_INST_PROBES)
- #undef TCL_DTRACE_DEBUG_INST_PROBES
- #define TCL_DTRACE_DEBUG_INST_PROBES 0
- #endif
- MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent;
- MODULE_SCOPE FILE *tclDTraceDebugLog;
- MODULE_SCOPE void TclDTraceOpenDebugLog(void);
- MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi);
- #define TCL_DTRACE_DEBUG_LOG() \
- int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \
- int tclDTraceDebugIndent = 0; \
- FILE *tclDTraceDebugLog = NULL; \
- void TclDTraceOpenDebugLog(void) { \
- char n[35]; \
- sprintf(n, "/tmp/tclDTraceDebug-%lu.log", \
- (unsigned long) getpid()); \
- tclDTraceDebugLog = fopen(n, "a"); \
- }
- #define TclDTraceDbgMsg(p, m, ...) \
- do { \
- if (tclDTraceDebugEnabled) { \
- int _l, _t = 0; \
- if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \
- fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", \
- strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \
- fprintf(tclDTraceDebugLog, " %.*s():%n", \
- (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \
- fprintf(tclDTraceDebugLog, "%*s" p "%n", \
- (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \
- "", &_l); _t += _l; \
- fprintf(tclDTraceDebugLog, "%*s" m "\n", \
- (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__); \
- fflush(tclDTraceDebugLog); \
- } \
- } while (0)
- #define TCL_DTRACE_PROC_ENTRY_ENABLED() 1
- #define TCL_DTRACE_PROC_RETURN_ENABLED() 1
- #define TCL_DTRACE_PROC_RESULT_ENABLED() 1
- #define TCL_DTRACE_PROC_ARGS_ENABLED() 1
- #define TCL_DTRACE_PROC_INFO_ENABLED() 1
- #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \
- tclDTraceDebugIndent++; \
- TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2)
- #define TCL_DTRACE_PROC_RETURN(a0, a1) \
- TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \
- tclDTraceDebugIndent--
- #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \
- TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3)
- #define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
- TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
- a1, a2, a3, a4, a5, a6, a7, a8, a9)
- #define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
- TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \
- a2, a3, a4, a5, a6, a7)
- #define TCL_DTRACE_CMD_ENTRY_ENABLED() 1
- #define TCL_DTRACE_CMD_RETURN_ENABLED() 1
- #define TCL_DTRACE_CMD_RESULT_ENABLED() 1
- #define TCL_DTRACE_CMD_ARGS_ENABLED() 1
- #define TCL_DTRACE_CMD_INFO_ENABLED() 1
- #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \
- tclDTraceDebugIndent++; \
- TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2)
- #define TCL_DTRACE_CMD_RETURN(a0, a1) \
- TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \
- tclDTraceDebugIndent--
- #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \
- TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3)
- #define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
- TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
- a1, a2, a3, a4, a5, a6, a7, a8, a9)
- #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
- TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \
- a2, a3, a4, a5, a6, a7)
- #define TCL_DTRACE_INST_START_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES
- #define TCL_DTRACE_INST_DONE_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES
- #define TCL_DTRACE_INST_START(a0, a1, a2) \
- TclDTraceDbgMsg(" | inst-start", "%s %d %p", a0, a1, a2)
- #define TCL_DTRACE_INST_DONE(a0, a1, a2) \
- TclDTraceDbgMsg(" | inst-end", "%s %d %p", a0, a1, a2)
- #define TCL_DTRACE_TCL_PROBE_ENABLED() 1
- #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
- do { \
- tclDTraceDebugEnabled = 1; \
- TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \
- a1, a2, a3, a4, a5, a6, a7, a8, a9); \
- } while (0)
- #endif /* TCL_DTRACE_DEBUG */
- #endif /* _TCLCOMPILATION */
- /*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
|