Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Comment: | Merge to feature branch |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | dkf-notifier-poll |
Files: | files | file ages | folders |
SHA1: |
5f90ef1bc286b574fe62ebe18708ccae |
User & Date: | dkf 2011-08-08 21:14:17 |
2011-08-16
| ||
14:03 | Merge to feature branch check-in: 7db2c10d31 user: dkf tags: dkf-notifier-poll | |
2011-08-08
| ||
21:14 | Merge to feature branch check-in: 5f90ef1bc2 user: dkf tags: dkf-notifier-poll | |
18:32 | merge release to trunk check-in: 99580352a4 user: dgp tags: trunk | |
2011-08-02
| ||
09:12 | Merge to feature branch check-in: 8a0bf2664b user: dkf tags: dkf-notifier-poll | |
Changes to ChangeLog.
1 2 3 4 5 6 7 | 2011-08-02 Donal K. Fellows <[email protected]> * generic/tclObj.c (Tcl_DbIncrRefCount, Tcl_DbDecrRefCount) (Tcl_DbIsShared): [Bug 3384007]: Fix the panic messages so they share what should be shared and have the right number of spaces. 2011-08-01 Miguel Sofer <[email protected]> | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | 2011-08-07 Donal K. Fellows <[email protected]> * generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory leak in call chain introspection. 2011-08-06 Kevin B, Kenny <[email protected]> * generic/tclAssemnbly.c: [Bug 3384840]: Plug another memory leak. * generic/tclStrToD.c: [Bug 3386975]: Plug another memory leak. 2011-08-05 Kevin B. Kenny <[email protected]> * generic/tclStrToD.c: [Bug 3386975]: Plugged a memory leak in double->string conversion. 2011-08-05 Don Porter <[email protected]> *** 8.6b2 TAGGED FOR RELEASE *** * changes: Updates for 8.6b2 release. 2011-08-05 Donal K. Fellows <[email protected]> * generic/tclAssembly.c (AssembleOneLine): Ensure that memory isn't leaked when an unknown instruction is encountered. Also simplify code through use of Tcl_ObjPrintf in error message generation. * generic/tclZlib.c (ZlibTransformClose): [Bug 3386197]: Plug a memory leak found by Miguel with valgrind, and ensure that the correct direction's buffers are released. 2011-08-04 Miguel Sofer <[email protected]> * generic/tclVar.c (TclPtrSetVar): Fix valgrind-detected error when newValuePtr is the interp's result obj. 2011-08-04 Donal K. Fellows <[email protected]> * generic/tclAssembly.c (FreeAssemblyEnv): [Bug 3384840]: Plug another possible memory leak due to over-complex code for freeing the table of labels. 2011-08-04 Reinhard Max <[email protected]> * generic/tclIOSock.c (TclCreateSocketAddress): Don't bother using AI_ADDRCONFIG for now, as it was causing problems in various situations. 2011-08-04 Donal K. Fellows <[email protected]> * generic/tclAssembly.c (AssembleOneLine, GetBooleanOperand) (GetIntegerOperand, GetListIndexOperand, FindLocalVar): [Bug 3384840]: A Tcl_Obj is allocated by GetNextOperand, so callers of it must not hold a reference to one in the 'out' parameter when calling it. This was causing a great many memory leaks. * tests/assemble.test (assemble-51.*): Added group of memory leak tests. 2011-08-02 Don Porter <[email protected]> * changes: Updates for 8.6b2 release. * tools/tcltk-man2html.tcl: Variable substitution botch. 2011-08-02 Donal K. Fellows <[email protected]> * generic/tclObj.c (Tcl_DbIncrRefCount, Tcl_DbDecrRefCount) (Tcl_DbIsShared): [Bug 3384007]: Fix the panic messages so they share what should be shared and have the right number of spaces. 2011-08-01 Miguel Sofer <[email protected]> |
︙ | ︙ | |||
82 83 84 85 86 87 88 89 90 91 92 93 94 95 | * tools/tcltk-man2html-utils.tcl (output-IP-list, cross-reference): Update to generation to produce proper HTML bulleted and enumerated lists. 2011-07-19 Alexandre Ferrieux <[email protected]> * doc/upvar.n: Undocument long gone limitation of [upvar]. 2011-07-15 Don Porter <[email protected]> * generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats() is called in a deleted interp. * generic/tclCompile.c: [Bug 467523, 3357771]: Prevent circular | > > > > > > > > > > > > > | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 | * tools/tcltk-man2html-utils.tcl (output-IP-list, cross-reference): Update to generation to produce proper HTML bulleted and enumerated lists. 2011-07-19 Alexandre Ferrieux <[email protected]> * doc/upvar.n: Undocument long gone limitation of [upvar]. 2011-07-18 Don Porter <[email protected]> * generic/tcl.h: Bump version number to 8.6b2. * library/init.tcl: * unix/configure.in: * win/configure.in: * unix/tcl.spec: * tools/tcl.wse.in: * README: * unix/configure: autoconf-2.59 * win/configure: 2011-07-15 Don Porter <[email protected]> * generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats() is called in a deleted interp. * generic/tclCompile.c: [Bug 467523, 3357771]: Prevent circular |
︙ | ︙ | |||
113 114 115 116 117 118 119 | 2011-07-08 Donal K. Fellows <[email protected]> * doc/http.n: [FRQ 3358415]: State what RFC defines HTTP/1.1. 2011-07-07 Miguel Sofer <[email protected]> | | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | 2011-07-08 Donal K. Fellows <[email protected]> * doc/http.n: [FRQ 3358415]: State what RFC defines HTTP/1.1. 2011-07-07 Miguel Sofer <[email protected]> * generic/tclBasic.c: Add missing INT2PTR 2011-07-03 Donal K. Fellows <[email protected]> * doc/FileSystem.3: Corrected statements about ctime field of 'struct stat'; that was always the time of the last metadata change, not the time of creation. |
︙ | ︙ |
Changes to README.
1 | README: Tcl | | | 1 2 3 4 5 6 7 8 9 | README: Tcl This is the Tcl 8.6b2 source distribution. http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. Contents -------- 1. Introduction |
︙ | ︙ |
Changes to changes.
︙ | ︙ | |||
7528 7529 7530 7531 7532 7533 7534 | 2009-04-30 (bug fix)[2486550] coroutine in [interp invokehidden] (sofer) 2009-05-07 (bug fix)[2785893] find command in deleted namespace (sofer) 2009-05-08 (bug fix)[2414858] tailcall in oo constructor (fellows) | | | 7528 7529 7530 7531 7532 7533 7534 7535 7536 7537 7538 7539 7540 7541 7542 | 2009-04-30 (bug fix)[2486550] coroutine in [interp invokehidden] (sofer) 2009-05-07 (bug fix)[2785893] find command in deleted namespace (sofer) 2009-05-08 (bug fix)[2414858] tailcall in oo constructor (fellows) 2009-05-14 (new subcommand)[TIP 354] [info object namespace] (fellows) 2009-05-29 (platform support) account for ia64_32 (kupries) => platform 1.0.5 2009-06-02 (bug fix)[2798543] incorrect [expr] integer ** results (porter) 2009-06-10 (bug fix)[2801413] overflow in [format] (porter) |
︙ | ︙ | |||
7559 7560 7561 7562 7563 7564 7565 | 2009-07-13 (bug fix)[1605269] NR-related [info frame] fixes (kupries) 2009-07-14 (bug fix)[2821401] NR-enable direct eval [switch] (kenny) 2009-07-16 (bug fix)[2819200] underflow settings on MIPS systems (porter) | | | 7559 7560 7561 7562 7563 7564 7565 7566 7567 7568 7569 7570 7571 7572 7573 | 2009-07-13 (bug fix)[1605269] NR-related [info frame] fixes (kupries) 2009-07-14 (bug fix)[2821401] NR-enable direct eval [switch] (kenny) 2009-07-16 (bug fix)[2819200] underflow settings on MIPS systems (porter) 2009-07-19 (interface)[TIP 354] new routine Tcl_GetObjectName() (fellows) 2009-07-20 (performance) favor [string is] success cases over empty (fellows) 2009-07-22 (interface) removed TclpPanic() routine (nijtmans) 2009-07-23 (bug fix)[2820349] plug event leak in notifier (mistachkin) |
︙ | ︙ | |||
7945 7946 7947 7948 7949 7950 7951 7952 7953 | 2011-06-22 (new feature) DEB_HOST_MULTIARCH support (kupries) => platform 1.0.10 2011-07-15 (bug fix)[3357771] Prevent circular refs in bytecode (porter) 2011-07-28 tzdata updated to Olson's tzdata2011h (porter) Many more Tcl built-in command errors now set an -errorcode. | > > | | 7945 7946 7947 7948 7949 7950 7951 7952 7953 7954 7955 7956 | 2011-06-22 (new feature) DEB_HOST_MULTIARCH support (kupries) => platform 1.0.10 2011-07-15 (bug fix)[3357771] Prevent circular refs in bytecode (porter) 2011-07-28 tzdata updated to Olson's tzdata2011h (porter) 2011-08-01 (bug fix)[3383616] memleak exposed by XOTcl (neumann,sofer) Many more Tcl built-in command errors now set an -errorcode. --- Released 8.6b2, August 8, 2011 --- See ChangeLog for details --- |
Changes to generic/tcl.h.
︙ | ︙ | |||
54 55 56 57 58 59 60 | * tools/tcl.wse.in (for windows installer) * tools/tclSplash.bmp (not patchlevel) */ #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_BETA_RELEASE | | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | * tools/tcl.wse.in (for windows installer) * tools/tclSplash.bmp (not patchlevel) */ #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_BETA_RELEASE #define TCL_RELEASE_SERIAL 2 #define TCL_VERSION "8.6" #define TCL_PATCH_LEVEL "8.6b2" /* *---------------------------------------------------------------------------- * The following definitions set up the proper options for Windows compilers. * We use this method because there is no autoconf equivalent. */ |
︙ | ︙ |
Changes to generic/tclAssembly.c.
1 | /* | | | 1 2 3 4 5 6 7 8 9 | /* * tclAssembly.c -- * * Assembler for Tcl bytecodes. * * This file contains the procedures that convert Tcl Assembly Language (TAL) * to a sequence of bytecode instructions for the Tcl execution engine. * * Copyright (c) 2010 by Ozgur Dogan Ugurlu. |
︙ | ︙ | |||
80 81 82 83 84 85 86 | /* BasicBlock structure of the following * block: NULL at the end of the bytecode * sequence. */ Tcl_Obj* jumpTarget; /* Jump target label if the jump target is * unresolved */ int initialStackDepth; /* Absolute stack depth on entry */ int minStackDepth; /* Low-water relative stack depth */ | | | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | /* BasicBlock structure of the following * block: NULL at the end of the bytecode * sequence. */ Tcl_Obj* jumpTarget; /* Jump target label if the jump target is * unresolved */ int initialStackDepth; /* Absolute stack depth on entry */ int minStackDepth; /* Low-water relative stack depth */ int maxStackDepth; /* High-water relative stack depth */ int finalStackDepth; /* Relative stack depth on exit */ enum BasicBlockCatchState catchState; /* State of the block for 'catch' analysis */ int catchDepth; /* Number of nested catches in which the basic * block appears */ struct BasicBlock* enclosingCatch; /* BasicBlock structure of the last startCatch |
︙ | ︙ | |||
189 190 191 192 193 194 195 | /* * Description of an instruction recognized by the assembler. */ typedef struct TalInstDesc { const char *name; /* Name of instruction. */ | | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | /* * Description of an instruction recognized by the assembler. */ typedef struct TalInstDesc { const char *name; /* Name of instruction. */ TalInstType instType; /* The type of instruction */ int tclInstCode; /* Instruction code. For instructions having * 1- and 4-byte variables, tclInstCode is * ((1byte)<<8) || (4byte) */ int operandsConsumed; /* Number of operands consumed by the * operation, or INT_MIN if the operation is * variadic */ int operandsProduced; /* Number of operands produced by the |
︙ | ︙ | |||
779 780 781 782 783 784 785 | return TCL_ERROR; } /* * Use NRE to evaluate the bytecode from the trampoline. */ | < < < < < | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 | return TCL_ERROR; } /* * Use NRE to evaluate the bytecode from the trampoline. */ return TclNRExecuteByteCode(interp, codePtr); } /* *----------------------------------------------------------------------------- * * CompileAssembleObj -- |
︙ | ︙ | |||
813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 | Tcl_Obj *objPtr) /* Source code to assemble */ { Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ register ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ Namespace* namespacePtr; /* Namespace in which variable and command * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ int sourceLen; /* Length of the source code in bytes */ /* * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ if (objPtr->typePtr == &assembleCodeType) { namespacePtr = iPtr->varFramePtr->nsPtr; codePtr = objPtr->internalRep.otherValuePtr; | > > > > > > | | | | | | < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 | Tcl_Obj *objPtr) /* Source code to assemble */ { Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ register ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ register const AuxData * auxDataPtr; /* Pointer to an auxiliary data element * in a compilation environment being * destroyed. */ Namespace* namespacePtr; /* Namespace in which variable and command * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ int sourceLen; /* Length of the source code in bytes */ int i; /* * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ if (objPtr->typePtr == &assembleCodeType) { namespacePtr = iPtr->varFramePtr->nsPtr; codePtr = objPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle == iPtr) && (codePtr->compileEpoch == iPtr->compileEpoch) && (codePtr->nsPtr == namespacePtr) && (codePtr->nsEpoch == namespacePtr->resolverEpoch) && (codePtr->localCachePtr == iPtr->varFramePtr->localCachePtr)) { return codePtr; } /* * Not valid, so free it and regenerate. */ FreeAssembleCodeInternalRep(objPtr); } /* * Set up the compilation environment, and assemble the code. */ source = TclGetStringFromObj(objPtr, &sourceLen); TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0); status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT); if (status != TCL_OK) { /* * Assembly failed. Clean up and report the error. */ /* * Free any literals that were constructed for the assembly. */ for (i = 0; i < compEnv.literalArrayNext; i++) { TclReleaseLiteral(interp, compEnv.literalArrayPtr[i].objPtr); } /* * Free any auxiliary data that was attached to the bytecode * under construction. */ for (i = 0; i < compEnv.auxDataArrayNext; i++) { auxDataPtr = compEnv.auxDataArrayPtr + i; if (auxDataPtr->type->freeProc != NULL) { (auxDataPtr->type->freeProc)(auxDataPtr->clientData); } } /* * TIP 280. If there is extended command line information, * we need to clean it up. */ if (compEnv.extCmdMapPtr != NULL) { if (compEnv.extCmdMapPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(compEnv.extCmdMapPtr->path); } for (i = 0; i < compEnv.extCmdMapPtr->nuloc; ++i) { ckfree(compEnv.extCmdMapPtr->loc[i].line); } if (compEnv.extCmdMapPtr->loc != NULL) { ckfree(compEnv.extCmdMapPtr->loc); } Tcl_DeleteHashTable(&(compEnv.extCmdMapPtr->litInfo)); } TclFreeCompileEnv(&compEnv); return NULL; } /* * Add a "done" instruction as the last instruction and change the object |
︙ | ︙ | |||
963 964 965 966 967 968 969 | * environment's stack depth. * *----------------------------------------------------------------------------- */ static int TclAssembleCode( | | | 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 | * environment's stack depth. * *----------------------------------------------------------------------------- */ static int TclAssembleCode( CompileEnv *envPtr, /* Compilation environment that is to receive * the generated bytecode */ const char* codePtr, /* Assembly-language code to be processed */ int codeLen, /* Length of the code */ int flags) /* OR'ed combination of flags */ { Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ |
︙ | ︙ | |||
1168 1169 1170 1171 1172 1173 1174 | if (thisBB->jtPtr != NULL) { DeleteMirrorJumpTable(thisBB->jtPtr); thisBB->jtPtr = NULL; } ckfree(thisBB); } | < < < < < < < < < < < < < < < > | 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 | if (thisBB->jtPtr != NULL) { DeleteMirrorJumpTable(thisBB->jtPtr); thisBB->jtPtr = NULL; } ckfree(thisBB); } /* * Dispose what's left. */ Tcl_DeleteHashTable(&assemEnvPtr->labelHash); TclStackFree(interp, assemEnvPtr->parsePtr); TclStackFree(interp, assemEnvPtr); } /* *----------------------------------------------------------------------------- * |
︙ | ︙ | |||
1218 1219 1220 1221 1222 1223 1224 | /* Compilation environment being used for code * gen */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Parse* parsePtr = assemEnvPtr->parsePtr; /* Parse of the line of code */ Tcl_Token* tokenPtr; /* Current token within the line of code */ | | < | < < | | 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 | /* Compilation environment being used for code * gen */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Parse* parsePtr = assemEnvPtr->parsePtr; /* Parse of the line of code */ Tcl_Token* tokenPtr; /* Current token within the line of code */ Tcl_Obj* instNameObj; /* Name of the instruction */ int tblIdx; /* Index in TalInstructionTable of the * instruction */ enum TalInstType instType; /* Type of the instruction */ Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ int operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ int localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ JumptableInfo* jtPtr; /* Pointer to a jumptable */ int infoIndex; /* Index of the jumptable in auxdata */ int status = TCL_ERROR; /* Return value from this function */ /* * Make sure that the instruction name is known at compile time. */ tokenPtr = parsePtr->tokenPtr; if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) { return TCL_ERROR; } /* * Look up the instruction name. */ if (Tcl_GetIndexFromObjStruct(interp, instNameObj, &TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction", TCL_EXACT, &tblIdx) != TCL_OK) { goto cleanup; } /* * Vector on the type of instruction being processed. */ instType = TalInstructionTable[tblIdx].instType; |
︙ | ︙ | |||
1322 1323 1324 1325 1326 1327 1328 | break; case ASSEM_BOOL_LVT4: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName"); goto cleanup; } | | > > | > | 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 | break; case ASSEM_BOOL_LVT4: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName"); goto cleanup; } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); TclEmitInt4(localVar, envPtr); break; case ASSEM_CONCAT1: |
︙ | ︙ | |||
1361 1362 1363 1364 1365 1366 1367 | case ASSEM_DICT_SET: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK | | > > | > | > > | > | 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 | case ASSEM_DICT_SET: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); TclEmitInt4(localVar, envPtr); break; case ASSEM_DICT_UNSET: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); TclEmitInt4(localVar, envPtr); break; case ASSEM_END_CATCH: |
︙ | ︙ | |||
1570 1571 1572 1573 1574 1575 1576 | break; case ASSEM_LVT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } | | > | | | | | > | 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 | break; case ASSEM_LVT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_LVT1: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0 || CheckOneByte(interp, localVar)) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_LVT1_SINT1: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0 || CheckOneByte(interp, localVar) || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckSignedOneByte(interp, opnd)) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); TclEmitInt1(opnd, envPtr); break; case ASSEM_LVT4: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_OVER: if (parsePtr->numWords != 2) { |
︙ | ︙ | |||
1670 1671 1672 1673 1674 1675 1676 | break; case ASSEM_SINT4_LVT4: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } | | > > | > < | < | 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 | break; case ASSEM_SINT4_LVT4: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0); TclEmitInt4(localVar, envPtr); break; default: Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n", Tcl_GetString(instNameObj)); } status = TCL_OK; cleanup: Tcl_DecrRefCount(instNameObj); if (operand1Obj) { Tcl_DecrRefCount(operand1Obj); } return status; } /* |
︙ | ︙ | |||
1869 1870 1871 1872 1873 1874 1875 | * once flow analysis has determined the actual stack depth of the block. */ DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n", curr_bb, exceptionCount, savedExceptArrayNext); curr_bb->foreignExceptionBase = savedExceptArrayNext; curr_bb->foreignExceptionCount = exceptionCount; | | | 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 | * once flow analysis has determined the actual stack depth of the block. */ DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n", curr_bb, exceptionCount, savedExceptArrayNext); curr_bb->foreignExceptionBase = savedExceptArrayNext; curr_bb->foreignExceptionCount = exceptionCount; curr_bb->foreignExceptions = ckalloc(exceptionCount * sizeof(ExceptionRange)); memcpy(curr_bb->foreignExceptions, envPtr->exceptArrayPtr + savedExceptArrayNext, exceptionCount * sizeof(ExceptionRange)); for (i = 0; i < exceptionCount; ++i) { curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth; } |
︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 | BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ JumptableInfo* jtPtr; Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */ Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */ int isNew; /* Flag==1 if the key is not yet in the * table. */ | < | 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 | BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ JumptableInfo* jtPtr; Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */ Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */ int isNew; /* Flag==1 if the key is not yet in the * table. */ int i; if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) { return TCL_ERROR; } if (objc % 2 != 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { |
︙ | ︙ | |||
1952 1953 1954 1955 1956 1957 1958 | for (i = 0; i < objc; i+=2) { DEBUG_PRINT(" %s -> %s\n", Tcl_GetString(objv[i]), Tcl_GetString(objv[i+1])); hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]), &isNew); if (!isNew) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { | | | | < < | | 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 | for (i = 0; i < objc; i+=2) { DEBUG_PRINT(" %s -> %s\n", Tcl_GetString(objv[i]), Tcl_GetString(objv[i+1])); hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]), &isNew); if (!isNew) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "duplicate entry in jump table for \"%s\"", Tcl_GetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY"); DeleteMirrorJumpTable(jtPtr); return TCL_ERROR; } } Tcl_SetHashValue(hashEntry, objv[i+1]); Tcl_IncrRefCount(objv[i+1]); } DEBUG_PRINT("}\n"); /* * Put the mirror jumptable in the basic block struct. */ |
︙ | ︙ | |||
2083 2084 2085 2086 2087 2088 2089 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ | < | < < | 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ Tcl_Obj* intObj; /* Integer from the source code */ int status; /* Tcl status return */ /* * Extract the next token as a string. */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) { return TCL_ERROR; } /* * Convert to an integer, advance to the next token and return. */ |
︙ | ︙ | |||
2139 2140 2141 2142 2143 2144 2145 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ | < | < < | 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ Tcl_Obj* intObj; /* Integer from the source code */ int status; /* Tcl status return */ /* * Extract the next token as a string. */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) { return TCL_ERROR; } /* * Convert to an integer, advance to the next token and return. */ |
︙ | ︙ | |||
2195 2196 2197 2198 2199 2200 2201 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ | < | < < | 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code */ Tcl_Obj* intObj; /* Integer from the source code */ int status; /* Tcl status return */ /* * Extract the next token as a string. */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) { return TCL_ERROR; } /* * Convert to an integer, advance to the next token and return. */ |
︙ | ︙ | |||
2250 2251 2252 2253 2254 2255 2256 | Tcl_Token** tokenPtrPtr) { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; | | | < | < < > | 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 | Tcl_Token** tokenPtrPtr) { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; int varNameLen; int localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { return -1; } varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen); if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) { Tcl_DecrRefCount(varNameObj); return -1; } localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr); Tcl_DecrRefCount(varNameObj); if (localVar == -1) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( |
︙ | ︙ | |||
2303 2304 2305 2306 2307 2308 2309 | static int CheckNamespaceQualifiers( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ const char* name, /* Variable name to check */ int nameLen) /* Length of the variable */ { | < > < < < | > | 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 | static int CheckNamespaceQualifiers( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ const char* name, /* Variable name to check */ int nameLen) /* Length of the variable */ { const char* p; for (p = name; p+2 < name+nameLen; p++) { if ((*p == ':') && (p[1] == ':')) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "variable \"%s\" is not local", name)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL); return TCL_ERROR; } } return TCL_OK; } |
︙ | ︙ | |||
2481 2482 2483 2484 2485 2486 2487 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_HashEntry* entry; /* Label's entry in the symbol table */ int isNew; /* Flag == 1 iff the label was previously * undefined */ | < | | | < < < | | | 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_HashEntry* entry; /* Label's entry in the symbol table */ int isNew; /* Flag == 1 iff the label was previously * undefined */ /* TODO - This can now be simplified! */ StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL); /* * Look up the newly-defined label in the symbol table. */ entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew); if (!isNew) { /* * This is a duplicate label. */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "duplicate definition of label \"%s\"", labelName)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName, NULL); } return TCL_ERROR; } /* * This is the first appearance of the label in the code. */ |
︙ | ︙ | |||
2541 2542 2543 2544 2545 2546 2547 | int flags, /* Flags to apply to the basic block being * closed, if there is one. */ Tcl_Obj* jumpLabel) /* Label of the location that the block jumps * to, or NULL if the block does not jump */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ | | | 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 | int flags, /* Flags to apply to the basic block being * closed, if there is one. */ Tcl_Obj* jumpLabel) /* Label of the location that the block jumps * to, or NULL if the block does not jump */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* newBB; /* BasicBlock structure for the new block */ BasicBlock* currBB = assemEnvPtr->curr_bb; /* * Coalesce zero-length blocks. */ if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) { |
︙ | ︙ | |||
2703 2704 2705 2706 2707 2708 2709 | * Compute stack balance throughout the program. */ if (CheckStack(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } | > | | > | 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 | * Compute stack balance throughout the program. */ if (CheckStack(assemEnvPtr) != TCL_OK) { return TCL_ERROR; } /* * TODO - Check for unreachable code. Or maybe not; unreachable code is * Mostly Harmless. */ return TCL_OK; } /* *----------------------------------------------------------------------------- * |
︙ | ︙ | |||
2762 2763 2764 2765 2766 2767 2768 | */ *mustMove = 0; do { motion = 0; for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; | | | 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 | */ *mustMove = 0; do { motion = 0; for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr = bbPtr->successor1) { /* * Advance the basic block start offset by however many bytes we * have inserted in the code up to this point */ bbPtr->startOffset += motion; |
︙ | ︙ | |||
2862 2863 2864 2865 2866 2867 2868 | symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { symbolObj = Tcl_GetHashValue(symEntryPtr); valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(symbolObj)); DEBUG_PRINT(" %s -> %s (%d)\n", (char*) Tcl_GetHashKey(symHash, symEntryPtr), | | < | 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 | symEntryPtr != NULL; symEntryPtr = Tcl_NextHashEntry(&search)) { symbolObj = Tcl_GetHashValue(symEntryPtr); valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash, Tcl_GetString(symbolObj)); DEBUG_PRINT(" %s -> %s (%d)\n", (char*) Tcl_GetHashKey(symHash, symEntryPtr), Tcl_GetString(symbolObj), (valEntryPtr != NULL)); if (valEntryPtr == NULL) { ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj); return TCL_ERROR; } } DEBUG_PRINT("}\n"); return TCL_OK; |
︙ | ︙ | |||
2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 | * * Side effects: * Stores an error message, error code, and line number information in * the assembler's Tcl interpreter. * *----------------------------------------------------------------------------- */ static void ReportUndefinedLabel( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* bbPtr, /* Basic block that contains the undefined * label */ Tcl_Obj* jumpTarget) /* Label of a jump target */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ | > < < < < | > | 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 | * * Side effects: * Stores an error message, error code, and line number information in * the assembler's Tcl interpreter. * *----------------------------------------------------------------------------- */ static void ReportUndefinedLabel( AssemblyEnv* assemEnvPtr, /* Assembly environment */ BasicBlock* bbPtr, /* Basic block that contains the undefined * label */ Tcl_Obj* jumpTarget) /* Label of a jump target */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "undefined label \"%s\"", Tcl_GetString(jumpTarget))); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL", Tcl_GetString(jumpTarget), NULL); Tcl_SetErrorLine(interp, bbPtr->jumpLine); } } /* |
︙ | ︙ | |||
3048 3049 3050 3051 3052 3053 3054 | BasicBlock* jumpTargetBBPtr; /* Basic block that the jump proceeds to */ int junk; auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); | < | | 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 | BasicBlock* jumpTargetBBPtr; /* Basic block that the jump proceeds to */ int junk; auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1); DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n", bbPtr, bbPtr->jumpOffset, auxDataIndex); realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData; realJumpHashPtr = &realJumpTablePtr->hashTable; /* * Look up every jump target in the jump hash. */ DEBUG_PRINT("resolve jump table {\n"); |
︙ | ︙ | |||
3157 3158 3159 3160 3161 3162 3163 | /* Tcl interpreter */ BasicBlock* nextPtr; /* Pointer to the succeeding basic block */ int offset; /* Bytecode offset of the current * instruction */ int bound; /* Bytecode offset following the last * instruction of the block. */ unsigned char opcode; /* Current bytecode instruction */ | < | 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 | /* Tcl interpreter */ BasicBlock* nextPtr; /* Pointer to the succeeding basic block */ int offset; /* Bytecode offset of the current * instruction */ int bound; /* Bytecode offset following the last * instruction of the block. */ unsigned char opcode; /* Current bytecode instruction */ /* * Determine where in the code array the basic block ends. */ nextPtr = blockPtr->successor1; if (nextPtr == NULL) { |
︙ | ︙ | |||
3187 3188 3189 3190 3191 3192 3193 | opcode = (envPtr->codeStart)[offset]; if (BytecodeMightThrow(opcode)) { /* * Report an error for a throw in the wrong context. */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { | | < | | > < | 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 | opcode = (envPtr->codeStart)[offset]; if (BytecodeMightThrow(opcode)) { /* * Report an error for a throw in the wrong context. */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" instruction may not appear in " "a context where an exception has been " "caught and not disposed of.", tclInstructionTable[opcode].name)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); } return TCL_ERROR; } offset += tclInstructionTable[opcode].numBytes; } return TCL_OK; |
︙ | ︙ | |||
3226 3227 3228 3229 3230 3231 3232 | unsigned char opcode) { /* * Binary search on the non-throwing bytecode list. */ int min = 0; | | | 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 | unsigned char opcode) { /* * Binary search on the non-throwing bytecode list. */ int min = 0; int max = sizeof(NonThrowingByteCodes) - 1; int mid; unsigned char c; while (max >= min) { mid = (min + max) / 2; c = NonThrowingByteCodes[mid]; if (opcode < c) { |
︙ | ︙ | |||
3367 3368 3369 3370 3371 3372 3373 | if (blockPtr->initialStackDepth == initialStackDepth) { return TCL_OK; } if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "inconsistent stack depths on two execution paths", -1)); | > > | > > | 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 | if (blockPtr->initialStackDepth == initialStackDepth) { return TCL_OK; } if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "inconsistent stack depths on two execution paths", -1)); /* * TODO - add execution trace of both paths */ Tcl_SetErrorLine(interp, blockPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); } return TCL_ERROR; } /* |
︙ | ︙ | |||
3500 3501 3502 3503 3504 3505 3506 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ int depth; /* Net stack effect */ int litIndex; /* Index in the literal pool of the empty * string */ | < < | | | | | | | | | | | | | < < | < < | < < | | | | | | | 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ int depth; /* Net stack effect */ int litIndex; /* Index in the literal pool of the empty * string */ BasicBlock* curr_bb = assemEnvPtr->curr_bb; /* Final basic block in the assembly */ /* * Don't perform these checks if execution doesn't reach the exit (either * because of an infinite loop or because the only return is from the * middle. */ if (curr_bb->flags & BB_VISITED) { /* * Exit with no operands; push an empty one. */ depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth; if (depth == 0) { /* * Emit a 'push' of the empty literal. */ litIndex = TclRegisterNewLiteral(envPtr, "", 0); /* * Assumes that 'push' is at slot 0 in TalInstructionTable. */ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); ++depth; } /* * Exit with unbalanced stack. */ if (depth != 1) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "stack is unbalanced on exit from the code (depth=%d)", depth)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); } return TCL_ERROR; } /* * Record stack usage. */ envPtr->currStackDepth += depth; } return TCL_OK; } /* *----------------------------------------------------------------------------- |
︙ | ︙ | |||
3721 3722 3723 3724 3725 3726 3727 | */ fallThruEnclosing = enclosing; fallThruState = state; jumpEnclosing = enclosing; jumpState = state; | > | | > | 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 | */ fallThruEnclosing = enclosing; fallThruState = state; jumpEnclosing = enclosing; jumpState = state; /* * TODO: Make sure that the test cases include validating that a natural * loop can't include 'beginCatch' or 'endCatch' */ if (bbPtr->flags & BB_BEGINCATCH) { /* * If the block begins a catch, the state for the successor is 'in * catch'. The jump target is the exception exit, and the state of the * jump target is 'caught.' */ |
︙ | ︙ | |||
3866 3867 3868 3869 3870 3871 3872 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr; /* Current basic block */ BasicBlock* prevPtr = NULL; /* Previous basic block */ int catchDepth = 0; /* Current catch depth */ int maxCatchDepth = 0; /* Maximum catch depth in the program */ BasicBlock** catches; /* Stack of catches in progress */ | | | | 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 | CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ BasicBlock* bbPtr; /* Current basic block */ BasicBlock* prevPtr = NULL; /* Previous basic block */ int catchDepth = 0; /* Current catch depth */ int maxCatchDepth = 0; /* Maximum catch depth in the program */ BasicBlock** catches; /* Stack of catches in progress */ int* catchIndices; /* Indices of the exception ranges of catches * in progress */ int i; /* * Determine the max catch depth for the entire assembly script * (excluding embedded eval's and expr's, which will be handled later). */ |
︙ | ︙ | |||
3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 | TclStoreInt4AtPtr(catchIndices[catchDepth-1], envPtr->codeStart + bbPtr->startOffset - 4); } prevPtr = bbPtr; } if (catchDepth != 0) { Tcl_Panic("unclosed catch at end of code in " "tclAssembly.c:BuildExceptionRanges, can't happen"); } return TCL_OK; } /* *----------------------------------------------------------------------------- * | > > > > > > > | 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 | TclStoreInt4AtPtr(catchIndices[catchDepth-1], envPtr->codeStart + bbPtr->startOffset - 4); } prevPtr = bbPtr; } /* Make sure that all catches are closed */ if (catchDepth != 0) { Tcl_Panic("unclosed catch at end of code in " "tclAssembly.c:BuildExceptionRanges, can't happen"); } /* Free temp storage */ ckfree(catchIndices); ckfree(catches); return TCL_OK; } /* *----------------------------------------------------------------------------- * |
︙ | ︙ | |||
4116 4117 4118 4119 4120 4121 4122 | BasicBlock* bbPtr; /* Current basic block */ int rangeBase; /* Base of the foreign exception ranges when * they are reinstalled */ int rangeIndex; /* Index of the current foreign exception * range as reinstalled */ ExceptionRange* range; /* Current foreign exception range */ unsigned char opcode; /* Current instruction's opcode */ | | | 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 | BasicBlock* bbPtr; /* Current basic block */ int rangeBase; /* Base of the foreign exception ranges when * they are reinstalled */ int rangeIndex; /* Index of the current foreign exception * range as reinstalled */ ExceptionRange* range; /* Current foreign exception range */ unsigned char opcode; /* Current instruction's opcode */ int catchIndex; /* Index of the exception range to which the * current instruction refers */ int i; /* * Walk the basic blocks looking for exceptions in embedded scripts. */ |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
3641 3642 3643 3644 3645 3646 3647 | Tcl_DecrRefCount(cmdNameObj); /* * Report unknown functions. */ if (cmdPtr == NULL) { | < < < < < | > | 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 | Tcl_DecrRefCount(cmdNameObj); /* * Report unknown functions. */ if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown math function \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL); *numArgsPtr = -1; *argTypesPtr = NULL; *procPtr = NULL; *clientDataPtr = NULL; return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclFileName.c.
︙ | ︙ | |||
1206 1207 1208 1209 1210 1211 1212 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int index, i, globFlags, length, join, dir, result; char *string; const char *separators; | | | 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int index, i, globFlags, length, join, dir, result; char *string; const char *separators; Tcl_Obj *typePtr, *look; Tcl_Obj *pathOrDir = NULL; Tcl_DString prefix; static const char *const options[] = { "-directory", "-join", "-nocomplain", "-path", "-tails", "-types", "--", NULL }; enum options { |
︙ | ︙ | |||
1493 1494 1495 1496 1497 1498 1499 | } globTypes->macType = look; Tcl_IncrRefCount(look); } else { Tcl_Obj *item; | | | | 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 | } globTypes->macType = look; Tcl_IncrRefCount(look); } else { Tcl_Obj *item; if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) && (len == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); if (!strcmp("macintosh", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 1, &item); if (!strcmp("type", Tcl_GetString(item))) { Tcl_ListObjIndex(interp, look, 2, &item); if (globTypes->macType != NULL) { goto badMacTypesArg; |
︙ | ︙ | |||
1524 1525 1526 1527 1528 1529 1530 | /* * Error cases. We reset the 'join' flag to zero, since we * haven't yet made use of it. */ badTypesArg: | < < < | > > | 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 | /* * Error cases. We reset the 'join' flag to zero, since we * haven't yet made use of it. */ badTypesArg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument to \"-types\": %s", Tcl_GetString(look))); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); result = TCL_ERROR; join = 0; goto endOfGlob; badMacTypesArg: Tcl_SetObjResult(interp, Tcl_NewStringObj( |
︙ | ︙ | |||
1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 | if (length == 0) { Tcl_AppendResult(interp, "no files matched glob pattern", (join || (objc == 1)) ? " \"" : "s \"", NULL); if (join) { Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL); } else { const char *sep = ""; for (i = 0; i < objc; i++) { string = Tcl_GetString(objv[i]); Tcl_AppendResult(interp, sep, string, NULL); sep = " "; } } Tcl_AppendResult(interp, "\"", NULL); | > | 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 | if (length == 0) { Tcl_AppendResult(interp, "no files matched glob pattern", (join || (objc == 1)) ? " \"" : "s \"", NULL); if (join) { Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL); } else { const char *sep = ""; for (i = 0; i < objc; i++) { string = Tcl_GetString(objv[i]); Tcl_AppendResult(interp, sep, string, NULL); sep = " "; } } Tcl_AppendResult(interp, "\"", NULL); |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
2091 2092 2093 2094 2095 2096 2097 | { Channel *chanPtr; /* The actual channel. */ ClientData handle; int result; chanPtr = ((Channel *) chan)->state->bottomChanPtr; if (!chanPtr->typePtr->getHandleProc) { | < | < < | | | 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 | { Channel *chanPtr; /* The actual channel. */ ClientData handle; int result; chanPtr = ((Channel *) chan)->state->bottomChanPtr; if (!chanPtr->typePtr->getHandleProc) { Tcl_SetChannelError(chan, Tcl_ObjPrintf( "channel \"%s\" does not support OS handles", Tcl_GetChannelName(chan))); return TCL_ERROR; } result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction, &handle); if (handlePtr) { *handlePtr = handle; } |
︙ | ︙ |
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
601 602 603 604 605 606 607 | * Verify the result. * - List, of method names. Convert to mask. * Check for non-optionals through the mask. * Compare open mode against optional r/w. */ if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { | < < < < | > > | 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 | * Verify the result. * - List, of method names. Convert to mask. * Check for non-optionals through the mask. * Compare open mode against optional r/w. */ if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned non-list: %s", Tcl_GetString(cmdObj), Tcl_GetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } methods = 0; while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, |
︙ | ︙ | |||
629 630 631 632 633 634 635 | methods |= FLAG(methIndex); listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { | < < < | > > < < < | > > < < < | > > < < < | > > < < < | > > | 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 | methods |= FLAG(methIndex); listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" does not support all required methods", Tcl_GetString(cmdObj))); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" lacks a \"read\" method", Tcl_GetString(cmdObj))); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" lacks a \"write\" method", Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", Tcl_GetString(cmdObj))); goto error; } Tcl_ResetResult(interp); /* * Everything is fine now. |
︙ | ︙ |
Changes to generic/tclIORTrans.c.
︙ | ︙ | |||
597 598 599 600 601 602 603 | /* * Verify the result. * - List, of method names. Convert to mask. Check for non-optionals * through the mask. Compare open mode against optional r/w. */ if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { | < < < < | > > | 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 | /* * Verify the result. * - List, of method names. Convert to mask. Check for non-optionals * through the mask. Compare open mode against optional r/w. */ if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned non-list: %s", Tcl_GetString(cmdObj), Tcl_GetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } methods = 0; while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, |
︙ | ︙ | |||
625 626 627 628 629 630 631 | methods |= FLAG(methIndex); listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { | < < < | > > < < < | > > < < < | > > < < < | > > | 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 | methods |= FLAG(methIndex); listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" does not support all required methods", Tcl_GetString(cmdObj))); goto error; } /* * Mode tell us what the parent channel supports. The methods tell us what * the handler supports. We remove the non-supported bits from the mode * and check that the channel is not completely inacessible. Afterward the * mode tells us which methods are still required, and these methods will * also be supported by the handler, by design of the check. */ if (!HAS(methods, METH_READ)) { mode &= ~TCL_READABLE; } if (!HAS(methods, METH_WRITE)) { mode &= ~TCL_WRITABLE; } if (!mode) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" makes the channel inaccessible", Tcl_GetString(cmdObj))); goto error; } /* * The mode and support for it is ok, now check the internal constraints. */ if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"drain\" but not \"read\"", Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"flush\" but not \"write\"", Tcl_GetString(cmdObj))); goto error; } Tcl_ResetResult(interp); /* * Everything is fine now. |
︙ | ︙ |
Changes to generic/tclIOSock.c.
︙ | ︙ | |||
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 | } else if (strcmp(family, "inet6") == 0) { hints.ai_family = AF_INET6; } } } hints.ai_socktype = SOCK_STREAM; #if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux) /* * Missing on: OpenBSD, NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ hints.ai_flags |= AI_ADDRCONFIG; #endif if (willBind) { hints.ai_flags |= AI_PASSIVE; } result = getaddrinfo(native, portstring, &hints, addrlist); | > > > > > > > > > | 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 | } else if (strcmp(family, "inet6") == 0) { hints.ai_family = AF_INET6; } } } hints.ai_socktype = SOCK_STREAM; #if 0 /* * We found some problems when using AI_ADDRCONFIG, e.g. on systems that * have no networking besides the loopback interface and want to resolve * localhost. See bugs 3385024, 3382419, 3382431. As the advantage of * using AI_ADDRCONFIG in situations where it works, is probably low, * we'll leave it out for now. After all, it is just an optimisation. */ #if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux) /* * Missing on: OpenBSD, NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ hints.ai_flags |= AI_ADDRCONFIG; #endif #endif if (willBind) { hints.ai_flags |= AI_PASSIVE; } result = getaddrinfo(native, portstring, &hints, addrlist); |
︙ | ︙ |
Changes to generic/tclOOCall.c.
︙ | ︙ | |||
1162 1163 1164 1165 1166 1167 1168 | Tcl_SetHashValue(hPtr, NULL); TclOODeleteChain(callPtr); } } else { hPtr = NULL; } | | | 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 | Tcl_SetHashValue(hPtr, NULL); TclOODeleteChain(callPtr); } } else { hPtr = NULL; } callPtr = ckalloc(sizeof(CallChain)); memset(callPtr, 0, sizeof(CallChain)); callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING); callPtr->epoch = fPtr->epoch; callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount; callPtr->objectEpoch = clsPtr->thisPtr->epoch; callPtr->refCount = 1; callPtr->chain = callPtr->staticChain; |
︙ | ︙ | |||
1210 1211 1212 1213 1214 1215 1216 | if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else { if (hPtr == NULL) { if (clsPtr->classChainCache == NULL) { | | < < | 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 | if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } } else { if (hPtr == NULL) { if (clsPtr->classChainCache == NULL) { clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitObjHashTable(clsPtr->classChainCache); } hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache, (char *) methodNameObj, &i); } callPtr->refCount++; Tcl_SetHashValue(hPtr, callPtr); |
︙ | ︙ |
Changes to generic/tclOOInfo.c.
︙ | ︙ | |||
1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 | callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD); if (callPtr == NULL) { Tcl_AppendResult(interp, "cannot construct any call chain", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr)); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 | > | 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 | callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD); if (callPtr == NULL) { Tcl_AppendResult(interp, "cannot construct any call chain", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr)); TclOODeleteChain(callPtr); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
2759 2760 2761 2762 2763 2764 2765 | return TCL_OK; } goto tooLarge; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { | < | | | < < | 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 | return TCL_OK; } goto tooLarge; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { /* * Must check for those bignum values that can fit in a long, even |
︙ | ︙ | |||
3063 3064 3065 3066 3067 3068 3069 | #endif if (objPtr->typePtr == &tclIntType) { *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { | < | | | < < | 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 | #endif if (objPtr->typePtr == &tclIntType) { *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue; return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } if (objPtr->typePtr == &tclBignumType) { /* * Must check for those bignum values that can fit in a |
︙ | ︙ | |||
3397 3398 3399 3400 3401 3402 3403 | TclBNInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { | < | | | < < | 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 | TclBNInitBignumFromWideInt(bignumValue, objPtr->internalRep.wideValue); return TCL_OK; } #endif if (objPtr->typePtr == &tclDoubleType) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclPosixStr.c.
︙ | ︙ | |||
199 200 201 202 203 204 205 | #endif #ifdef ELIBBAD case ELIBBAD: return "ELIBBAD"; #endif #ifdef ELIBEXEC case ELIBEXEC: return "ELIBEXEC"; #endif | | | 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | #endif #ifdef ELIBBAD case ELIBBAD: return "ELIBBAD"; #endif #ifdef ELIBEXEC case ELIBEXEC: return "ELIBEXEC"; #endif #if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED)) case ELIBMAX: return "ELIBMAX"; #endif #ifdef ELIBSCN case ELIBSCN: return "ELIBSCN"; #endif #ifdef ELNRNG case ELNRNG: return "ELNRNG"; |
︙ | ︙ | |||
658 659 660 661 662 663 664 | #endif #ifdef ELIBBAD case ELIBBAD: return "accessing a corrupted shared library"; #endif #ifdef ELIBEXEC case ELIBEXEC: return "cannot exec a shared library directly"; #endif | | | 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 | #endif #ifdef ELIBBAD case ELIBBAD: return "accessing a corrupted shared library"; #endif #ifdef ELIBEXEC case ELIBEXEC: return "cannot exec a shared library directly"; #endif #if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED)) case ELIBMAX: return "attempting to link in more shared libraries than system limit"; #endif #ifdef ELIBSCN case ELIBSCN: return ".lib section in a.out corrupted"; #endif #ifdef ELNRNG |
︙ | ︙ |
Changes to generic/tclProc.c.
︙ | ︙ | |||
2476 2477 2478 2479 2480 2481 2482 | static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; | | < < < | > > | 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 | static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; int objc, result; Proc *procPtr; if (interp == NULL) { return TCL_ERROR; } /* * Convert objPtr to list type first; if it cannot be converted, or if its * length is not 2, then it cannot be converted to lambdaType. */ result = TclListObjGetElements(NULL, objPtr, &objc, &objv); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", Tcl_GetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL); return TCL_ERROR; } argsPtr = objv[0]; bodyPtr = objv[1]; |
︙ | ︙ |
Changes to generic/tclStrToD.c.
︙ | ︙ | |||
1380 1381 1382 1383 1384 1385 1386 | /* * Format an error message when an invalid number is encountered. */ if (status != TCL_OK) { if (interp != NULL) { | | > < < < | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 | /* * Format an error message when an invalid number is encountered. */ if (status != TCL_OK) { if (interp != NULL) { Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"", expected); Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); Tcl_AppendToObj(msg, "\"", -1); if (state == BAD_OCTAL) { Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1); } Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); |
︙ | ︙ | |||
3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 | int i, j; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ TclBNInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); mp_init_set_int(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* * Handle the case where we guess the position of the decimal point wrong. */ if (mp_cmp_mag(&b, &S) == MP_LT) { mp_mul_d(&b, 10, &b); ilim =ilim1; --k; } | > < < | 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 | int i, j; /* * b = bw * 2**b2 * 5**b5 * S = 2**s2 * 5*s5 */ mp_init_multi(&temp, &dig, NULL); TclBNInitBignumFromWideUInt(&b, bw); mp_mul_2d(&b, b2, &b); mp_init_set_int(&S, 1); MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S); /* * Handle the case where we guess the position of the decimal point wrong. */ if (mp_cmp_mag(&b, &S) == MP_LT) { mp_mul_d(&b, 10, &b); ilim =ilim1; --k; } /* * Convert the leading digit. */ i = 0; mp_div(&b, &S, &dig, &b); if (dig.used > 1 || dig.dp[0] >= 10) { Tcl_Panic("wrong digit!"); } digit = dig.dp[0]; |
︙ | ︙ | |||
3981 3982 3983 3984 3985 3986 3987 | ++s; /* * Endgame - store the location of the decimal point and the end of the * string. */ | | | 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 | ++s; /* * Endgame - store the location of the decimal point and the end of the * string. */ mp_clear_multi(&b, &S, &temp, &dig, NULL); *s = '\0'; *decpt = k; if (endPtr) { *endPtr = s; } return retval; } |
︙ | ︙ | |||
4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 | TclFinalizeDoubleConversion(void) { int i; ckfree(pow10_wide); for (i=0; i<9; ++i) { mp_clear(pow5 + i); } } /* *---------------------------------------------------------------------- * * Tcl_InitBignumFromDouble -- | > > > | 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 | TclFinalizeDoubleConversion(void) { int i; ckfree(pow10_wide); for (i=0; i<9; ++i) { mp_clear(pow5 + i); } for (i=0; i < 5; ++i) { mp_clear(pow5_13 + i); } } /* *---------------------------------------------------------------------- * * Tcl_InitBignumFromDouble -- |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 | int index) /* Index of local var where part1 is to be * found. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldValuePtr; Tcl_Obj *resultPtr = NULL; int result; /* * If the variable is in a hashtable and its hPtr field is NULL, then we * may have an upvar to an array element where the array was deleted or an * upvar to a namespace variable whose namespace was deleted. Generate an * error (allowing the variable to be reset would screw up our storage * allocation and is meaningless anyway). | > | 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 | int index) /* Index of local var where part1 is to be * found. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldValuePtr; Tcl_Obj *resultPtr = NULL; int result; int cleanupOnEarlyError = (newValuePtr->refCount == 0); /* * If the variable is in a hashtable and its hPtr field is NULL, then we * may have an upvar to an array element where the array was deleted or an * upvar to a namespace variable whose namespace was deleted. Generate an * error (allowing the variable to be reset would screw up our storage * allocation and is meaningless anyway). |
︙ | ︙ | |||
1993 1994 1995 1996 1997 1998 1999 | } if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); } return resultPtr; earlyError: | | | 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 | } if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); } return resultPtr; earlyError: if (cleanupOnEarlyError) { Tcl_DecrRefCount(newValuePtr); } goto cleanup; } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclZlib.c.
︙ | ︙ | |||
2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 | ZlibTransformClose( ClientData instanceData, Tcl_Interp *interp) { ZlibChannelData *cd = instanceData; int e, result = TCL_OK; ZlibTransformTimerKill(cd); if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { cd->outStream.avail_in = 0; do { cd->outStream.next_out = (Bytef *) cd->outBuffer; cd->outStream.avail_out = (unsigned) cd->outAllocated; e = deflate(&cd->outStream, Z_FINISH); if (e != Z_OK && e != Z_STREAM_END) { | > > > > > > > > > | 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 | ZlibTransformClose( ClientData instanceData, Tcl_Interp *interp) { ZlibChannelData *cd = instanceData; int e, result = TCL_OK; /* * Delete the support timer. */ ZlibTransformTimerKill(cd); /* * Flush any data waiting to be compressed. */ if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { cd->outStream.avail_in = 0; do { cd->outStream.next_out = (Bytef *) cd->outBuffer; cd->outStream.avail_out = (unsigned) cd->outAllocated; e = deflate(&cd->outStream, Z_FINISH); if (e != Z_OK && e != Z_STREAM_END) { |
︙ | ︙ | |||
2282 2283 2284 2285 2286 2287 2288 | } } result = TCL_ERROR; break; } } } while (e != Z_STREAM_END); | | | > > > > > | 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 | } } result = TCL_ERROR; break; } } } while (e != Z_STREAM_END); e = deflateEnd(&cd->outStream); } else { e = inflateEnd(&cd->inStream); } /* * Release all memory. */ if (cd->inBuffer) { ckfree(cd->inBuffer); cd->inBuffer = NULL; } if (cd->outBuffer) { ckfree(cd->outBuffer); cd->outBuffer = NULL; } ckfree(cd); return result; } static int ZlibTransformInput( ClientData instanceData, char *buf, |
︙ | ︙ |
Changes to library/init.tcl.
︙ | ︙ | |||
11 12 13 14 15 16 17 | # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } package require -exact Tcl 8.6b2 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: # # The environment variable TCLLIBPATH # # tcl_library, which is the directory containing this init.tcl script. |
︙ | ︙ |
Changes to tests/assemble.test.
︙ | ︙ | |||
26 27 28 29 30 31 32 33 34 35 36 37 38 39 | set sep {} for {set i 0} {$i < 256} {incr i} { append s $sep [list set v$i literal$i] set sep \n } return $s } # assemble-1 - TclNRAssembleObjCmd test assemble-1.1 {wrong # args, direct eval} { -body { eval [list assemble] } | > > > > > > > > > > > > > > > > > | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | set sep {} for {set i 0} {$i < 256} {incr i} { append s $sep [list set v$i literal$i] set sep \n } return $s } testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { set lines [split [memory info] \n] return [lindex $lines 3 3] } proc leaktest {script {iterations 3}} { set end [getbytes] for {set i 0} {$i < $iterations} {incr i} { uplevel 1 $script set tmp $end set end [getbytes] } return [expr {$end - $tmp}] } } # assemble-1 - TclNRAssembleObjCmd test assemble-1.1 {wrong # args, direct eval} { -body { eval [list assemble] } |
︙ | ︙ | |||
3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 | for {set i 1} {$i < 30} {incr i} { lappend result [ulam $i] } set result } -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88} } rename fillTables {} rename assemble {} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 | for {set i 1} {$i < 30} {incr i} { lappend result [ulam $i] } set result } -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88} } test assemble-51.1 {memory leak testing} memory { leaktest { apply {{} {assemble {push hello}}} } } 0 test assemble-51.2 {memory leak testing} memory { leaktest { apply {{{x 0}} {assemble {incrImm x 1}}} } } 0 test assemble-51.3 {memory leak testing} memory { leaktest { apply {{n} { assemble { load n; # max dup; # max n jump start; # max n label loop; # max n over 1; # max n max over 1; # max in max n ge; # man n max>=n jumpTrue skip; # max n reverse 2; # n max pop; # n dup; # n n label skip; # max n dup; # max n n push 2; # max n n 2 mod; # max n n%2 jumpTrue odd; # max n push 2; # max n 2 div; # max n/2 -> max n jump start; # max n label odd; # max n push 3; # max n 3 mult; # max 3*n push 1; # max 3*n 1 add; # max 3*n+1 label start; # max n dup; # max n n push 1; # max n n 1 neq; # max n n>1 jumpTrue loop; # max n pop; # max } }} 1 } } 0 test assemble-51.4 {memory leak testing} memory { leaktest { catch { apply {{} { assemble {reverse polish notation} }} } } } 0 rename fillTables {} rename assemble {} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: |
Changes to tests/ioTrans.test.
︙ | ︙ | |||
203 204 205 206 207 208 209 | } -match glob -result {*returned bad method "BOGUS": must be clear, drain, finalize, flush, initialize, limit?, read, or write} test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler mismatch} -body { proc foo {args} {return {initialize finalize}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} | | | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | } -match glob -result {*returned bad method "BOGUS": must be clear, drain, finalize, flush, initialize, limit?, read, or write} test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler mismatch} -body { proc foo {args} {return {initialize finalize}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone rename foo {} } -match glob -result {*makes the channel inaccessible} # iortrans-2.15 event/watch methods elimimated, removed these tests. # iortrans-2.16 test iortrans-2.17 {chan push, initialize failed, bad result, drain/read mismatch} -body { proc foo {args} {return {initialize finalize drain write}} chan push [tempchan] foo } -returnCodes error -cleanup { tempdone |
︙ | ︙ |
Changes to tests/ooNext2.test.
︙ | ︙ | |||
509 510 511 512 513 514 515 516 517 518 519 520 521 522 | info object call notanobject x } -returnCodes error -result {notanobject does not refer to an object} test oo-call-1.18 {object call introspection - memory leaks} -body { leaktest { info object call oo::object destroy } } -constraints memory -result 0 test oo-call-2.1 {class call introspection} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} | > > > > > > > > > > > > > > > | 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | info object call notanobject x } -returnCodes error -result {notanobject does not refer to an object} test oo-call-1.18 {object call introspection - memory leaks} -body { leaktest { info object call oo::object destroy } } -constraints memory -result 0 test oo-call-1.19 {object call introspection - memory leaks} -setup { oo::class create leaktester { method foo {} {dummy} } } -body { leaktest { set lt [leaktester new] oo::objdefine $lt method foobar {} {dummy} list [info object call $lt destroy] \ [info object call $lt foo] \ [info object call $lt bar] \ [info object call $lt foobar] \ [$lt destroy] } } -cleanup { leaktester destroy } -constraints memory -result 0 test oo-call-2.1 {class call introspection} -setup { oo::class create root } -body { oo::class create ::A { superclass root method x {} {} |
︙ | ︙ | |||
678 679 680 681 682 683 684 685 686 687 688 689 690 691 | info class call notaclass x } -returnCodes error -cleanup { root destroy } -result {"notaclass" is not a class} test oo-call-2.13 {class call introspection - memory leaks} -body { leaktest { info class call oo::class destroy } } -constraints memory -result 0 test oo-call-3.1 {current call introspection} -setup { oo::class create root } -body { oo::class create A { | > > > > > > > > > > | 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 | info class call notaclass x } -returnCodes error -cleanup { root destroy } -result {"notaclass" is not a class} test oo-call-2.13 {class call introspection - memory leaks} -body { leaktest { info class call oo::class destroy } } -constraints memory -result 0 test oo-call-2.14 {class call introspection - memory leaks} -body { leaktest { oo::class create leaktester { method foo {} {dummy} } [leaktester new] destroy list [info class call leaktester destroy] \ [info class call leaktester foo] \ [info class call leaktester bar] \ [leaktester destroy] } } -constraints memory -result 0 test oo-call-3.1 {current call introspection} -setup { oo::class create root } -body { oo::class create A { |
︙ | ︙ |
Changes to tools/tcl.wse.in.
︙ | ︙ | |||
8 9 10 11 12 13 14 | Japanese Font Size=10 Start Gradient=0 0 255 End Gradient=0 0 0 Windows Flags=00000000000000010010110000001000 Log Pathname=%MAINDIR%\INSTALL.LOG Message Font=MS Sans Serif Font Size=8 | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | Japanese Font Size=10 Start Gradient=0 0 255 End Gradient=0 0 0 Windows Flags=00000000000000010010110000001000 Log Pathname=%MAINDIR%\INSTALL.LOG Message Font=MS Sans Serif Font Size=8 Disk Label=tcl8.6b2 Disk Filename=setup Patch Flags=0000000000000001 Patch Threshold=85 Patch Memory=4000 Variable Name1=_SYS_ Variable Default1=C:\WINDOWS\SYSTEM Variable Flags1=00001000 |
︙ | ︙ |
Changes to tools/tcltk-man2html.tcl.
︙ | ︙ | |||
770 771 772 773 774 775 776 | if {![llength [glob -nocomplain $globpat]]} { # Fallback for manpages generated using doctools set globpat $tcltkdir/$tcldir/pkgs/$dir*/doc/man/*.$type if {![llength [glob -nocomplain $globpat]]} { continue } } | | | 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 | if {![llength [glob -nocomplain $globpat]]} { # Fallback for manpages generated using doctools set globpat $tcltkdir/$tcldir/pkgs/$dir*/doc/man/*.$type if {![llength [glob -nocomplain $globpat]]} { continue } } regexp "pkgs/${dir}(.*)/doc$" [glob $tcltkdir/$tcldir/pkgs/$dir*/doc] \ -> version switch $type { n { set title "$name Package Commands" if {$version ne ""} { append title ", version $version" } |
︙ | ︙ | |||
969 970 971 972 973 974 975 | close $f } } } trap {POSIX ENOENT} {} { set packageDirNameMap { itcl {[incr Tcl]} tdbc {TDBC} | | | 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 | close $f } } } trap {POSIX ENOENT} {} { set packageDirNameMap { itcl {[incr Tcl]} tdbc {TDBC} thread Thread } } # # Invoke the scraper/converter engine. # make-man-pages $webdir \ |
︙ | ︙ |
Changes to unix/configure.
︙ | ︙ | |||
1799 1800 1801 1802 1803 1804 1805 | TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 | | | 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 | TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL="b2" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ # Setup configure arguments for bundled packages #------------------------------------------------------------------------ PKG_CFG_ARGS="$ac_configure_args ${PKG_CFG_ARGS}" |
︙ | ︙ |
Changes to unix/configure.in.
︙ | ︙ | |||
21 22 23 24 25 26 27 | /* override */ #undef PACKAGE_TARNAME #endif /* _TCLCONFIG */]) ]) TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | /* override */ #undef PACKAGE_TARNAME #endif /* _TCLCONFIG */]) ]) TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL="b2" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ # Setup configure arguments for bundled packages #------------------------------------------------------------------------ PKG_CFG_ARGS="$ac_configure_args ${PKG_CFG_ARGS}" |
︙ | ︙ |
Changes to unix/tcl.spec.
1 2 3 4 5 6 | # This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} Name: tcl Summary: Tcl scripting language development environment | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | # This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} Name: tcl Summary: Tcl scripting language development environment Version: 8.6b2 Release: 2 License: BSD Group: Development/Languages Source: http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz URL: http://www.tcl.tk/ Buildroot: /var/tmp/%{name}%{version} |
︙ | ︙ |
Changes to unix/tclConfig.h.in.
︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 | #undef HAVE_COPYFILE /* Define to 1 if you have the <copyfile.h> header file. */ #undef HAVE_COPYFILE_H /* Do we have access to Darwin CoreFoundation.framework? */ #undef HAVE_COREFOUNDATION /* Do we have fts functions? */ #undef HAVE_FTS | > > > > > > | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | #undef HAVE_COPYFILE /* Define to 1 if you have the <copyfile.h> header file. */ #undef HAVE_COPYFILE_H /* Do we have access to Darwin CoreFoundation.framework? */ #undef HAVE_COREFOUNDATION /* Define to 1 if you have the `freeaddrinfo' function. */ #undef HAVE_FREEADDRINFO /* Do we have fts functions? */ #undef HAVE_FTS /* Define to 1 if you have the `gai_strerror' function. */ #undef HAVE_GAI_STRERROR /* Define to 1 if you have the `getaddrinfo' function. */ #undef HAVE_GETADDRINFO /* Define to 1 if you have the `getattrlist' function. */ #undef HAVE_GETATTRLIST /* Define to 1 if you have the `getcwd' function. */ #undef HAVE_GETCWD |
︙ | ︙ | |||
74 75 76 77 78 79 80 81 82 83 84 85 86 87 | #undef HAVE_GETHOSTBYNAME_R_3 /* Define to 1 if gethostbyname_r takes 5 args. */ #undef HAVE_GETHOSTBYNAME_R_5 /* Define to 1 if gethostbyname_r takes 6 args. */ #undef HAVE_GETHOSTBYNAME_R_6 /* Define to 1 if getpwnam_r is available. */ #undef HAVE_GETPWNAM_R /* Define to 1 if getpwnam_r takes 4 args. */ #undef HAVE_GETPWNAM_R_4 | > > > | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | #undef HAVE_GETHOSTBYNAME_R_3 /* Define to 1 if gethostbyname_r takes 5 args. */ #undef HAVE_GETHOSTBYNAME_R_5 /* Define to 1 if gethostbyname_r takes 6 args. */ #undef HAVE_GETHOSTBYNAME_R_6 /* Define to 1 if you have the `getnameinfo' function. */ #undef HAVE_GETNAMEINFO /* Define to 1 if getpwnam_r is available. */ #undef HAVE_GETPWNAM_R /* Define to 1 if getpwnam_r takes 4 args. */ #undef HAVE_GETPWNAM_R_4 |
︙ | ︙ | |||
173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 | #undef HAVE_STRINGS_H /* Define to 1 if you have the <string.h> header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the `strtol' function. */ #undef HAVE_STRTOL /* Is 'struct dirent64' in <sys/types.h>? */ #undef HAVE_STRUCT_DIRENT64 /* Is 'struct stat64' in <sys/stat.h>? */ #undef HAVE_STRUCT_STAT64 /* Define to 1 if `st_blksize' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE | > > > > > > > > > > > > | 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | #undef HAVE_STRINGS_H /* Define to 1 if you have the <string.h> header file. */ #undef HAVE_STRING_H /* Define to 1 if you have the `strtol' function. */ #undef HAVE_STRTOL /* Define to 1 if the system has the type `struct addrinfo'. */ #undef HAVE_STRUCT_ADDRINFO /* Is 'struct dirent64' in <sys/types.h>? */ #undef HAVE_STRUCT_DIRENT64 /* Define to 1 if the system has the type `struct in6_addr'. */ #undef HAVE_STRUCT_IN6_ADDR /* Define to 1 if the system has the type `struct sockaddr_in6'. */ #undef HAVE_STRUCT_SOCKADDR_IN6 /* Define to 1 if the system has the type `struct sockaddr_storage'. */ #undef HAVE_STRUCT_SOCKADDR_STORAGE /* Is 'struct stat64' in <sys/stat.h>? */ #undef HAVE_STRUCT_STAT64 /* Define to 1 if `st_blksize' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE |
︙ | ︙ | |||
240 241 242 243 244 245 246 | /* Is there an installed zlib? */ #undef HAVE_ZLIB /* Is this a Mac I see before me? */ #undef MAC_OSX_TCL | | > > > | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | /* Is there an installed zlib? */ #undef HAVE_ZLIB /* Is this a Mac I see before me? */ #undef MAC_OSX_TCL /* No Compiler support for module scope symbols */ #undef MODULE_SCOPE /* Default libtommath precision. */ #undef MP_PREC /* Use compat implementation of getaddrinfo() and friends */ #undef NEED_FAKE_RFC2553 /* Is Darwin CoreFoundation unavailable for 64-bit? */ #undef NO_COREFOUNDATION_64 /* Do we have <dirent.h>? */ #undef NO_DIRENT_H |
︙ | ︙ | |||
302 303 304 305 306 307 308 309 310 311 312 313 314 315 | #undef NO_UNAME /* Do we have a usable 'union wait'? */ #undef NO_UNION_WAIT /* Do we have <values.h>? */ #undef NO_VALUES_H /* Do we have wait3() */ #undef NO_WAIT3 /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT | > > > | 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 | #undef NO_UNAME /* Do we have a usable 'union wait'? */ #undef NO_UNION_WAIT /* Do we have <values.h>? */ #undef NO_VALUES_H /* No visibility attribute */ #undef NO_VIZ /* Do we have wait3() */ #undef NO_WAIT3 /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT |
︙ | ︙ |
Changes to win/configure.
︙ | ︙ | |||
1307 1308 1309 1310 1311 1312 1313 | # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 | | | 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 | # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL="b2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=3 TCL_DDE_PATCH_LEVEL="2" DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION |
︙ | ︙ |
Changes to win/configure.in.
︙ | ︙ | |||
10 11 12 13 14 15 16 | # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | # versions of autoconf incorrectly set SHELL to /bin/bash instead of # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL="b2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=3 TCL_DDE_PATCH_LEVEL="2" DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION |
︙ | ︙ |