diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2007-09-25 20:27:17 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2007-09-25 20:27:17 (GMT) |
commit | 672cb039e55156194700decdd3ab48d444249b4a (patch) | |
tree | 8f3fb850f2394af6bdd6ca36cb82dc3506cabe47 /generic/tclCompile.c | |
parent | 07010d008140290042f0c4f42cc7892cd4ddf12e (diff) | |
download | tcl-672cb039e55156194700decdd3ab48d444249b4a.zip tcl-672cb039e55156194700decdd3ab48d444249b4a.tar.gz tcl-672cb039e55156194700decdd3ab48d444249b4a.tar.bz2 |
Add a new command, ::tcl::unsupported::disassemble
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r-- | generic/tclCompile.c | 354 |
1 files changed, 224 insertions, 130 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 6ae3aaf..d4c5d9e 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.133 2007/09/11 14:47:42 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.134 2007/09/25 20:27:17 dkf Exp $ */ #include "tclInt.h" @@ -376,10 +376,10 @@ InstructionDesc tclInstructionTable[] = { /* finds level and otherName in stack, links to local variable at * index op1. Leaves the level on stack. */ {"nsupvar", 5, 0, 1, {OPERAND_LVT4}}, - /* finds namespace and otherName in stack, links to local variable at + /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ {"variable", 5, 0, 1, {OPERAND_LVT4}}, - /* finds namespace and otherName in stack, links to local variable at + /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ {"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, /* Compiled bytecodes to signal syntax error. */ @@ -407,6 +407,10 @@ static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ static int SetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static int FormatInstruction(ByteCode *codePtr, + unsigned char *pc, Tcl_Obj *bufferObj); +static void PrintSourceToObj(Tcl_Obj *appendObj, + const char *stringPtr, int maxChars); /* * TIP #280: Helper for building the per-word line information of all compiled * commands. @@ -720,7 +724,7 @@ TclCleanupByteCode( * 1) decrement the ref counts of the LiteralEntry's in its literal array, * 2) call the free procs for the auxiliary data items, 3) free the * localCache if it is unused, and finally 4) free the ByteCode - * structure's heap object. + * structure's heap object. * * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes, like * those generated from tbcload) is special, as they doesn't make use of @@ -916,7 +920,7 @@ TclInitCompileEnv( ctxPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); *ctxPtr = *invoker; - + if (invoker->type == TCL_LOCATION_BC) { /* * Note: Type BC => ctx.data.eval.path is not used. @@ -1162,7 +1166,7 @@ TclCompileScript( if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { /* Compile bytecodes to report the parse error at runtime. */ - Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, + Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, /* Drop the command terminator (";","]") if appropriate */ (parsePtr->term == parsePtr->commandStart + parsePtr->commandSize - 1)? @@ -1330,7 +1334,7 @@ TclCompileScript( * case. [Bug 1752146] * Note that the environment is initialised with * atCmdStart=1 to avoid emitting ISC for the first - * command. + * command. */ if (envPtr->atCmdStart) { @@ -1341,9 +1345,9 @@ TclCompileScript( * this depends on the exact layout of the * INST_START_CMD's operands, so be careful! */ - + unsigned char *fixPtr = envPtr->codeNext - 4; - + TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1, fixPtr); } @@ -1828,7 +1832,7 @@ TclCompileExprWords( * Side effects: * Instructions are added to envPtr to execute a no-op at runtime. No * result is pushed onto the stack: the compiler has to take care of this - * itself if the last compiled command is a NoOp. + * itself if the last compiled command is a NoOp. * *---------------------------------------------------------------------- */ @@ -3207,15 +3211,135 @@ TclPrintByteCodeObj( Tcl_Interp *interp, /* Used only for Tcl_GetStringFromObj. */ Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ { - ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; + Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr); + + fprintf(stdout, "\n%s", TclGetString(bufPtr)); + Tcl_DecrRefCount(bufPtr); +} + +/* + *---------------------------------------------------------------------- + * + * TclPrintInstruction -- + * + * This procedure prints ("disassembles") one instruction from a bytecode + * object to stdout. + * + * Results: + * Returns the length in bytes of the current instruiction. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclPrintInstruction( + ByteCode *codePtr, /* Bytecode containing the instruction. */ + unsigned char *pc) /* Points to first byte of instruction. */ +{ + Tcl_Obj *bufferObj; + + TclNewObj(bufferObj); + FormatInstruction(codePtr, pc, bufferObj); + fprintf(stdout, "%s", TclGetString(bufferObj)); + Tcl_DecrRefCount(bufferObj); + return numBytes; +} + +/* + *---------------------------------------------------------------------- + * + * TclPrintObject -- + * + * This procedure prints up to a specified number of characters from the + * argument Tcl object's string representation to a specified file. + * + * Results: + * None. + * + * Side effects: + * Outputs characters to the specified file. + * + *---------------------------------------------------------------------- + */ + +void +TclPrintObject( + FILE *outFile, /* The file to print the source to. */ + Tcl_Obj *objPtr, /* Points to the Tcl object whose string + * representation should be printed. */ + int maxChars) /* Maximum number of chars to print. */ +{ + char *bytes; + int length; + + bytes = Tcl_GetStringFromObj(objPtr, &length); + TclPrintSource(outFile, bytes, TclMin(length, maxChars)); +} + +/* + *---------------------------------------------------------------------- + * + * 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( + FILE *outFile, /* The file to print the source to. */ + const char *stringPtr, /* The string to print. */ + int maxChars) /* Maximum number of chars to print. */ +{ + Tcl_Obj *bufferObj; + + TclNewObj(bufferObj); + PrintSourceToObj(bufferObj, stringPtr, maxChars); + fprintf(outFile, TclGetString(bufferObj)); + Tcl_DecrRefCount(bufferObj); +} +#endif /* TCL_COMPILE_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * TclDisassembleByteCodeObj -- + * + * Given an object which is of bytecode type, return a disassembled + * version of the bytecode (in a new refcount 0 object). No guarantees + * are made about the details of the contents of the result. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclDisassembleByteCodeObj( + Tcl_Obj *objPtr) /* The bytecode object to disassemble. */ +{ + ByteCode *codePtr = objPtr->internalRep.otherValuePtr; unsigned char *codeStart, *codeLimit, *pc; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i; Interp *iPtr = (Interp *) *codePtr->interpHandle; + Tcl_Obj *bufferObj; + char ptrBuf1[20], ptrBuf2[20]; + TclNewObj(bufferObj); if (codePtr->refCount <= 0) { - return; /* already freed */ + return bufferObj; /* Already freed. */ } codeStart = codePtr->codeStart; @@ -3226,14 +3350,17 @@ TclPrintByteCodeObj( * Print header lines describing the ByteCode. */ - fprintf(stdout, - "\nByteCode 0x%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n", - codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, + sprintf(ptrBuf1, "%p", codePtr); + sprintf(ptrBuf2, "%p", iPtr); + Tcl_AppendPrintfToObj(bufferObj, + "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n", + ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2, iPtr->compileEpoch); - fprintf(stdout, " Source "); - TclPrintSource(stdout, codePtr->source, + Tcl_AppendToObj(bufferObj, " Source ", -1); + PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); - fprintf(stdout, "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n", + Tcl_AppendPrintfToObj(bufferObj, + "\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n", numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, @@ -3244,7 +3371,7 @@ TclPrintByteCodeObj( 0.0); #ifdef TCL_COMPILE_STATS - fprintf(stdout, + Tcl_AppendPrintfToObj(bufferObj, " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n", (unsigned long) codePtr->structureSize, (unsigned long) (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))), @@ -3264,14 +3391,18 @@ TclPrintByteCodeObj( if (codePtr->procPtr != NULL) { Proc *procPtr = codePtr->procPtr; int numCompiledLocals = procPtr->numCompiledLocals; - fprintf(stdout, - " Proc 0x%p, refCt %d, args %d, compiled locals %d\n", - procPtr, procPtr->refCount, procPtr->numArgs, + + sprintf(ptrBuf1, "%p", procPtr); + Tcl_AppendPrintfToObj(bufferObj, + " Proc 0x%s, refCt %d, args %d, compiled locals %d\n", + ptrBuf1, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { CompiledLocal *localPtr = procPtr->firstLocalPtr; + for (i = 0; i < numCompiledLocals; i++) { - fprintf(stdout, " slot %d%s%s%s%s%s%s", i, + Tcl_AppendPrintfToObj(bufferObj, + " slot %d%s%s%s%s%s%s", i, (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar", (localPtr->flags & VAR_ARRAY) ? ", array" : "", (localPtr->flags & VAR_LINK) ? ", link" : "", @@ -3279,9 +3410,10 @@ TclPrintByteCodeObj( (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "", (localPtr->flags & VAR_RESOLVED) ? ", resolved" : ""); if (TclIsVarTemporary(localPtr)) { - fprintf(stdout, "\n"); + Tcl_AppendToObj(bufferObj, "\n", -1); } else { - fprintf(stdout, ", \"%s\"\n", localPtr->name); + Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n", + localPtr->name); } localPtr = localPtr->nextPtr; } @@ -3293,25 +3425,28 @@ TclPrintByteCodeObj( */ if (codePtr->numExceptRanges > 0) { - fprintf(stdout, " Exception ranges %d, depth %d:\n", + Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %d, depth %d:\n", codePtr->numExceptRanges, codePtr->maxExceptDepth); for (i = 0; i < codePtr->numExceptRanges; i++) { ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[i]); - fprintf(stdout, " %d: level %d, %s, pc %d-%d, ", + + Tcl_AppendPrintfToObj(bufferObj, + " %d: level %d, %s, pc %d-%d, ", i, rangePtr->nestingLevel, (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"), rangePtr->codeOffset, (rangePtr->codeOffset + rangePtr->numCodeBytes - 1)); switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: - fprintf(stdout, "continue %d, break %d\n", + Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n", rangePtr->continueOffset, rangePtr->breakOffset); break; case CATCH_EXCEPTION_RANGE: - fprintf(stdout, "catch %d\n", rangePtr->catchOffset); + Tcl_AppendPrintfToObj(bufferObj, "catch %d\n", + rangePtr->catchOffset); break; default: - Tcl_Panic("TclPrintByteCodeObj: bad ExceptionRange type %d", + Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d", rangePtr->type); } } @@ -3325,10 +3460,10 @@ TclPrintByteCodeObj( if (numCmds == 0) { pc = codeStart; while (pc < codeLimit) { - fprintf(stdout, " "); - pc += TclPrintInstruction(codePtr, pc); + Tcl_AppendToObj(bufferObj, " ", -1); + pc += FormatInstruction(codePtr, pc, bufferObj); } - return; + return bufferObj; } /* @@ -3336,7 +3471,7 @@ TclPrintByteCodeObj( * for each command. These are encoded as a sequence of bytes. */ - fprintf(stdout, " Commands %d:", numCmds); + Tcl_AppendPrintfToObj(bufferObj, " Commands %d:", numCmds); codeDeltaNext = codePtr->codeDeltaStart; codeLengthNext = codePtr->codeLengthStart; srcDeltaNext = codePtr->srcDeltaStart; @@ -3381,13 +3516,13 @@ TclPrintByteCodeObj( srcLengthNext++; } - fprintf(stdout, "%s%4d: pc %d-%d, src %d-%d", + Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d", ((i % 2)? " " : "\n "), (i+1), codeOffset, (codeOffset + codeLen - 1), srcOffset, (srcOffset + srcLen - 1)); } if (numCmds > 0) { - fprintf(stdout, "\n"); + Tcl_AppendToObj(bufferObj, "\n", -1); } /* @@ -3436,14 +3571,14 @@ TclPrintByteCodeObj( */ while ((pc-codeStart) < codeOffset) { - fprintf(stdout, " "); - pc += TclPrintInstruction(codePtr, pc); + Tcl_AppendToObj(bufferObj, " ", -1); + pc += FormatInstruction(codePtr, pc, bufferObj); } - fprintf(stdout, " Command %d: ", (i+1)); - TclPrintSource(stdout, (codePtr->source + srcOffset), + Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1); + PrintSourceToObj(bufferObj, (codePtr->source + srcOffset), TclMin(srcLen, 55)); - fprintf(stdout, "\n"); + Tcl_AppendToObj(bufferObj, "\n", -1); } if (pc < codeLimit) { /* @@ -3451,43 +3586,37 @@ TclPrintByteCodeObj( */ while (pc < codeLimit) { - fprintf(stdout, " "); - pc += TclPrintInstruction(codePtr, pc); + Tcl_AppendToObj(bufferObj, " ", -1); + pc += FormatInstruction(codePtr, pc, bufferObj); } } + return bufferObj; } /* *---------------------------------------------------------------------- * - * TclPrintInstruction -- + * FormatInstruction -- * - * This procedure prints ("disassembles") one instruction from a bytecode - * object to stdout. - * - * Results: - * Returns the length in bytes of the current instruiction. - * - * Side effects: - * None. + * Appends a representation of a bytecode instruction to a Tcl_Obj. * *---------------------------------------------------------------------- */ -int -TclPrintInstruction( +static int +FormatInstruction( ByteCode *codePtr, /* Bytecode containing the instruction. */ - unsigned char *pc) /* Points to first byte of instruction. */ + unsigned char *pc, /* Points to first byte of instruction. */ + Tcl_Obj *bufferObj) /* Object to append instruction info to. */ { Proc *procPtr = codePtr->procPtr; unsigned char opCode = *pc; register InstructionDesc *instDesc = &tclInstructionTable[opCode]; unsigned char *codeStart = codePtr->codeStart; unsigned int pcOffset = (pc - codeStart); - int opnd, i, j, numBytes = 1; + int opnd = 0, i, j, numBytes = 1; int localCt = procPtr ? procPtr->numCompiledLocals : 0; CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL; - char suffixBuffer[64]; /* Additional info to print after main opcode * and immediates. */ char *suffixSrc = NULL; @@ -3495,7 +3624,7 @@ TclPrintInstruction( AuxData *auxPtr = NULL; suffixBuffer[0] = '\0'; - fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name); + Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name); for (i = 0; i < instDesc->numOperands; i++) { switch (instDesc->opTypes[i]) { case OPERAND_INT1: @@ -3504,7 +3633,7 @@ TclPrintInstruction( || opCode == INST_JUMP_FALSE1) { sprintf(suffixBuffer, "pc %u", pcOffset+opnd); } - fprintf(stdout, "%+d ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_INT4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; @@ -3514,14 +3643,14 @@ TclPrintInstruction( } else if (opCode == INST_START_CMD) { sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd); } - fprintf(stdout, "%+d ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_UINT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; if (opCode == INST_PUSH1) { suffixObj = codePtr->objArrayPtr[opnd]; } - fprintf(stdout, "%u ", (unsigned int) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned int) opnd); break; case OPERAND_AUX4: case OPERAND_UINT4: @@ -3531,7 +3660,7 @@ TclPrintInstruction( } else if (opCode == INST_START_CMD && opnd != 1) { sprintf(suffixBuffer, ", %u cmds start here", opnd); } - fprintf(stdout, "%u ", (unsigned int) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned int) opnd); if (instDesc->opTypes[i] == OPERAND_AUX4) { auxPtr = &codePtr->auxDataArrayPtr[opnd]; } @@ -3539,11 +3668,11 @@ TclPrintInstruction( case OPERAND_IDX4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; if (opnd >= -1) { - fprintf(stdout, "%d ", opnd); + Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd); } else if (opnd == -2) { - fprintf(stdout, "end "); + Tcl_AppendPrintfToObj(bufferObj, "end "); } else { - fprintf(stdout, "end-%d ", -2-opnd); + Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd); } break; case OPERAND_LVT1: @@ -3556,7 +3685,7 @@ TclPrintInstruction( printLVTindex: if (localPtr != NULL) { if (opnd >= localCt) { - Tcl_Panic("TclPrintInstruction: bad local var index %u (%u locals)", + Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)", (unsigned int) opnd, localCt); } for (j = 0; j < opnd; j++) { @@ -3569,7 +3698,7 @@ TclPrintInstruction( suffixSrc = localPtr->name; } } - fprintf(stdout, "%%v%u ", (unsigned) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd); break; case OPERAND_NONE: default: @@ -3577,19 +3706,24 @@ TclPrintInstruction( } } if (suffixObj) { - fprintf(stdout, "\t# "); - TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40); + char *bytes; + int length; + + Tcl_AppendToObj(bufferObj, "\t# ", -1); + bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length); + PrintSourceToObj(bufferObj, bytes, TclMin(length, 40)); } else if (suffixBuffer[0]) { - fprintf(stdout, "\t# %s", suffixBuffer); + Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer); if (suffixSrc) { - TclPrintSource(stdout, suffixSrc, 40); + PrintSourceToObj(bufferObj, suffixSrc, 40); } } - fprintf(stdout, "\n"); + Tcl_AppendToObj(bufferObj, "\n", -1); if (auxPtr && auxPtr->type->printProc) { - fprintf(stdout, "\t\t["); - auxPtr->type->printProc(auxPtr->clientData, codePtr, pcOffset); - fprintf(stdout, "]\n"); + Tcl_AppendToObj(bufferObj, "\t\t[", -1); + auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr, + pcOffset); + Tcl_AppendToObj(bufferObj, "]\n", -1); } return numBytes; } @@ -3597,55 +3731,16 @@ TclPrintInstruction( /* *---------------------------------------------------------------------- * - * TclPrintObject -- + * PrintSourceToObj -- * - * This procedure prints up to a specified number of characters from the - * argument Tcl object's string representation to a specified file. - * - * Results: - * None. - * - * Side effects: - * Outputs characters to the specified file. + * Appends a quoted representation of a string to a Tcl_Obj. * *---------------------------------------------------------------------- */ -void -TclPrintObject( - FILE *outFile, /* The file to print the source to. */ - Tcl_Obj *objPtr, /* Points to the Tcl object whose string - * representation should be printed. */ - int maxChars) /* Maximum number of chars to print. */ -{ - char *bytes; - int length; - - bytes = Tcl_GetStringFromObj(objPtr, &length); - TclPrintSource(outFile, bytes, TclMin(length, maxChars)); -} - -/* - *---------------------------------------------------------------------- - * - * 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( - FILE *outFile, /* The file to print the source to. */ +static void +PrintSourceToObj( + Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { @@ -3653,40 +3748,39 @@ TclPrintSource( register int i = 0; if (stringPtr == NULL) { - fprintf(outFile, "\"\""); + Tcl_AppendToObj(appendObj, "\"\"", -1); return; } - fprintf(outFile, "\""); + Tcl_AppendToObj(appendObj, "\"", -1); p = stringPtr; for (; (*p != '\0') && (i < maxChars); p++, i++) { switch (*p) { case '"': - fprintf(outFile, "\\\""); + Tcl_AppendToObj(appendObj, "\\\"", -1); continue; case '\f': - fprintf(outFile, "\\f"); + Tcl_AppendToObj(appendObj, "\\f", -1); continue; case '\n': - fprintf(outFile, "\\n"); + Tcl_AppendToObj(appendObj, "\\n", -1); continue; case '\r': - fprintf(outFile, "\\r"); + Tcl_AppendToObj(appendObj, "\\r", -1); continue; case '\t': - fprintf(outFile, "\\t"); + Tcl_AppendToObj(appendObj, "\\t", -1); continue; case '\v': - fprintf(outFile, "\\v"); + Tcl_AppendToObj(appendObj, "\\v", -1); continue; default: - fprintf(outFile, "%c", *p); + Tcl_AppendPrintfToObj(appendObj, "%c", *p); continue; } } - fprintf(outFile, "\""); + Tcl_AppendToObj(appendObj, "\"", -1); } -#endif /* TCL_COMPILE_DEBUG */ #ifdef TCL_COMPILE_STATS /* |