tclcompile.c

linux系统下的音频通信

	    } else {
		fprintf(stdout, "%d", opnd);
	    }
	    break;
	case OPERAND_INT4:
	    opnd = TclGetInt4AtPtr(pc+1+i);
	    if ((i == 0) && ((opCode == INST_JUMP4)
			     || (opCode == INST_JUMP_TRUE4)
		             || (opCode == INST_JUMP_FALSE4))) {
		fprintf(stdout, "%d  	# pc %u", opnd, (pcOffset + opnd));
	    } else {
		fprintf(stdout, "%d", opnd);
	    }
	    break;
	case OPERAND_UINT1:
	    opnd = TclGetUInt1AtPtr(pc+1+i);
	    if ((i == 0) && (opCode == INST_PUSH1)) {
		elemPtr = codePtr->objArrayPtr[opnd];
		string = Tcl_GetStringFromObj(elemPtr, &elemLen);
		fprintf(stdout, "%u  	# ", (unsigned int) opnd);
		TclPrintSource(stdout, string, TclMin(elemLen, 40));
	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
				    || (opCode == INST_LOAD_ARRAY1)
				    || (opCode == INST_STORE_SCALAR1)
				    || (opCode == INST_STORE_ARRAY1))) {
		int localCt = procPtr->numCompiledLocals;
		CompiledLocal *localPtr = procPtr->firstLocalPtr;
		if (opnd >= localCt) {
		    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
			     (unsigned int) opnd, localCt);
		    return instDesc->numBytes;
		}
		for (j = 0;  j < opnd;  j++) {
		    localPtr = localPtr->nextPtr;
		}
		if (TclIsVarTemporary(localPtr)) {
		    fprintf(stdout, "%u	# temp var %u",
			    (unsigned int) opnd, (unsigned int) opnd);
		} else {
		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
		    TclPrintSource(stdout, localPtr->name, 40);
		}
	    } else {
		fprintf(stdout, "%u ", (unsigned int) opnd);
	    }
	    break;
	case OPERAND_UINT4:
	    opnd = TclGetUInt4AtPtr(pc+1+i);
	    if (opCode == INST_PUSH4) {
		elemPtr = codePtr->objArrayPtr[opnd];
		string = Tcl_GetStringFromObj(elemPtr, &elemLen);
		fprintf(stdout, "%u  	# ", opnd);
		TclPrintSource(stdout, string, TclMin(elemLen, 40));
	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
				    || (opCode == INST_LOAD_ARRAY4)
				    || (opCode == INST_STORE_SCALAR4)
				    || (opCode == INST_STORE_ARRAY4))) {
		int localCt = procPtr->numCompiledLocals;
		CompiledLocal *localPtr = procPtr->firstLocalPtr;
		if (opnd >= localCt) {
		    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
			     (unsigned int) opnd, localCt);
		    return instDesc->numBytes;
		}
		for (j = 0;  j < opnd;  j++) {
		    localPtr = localPtr->nextPtr;
		}
		if (TclIsVarTemporary(localPtr)) {
		    fprintf(stdout, "%u	# temp var %u",
			    (unsigned int) opnd, (unsigned int) opnd);
		} else {
		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
		    TclPrintSource(stdout, localPtr->name, 40);
		}
	    } else {
		fprintf(stdout, "%u ", (unsigned int) opnd);
	    }
	    break;
	case OPERAND_NONE:
	default:
	    break;
	}
    }
    fprintf(stdout, "\n");
    return instDesc->numBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --
 *
 *	This procedure prints up to a specified number of characters from
 *	the argument string to a specified file. It tries to produce legible
 *	output by adding backslashes as necessary.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Outputs characters to the specified file.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintSource(outFile, string, maxChars)
    FILE *outFile;		/* The file to print the source to. */
    char *string;		/* The string to print. */
    int maxChars;		/* Maximum number of chars to print. */
{
    register char *p;
    register int i = 0;

    if (string == NULL) {
	fprintf(outFile, "\"\"");
	return;
    }

    fprintf(outFile, "\"");
    p = string;
    for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
	switch (*p) {
	    case '"':
		fprintf(outFile, "\\\"");
		continue;
	    case '\f':
		fprintf(outFile, "\\f");
		continue;
	    case '\n':
		fprintf(outFile, "\\n");
		continue;
            case '\r':
		fprintf(outFile, "\\r");
		continue;
	    case '\t':
		fprintf(outFile, "\\t");
		continue;
            case '\v':
		fprintf(outFile, "\\v");
		continue;
	    default:
		fprintf(outFile, "%c", *p);
		continue;
	}
    }
    fprintf(outFile, "\"");
}

/*
 *----------------------------------------------------------------------
 *
 * FreeByteCodeInternalRep --
 *
 *	Part of the bytecode Tcl object type implementation. Frees the
 *	storage associated with a bytecode object's internal representation
 *	unless its code is actively being executed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The bytecode object's internal rep is marked invalid and its
 *	code gets freed unless the code is actively being executed.
 *	In that case the cleanup is delayed until the last execution
 *	of the code completes.
 *
 *----------------------------------------------------------------------
 */

