Fork me on GitHub

Changeset adeddd8 in git for external/tcl/tclCompile.c


Ignore:
Timestamp:
May 29, 2019, 2:53:12 PM (5 years ago)
Author:
Pavel Demin <pavel-demin@…>
Branches:
ImprovedOutputFile, Timing, master
Children:
969eb19
Parents:
e15936c
Message:

remove debug code from Tcl

File:
1 edited

Legend:

Unmodified
Added
Removed

  • external/tcl/tclCompile.c

    re15936c radeddd8  
    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 
    29 int tclTraceCompile = 0;
    30 static 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
    38 long tclNumCompilations = 0;
    39 double tclTotalSourceBytes = 0.0;
    40 double tclTotalCodeBytes = 0.0;
    41 
    42 double tclTotalInstBytes = 0.0;
    43 double tclTotalObjBytes = 0.0;
    44 double tclTotalExceptBytes = 0.0;
    45 double tclTotalAuxBytes = 0.0;
    46 double tclTotalCmdMapBytes = 0.0;
    47 
    48 double tclCurrentSourceBytes = 0.0;
    49 double tclCurrentCodeBytes = 0.0;
    50 
    51 int tclSourceCount[32];
    52 int tclByteCodeCount[32];
    53 #endif /* TCL_COMPILE_STATS */
    5419
    5520/*
    … …  
    443408 *----------------------------------------------------------------------
    444409 *
    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 
    459 void
    460 TclPrintByteCodeObj(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 
    731 int
    732 TclPrintInstruction(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  *
    845410 * TclPrintSource --
    846411 *
    … …  
    972537    register int i;
    973538
    974 #ifdef TCL_COMPILE_STATS   
    975     tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
    976     tclCurrentCodeBytes -= (double) codePtr->totalSize;
    977 #endif /* TCL_COMPILE_STATS */
    978 
    979539    /*
    980540     * A single heap object holds the ByteCode structure and its code,
    … …  
    1067627    int length, result;
    1068628
    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    
    1077629    string = Tcl_GetStringFromObj(objPtr, &length);
    1078630    TclInitCompileEnv(interp, &compEnv, string);
    … …  
    1113665    TclFreeCompileEnv(&compEnv);
    1114666
    1115     if (result == TCL_OK) {
    1116         if (tclTraceCompile == 2) {
    1117             TclPrintByteCodeObj(interp, objPtr);
    1118         }
    1119     }
    1120667    return result;
    1121668}
    … …  
    1311858    int numObjects, i;
    1312859    Namespace *namespacePtr;
    1313 #ifdef TCL_COMPILE_STATS
    1314     int srcLenLog2, sizeLog2;
    1315 #endif /*TCL_COMPILE_STATS*/
    1316860
    1317861    codeBytes = (envPtr->codeNext - envPtr->codeStart);
    … …  
    1342886    }
    1343887    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 */   
    1367888
    1368889    if (envPtr->iPtr->varFramePtr != NULL) {
    … …  
    18201341                cmdCodeOffset);
    18211342           
    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        
    18481343        while ((type != TCL_COMMAND_END)
    18491344                || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {
Note: See TracChangeset for help on using the changeset viewer.