tclcompile.c

linux系统下的音频通信

/* 
 * tclCompile.c --
 *
 *	This file contains procedures that compile Tcl commands or parts
 *	of commands (like quoted strings or nested sub-commands) into a
 *	sequence of instructions ("bytecodes"). 
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclCompile.c 1.10 98/08/07 11:46:30
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * 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".
 */

int tclTraceCompile = 0;
static int traceInitialized = 0;

/*
 * Count of the number of compilations and various other compilation-
 * related statistics.
 */

#ifdef TCL_COMPILE_STATS
long tclNumCompilations = 0;
double tclTotalSourceBytes = 0.0;
double tclTotalCodeBytes = 0.0;

double tclTotalInstBytes = 0.0;
double tclTotalObjBytes = 0.0;
double tclTotalExceptBytes = 0.0;
double tclTotalAuxBytes = 0.0;
double tclTotalCmdMapBytes = 0.0;

double tclCurrentSourceBytes = 0.0;
double tclCurrentCodeBytes = 0.0;

int tclSourceCount[32];
int tclByteCodeCount[32];
#endif /* TCL_COMPILE_STATS */

/*
 * A table describing the Tcl bytecode instructions. The entries in this
 * table must correspond to the list of instructions in tclInt.h. The names
 * "op1" and "op4" refer to an instruction's one or four byte first operand.
 * Similarly, "stktop" and "stknext" refer to the topmost and next to
 * topmost stack elements.
 *
 * Note that the load, store, and incr instructions do not distinguish local
 * from global variables; the bytecode interpreter at runtime uses the
 * existence of a procedure call frame to distinguish these.
 */