static void
FreeByteCodeInternalRep(objPtr)
    register Tcl_Obj *objPtr;	/* Object whose internal rep to free. */
{
    register ByteCode *codePtr =
	    (ByteCode *) objPtr->internalRep.otherValuePtr;

    codePtr->refCount--;
    if (codePtr->refCount <= 0) {
	TclCleanupByteCode(codePtr);
    }
    objPtr->typePtr = NULL;
    objPtr->internalRep.otherValuePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCleanupByteCode --
 *
 *	This procedure does all the real work of freeing up a bytecode
 *	object's ByteCode structure. It's called only when the structure's
 *	reference count becomes zero.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees objPtr's bytecode internal representation and sets
 *	its type and objPtr->internalRep.otherValuePtr NULL. Also
 *	decrements the ref counts on each object in its object array,
 *	and frees its auxiliary data items.
 *
 *----------------------------------------------------------------------
 */

void
TclCleanupByteCode(codePtr)
    ByteCode *codePtr;		/* ByteCode to free. */
{
    Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
    int numObjects = codePtr->numObjects;
    int numAuxDataItems = codePtr->numAuxDataItems;
    register AuxData *auxDataPtr;
    register Tcl_Obj *elemPtr;
    register int i;

#ifdef TCL_COMPILE_STATS    
    tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
    tclCurrentCodeBytes -= (double) codePtr->totalSize;
#endif /* TCL_COMPILE_STATS */

    /*
     * A single heap object holds the ByteCode structure and its code,
     * object, command location, and auxiliary data arrays. This means we
     * only need to 1) decrement the ref counts on the objects in its
     * object array, 2) call the free procs for the auxiliary data items,
     * and 3) free the ByteCode structure's heap object.
     */

    for (i = 0;  i < numObjects;  i++) {
	elemPtr = objArrayPtr[i];
	TclDecrRefCount(elemPtr);
    }

    auxDataPtr = codePtr->auxDataArrayPtr;
    for (i = 0;  i < numAuxDataItems;  i++) {
	if (auxDataPtr->type->freeProc != NULL) {
	    auxDataPtr->type->freeProc(auxDataPtr->clientData);
	}
	auxDataPtr++;
    }
    
    ckfree((char *) codePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DupByteCodeInternalRep --
 *
 *	Part of the bytecode Tcl object type implementation. However, it
 *	does not copy the internal representation of a bytecode Tcl_Obj, but
 *	instead leaves the new object untyped (with a NULL type pointer).
 *	Code will be compiled for the new object only if necessary.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
DupByteCodeInternalRep(srcPtr, copyPtr)
    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
{
    return;
}

/*
 *-----------------------------------------------------------------------
 *
 * SetByteCodeFromAny --
 *
 *	Part of the bytecode Tcl object type implementation. Attempts to
 *	generate an byte code internal form for the Tcl object "objPtr" by
 *	compiling its string representation.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	during compilation, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	Frees the old internal representation. If no error occurs, then the
 *	compiled code is stored as "objPtr"s bytecode representation.
 *	Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
 *	used to trace compilations.
 *
 *----------------------------------------------------------------------
 */

static int
SetByteCodeFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* The interpreter for which the code is
				 * compiled. */
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    Interp *iPtr = (Interp *) interp;
    char *string;
    CompileEnv compEnv;		/* Compilation environment structure
				 * allocated in frame. */
    AuxData *auxDataPtr;
    register int i;
    int length, result;

    if (!traceInitialized) {
        if (Tcl_LinkVar(interp, "tcl_traceCompile",
	            (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
            panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
        }
        traceInitialized = 1;
    }
    
    string = Tcl_GetStringFromObj(objPtr, &length);
    TclInitCompileEnv(interp, &compEnv, string);
    result = TclCompileString(interp, string, string+length,
	    iPtr->evalFlags, &compEnv);
    if (result == TCL_OK) {
	/*
	 * Add a "done" instruction at the end of the instruction sequence.
	 */
    
	TclEmitOpcode(INST_DONE, &compEnv);
	
	/*
	 * Convert the object to a ByteCode object.
	 */

	TclInitByteCodeObj(objPtr, &compEnv);
    } else {
	/*
	 * Compilation errors. Decrement the ref counts on any objects in
	 * the object array and free any aux data items prior to freeing
	 * the compilation environment.
	 */
	
	for (i = 0;  i < compEnv.objArrayNext;  i++) {
	    Tcl_Obj *elemPtr = compEnv.objArrayPtr[i];
	    Tcl_DecrRefCount(elemPtr);
	}

	auxDataPtr = compEnv.auxDataArrayPtr;
	for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
	    if (auxDataPtr->type->freeProc != NULL) {
            auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr++;
	}
    }
    TclFreeCompileEnv(&compEnv);

    if (result == TCL_OK) {
	if (tclTraceCompile == 2) {
	    TclPrintByteCodeObj(interp, objPtr);
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfByteCode --
 *
 *	Part of the bytecode Tcl object type implementation. Called to
 *	update the string representation for a byte code object.
 *	Note: This procedure does not free an existing old string rep
 *	so storage will be lost if this has not already been done.
 *
 * Results: