Fork me on GitHub

Ignore:
File:
1 edited

Legend:

Unmodified
Added
Removed

  • external/tcl/tclCompile.c

    radeddd8 rd7d2da3  
    1717#include "tclInt.h"
    1818#include "tclCompile.h"
     19
     20/*
     21 * Variable that controls whether compilation tracing is enabled and, if so,
     22 * what level of tracing is desired:
     23 *    0: no compilation tracing
     24 *    1: summarize compilation of top level cmds and proc bodies
     25 *    2: display all instructions of each ByteCode compiled
     26 * This variable is linked to the Tcl variable "tcl_traceCompile".
     27 */
     28
     29int tclTraceCompile = 0;
     30static int traceInitialized = 0;
     31
     32/*
     33 * Count of the number of compilations and various other compilation-
     34 * related statistics.
     35 */
     36
     37#ifdef TCL_COMPILE_STATS
     38long tclNumCompilations = 0;
     39double tclTotalSourceBytes = 0.0;
     40double tclTotalCodeBytes = 0.0;
     41
     42double tclTotalInstBytes = 0.0;
     43double tclTotalObjBytes = 0.0;
     44double tclTotalExceptBytes = 0.0;
     45double tclTotalAuxBytes = 0.0;
     46double tclTotalCmdMapBytes = 0.0;
     47
     48double tclCurrentSourceBytes = 0.0;
     49double tclCurrentCodeBytes = 0.0;
     50
     51int tclSourceCount[32];
     52int tclByteCodeCount[32];
     53#endif /* TCL_COMPILE_STATS */
    1954
    2055/*
    … …  
    408443 *----------------------------------------------------------------------
    409444 *
     445 * TclPrintByteCodeObj --
     446 *
     447 *      This procedure prints ("disassembles") the instructions of a
     448 *      bytecode object to stdout.
     449 *
     450 * Results:
     451 *      None.
     452 *
     453 * Side effects:
     454 *      None.
     455 *
     456 *----------------------------------------------------------------------
     457 */
     458
     459void
     460TclPrintByteCodeObj(interp, objPtr)
     461    Tcl_Interp *interp;         /* Used only for Tcl_GetStringFromObj. */
     462    Tcl_Obj *objPtr;            /* The bytecode object to disassemble. */
     463{
     464    ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
     465    unsigned char *codeStart, *codeLimit, *pc;
     466    unsigned char *codeDeltaNext, *codeLengthNext;
     467    unsigned char *srcDeltaNext, *srcLengthNext;
     468    int codeOffset, codeLen, srcOffset, srcLen;
     469    int numCmds, numObjs, delta, objBytes, i;
     470
     471    if (codePtr->refCount <= 0) {
     472        return;                 /* already freed */
     473    }
     474
     475    codeStart = codePtr->codeStart;
     476    codeLimit = (codeStart + codePtr->numCodeBytes);
     477    numCmds = codePtr->numCommands;
     478    numObjs = codePtr->numObjects;
     479
     480    objBytes = (numObjs * sizeof(Tcl_Obj));
     481    for (i = 0;  i < numObjs;  i++) {
     482        Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
     483        if (litObjPtr->bytes != NULL) {
     484            objBytes += litObjPtr->length;
     485        }
     486    }
     487
     488    /*
     489     * Print header lines describing the ByteCode.
     490     */
     491
     492    fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
     493            (unsigned int) codePtr, codePtr->refCount,
     494            codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
     495            codePtr->iPtr->compileEpoch);
     496    fprintf(stdout, "  Source ");
     497    TclPrintSource(stdout, codePtr->source,
     498            TclMin(codePtr->numSrcChars, 70));
     499    fprintf(stdout, "\n  Cmds %d, chars %d, inst %d, objs %u, aux %d, stk depth %u, code/src %.2f\n",
     500            numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
     501            codePtr->numAuxDataItems, codePtr->maxStackDepth,
     502            (codePtr->numSrcChars?
     503                    ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
     504    fprintf(stdout, "  Code %zu = %u(header)+%d(inst)+%d(objs)+%u(exc)+%u(aux)+%d(cmd map)\n",
     505            codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
     506            objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
     507            (codePtr->numAuxDataItems * sizeof(AuxData)),
     508            codePtr->numCmdLocBytes);
     509
     510    /*
     511     * If the ByteCode is the compiled body of a Tcl procedure, print
     512     * information about that procedure. Note that we don't know the
     513     * procedure's name since ByteCode's can be shared among procedures.
     514     */
     515   
     516    if (codePtr->procPtr != NULL) {
     517        Proc *procPtr = codePtr->procPtr;
     518        int numCompiledLocals = procPtr->numCompiledLocals;
     519        fprintf(stdout,
     520                "  Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
     521                (unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
     522                numCompiledLocals);
     523        if (numCompiledLocals > 0) {
     524            CompiledLocal *localPtr = procPtr->firstLocalPtr;
     525            for (i = 0;  i < numCompiledLocals;  i++) {
     526                fprintf(stdout, "      %d: slot %d%s%s%s%s%s%s",
     527                        i, localPtr->frameIndex,
     528                        ((localPtr->flags & VAR_SCALAR)?  ", scalar"  : ""),
     529                        ((localPtr->flags & VAR_ARRAY)?  ", array"  : ""),
     530                        ((localPtr->flags & VAR_LINK)?  ", link"  : ""),
     531                        ((localPtr->flags & VAR_ARGUMENT)?  ", arg"  : ""),
     532                        ((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
     533                        ((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
     534                if (TclIsVarTemporary(localPtr)) {
     535                    fprintf(stdout,     "\n");
     536                } else {
     537                    fprintf(stdout,     ", name=\"%s\"\n", localPtr->name);
     538                }
     539                localPtr = localPtr->nextPtr;
     540            }
     541        }
     542    }
     543
     544    /*
     545     * Print the ExceptionRange array.
     546     */
     547
     548    if (codePtr->numExcRanges > 0) {
     549        fprintf(stdout, "  Exception ranges %d, depth %d:\n",
     550                codePtr->numExcRanges, codePtr->maxExcRangeDepth);
     551        for (i = 0;  i < codePtr->numExcRanges;  i++) {
     552            ExceptionRange *rangePtr = &(codePtr->excRangeArrayPtr[i]);
     553            fprintf(stdout, "      %d: level %d, %s, pc %d-%d, ",
     554                    i, rangePtr->nestingLevel,
     555                    ((rangePtr->type == LOOP_EXCEPTION_RANGE)? "loop":"catch"),
     556                    rangePtr->codeOffset,
     557                    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
     558            switch (rangePtr->type) {
     559            case LOOP_EXCEPTION_RANGE:
     560                fprintf(stdout, "continue %d, break %d\n",
     561                        rangePtr->continueOffset, rangePtr->breakOffset);
     562                break;
     563            case CATCH_EXCEPTION_RANGE:
     564                fprintf(stdout, "catch %d\n", rangePtr->catchOffset);
     565                break;
     566            default:
     567                panic("TclPrintSource: unrecognized ExceptionRange type %d\n",
     568                        rangePtr->type);
     569            }
     570        }
     571    }
     572   
     573    /*
     574     * If there were no commands (e.g., an expression or an empty string
     575     * was compiled), just print all instructions and return.
     576     */
     577
     578    if (numCmds == 0) {
     579        pc = codeStart;
     580        while (pc < codeLimit) {
     581            fprintf(stdout, "    ");
     582            pc += TclPrintInstruction(codePtr, pc);
     583        }
     584        return;
     585    }
     586   
     587    /*
     588     * Print table showing the code offset, source offset, and source
     589     * length for each command. These are encoded as a sequence of bytes.
     590     */
     591
     592    fprintf(stdout, "  Commands %d:", numCmds);
     593    codeDeltaNext = codePtr->codeDeltaStart;
     594    codeLengthNext = codePtr->codeLengthStart;
     595    srcDeltaNext  = codePtr->srcDeltaStart;
     596    srcLengthNext = codePtr->srcLengthStart;
     597    codeOffset = srcOffset = 0;
     598    for (i = 0;  i < numCmds;  i++) {
     599        if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
     600            codeDeltaNext++;
     601            delta = TclGetInt4AtPtr(codeDeltaNext);
     602            codeDeltaNext += 4;
     603        } else {
     604            delta = TclGetInt1AtPtr(codeDeltaNext);
     605            codeDeltaNext++;
     606        }
     607        codeOffset += delta;
     608
     609        if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
     610            codeLengthNext++;
     611            codeLen = TclGetInt4AtPtr(codeLengthNext);
     612            codeLengthNext += 4;
     613        } else {
     614            codeLen = TclGetInt1AtPtr(codeLengthNext);
     615            codeLengthNext++;
     616        }
     617       
     618        if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
     619            srcDeltaNext++;
     620            delta = TclGetInt4AtPtr(srcDeltaNext);
     621            srcDeltaNext += 4;
     622        } else {
     623            delta = TclGetInt1AtPtr(srcDeltaNext);
     624            srcDeltaNext++;
     625        }
     626        srcOffset += delta;
     627
     628        if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
     629            srcLengthNext++;
     630            srcLen = TclGetInt4AtPtr(srcLengthNext);
     631            srcLengthNext += 4;
     632        } else {
     633            srcLen = TclGetInt1AtPtr(srcLengthNext);
     634            srcLengthNext++;
     635        }
     636       
     637        fprintf(stdout, "%s%4d: pc %d-%d, source %d-%d",
     638                ((i % 2)? "     " : "\n   "),
     639                (i+1), codeOffset, (codeOffset + codeLen - 1),
     640                srcOffset, (srcOffset + srcLen - 1));
     641    }
     642    if ((numCmds > 0) && ((numCmds % 2) != 0)) {
     643        fprintf(stdout, "\n");
     644    }
     645   
     646    /*
     647     * Print each instruction. If the instruction corresponds to the start
     648     * of a command, print the command's source. Note that we don't need
     649     * the code length here.
     650     */
     651
     652    codeDeltaNext = codePtr->codeDeltaStart;
     653    srcDeltaNext  = codePtr->srcDeltaStart;
     654    srcLengthNext = codePtr->srcLengthStart;
     655    codeOffset = srcOffset = 0;
     656    pc = codeStart;
     657    for (i = 0;  i < numCmds;  i++) {
     658        if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
     659            codeDeltaNext++;
     660            delta = TclGetInt4AtPtr(codeDeltaNext);
     661            codeDeltaNext += 4;
     662        } else {
     663            delta = TclGetInt1AtPtr(codeDeltaNext);
     664            codeDeltaNext++;
     665        }
     666        codeOffset += delta;
     667
     668        if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
     669            srcDeltaNext++;
     670            delta = TclGetInt4AtPtr(srcDeltaNext);
     671            srcDeltaNext += 4;
     672        } else {
     673            delta = TclGetInt1AtPtr(srcDeltaNext);
     674            srcDeltaNext++;
     675        }
     676        srcOffset += delta;
     677
     678        if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
     679            srcLengthNext++;
     680            srcLen = TclGetInt4AtPtr(srcLengthNext);
     681            srcLengthNext += 4;
     682        } else {
     683            srcLen = TclGetInt1AtPtr(srcLengthNext);
     684            srcLengthNext++;
     685        }
     686
     687        /*
     688         * Print instructions before command i.
     689         */
     690       
     691        while ((pc-codeStart) < codeOffset) {
     692            fprintf(stdout, "    ");
     693            pc += TclPrintInstruction(codePtr, pc);
     694        }
     695
     696        fprintf(stdout, "  Command %d: ", (i+1));
     697        TclPrintSource(stdout, (codePtr->source + srcOffset),
     698                TclMin(srcLen, 70));
     699        fprintf(stdout, "\n");
     700    }
     701    if (pc < codeLimit) {
     702        /*
     703         * Print instructions after the last command.
     704         */
     705
     706        while (pc < codeLimit) {
     707            fprintf(stdout, "    ");
     708            pc += TclPrintInstruction(codePtr, pc);
     709        }
     710    }
     711}
     712
     713
     714/*
     715 *----------------------------------------------------------------------
     716 *
     717 * TclPrintInstruction --
     718 *
     719 *      This procedure prints ("disassembles") one instruction from a
     720 *      bytecode object to stdout.
     721 *
     722 * Results:
     723 *      Returns the length in bytes of the current instruiction.
     724 *
     725 * Side effects:
     726 *      None.
     727 *
     728 *----------------------------------------------------------------------
     729 */
     730
     731int
     732TclPrintInstruction(codePtr, pc)
     733    ByteCode* codePtr;          /* Bytecode containing the instruction. */
     734    unsigned char *pc;          /* Points to first byte of instruction. */
     735{
     736    Proc *procPtr = codePtr->procPtr;
     737    unsigned char opCode = *pc;
     738    register InstructionDesc *instDesc = &instructionTable[opCode];
     739    unsigned char *codeStart = codePtr->codeStart;
     740    unsigned int pcOffset = (pc - codeStart);
     741    int opnd, elemLen, i, j;
     742    Tcl_Obj *elemPtr;
     743    char *string;
     744   
     745    fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
     746    for (i = 0;  i < instDesc->numOperands;  i++) {
     747        switch (instDesc->opTypes[i]) {
     748        case OPERAND_INT1:
     749            opnd = TclGetInt1AtPtr(pc+1+i);
     750            if ((i == 0) && ((opCode == INST_JUMP1)
     751                             || (opCode == INST_JUMP_TRUE1)
     752                             || (opCode == INST_JUMP_FALSE1))) {
     753                fprintf(stdout, "%d     # pc %u", opnd, (pcOffset + opnd));
     754            } else {
     755                fprintf(stdout, "%d", opnd);
     756            }
     757            break;
     758        case OPERAND_INT4:
     759            opnd = TclGetInt4AtPtr(pc+1+i);
     760            if ((i == 0) && ((opCode == INST_JUMP4)
     761                             || (opCode == INST_JUMP_TRUE4)
     762                             || (opCode == INST_JUMP_FALSE4))) {
     763                fprintf(stdout, "%d     # pc %u", opnd, (pcOffset + opnd));
     764            } else {
     765                fprintf(stdout, "%d", opnd);
     766            }
     767            break;
     768        case OPERAND_UINT1:
     769            opnd = TclGetUInt1AtPtr(pc+1+i);
     770            if ((i == 0) && (opCode == INST_PUSH1)) {
     771                elemPtr = codePtr->objArrayPtr[opnd];
     772                string = Tcl_GetStringFromObj(elemPtr, &elemLen);
     773                fprintf(stdout, "%u     # ", (unsigned int) opnd);
     774                TclPrintSource(stdout, string, TclMin(elemLen, 40));
     775            } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
     776                                    || (opCode == INST_LOAD_ARRAY1)
     777                                    || (opCode == INST_STORE_SCALAR1)
     778                                    || (opCode == INST_STORE_ARRAY1))) {
     779                int localCt = procPtr->numCompiledLocals;
     780                CompiledLocal *localPtr = procPtr->firstLocalPtr;
     781                if (opnd >= localCt) {
     782                    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
     783                             (unsigned int) opnd, localCt);
     784                    return instDesc->numBytes;
     785                }
     786                for (j = 0;  j < opnd;  j++) {
     787                    localPtr = localPtr->nextPtr;
     788                }
     789                if (TclIsVarTemporary(localPtr)) {
     790                    fprintf(stdout, "%u # temp var %u",
     791                            (unsigned int) opnd, (unsigned int) opnd);
     792                } else {
     793                    fprintf(stdout, "%u # var ", (unsigned int) opnd);
     794                    TclPrintSource(stdout, localPtr->name, 40);
     795                }
     796            } else {
     797                fprintf(stdout, "%u ", (unsigned int) opnd);
     798            }
     799            break;
     800        case OPERAND_UINT4:
     801            opnd = TclGetUInt4AtPtr(pc+1+i);
     802            if (opCode == INST_PUSH4) {
     803                elemPtr = codePtr->objArrayPtr[opnd];
     804                string = Tcl_GetStringFromObj(elemPtr, &elemLen);
     805                fprintf(stdout, "%u     # ", opnd);
     806                TclPrintSource(stdout, string, TclMin(elemLen, 40));
     807            } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
     808                                    || (opCode == INST_LOAD_ARRAY4)
     809                                    || (opCode == INST_STORE_SCALAR4)
     810                                    || (opCode == INST_STORE_ARRAY4))) {
     811                int localCt = procPtr->numCompiledLocals;
     812                CompiledLocal *localPtr = procPtr->firstLocalPtr;
     813                if (opnd >= localCt) {
     814                    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
     815                             (unsigned int) opnd, localCt);
     816                    return instDesc->numBytes;
     817                }
     818                for (j = 0;  j < opnd;  j++) {
     819                    localPtr = localPtr->nextPtr;
     820                }
     821                if (TclIsVarTemporary(localPtr)) {
     822                    fprintf(stdout, "%u # temp var %u",
     823                            (unsigned int) opnd, (unsigned int) opnd);
     824                } else {
     825                    fprintf(stdout, "%u # var ", (unsigned int) opnd);
     826                    TclPrintSource(stdout, localPtr->name, 40);
     827                }
     828            } else {
     829                fprintf(stdout, "%u ", (unsigned int) opnd);
     830            }
     831            break;
     832        case OPERAND_NONE:
     833        default:
     834            break;
     835        }
     836    }
     837    fprintf(stdout, "\n");
     838    return instDesc->numBytes;
     839}
     840
     841
     842/*
     843 *----------------------------------------------------------------------
     844 *
    410845 * TclPrintSource --
    411846 *
    … …  
    537972    register int i;
    538973
     974#ifdef TCL_COMPILE_STATS   
     975    tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
     976    tclCurrentCodeBytes -= (double) codePtr->totalSize;
     977#endif /* TCL_COMPILE_STATS */
     978
    539979    /*
    540980     * A single heap object holds the ByteCode structure and its code,
    … …  
    6271067    int length, result;
    6281068
     1069    if (!traceInitialized) {
     1070        if (Tcl_LinkVar(interp, "tcl_traceCompile",
     1071                    (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
     1072            panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
     1073        }
     1074        traceInitialized = 1;
     1075    }
     1076   
    6291077    string = Tcl_GetStringFromObj(objPtr, &length);
    6301078    TclInitCompileEnv(interp, &compEnv, string);
    … …  
    6651113    TclFreeCompileEnv(&compEnv);
    6661114
     1115    if (result == TCL_OK) {
     1116        if (tclTraceCompile == 2) {
     1117            TclPrintByteCodeObj(interp, objPtr);
     1118        }
     1119    }
    6671120    return result;
    6681121}
    … …  
    8581311    int numObjects, i;
    8591312    Namespace *namespacePtr;
     1313#ifdef TCL_COMPILE_STATS
     1314    int srcLenLog2, sizeLog2;
     1315#endif /*TCL_COMPILE_STATS*/
    8601316
    8611317    codeBytes = (envPtr->codeNext - envPtr->codeStart);
    … …  
    8861342    }
    8871343    totalSize = (size + objBytes);
     1344
     1345#ifdef TCL_COMPILE_STATS
     1346    tclNumCompilations++;
     1347    tclTotalSourceBytes += (double) srcLen;
     1348    tclTotalCodeBytes += (double) totalSize;
     1349   
     1350    tclTotalInstBytes += (double) codeBytes;
     1351    tclTotalObjBytes += (double) objBytes;
     1352    tclTotalExceptBytes += exceptArrayBytes;
     1353    tclTotalAuxBytes += (double) auxDataArrayBytes;
     1354    tclTotalCmdMapBytes += (double) cmdLocBytes;
     1355
     1356    tclCurrentSourceBytes += (double) srcLen;
     1357    tclCurrentCodeBytes += (double) totalSize;
     1358
     1359    srcLenLog2 = TclLog2(srcLen);
     1360    sizeLog2 = TclLog2((int) totalSize);
     1361    if ((srcLenLog2 > 31) || (sizeLog2 > 31)) {
     1362        panic("TclInitByteCodeObj: bad source or code sizes\n");
     1363    }
     1364    tclSourceCount[srcLenLog2]++;
     1365    tclByteCodeCount[sizeLog2]++;
     1366#endif /* TCL_COMPILE_STATS */   
    8881367
    8891368    if (envPtr->iPtr->varFramePtr != NULL) {
    … …  
    13411820                cmdCodeOffset);
    13421821           
     1822        if ((!(flags & TCL_BRACKET_TERM))
     1823                && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
     1824            /*
     1825             * Display a line summarizing the top level command we are about
     1826             * to compile.
     1827             */
     1828           
     1829            char *p = cmdSrcStart;
     1830            int numChars, complete;
     1831           
     1832            while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
     1833                   || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
     1834                p++;
     1835            }
     1836            numChars = (p - cmdSrcStart);
     1837            complete = 1;
     1838            if (numChars > 60) {
     1839                numChars = 60;
     1840                complete = 0;
     1841            } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
     1842                complete = 0;
     1843            }
     1844            fprintf(stdout, "Compiling: %.*s%s\n",
     1845                    numChars, cmdSrcStart, (complete? "" : " ..."));
     1846        }
     1847       
    13431848        while ((type != TCL_COMMAND_END)
    13441849                || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {
Note: See TracChangeset for help on using the changeset viewer.