Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | novem |
Files: | files | file ages | folders |
SHA1: |
e24c4b1f62b9e91f9fdc2604d9b697d4 |
User & Date: | jan.nijtmans 2013-08-14 14:40:40 |
Context
2013-09-21
| ||
12:49 | merge trunk check-in: 7c19121b2e user: dgp tags: novem | |
2013-08-14
| ||
14:40 | merge trunk check-in: e24c4b1f62 user: jan.nijtmans tags: novem | |
14:15 | restore all #ifdef TCL_WIDE_INT_IS_LONG, which were accidently removed in [19ff9b95e1] check-in: 7958111476 user: jan.nijtmans tags: novem | |
12:43 | Arrange for both execution traces and [info frame] to get their pre-subst source strings from a comm... check-in: 3648c59d0d user: dgp tags: trunk | |
Changes
Changes to ChangeLog.
1 2 | 2013-08-01 Harald Oehlmann <[email protected]> | > > > > > > > > > > > | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | 2013-08-03 Donal Fellows <[email protected]> * library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found by the autoloading mechanism. 2013-08-02 Donal Fellows <[email protected]> * generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop crashes when emptying the superclass slot, even when doing elaborate things with metaclasses. 2013-08-01 Harald Oehlmann <[email protected]> * tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier thread again if we were forked, to solve Rivet bug 55153. 2013-07-05 Kevin B. Kenny <[email protected]> * library/tzdata/Africa/Casablanca: * library/tzdata/America/Asuncion: * library/tzdata/Antarctica/Macquarie: * library/tzdata/Asia/Gaza: |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
111 112 113 114 115 116 117 | static Tcl_ObjCmdProc ExprIsqrtFunc; static Tcl_ObjCmdProc ExprRandFunc; static Tcl_ObjCmdProc ExprRoundFunc; static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; | < < | | 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | static Tcl_ObjCmdProc ExprIsqrtFunc; static Tcl_ObjCmdProc ExprRandFunc; static Tcl_ObjCmdProc ExprRoundFunc; static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); static Tcl_NRPostProc NRRunObjProc; static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); static inline Command * TEOV_LookupCmdFromObj(Tcl_Interp *interp, Tcl_Obj *namePtr, Namespace *lookupNsPtr); static int TEOV_NotFound(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr); static int TEOV_RunEnterTraces(Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr); static Tcl_NRPostProc RewindCoroutineCallback; static Tcl_NRPostProc TailcallCleanup; static Tcl_NRPostProc TEOEx_ByteCodeCallback; static Tcl_NRPostProc TEOEx_ListCallback; static Tcl_NRPostProc TEOV_Error; static Tcl_NRPostProc TEOV_Exception; |
︙ | ︙ | |||
3312 3313 3314 3315 3316 3317 3318 | return code; } /* *---------------------------------------------------------------------- * | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 | return code; } /* *---------------------------------------------------------------------- * * TclCleanupCommand -- * * This function frees up a Command structure unless it is still * referenced from an interpreter's command hashtable or from a CmdName * Tcl object representing the name of a command in a ByteCode * instruction sequence. * |
︙ | ︙ | |||
3870 3871 3872 3873 3874 3875 3876 | commandFound: if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { /* * Call enter traces. They will schedule a call to the leave traces if * necessary. */ | | > > | 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 | commandFound: if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { /* * Call enter traces. They will schedule a call to the leave traces if * necessary. */ result = TEOV_RunEnterTraces(interp, &cmdPtr, TclGetSourceFromFrame( flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, objc, objv), objc, objv, lookupNsPtr); if (!cmdPtr) { return TEOV_NotFound(interp, objc, objv, lookupNsPtr); } if (result != TCL_OK) { return result; } } |
︙ | ︙ | |||
4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 | return result; } static int TEOV_RunEnterTraces( Tcl_Interp *interp, Command **cmdPtrPtr, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; int traceCode = TCL_OK; int cmdEpoch = cmdPtr->cmdEpoch; int newEpoch; const char *command; int length; | > < | | 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 | return result; } static int TEOV_RunEnterTraces( Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; int traceCode = TCL_OK; int cmdEpoch = cmdPtr->cmdEpoch; int newEpoch; const char *command; int length; Tcl_IncrRefCount(commandPtr); command = Tcl_GetStringFromObj(commandPtr, &length); /* * Call trace functions. * Execute any command or execution traces. Note that we bump up the * command's reference count for the duration of the calling of the traces * so that the structure doesn't go away underneath our feet. |
︙ | ︙ | |||
4315 4316 4317 4318 4319 4320 4321 | */ if (cmdEpoch != newEpoch) { cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); *cmdPtrPtr = cmdPtr; } | | | | < < < | > | < < < | > > > | | 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 | */ if (cmdEpoch != newEpoch) { cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); *cmdPtrPtr = cmdPtr; } if (cmdPtr && (traceCode == TCL_OK)) { /* * Command was found: push a record to schedule the leave traces. */ TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), commandPtr, cmdPtr, objv); cmdPtr->refCount++; } else { Tcl_DecrRefCount(commandPtr); } return traceCode; } static int TEOV_RunLeaveTraces( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = data[1]; Command *cmdPtr = data[2]; Tcl_Obj **objv = data[3]; if (!(cmdPtr->flags & CMD_IS_DELETED)) { int length; const char *command = Tcl_GetStringFromObj(commandPtr, &length); if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){ traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } |
︙ | ︙ | |||
4557 4558 4559 4560 4561 4562 4563 | expand = expandStack; p = script; bytesLeft = numBytes; /* * TIP #280 Initialize tracking. Do not push on the frame stack yet. * | < | | | | | < > | < < < < < < < < | 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 | expand = expandStack; p = script; bytesLeft = numBytes; /* * TIP #280 Initialize tracking. Do not push on the frame stack yet. * * We open a new context, either for a sourced script, or 'eval'. * For sourced files we always have a path object, even if nothing was * specified in the interp itself. That makes code using it simpler as * NULL checks can be left out. Sourced file without path in the * 'scriptFile' is possible during Tcl initialization. */ eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1; eeFramePtr->framePtr = iPtr->framePtr; eeFramePtr->nextPtr = iPtr->cmdFramePtr; eeFramePtr->nline = 0; eeFramePtr->line = NULL; eeFramePtr->cmdObj = NULL; iPtr->cmdFramePtr = eeFramePtr; if (iPtr->evalFlags & TCL_EVAL_FILE) { /* * Set up for a sourced file. */ eeFramePtr->type = TCL_LOCATION_SOURCE; if (iPtr->scriptFile) { |
︙ | ︙ | |||
4792 4793 4794 4795 4796 4797 4798 | * TIP #280: Remember the command itself for 'info frame'. We * shorten the visible command by one char to exclude the * termination character, if necessary. Here is where we put our * frame on the stack of frames too. _After_ the nested commands * have been executed. */ | | | | | > > > > > | 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 | * TIP #280: Remember the command itself for 'info frame'. We * shorten the visible command by one char to exclude the * termination character, if necessary. Here is where we put our * frame on the stack of frames too. _After_ the nested commands * have been executed. */ eeFramePtr->cmd = parsePtr->commandStart; eeFramePtr->len = parsePtr->commandSize; if (parsePtr->term == parsePtr->commandStart + parsePtr->commandSize - 1) { eeFramePtr->len--; } eeFramePtr->nline = objectsUsed; eeFramePtr->line = lines; TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr); code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME); TclArgumentRelease(interp, objv, objectsUsed); eeFramePtr->line = NULL; eeFramePtr->nline = 0; if (eeFramePtr->cmdObj) { Tcl_DecrRefCount(eeFramePtr->cmdObj); eeFramePtr->cmdObj = NULL; } if (code != TCL_OK) { goto error; } for (i = 0; i < objectsUsed; i++) { Tcl_DecrRefCount(objv[i]); } |
︙ | ︙ | |||
5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 | * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is * specified. * * Results: * The return value is one of the return codes defined in tcl.h (such as * TCL_OK), and the interpreter's result contains a value to supplement * the return code. * * Side effects: * The object is converted, if necessary, to a ByteCode object that holds | > > > > > | 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 5322 5323 5324 5325 | * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is * specified. * * If the flag TCL_EVAL_DIRECT is passed in, the value of invoker * must be NULL. Support for non-NULL invokers in that mode has * been removed since it was unused and untested. Failure to * follow this limitation will lead to an assertion panic. * * Results: * The return value is one of the return codes defined in tcl.h (such as * TCL_OK), and the interpreter's result contains a value to supplement * the return code. * * Side effects: * The object is converted, if necessary, to a ByteCode object that holds |
︙ | ︙ | |||
5441 5442 5443 5444 5445 5446 5447 | /* * This function consists of three independent blocks for: direct * evaluation of canonical lists, compilation and bytecode execution and * finally direct evaluation. Precisely one of these blocks will be run. */ if (TclListObjIsCanonical(objPtr)) { | < | | < < < < < > < | 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 | /* * This function consists of three independent blocks for: direct * evaluation of canonical lists, compilation and bytecode execution and * finally direct evaluation. Precisely one of these blocks will be run. */ if (TclListObjIsCanonical(objPtr)) { CmdFrame *eoFramePtr = NULL; int objc; Tcl_Obj *listPtr, **objv; /* * Canonical List Optimization: In this case, we * can safely use Tcl_EvalObjv instead and get an appreciable * improvement in execution speed. This is because it allows us to * avoid a setFromAny step that would just pack everything into a * string and back out again. * * This also preserves any associations between list elements and * location information for such elements. */ /* * Shimmer protection! Always pass an unshared obj. The caller could * incr the refCount of objPtr AFTER calling us! To be completely safe * we always make a copy. The callback takes care od the refCounts for * both listPtr and objPtr. * * TODO: Create a test to demo this need, or eliminate it. * FIXME OPT: preserve just the internal rep? */ Tcl_IncrRefCount(objPtr); listPtr = TclListObjCopy(interp, objPtr); Tcl_IncrRefCount(listPtr); if (word != INT_MIN) { /* * TIP #280 Structures for tracking lines. As we know that this is * dynamic execution we ignore the invoker, even if known. * * TIP #280. We do _not_ compute all the line numbers for the |
︙ | ︙ | |||
5497 5498 5499 5500 5501 5502 5503 | * should be pushed, as needed by alias and ensemble redirections. */ eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; | | < > | > > > | | 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 | * should be pushed, as needed by alias and ensemble redirections. */ eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; eoFramePtr->type = TCL_LOCATION_EVAL; eoFramePtr->level = (iPtr->cmdFramePtr == NULL? 1 : iPtr->cmdFramePtr->level + 1); eoFramePtr->framePtr = iPtr->framePtr; eoFramePtr->nextPtr = iPtr->cmdFramePtr; eoFramePtr->cmdObj = objPtr; eoFramePtr->cmd = NULL; eoFramePtr->len = 0; eoFramePtr->data.eval.path = NULL; iPtr->cmdFramePtr = eoFramePtr; flags |= TCL_EVAL_SOURCE_IN_FRAME; } TclMarkTailcall(interp); TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); ListObjGetElements(listPtr, objc, objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } if (!(flags & TCL_EVAL_DIRECT)) { /* |
︙ | ︙ | |||
5552 5553 5554 5555 5556 5557 5558 | } { /* * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). | < < < < < < < < | 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 | } { /* * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). */ const char *script; int numSrcBytes; /* * Now we check if we have data about invisible continuation lines for |
︙ | ︙ | |||
5583 5584 5585 5586 5587 5588 5589 | * * Another important action is to save (and later restore) the * continuation line information of the caller, in case we are * executing nested commands in the eval/direct path. */ ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr; | < < < < < < < < < | < < < < < < < < < < < < < < < < < < | < < < < < < < < | < < | < | < < < < < < < < | < < < < < < < < < < < < < < < | | < < < < < < < < < < < < | 5511 5512 5513 5514 5515 5516 5517 5518 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 5534 5535 5536 5537 | * * Another important action is to save (and later restore) the * continuation line information of the caller, in case we are * executing nested commands in the eval/direct path. */ ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr; assert(invoker == NULL); iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr); Tcl_IncrRefCount(objPtr); script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); result = Tcl_EvalEx(interp, script, numSrcBytes, flags); TclDecrRefCount(objPtr); iPtr->scriptCLLocPtr = saveCLLocPtr; return result; } } static int TEOEx_ByteCodeCallback( ClientData data[], |
︙ | ︙ | |||
5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 5740 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 | ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = data[0]; CmdFrame *eoFramePtr = data[1]; /* * Remove the cmdFrame */ if (eoFramePtr) { iPtr->cmdFramePtr = eoFramePtr->nextPtr; TclStackFree(interp, eoFramePtr); } TclDecrRefCount(listPtr); return result; } /* *---------------------------------------------------------------------- | > > | 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 5597 5598 5599 5600 5601 5602 5603 5604 5605 5606 5607 | ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = data[0]; CmdFrame *eoFramePtr = data[1]; Tcl_Obj *objPtr = data[2]; /* * Remove the cmdFrame */ if (eoFramePtr) { iPtr->cmdFramePtr = eoFramePtr->nextPtr; TclStackFree(interp, eoFramePtr); } TclDecrRefCount(objPtr); TclDecrRefCount(listPtr); return result; } /* *---------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
1298 1299 1300 1301 1302 1303 1304 | case TCL_LOCATION_EVAL: /* * Evaluation, dynamic script. Type, line, cmd, the latter through * str. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); | > | < < < | < < < < < < < | | < < < < < < | < | 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 | case TCL_LOCATION_EVAL: /* * Evaluation, dynamic script. Type, line, cmd, the latter through * str. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); if (framePtr->line) { ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); } else { ADD_PAIR("line", Tcl_NewIntObj(1)); } ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PREBC: /* * Precompiled. Result contains the type as signal, nothing else. */ |
︙ | ︙ | |||
1367 1368 1369 1370 1371 1372 1373 | /* * Death of reference by TclGetSrcInfoForPc. */ Tcl_DecrRefCount(fPtr->data.eval.path); } | | < | < | 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 | /* * Death of reference by TclGetSrcInfoForPc. */ Tcl_DecrRefCount(fPtr->data.eval.path); } ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL)); TclStackFree(interp, fPtr); break; } case TCL_LOCATION_SOURCE: /* * Evaluation of a script file. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); ADD_PAIR("file", framePtr->data.eval.path); /* * Refcount framePtr->data.eval.path goes up when lv is converted into * the result list object. */ ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PROC: Tcl_Panic("TCL_LOCATION_PROC found in standard frame"); break; } |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
709 710 711 712 713 714 715 | * lock on it. We release this lock in the function TclFreeCompileEnv(), * found in this file. The "lineCLPtr" hashtable is managed in the file * "tclObj.c". */ clLocPtr = TclContinuationsGet(objPtr); if (clLocPtr) { | < | < | 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 | * lock on it. We release this lock in the function TclFreeCompileEnv(), * found in this file. The "lineCLPtr" hashtable is managed in the file * "tclObj.c". */ clLocPtr = TclContinuationsGet(objPtr); if (clLocPtr) { compEnv.clNext = &clLocPtr->loc[0]; } TclCompileScript(interp, stringPtr, length, &compEnv); /* * Successful compilation. Add a "done" instruction at the end. */ |
︙ | ︙ | |||
738 739 740 741 742 743 744 | !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME) && IsCompactibleCompileEnv(interp, &compEnv)) { TclFreeCompileEnv(&compEnv); iPtr->compiledProcPtr = procPtr; TclInitCompileEnv(interp, &compEnv, stringPtr, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); if (clLocPtr) { | < | < | 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 | !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME) && IsCompactibleCompileEnv(interp, &compEnv)) { TclFreeCompileEnv(&compEnv); iPtr->compiledProcPtr = procPtr; TclInitCompileEnv(interp, &compEnv, stringPtr, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); if (clLocPtr) { compEnv.clNext = &clLocPtr->loc[0]; } compEnv.atCmdStart = 2; /* The disabling magic. */ TclCompileScript(interp, stringPtr, length, &compEnv); assert (compEnv.atCmdStart > 1); TclEmitOpcode(INST_DONE, &compEnv); assert (compEnv.atCmdStart > 1); } |
︙ | ︙ | |||
1371 1372 1373 1374 1375 1376 1377 | envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc)); envPtr->extCmdMapPtr->loc = NULL; envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; envPtr->extCmdMapPtr->path = NULL; | | | 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 | envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc)); envPtr->extCmdMapPtr->loc = NULL; envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; envPtr->extCmdMapPtr->path = NULL; if (invoker == NULL) { /* * Initialize the compiler for relative counting in case of a * dynamic context. */ envPtr->line = 1; if (iPtr->evalFlags & TCL_EVAL_FILE) { |
︙ | ︙ | |||
1485 1486 1487 1488 1489 1490 1491 | /* * Initialize the data about invisible continuation lines as empty, i.e. * not used. The caller (TclSetByteCodeFromAny) will set this up, if such * data is available. */ | < | 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 | /* * Initialize the data about invisible continuation lines as empty, i.e. * not used. The caller (TclSetByteCodeFromAny) will set this up, if such * data is available. */ envPtr->clNext = NULL; envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace; envPtr->auxDataArrayNext = 0; envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE; envPtr->mallocedAuxDataArray = 0; } |
︙ | ︙ | |||
1570 1571 1572 1573 1574 1575 1576 | if (envPtr->mallocedAuxDataArray) { ckfree(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { ReleaseCmdWordData(envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; } | < < < < < < < < < < | 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 | if (envPtr->mallocedAuxDataArray) { ckfree(envPtr->auxDataArrayPtr); } if (envPtr->extCmdMapPtr) { ReleaseCmdWordData(envPtr->extCmdMapPtr); envPtr->extCmdMapPtr = NULL; } } /* *---------------------------------------------------------------------- * * TclWordKnownAtCompileTime -- * |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
361 362 363 364 365 366 367 | * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ int expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ | < < < < | 361 362 363 364 365 366 367 368 369 370 371 372 373 374 | * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ int expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ int *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ } CompileEnv; /* * The structure defining the bytecode instructions resulting from compiling a |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
1937 1938 1939 1940 1941 1942 1943 | * TIP #280: Initialize the frame. Do not push it yet: it will be pushed * every time that we call out from this TD, popped when we return to it. */ bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) ? TCL_LOCATION_PREBC : TCL_LOCATION_BC); bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1); | < | | > | 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 | * TIP #280: Initialize the frame. Do not push it yet: it will be pushed * every time that we call out from this TD, popped when we return to it. */ bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) ? TCL_LOCATION_PREBC : TCL_LOCATION_BC); bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1); bcFramePtr->framePtr = iPtr->framePtr; bcFramePtr->nextPtr = iPtr->cmdFramePtr; bcFramePtr->nline = 0; bcFramePtr->line = NULL; bcFramePtr->litarg = NULL; bcFramePtr->data.tebc.codePtr = codePtr; bcFramePtr->data.tebc.pc = NULL; bcFramePtr->cmdObj = NULL; bcFramePtr->cmd = NULL; bcFramePtr->len = 0; #ifdef TCL_COMPILE_STATS iPtr->stats.numExecutions++; #endif /* * Push the callback for bytecode execution |
︙ | ︙ | |||
2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 | #endif if (data[1] /* resume from invocation */) { if (iPtr->execEnvPtr->rewind) { result = TCL_ERROR; } NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); iPtr->cmdFramePtr = bcFramePtr->nextPtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr); } if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { iPtr->flags |= ERR_ALREADY_LOGGED; codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; | > > > > > | 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 | #endif if (data[1] /* resume from invocation */) { if (iPtr->execEnvPtr->rewind) { result = TCL_ERROR; } NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); if (bcFramePtr->cmdObj) { Tcl_DecrRefCount(bcFramePtr->cmdObj); bcFramePtr->cmdObj = NULL; bcFramePtr->cmd = NULL; } iPtr->cmdFramePtr = bcFramePtr->nextPtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr); } if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { iPtr->flags |= ERR_ALREADY_LOGGED; codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; |
︙ | ︙ | |||
2839 2840 2841 2842 2843 2844 2845 | } DECACHE_STACK_INFO(); pc += pcAdjustment; TEBC_YIELD(); return TclNREvalObjv(interp, objc, objv, | | | 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 | } DECACHE_STACK_INFO(); pc += pcAdjustment; TEBC_YIELD(); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); /* * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the * changes to add a ::tcl::mathfunc namespace in 8.5. */ case INST_CALL_BUILTIN_FUNC1: |
︙ | ︙ | |||
8581 8582 8583 8584 8585 8586 8587 | Tcl_GetString(opndPtr), operator)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } /* *---------------------------------------------------------------------- * | | | | | | > > > > > | | | | > > > > > > > | > | | | > | | 8586 8587 8588 8589 8590 8591 8592 8593 8594 8595 8596 8597 8598 8599 8600 8601 8602 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 8619 8620 8621 8622 8623 8624 8625 8626 8627 8628 8629 8630 8631 8632 8633 8634 8635 8636 8637 8638 8639 8640 8641 8642 8643 8644 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 | Tcl_GetString(opndPtr), operator)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } /* *---------------------------------------------------------------------- * * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame -- * * Given a program counter value, finds the closest command in the * bytecode code unit's CmdLocation array and returns information about * that command's source: a pointer to its first byte and the number of * characters. * * Results: * If a command is found that encloses the program counter value, a * pointer to the command's source is returned and the length of the * source is stored at *lengthPtr. If multiple commands resulted in code * at pc, information about the closest enclosing command is returned. If * no matching command is found, NULL is returned and *lengthPtr is * unchanged. * * Side effects: * The CmdFrame at *cfPtr is updated. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetSourceFromFrame( CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]) { if (cfPtr == NULL) { return Tcl_NewListObj(objc, objv); } if (cfPtr->cmdObj == NULL) { if (cfPtr->cmd == NULL) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; cfPtr->cmd = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); } cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); Tcl_IncrRefCount(cfPtr->cmdObj); } return cfPtr->cmdObj; } void TclGetSrcInfoForPc( CmdFrame *cfPtr) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; assert(cfPtr->type == TCL_LOCATION_BC); if (cfPtr->cmd == NULL) { cfPtr->cmd = GetSrcInfoForPc( (unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); } assert(cfPtr->cmd != NULL); { /* * We now have the command. We can get the srcOffset back and from * there find the list of word locations for this command. */ ExtCmdLoc *eclPtr; ECL *locPtr = NULL; int srcOffset, i; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; } srcOffset = cfPtr->cmd - codePtr->source; eclPtr = Tcl_GetHashValue(hePtr); for (i=0; i < eclPtr->nuloc; i++) { if (eclPtr->loc[i].srcOffset == srcOffset) { locPtr = eclPtr->loc+i; break; } |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
1171 1172 1173 1174 1175 1176 1177 | * NULL. */ struct CmdFrame *nextPtr; /* Link to calling frame. */ /* * Data needed for Eval vs TEBC * * EXECUTION CONTEXTS and usage of CmdFrame * | | | | | | | | | | | | | | | | | < < | | | | < | | < < < < < | 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 | * NULL. */ struct CmdFrame *nextPtr; /* Link to calling frame. */ /* * Data needed for Eval vs TEBC * * EXECUTION CONTEXTS and usage of CmdFrame * * Field TEBC EvalEx * ======= ==== ====== * level yes yes * type BC/PREBC SRC/EVAL * line0 yes yes * framePtr yes yes * ======= ==== ====== * * ======= ==== ========= union data * line1 - yes * line3 - yes * path - yes * ------- ---- ------ * codePtr yes - * pc yes - * ======= ==== ====== * * ======= ==== ========= union cmd * str.cmd yes yes * str.len yes yes * ------- ---- ------ */ union { struct { Tcl_Obj *path; /* Path of the sourced file the command is * in. */ } eval; struct { const void *codePtr;/* Byte code currently executed... */ const char *pc; /* ... and instruction pointer. */ } tebc; } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ int len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by * TclArgumentBCEnter(). These will be removed * by TclArgumentBCRelease. */ } CmdFrame; |
︙ | ︙ | |||
1278 1279 1280 1281 1282 1283 1284 | /* * The following macros define the allowed values for the type field of the * CmdFrame structure above. Some of the values occur only in the extended * location data referenced via the 'baseLocPtr'. * * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. | < < < < | 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 | /* * The following macros define the allowed values for the type field of the * CmdFrame structure above. Some of the values occur only in the extended * location data referenced via the 'baseLocPtr'. * * TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx. * TCL_LOCATION_BC : Frame is for bytecode. * TCL_LOCATION_PREBC : Frame is for precompiled bytecode. * TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a * sourced file. * TCL_LOCATION_PROC : Frame is for bytecode of a procedure. * * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC * types, per the context of the byte code in execution. */ #define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */ #define TCL_LOCATION_BC (2) /* Location in byte code. */ #define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no * location. */ #define TCL_LOCATION_SOURCE (4) /* Location in a file. */ #define TCL_LOCATION_PROC (5) /* Location in a dynamic proc. */ #define TCL_LOCATION_LAST (6) /* Number of values in the enum. */ |
︙ | ︙ | |||
2179 2180 2181 2182 2183 2184 2185 | * EvalFlag bits for Interp structures: * * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with a * code other than TCL_OK or TCL_ERROR; 0 means codes * other than these should be turned into errors. */ | | | | | 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 | * EvalFlag bits for Interp structures: * * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with a * code other than TCL_OK or TCL_ERROR; 0 means codes * other than these should be turned into errors. */ #define TCL_ALLOW_EXCEPTIONS 0x04 #define TCL_EVAL_FILE 0x02 #define TCL_EVAL_SOURCE_IN_FRAME 0x10 /* * Flag bits for Interp structures: * * DELETED: Non-zero means the interpreter has been deleted: * don't process any more commands for it, and destroy * the structure as soon as all nested invocations of |
︙ | ︙ | |||
2876 2877 2878 2879 2880 2881 2882 | MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); | | > | 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 | MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientDataPtr, int *typePtr); MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, const char *modeString, int *seekFlagPtr, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); MODULE_SCOPE int TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp, |
︙ | ︙ |
Changes to generic/tclOODefineCmds.c.
︙ | ︙ | |||
2202 2203 2204 2205 2206 2207 2208 2209 2210 | * Allocate some working space. */ superclasses = (Class **) ckalloc(sizeof(Class *) * superc); /* * Parse the arguments to get the class to use as superclasses. */ | > > > > > > > > > > > | | | | | | | | | | > | | | | | | | | | | | > | 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 | * Allocate some working space. */ superclasses = (Class **) ckalloc(sizeof(Class *) * superc); /* * Parse the arguments to get the class to use as superclasses. * * Note that zero classes is special, as it is equivalent to just the * class of objects. [Bug 9d61624b3d] */ if (superc == 0) { superclasses = ckrealloc(superclasses, sizeof(Class *)); superclasses[0] = oPtr->fPtr->objectCls; superc = 1; if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) { superclasses[0] = oPtr->fPtr->classCls; } } else { for (i=0 ; i<superc ; i++) { superclasses[i] = GetClassInOuterContext(interp, superv[i], "only a class can be a superclass"); if (superclasses[i] == NULL) { goto failedAfterAlloc; } for (j=0 ; j<i ; j++) { if (superclasses[j] == superclasses[i]) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "class should only be a direct superclass once", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL); goto failedAfterAlloc; } } if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to form circular dependency graph", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); failedAfterAlloc: ckfree((char *) superclasses); return TCL_ERROR; } } } /* * Install the list of superclasses into the class. Note that this also * involves splicing the class out of the superclasses' subclass list that * it used to be a member of and splicing it into the new superclasses' |
︙ | ︙ |
Changes to generic/tclOOMethod.c.
︙ | ︙ | |||
509 510 511 512 513 514 515 | cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = context.data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); | | | | 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 | cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = context.data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); cfPtr->cmd = NULL; cfPtr->len = 0; hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew); Tcl_SetHashValue(hPtr, cfPtr); } /* |
︙ | ︙ | |||
622 623 624 625 626 627 628 | cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = context.data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); | | | | 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 | cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = context.data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); cfPtr->cmd = NULL; cfPtr->len = 0; hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew); Tcl_SetHashValue(hPtr, cfPtr); } /* |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
93 94 95 96 97 98 99 | * that a Tcl_Obj was not allocated by some * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; | < | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | * that a Tcl_Obj was not allocated by some * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; static void TclThreadFinalizeContLines(ClientData clientData); static ThreadSpecificData *TclGetContLineTable(void); /* * Nested Tcl_Obj deletion management support * * All context references used in the object freeing code are pointers to this |
︙ | ︙ | |||
801 802 803 804 805 806 807 | ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < | 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 | ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(tsdPtr->lineCLPtr); ckfree(tsdPtr->lineCLPtr); tsdPtr->lineCLPtr = NULL; } /* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- * * This function is called to register a new Tcl object type in the table |
︙ | ︙ | |||
1401 1402 1403 1404 1405 1406 1407 | { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { | | | 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } #else /* TCL_MEM_DEBUG */ |
︙ | ︙ | |||
1492 1493 1494 1495 1496 1497 1498 | { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { | | | 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 | { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { ckfree(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); } } } } #endif /* TCL_MEM_DEBUG */ |
︙ | ︙ |
Changes to generic/tclParse.c.
︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * Copyright (c) 1998-2000 Ajuba Solutions. * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclParse.h" /* * The following table provides parsing information about each possible 8-bit * character. The table is designed to be referenced with either signed or * unsigned characters, so it has 384 entries. The first 128 entries | > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | * Copyright (c) 1998-2000 Ajuba Solutions. * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <assert.h> #include "tclInt.h" #include "tclParse.h" /* * The following table provides parsing information about each possible 8-bit * character. The table is designed to be referenced with either signed or * unsigned characters, so it has 384 entries. The first 128 entries |
︙ | ︙ | |||
1574 1575 1576 1577 1578 1579 1580 | } objPtr = Tcl_GetObjResult(interp); /* * At this point we should have an object containing the value of a * variable. Just return the string from that object. * | | | | < < | < | | 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 | } objPtr = Tcl_GetObjResult(interp); /* * At this point we should have an object containing the value of a * variable. Just return the string from that object. * * Since TclSubstTokens above returned TCL_OK, we know that objPtr * is shared. It is in both the interp result and the value of the * variable. Returning the string relies on that to be true. */ assert( Tcl_IsShared(objPtr) ); Tcl_ResetResult(interp); return TclGetString(objPtr); } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclProc.c.
︙ | ︙ | |||
267 268 269 270 271 272 273 | cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = contextPtr->data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); | | | | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = contextPtr->data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); cfPtr->cmd = NULL; cfPtr->len = 0; hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr, &isNew); if (!isNew) { /* * Get the old command frame and release it. See also * TclProcCleanupProc in this file. Currently it seems as |
︙ | ︙ | |||
2591 2592 2593 2594 2595 2596 2597 | cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = contextPtr->data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); | | | | 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 | cfPtr->nline = 1; cfPtr->framePtr = NULL; cfPtr->nextPtr = NULL; cfPtr->data.eval.path = contextPtr->data.eval.path; Tcl_IncrRefCount(cfPtr->data.eval.path); cfPtr->cmd = NULL; cfPtr->len = 0; } /* * 'contextPtr' is going out of scope. Release the reference that * it's holding to the source file path */ |
︙ | ︙ |
Changes to library/auto.tcl.
︙ | ︙ | |||
612 613 614 615 616 617 618 619 620 | set name ::[join [lreverse $contextStack] ::] # create artifical proc to force an entry in the tclIndex $parser eval [list ::proc $name {} {}] } } } } return | > > > > > > > > > > > > > > | 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 | set name ::[join [lreverse $contextStack] ::] # create artifical proc to force an entry in the tclIndex $parser eval [list ::proc $name {} {}] } } } } # AUTO MKINDEX: oo::class create name ?definition? # Adds an entry to the auto index list for the given class name. foreach cmd {oo::class class} { auto_mkindex_parser::command $cmd {ecmd name {body ""}} { if {$cmd eq "create"} { variable index variable scriptFile append index [format "set %s \[list source \[%s]]\n" \ [list auto_index([fullname $name])] \ [list file join $dir {*}[file split $scriptFile]]] } } } return |
Changes to library/clock.tcl.
︙ | ︙ | |||
320 321 322 323 324 325 326 | :America/Santiago {-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus {-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax {-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires | | | 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 | :America/Santiago {-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus {-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax {-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo {-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha {-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores {-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Atlantic/Cape_Verde {0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :UTC {0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0} :Europe/London {3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Kinshasa |
︙ | ︙ |
Changes to tests/oo.test.
︙ | ︙ | |||
3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 | } {{-append -clear -set} {Get Set}} test oo-34.8 {TIP 380: slots - presence} { getMethods oo::objdefine::mixin } {{-append -clear -set} {--default-operation Get Set}} test oo-34.9 {TIP 380: slots - presence} { getMethods oo::objdefine::variable } {{-append -clear -set} {Get Set}} cleanupTests return # Local Variables: # mode: tcl # End: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 | } {{-append -clear -set} {Get Set}} test oo-34.8 {TIP 380: slots - presence} { getMethods oo::objdefine::mixin } {{-append -clear -set} {--default-operation Get Set}} test oo-34.9 {TIP 380: slots - presence} { getMethods oo::objdefine::variable } {{-append -clear -set} {Get Set}} test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup { oo::class create fruit { method eat {} {} } set result {} } -body { lappend result [fruit create ::apple] [info class superclasses fruit] oo::define fruit superclass lappend result [info class superclasses fruit] \ [info object class apple oo::object] \ [info class call fruit destroy] \ [catch { apple }] } -cleanup { unset -nocomplain result fruit destroy } -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1} test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup { oo::class create fruitMetaclass { superclass oo::class method eat {} {} } set result {} } -body { lappend result [fruitMetaclass create ::appleClass] \ [appleClass create orange] \ [info class superclasses fruitMetaclass] oo::define fruitMetaclass superclass lappend result [info class superclasses fruitMetaclass] \ [info object class appleClass oo::class] \ [catch { orange }] [info object class orange] \ [appleClass create pear] } -cleanup { unset -nocomplain result fruitMetaclass destroy } -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear} cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/parse.test.
︙ | ︙ | |||
1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 | test parse-21.0 {Bug 1884496} testevent { set ::script {testevent delete a; set a [p]; set ::done $a} proc ::p {} {string first s $::script} testevent queue a head $::script vwait done } {} cleanupTests } namespace delete ::tcl::test::parse return | > > > > > > | 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 | test parse-21.0 {Bug 1884496} testevent { set ::script {testevent delete a; set a [p]; set ::done $a} proc ::p {} {string first s $::script} testevent queue a head $::script vwait done } {} test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent { testevent queue a head {testevent delete a; \ set ::done [dict get [info frame 0] line]} vwait done set ::done } 2 cleanupTests } namespace delete ::tcl::test::parse return |
Changes to tests/unixForkEvent.test.
︙ | ︙ | |||
12 13 14 15 16 17 18 | namespace import -force ::tcltest::* testConstraint testfork [llength [info commands testfork]] # Test if the notifier thread is well initialized in a forked interpreter # by Tcl_InitNotifier test unixforkevent-1.1 {fork and test writeable event} \ | | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | namespace import -force ::tcltest::* testConstraint testfork [llength [info commands testfork]] # Test if the notifier thread is well initialized in a forked interpreter # by Tcl_InitNotifier test unixforkevent-1.1 {fork and test writeable event} \ -constraints {testfork nonPortable} \ -body { set myFolder [makeDirectory unixtestfork] set pid [testfork] if {$pid == 0} { # we are the forked process set result initialized set h [open [file join $myFolder test.txt] w] |
︙ | ︙ |
Changes to unix/configure.
︙ | ︙ | |||
4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 | fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? for ac_func in pthread_attr_setstacksize pthread_atfork do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then | > > > | 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 | fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" for ac_func in pthread_attr_setstacksize pthread_atfork do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` echo "$as_me:$LINENO: checking for $ac_func" >&5 echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 if eval "test \"\${$as_ac_var+set}\" = set"; then |
︙ | ︙ | |||
4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 | cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output echo "$as_me:$LINENO: checking for building with threads" >&5 echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 if test "${TCL_THREADS}" = 1; then | > | 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 | cat >>confdefs.h <<_ACEOF #define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF fi done LIBS=$ac_saved_libs else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output echo "$as_me:$LINENO: checking for building with threads" >&5 echo $ECHO_N "checking for building with threads... $ECHO_C" >&6 if test "${TCL_THREADS}" = 1; then |
︙ | ︙ |
Changes to unix/tcl.m4.
︙ | ︙ | |||
672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 | fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork) else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output AC_MSG_CHECKING([for building with threads]) if test "${TCL_THREADS}" = 1; then AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?]) | > > > > | 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 | fi fi fi fi # Does the pthread-implementation provide # 'pthread_attr_setstacksize' ? ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork) LIBS=$ac_saved_libs else TCL_THREADS=0 fi # Do checking message here to not mess up interleaved configure output AC_MSG_CHECKING([for building with threads]) if test "${TCL_THREADS}" = 1; then AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?]) |
︙ | ︙ |
Changes to unix/tclUnixTest.c.
︙ | ︙ | |||
568 569 570 571 572 573 574 | } pid = fork(); if (pid == -1) { Tcl_AppendResult(interp, "Cannot fork", NULL); return TCL_ERROR; } | | | | 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 | } pid = fork(); if (pid == -1) { Tcl_AppendResult(interp, "Cannot fork", NULL); return TCL_ERROR; } #if !defined(HAVE_PTHREAD_ATFORK) || defined(MAC_OSX_TCL) /* Only needed when pthread_atfork is not present or on OSX. */ if (pid==0) { Tcl_InitNotifier(); } #endif Tcl_SetObjResult(interp, Tcl_NewIntObj(pid)); return TCL_OK; } |
︙ | ︙ |