Changes in external/tcl/tclCompile.c [d7d2da3:adeddd8] in git
- File:
-
- 1 edited
-
external/tcl/tclCompile.c (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
external/tcl/tclCompile.c
rd7d2da3 radeddd8 17 17 #include "tclInt.h" 18 18 #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 tracing24 * 1: summarize compilation of top level cmds and proc bodies25 * 2: display all instructions of each ByteCode compiled26 * 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_STATS38 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 */54 19 55 20 /* … … 443 408 *---------------------------------------------------------------------- 444 409 * 445 * TclPrintByteCodeObj --446 *447 * This procedure prints ("disassembles") the instructions of a448 * bytecode object to stdout.449 *450 * Results:451 * None.452 *453 * Side effects:454 * None.455 *456 *----------------------------------------------------------------------457 */458 459 void460 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, print512 * information about that procedure. Note that we don't know the513 * 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 string575 * 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 source589 * 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 start648 * of a command, print the command's source. Note that we don't need649 * 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 a720 * 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 int732 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 *845 410 * TclPrintSource -- 846 411 * … … 972 537 register int i; 973 538 974 #ifdef TCL_COMPILE_STATS975 tclCurrentSourceBytes -= (double) codePtr->numSrcChars;976 tclCurrentCodeBytes -= (double) codePtr->totalSize;977 #endif /* TCL_COMPILE_STATS */978 979 539 /* 980 540 * A single heap object holds the ByteCode structure and its code, … … 1067 627 int length, result; 1068 628 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 1077 629 string = Tcl_GetStringFromObj(objPtr, &length); 1078 630 TclInitCompileEnv(interp, &compEnv, string); … … 1113 665 TclFreeCompileEnv(&compEnv); 1114 666 1115 if (result == TCL_OK) {1116 if (tclTraceCompile == 2) {1117 TclPrintByteCodeObj(interp, objPtr);1118 }1119 }1120 667 return result; 1121 668 } … … 1311 858 int numObjects, i; 1312 859 Namespace *namespacePtr; 1313 #ifdef TCL_COMPILE_STATS1314 int srcLenLog2, sizeLog2;1315 #endif /*TCL_COMPILE_STATS*/1316 860 1317 861 codeBytes = (envPtr->codeNext - envPtr->codeStart); … … 1342 886 } 1343 887 totalSize = (size + objBytes); 1344 1345 #ifdef TCL_COMPILE_STATS1346 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 */1367 888 1368 889 if (envPtr->iPtr->varFramePtr != NULL) { … … 1820 1341 cmdCodeOffset); 1821 1342 1822 if ((!(flags & TCL_BRACKET_TERM))1823 && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {1824 /*1825 * Display a line summarizing the top level command we are about1826 * 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 1848 1343 while ((type != TCL_COMMAND_END) 1849 1344 || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {
Note:
See TracChangeset
for help on using the changeset viewer.