InstructionDesc instructionTable[] = {
   /* Name	      Bytes #Opnds Operand types        Stack top, next   */
    {"done",	          1,   0,   {OPERAND_NONE}},
        /* Finish ByteCode execution and return stktop (top stack item) */
    {"push1",	          2,   1,   {OPERAND_UINT1}},
        /* Push object at ByteCode objArray[op1] */
    {"push4",	          5,   1,   {OPERAND_UINT4}},
        /* Push object at ByteCode objArray[op4] */
    {"pop",	          1,   0,   {OPERAND_NONE}},
        /* Pop the topmost stack object */
    {"dup",	          1,   0,   {OPERAND_NONE}},
        /* Duplicate the topmost stack object and push the result */
    {"concat1",	          2,   1,   {OPERAND_UINT1}},
        /* Concatenate the top op1 items and push result */
    {"invokeStk1",        2,   1,   {OPERAND_UINT1}},
        /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
    {"invokeStk4",        5,   1,   {OPERAND_UINT4}},
        /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
    {"evalStk",           1,   0,   {OPERAND_NONE}},
        /* Evaluate command in stktop using Tcl_EvalObj. */
    {"exprStk",           1,   0,   {OPERAND_NONE}},
        /* Execute expression in stktop using Tcl_ExprStringObj. */
    
    {"loadScalar1",       2,   1,   {OPERAND_UINT1}},
        /* Load scalar variable at index op1 <= 255 in call frame */
    {"loadScalar4",       5,   1,   {OPERAND_UINT4}},
        /* Load scalar variable at index op1 >= 256 in call frame */
    {"loadScalarStk",     1,   0,   {OPERAND_NONE}},
        /* Load scalar variable; scalar's name is stktop */
    {"loadArray1",        2,   1,   {OPERAND_UINT1}},
        /* Load array element; array at slot op1<=255, element is stktop */
    {"loadArray4",        5,   1,   {OPERAND_UINT4}},
        /* Load array element; array at slot op1 > 255, element is stktop */
    {"loadArrayStk",      1,   0,   {OPERAND_NONE}},
        /* Load array element; element is stktop, array name is stknext */
    {"loadStk",           1,   0,   {OPERAND_NONE}},
        /* Load general variable; unparsed variable name is stktop */
    {"storeScalar1",      2,   1,   {OPERAND_UINT1}},
        /* Store scalar variable at op1<=255 in frame; value is stktop */
    {"storeScalar4",      5,   1,   {OPERAND_UINT4}},
        /* Store scalar variable at op1 > 255 in frame; value is stktop */
    {"storeScalarStk",    1,   0,   {OPERAND_NONE}},
        /* Store scalar; value is stktop, scalar name is stknext */
    {"storeArray1",       2,   1,   {OPERAND_UINT1}},
        /* Store array element; array at op1<=255, value is top then elem */
    {"storeArray4",       5,   1,   {OPERAND_UINT4}},
        /* Store array element; array at op1>=256, value is top then elem */
    {"storeArrayStk",     1,   0,   {OPERAND_NONE}},
        /* Store array element; value is stktop, then elem, array names */
    {"storeStk",          1,   0,   {OPERAND_NONE}},
        /* Store general variable; value is stktop, then unparsed name */
    
    {"incrScalar1",       2,   1,   {OPERAND_UINT1}},
        /* Incr scalar at index op1<=255 in frame; incr amount is stktop */
    {"incrScalarStk",     1,   0,   {OPERAND_NONE}},
        /* Incr scalar; incr amount is stktop, scalar's name is stknext */
    {"incrArray1",        2,   1,   {OPERAND_UINT1}},
        /* Incr array elem; arr at slot op1<=255, amount is top then elem */
    {"incrArrayStk",      1,   0,   {OPERAND_NONE}},
        /* Incr array element; amount is top then elem then array names */
    {"incrStk",           1,   0,   {OPERAND_NONE}},
        /* Incr general variable; amount is stktop then unparsed var name */
    {"incrScalar1Imm",    3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
        /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
    {"incrScalarStkImm",  2,   1,   {OPERAND_INT1}},
        /* Incr scalar; scalar name is stktop; incr amount is op1 */
    {"incrArray1Imm",     3,   2,   {OPERAND_UINT1, OPERAND_INT1}},
        /* Incr array elem; array at slot op1 <= 255, elem is stktop,
	 * amount is 2nd operand byte */
    {"incrArrayStkImm",   2,   1,   {OPERAND_INT1}},
        /* Incr array element; elem is top then array name, amount is op1 */
    {"incrStkImm",        2,   1,   {OPERAND_INT1}},
        /* Incr general variable; unparsed name is top, amount is op1 */
    
    {"jump1",             2,   1,   {OPERAND_INT1}},
        /* Jump relative to (pc + op1) */
    {"jump4",             5,   1,   {OPERAND_INT4}},
        /* Jump relative to (pc + op4) */
    {"jumpTrue1",         2,   1,   {OPERAND_INT1}},
        /* Jump relative to (pc + op1) if stktop expr object is true */
    {"jumpTrue4",         5,   1,   {OPERAND_INT4}},
        /* Jump relative to (pc + op4) if stktop expr object is true */
    {"jumpFalse1",        2,   1,   {OPERAND_INT1}},
        /* Jump relative to (pc + op1) if stktop expr object is false */
    {"jumpFalse4",        5,   1,   {OPERAND_INT4}},
        /* Jump relative to (pc + op4) if stktop expr object is false */

    {"lor",               1,   0,   {OPERAND_NONE}},
        /* Logical or:	push (stknext || stktop) */
    {"land",              1,   0,   {OPERAND_NONE}},
        /* Logical and:	push (stknext && stktop) */
    {"bitor",             1,   0,   {OPERAND_NONE}},
        /* Bitwise or:	push (stknext | stktop) */
    {"bitxor",            1,   0,   {OPERAND_NONE}},
        /* Bitwise xor	push (stknext ^ stktop) */
    {"bitand",            1,   0,   {OPERAND_NONE}},
        /* Bitwise and:	push (stknext & stktop) */
    {"eq",                1,   0,   {OPERAND_NONE}},
        /* Equal:	push (stknext == stktop) */
    {"neq",               1,   0,   {OPERAND_NONE}},
        /* Not equal:	push (stknext != stktop) */
    {"lt",                1,   0,   {OPERAND_NONE}},
        /* Less:	push (stknext < stktop) */
    {"gt",                1,   0,   {OPERAND_NONE}},
        /* Greater:	push (stknext || stktop) */
    {"le",                1,   0,   {OPERAND_NONE}},
        /* Logical or:	push (stknext || stktop) */
    {"ge",                1,   0,   {OPERAND_NONE}},
        /* Logical or:	push (stknext || stktop) */
    {"lshift",            1,   0,   {OPERAND_NONE}},
        /* Left shift:	push (stknext << stktop) */
    {"rshift",            1,   0,   {OPERAND_NONE}},
        /* Right shift:	push (stknext >> stktop) */
    {"add",               1,   0,   {OPERAND_NONE}},
        /* Add:		push (stknext + stktop) */
    {"sub",               1,   0,   {OPERAND_NONE}},
        /* Sub:		push (stkext - stktop) */
    {"mult",              1,   0,   {OPERAND_NONE}},
        /* Multiply:	push (stknext * stktop) */
    {"div",               1,   0,   {OPERAND_NONE}},
        /* Divide:	push (stknext / stktop) */
    {"mod",               1,   0,   {OPERAND_NONE}},
        /* Mod:		push (stknext % stktop) */
    {"uplus",             1,   0,   {OPERAND_NONE}},
        /* Unary plus:	push +stktop */
    {"uminus",            1,   0,   {OPERAND_NONE}},
        /* Unary minus:	push -stktop */
    {"bitnot",            1,   0,   {OPERAND_NONE}},
        /* Bitwise not:	push ~stktop */
    {"not",               1,   0,   {OPERAND_NONE}},
        /* Logical not:	push !stktop */
    {"callBuiltinFunc1",  2,   1,   {OPERAND_UINT1}},
        /* Call builtin math function with index op1; any args are on stk */
    {"callFunc1",         2,   1,   {OPERAND_UINT1}},
        /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1>  */
    {"tryCvtToNumeric",   1,   0,   {OPERAND_NONE}},
        /* Try converting stktop to first int then double if possible. */

    {"break",             1,   0,   {OPERAND_NONE}},
        /* Abort closest enclosing loop; if none, return TCL_BREAK code. */
    {"continue",          1,   0,   {OPERAND_NONE}},
        /* Skip to next iteration of closest enclosing loop; if none,
	 * return TCL_CONTINUE code. */

    {"foreach_start4",    5,   1,   {OPERAND_UINT4}},
        /* Initialize execution of a foreach loop. Operand is aux data index
	 * of the ForeachInfo structure for the foreach command. */
    {"foreach_step4",     5,   1,   {OPERAND_UINT4}},
        /* "Step" or begin next iteration of foreach loop. Push 0 if to
	 *  terminate loop, else push 1. */

    {"beginCatch4",	  5,   1,   {OPERAND_UINT4}},
        /* Record start of catch with the operand's exception range index.
	 * Push the current stack depth onto a special catch stack. */
    {"endCatch",	  1,   0,   {OPERAND_NONE}},
        /* End of last catch. Pop the bytecode interpreter's catch stack. */
    {"pushResult",	  1,   0,   {OPERAND_NONE}},
        /* Push the interpreter's object result onto the stack. */
    {"pushReturnCode",	  1,   0,   {OPERAND_NONE}},
        /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
	 * a new object onto the stack. */
    {0}
};

/*
 * The following table assigns a type to each character. Only types
 * meaningful to Tcl parsing are represented here. The table is
 * designed to be referenced with either signed or unsigned characters,
 * so it has 384 entries. The first 128 entries correspond to negative
 * character values, the next 256 correspond to positive character
 * values. The last 128 entries are identical to the first 128. The
 * table is always indexed with a 128-byte offset (the 128th entry
 * corresponds to a 0 character value).
 */

unsigned char tclTypeTable[] = {
    /*
     * Negative character values, from -128 to -1:
     */

    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,

    /*
     * Positive character values, from 0-127:
     */

    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
    TCL_SPACE,         TCL_SPACE,         TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
    TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
    TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
    TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,

    /*
     * Large unsigned character values, from 128-255:
     */

    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
};

/*
 * Table of all AuxData types.
 */

static Tcl_HashTable auxDataTypeTable;
static int auxDataTypeTableInitialized = 0;    /* 0 means not yet
                                                * initialized. */

/*
 * Prototypes for procedures defined later in this file:
 */

static void		AdvanceToNextWord _ANSI_ARGS_((char *string,
			    CompileEnv *envPtr));
static int		CollectArgInfo _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, char *lastChar, int flags,
			    ArgInfo *argInfoPtr));
static int		CompileBraces _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, char *lastChar, int flags,
			    CompileEnv *envPtr));
static int		CompileCmdWordInline _ANSI_ARGS_((
    			    Tcl_Interp *interp, char *string,