tclcompile.c

linux系统下的音频通信

/*
 *----------------------------------------------------------------------
 *
 * EncodeCmdLocMap --
 *
 *	Encode the command location information for some compiled code into
 *	a ByteCode structure. The encoded command location map is stored as
 *	three adjacent byte sequences.
 *
 * Results:
 *	Pointer to the first byte after the encoded command location
 *	information.
 *
 * Side effects:
 *	The encoded information is stored into the block of memory headed
 *	by codePtr. Also records pointers to the start of the four byte
 *	sequences in fields in codePtr's ByteCode header structure.
 *
 *----------------------------------------------------------------------
 */

static unsigned char *
EncodeCmdLocMap(envPtr, codePtr, startPtr)
     CompileEnv *envPtr;	/* Points to compilation environment
				 * structure containing the CmdLocation
				 * structure to encode. */
     ByteCode *codePtr;		/* ByteCode in which to encode envPtr's
				 * command location information. */
     unsigned char *startPtr;	/* Points to the first byte in codePtr's
				 * memory block where the location
				 * information is to be stored. */
{
    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
    int numCmds = envPtr->numCommands;
    register unsigned char *p = startPtr;
    int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
    register int i;
    
    /*
     * Encode the code offset for each command as a sequence of deltas.
     */

    codePtr->codeDeltaStart = p;
    prevOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	codeDelta = (mapPtr[i].codeOffset - prevOffset);
	if (codeDelta < 0) {
	    panic("EncodeCmdLocMap: bad code offset");
	} else if (codeDelta <= 127) {
	    TclStoreInt1AtPtr(codeDelta, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(codeDelta, p);
	    p += 4;
	}
	prevOffset = mapPtr[i].codeOffset;
    }

    /*
     * Encode the code length for each command.
     */

    codePtr->codeLengthStart = p;
    for (i = 0;  i < numCmds;  i++) {
	codeLen = mapPtr[i].numCodeBytes;
	if (codeLen < 0) {
	    panic("EncodeCmdLocMap: bad code length");
	} else if (codeLen <= 127) {
	    TclStoreInt1AtPtr(codeLen, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(codeLen, p);
	    p += 4;
	}
    }

    /*
     * Encode the source offset for each command as a sequence of deltas.
     */

    codePtr->srcDeltaStart = p;
    prevOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	srcDelta = (mapPtr[i].srcOffset - prevOffset);
	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
	    TclStoreInt1AtPtr(srcDelta, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(srcDelta, p);
	    p += 4;
	}
	prevOffset = mapPtr[i].srcOffset;
    }

    /*
     * Encode the source length for each command.
     */

    codePtr->srcLengthStart = p;
    for (i = 0;  i < numCmds;  i++) {
	srcLen = mapPtr[i].numSrcChars;
	if (srcLen < 0) {
	    panic("EncodeCmdLocMap: bad source length");
	} else if (srcLen <= 127) {
	    TclStoreInt1AtPtr(srcLen, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(srcLen, p);
	    p += 4;
	}
    }
    
    return p;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileString --
 *
 *	Compile a Tcl script in a null-terminated binary string.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 *	envPtr->termOffset and interp->termOffset are filled in with the
 *	offset of the character in the string just after the last one
 *	successfully processed; this might be the offset of the ']' (if
 *	flags & TCL_BRACKET_TERM), or the offset of the '\0' at the end of
 *	the string. Also updates envPtr->maxStackDepth with the maximum
 *	number of stack elements needed to execute the string's commands.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the string at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileString(interp, string, lastChar, flags, envPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    char *string;		/* The source string to compile. */
    char *lastChar;		/* Pointer to terminating character of
				 * string. */
    int flags;			/* Flags to control compilation (same as
				 * passed to Tcl_Eval). */
    CompileEnv *envPtr;		/* Holds resulting instructions. */
{
    Interp *iPtr = (Interp *) interp;
    register char *src = string;/* Points to current source char. */
    register char c = *src;	/* The current char. */
    register int type;		/* Current char's CHAR_TYPE type. */
    char termChar = (char)((flags & TCL_BRACKET_TERM)? ']' : '\0');
				/* Return when this character is found
				 * (either ']' or '\0'). Zero means newlines
				 * terminate cmds. */
    int isFirstCmd = 1;		/* 1 if compiling the first cmd. */
    char *cmdSrcStart = NULL;	/* Points to first non-blank char in each
 				 * command. Initialized to avoid compiler
 				 * warning. */
    int cmdIndex;		/* The index of the current command in the
 				 * compilation environment's command
 				 * location table. */
    int lastTopLevelCmdIndex = -1;
    				/* Index of most recent toplevel command in
 				 * the command location table. Initialized
				 * to avoid compiler warning. */
    int cmdCodeOffset = -1;	/* Offset of first byte of current command's
 				 * code. Initialized to avoid compiler
 				 * warning. */
    int cmdWords;		/* Number of words in current command. */
    Tcl_Command cmd;		/* Used to search for commands. */
    Command *cmdPtr;		/* Points to command's Command structure if
				 * first word is simple and command was
				 * found; else NULL. */
    int maxDepth = 0;		/* Maximum number of stack elements needed
				 * to execute all cmds. */
    char *termPtr;		/* Points to char that terminated word. */
    char savedChar;		/* Holds the character from string
				 * termporarily replaced by a null character
				 * during processing of words. */
    int objIndex = -1;		/* The object array index for a pushed
 				 * object holding a word or word part
 				 * Initialized to avoid compiler warning. */
    unsigned char *entryCodeNext = envPtr->codeNext;
    				/* Value of envPtr's current instruction
				 * pointer at entry. Used to tell if any
				 * instructions generated. */
    char *ellipsis = "";	/* Used to set errorInfo variable; "..."
				 * indicates that not all of offending
				 * command is included in errorInfo. ""
				 * means that the command is all there. */
    Tcl_Obj *objPtr;
    int numChars;
    int result = TCL_OK;
    int savePushSimpleWords = envPtr->pushSimpleWords;

    /*
     * commands: command {(';' | '\n') command}
     */

    while ((src != lastChar) && (c != termChar)) {
	/*
	 * Skip white space, semicolons, backslash-newlines (treated as
	 * spaces), and comments before command.
	 */

	type = CHAR_TYPE(src, lastChar);
	while ((type & (TCL_SPACE | TCL_BACKSLASH))
	        || (c == '\n') || (c == ';')) {
	    if (type == TCL_BACKSLASH) {
		if (src[1] == '\n') {
		    src += 2;
		} else {
		    break;
		}
	    } else {
		src++;
	    }
	    c = *src;
	    type = CHAR_TYPE(src, lastChar);
	}

	if (c == '#') {
	    while (src != lastChar) {
		if (c == '\\') {
		    int numRead;
		    Tcl_Backslash(src, &numRead);
		    src += numRead;
		} else if (c == '\n') {
		    src++;
		    c = *src;
		    envPtr->termOffset = (src - string);
		    break;
		} else {
		    src++;
		}
		c = *src;
	    }
	    continue;	/* end of comment, restart outer command loop */
	}

	/*
	 * Compile one command: zero or more words terminated by a '\n',
	 * ';', ']' (if command is terminated by close bracket), or
	 * the end of string.
	 *
	 * command: word*
	 */

	type = CHAR_TYPE(src, lastChar);
	if ((type == TCL_COMMAND_END) 
	        && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
	    continue;  /* empty command; restart outer cmd loop */
	}

	/*
	 * If not the first command, discard the previous command's result.
	 */
	
	if (!isFirstCmd) {
	    TclEmitOpcode(INST_POP, envPtr);
	    if (!(flags & TCL_BRACKET_TERM)) {
		/*
		 * We are compiling a top level command. Update the number
		 * of code bytes for the last command to account for the pop
		 * instruction.
		 */
		
	        (envPtr->cmdMapPtr[lastTopLevelCmdIndex]).numCodeBytes =
		    (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset;
	    }
	}

	/*
	 * Compile the words of the command. Process the first word
	 * specially, since it is the name of a command. If it is a "simple"
	 * string (just a sequence of characters), look it up in the table
	 * of compilation procedures. If a word other than the first is
	 * simple and represents an integer whose formatted representation
	 * is the same as the word, just push an integer object. Also record
	 * starting source and object information for the command.
	 */

	envPtr->numCommands++;
	cmdIndex = (envPtr->numCommands - 1);
	if (!(flags & TCL_BRACKET_TERM)) {
	    lastTopLevelCmdIndex = cmdIndex;
	}
	
	cmdSrcStart = src;
	cmdCodeOffset = (envPtr->codeNext - envPtr->codeStart);
	cmdWords = 0;
	EnterCmdStartData(envPtr, cmdIndex, src-envPtr->source,
		cmdCodeOffset);
	    
	if ((!(flags & TCL_BRACKET_TERM))
	        && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
	    /*
	     * Display a line summarizing the top level command we are about
	     * to compile.
	     */
	    
	    char *p = cmdSrcStart;
	    int numChars, complete;
	    
	    while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
		   || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
		p++;
	    }
	    numChars = (p - cmdSrcStart);
	    complete = 1;
	    if (numChars > 60) {
		numChars = 60;
		complete = 0;
	    } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
		complete = 0;
	    }
	    fprintf(stdout, "Compiling: %.*s%s\n",
		    numChars, cmdSrcStart, (complete? "" : " ..."));
	}
	
	while ((type != TCL_COMMAND_END)
	        || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {
	    /*
	     * Skip any leading white space at the start of a word. Note
	     * that a backslash-newline is treated as a space.
	     */

	    while (type & (TCL_SPACE | TCL_BACKSLASH)) {
		if (type == TCL_BACKSLASH) {
		    if (src[1] == '\n') {
			src += 2;
		    } else {
			break;
		    }
		} else {
		    src++;
		}
		c = *src;
		type = CHAR_TYPE(src, lastChar);
	    }
	    if ((type == TCL_COMMAND_END) 
	            && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
		break;		/* no words remain for command. */
	    }

	    /*
	     * Compile one word. We use an inline version of CompileWord to
	     * avoid an extra procedure call.
	     */

	    envPtr->pushSimpleWords = 0;
	    if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
		src++;
		if (type == TCL_QUOTE) {
		    result = TclCompileQuotes(interp, src, lastChar,
			    '"', flags, envPtr);
		} else {
		    result = CompileBraces(interp, src, lastChar,
			    flags, envPtr);
		}
		termP