From b2c41c81e4080d7e8636328c58f27ed15b70c29b Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 13 Mar 2015 16:55:39 +0000 Subject: The STRICT directive influences how #include "windows.h" works. This is not a generic concern. Move it over the tclWinPort.h. --- generic/tcl.h | 10 ---------- win/tclWinPort.h | 2 ++ 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index ae425bb..f09315b 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -77,16 +77,6 @@ extern "C" { #endif /* - * STRICT: See MSDN Article Q83456 - */ - -#ifdef _WIN32 -# ifndef STRICT -# define STRICT -# endif -#endif /* _WIN32 */ - -/* * Utility macros: STRINGIFY takes an argument and wraps it in "" (double * quotation marks), JOIN joins two arguments. */ diff --git a/win/tclWinPort.h b/win/tclWinPort.h index ca6b2bf..1b23ee3 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -33,7 +33,9 @@ #endif #define WIN32_LEAN_AND_MEAN +#define STRICT /* See MSDN Article Q83456 */ #include +#undef STRICT #undef WIN32_LEAN_AND_MEAN /* Compatibility to older visual studio / windows platform SDK */ -- cgit v0.12 From f399206c210a987dad1e8f87fe889eeb1ffe00f2 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 13 Mar 2015 17:14:16 +0000 Subject: Upon further review, due the order of #include of headers, we do not have a history of a #define STRICT active when the #include "windows.h" in tclWinPort.h happens. Don't want to start something new now. --- win/tclAppInit.c | 2 ++ win/tclWinPort.h | 2 -- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index a6c1a67..e06eaf5 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -16,7 +16,9 @@ #include "tcl.h" #define WIN32_LEAN_AND_MEAN +#define STRICT /* See MSDN Article Q83456 */ #include +#undef STRICT #undef WIN32_LEAN_AND_MEAN #include #include diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 1b23ee3..ca6b2bf 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -33,9 +33,7 @@ #endif #define WIN32_LEAN_AND_MEAN -#define STRICT /* See MSDN Article Q83456 */ #include -#undef STRICT #undef WIN32_LEAN_AND_MEAN /* Compatibility to older visual studio / windows platform SDK */ -- cgit v0.12 From 50426ba9c5cb0fa954959ab5b810695b6bf20111 Mon Sep 17 00:00:00 2001 From: ashok Date: Thu, 19 Mar 2015 10:41:28 +0000 Subject: Ticket [e66e444440]. Modified ReadConsoleBytes to handle Ctrl-C / Ctrl-Break and not return 0 bytes indicating EOF for those cases. --- win/tclWinConsole.c | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 63150ef..7380003 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -220,8 +220,20 @@ ReadConsoleBytes( BOOL result; int tcharsize = sizeof(TCHAR); - result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, - NULL); + /* + * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return + * success with ntchars == 0 and GetLastError() will be + * ERROR_OPERATION_ABORTED. We do not want to treat this case + * as EOF so we will loop around again. If no Ctrl signal handlers + * have been established, the default signal OS handler in a separate + * thread will terminate the program. If a Ctrl signal handler + * has been established (through an extension for example), it + * will run and take whatever action it deems appropriate. + */ + do { + result = ReadConsole(hConsole, lpBuffer, nbytes / tcharsize, &ntchars, + NULL); + } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED); if (nbytesread != NULL) { *nbytesread = ntchars * tcharsize; } -- cgit v0.12 From 1292a0d927e1e406c26efa91c7f8b36087b2b767 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 21 Mar 2015 00:31:29 +0000 Subject: [d87cb18205] Let compiled ensembles handle tailcalls properly. --- generic/tclExecute.c | 1 - tests/nre.test | 21 +++++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index b9da8fc..322bd20 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3186,7 +3186,6 @@ TEBCresume( TEBC_YIELD(); TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); - TclSkipTailcall(interp); return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN); /* diff --git a/tests/nre.test b/tests/nre.test index b5eb032..e512eac 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -151,6 +151,27 @@ test nre-4.1 {ensembles are not recursive} -setup { testnrelevels } -result {{0 2 1 1} 0} +test nre-4.2 {(compiled) ensembles do not break tailcall} -setup { + # Fix Bug d87cb18205 + proc b {} { + tailcall append result first + } + set map [namespace ensemble configure ::dict -map] + dict set map a b + namespace ensemble configure ::dict -map $map + proc demo {} { + dict a + append result second + } +} -body { + demo +} -cleanup { + rename demo {} + namespace ensemble configure ::dict -map [dict remove $map a] + unset map + rename b {} +} -result firstsecond + test nre-5.1 {[namespace eval] is not recursive} -setup { namespace eval ::foo { setabs -- cgit v0.12 From 7dbf5ed0b0e60ff40474e45e7b0eb498d4eed3b9 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Sat, 21 Mar 2015 15:08:35 +0000 Subject: adding a test to reveal a problem with the fix of bug d87cb182053fd79b3 --- tests/tailcall.test | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/tests/tailcall.test b/tests/tailcall.test index 2d04f82..26f3cbf 100644 --- a/tests/tailcall.test +++ b/tests/tailcall.test @@ -147,6 +147,36 @@ test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup rename b {} } -result {0 0 0 0 0 0} +test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -setup { + # + # This test is related to [bug d87cb182053fd79b3]: the fix to that bug was + # to remove a call to TclSkipTailcall, which caused a violation of the + # constant-space property of tailcall in that particular + # configuration. This test was added to detect that, and insure that the + # problem is fixed. + # + + proc b i { + if {$i == 1} { + depthDiff + } + if {[incr i] > 10} { + return [depthDiff] + } + tailcall dict b $i + } + set map0 [namespace ensemble configure dict -map] + set map $map0 + dict set map b b + namespace ensemble configure dict -map $map +} -body { + dict b 0 +} -cleanup { + rename b {} + namespace ensemble configure dict -map $map0 + unset map map0 +} -result {0 0 0 0 0 0} + test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup { # # This test fails because ns-unknown is not NR-enabled -- cgit v0.12 From 2cc11d4918127e3ad2d7af5100ddf40c62cdb7f9 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Mon, 23 Mar 2015 00:33:07 +0000 Subject: completing the fix for bug d87cb182053fd79b3 --- generic/tclExecute.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 322bd20..4790ba3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3185,6 +3185,7 @@ TEBCresume( pc += 6; TEBC_YIELD(); + TclMarkTailcall(interp); TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN); -- cgit v0.12 -- cgit v0.12 From d4166a6b3a790e67fedc6e636715146d4526972a Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Mon, 23 Mar 2015 02:11:30 +0000 Subject: updated, improved tailcall comments --- generic/tclBasic.c | 45 +++++++++++++++++++++------------------------ 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 361ed49..e92e8e9 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4142,8 +4142,9 @@ TclNREvalObjv( /* * data[1] stores a marker for use by tailcalls; it will be set to 1 by - * command redirectors (imports, alias, ensembles) so that tailcalls - * finishes the source command and not just the target. + * command redirectors (imports, alias, ensembles) so that tailcall skips + * this callback (that marks the end of the target command) and goes back + * to the end of the source command. */ if (iPtr->deferredCallbacks) { @@ -4406,7 +4407,7 @@ NRCommand( iPtr->numLevels--; /* - * If there is a tailcall, schedule it + * If there is a tailcall, schedule it next */ if (data[1] && (data[1] != INT2PTR(1))) { @@ -8170,27 +8171,24 @@ Tcl_NRCmdSwap( } /***************************************************************************** - * Stuff for tailcalls + * Tailcall related code ***************************************************************************** * - * Just to show that IT CAN BE DONE! The precise semantics are not simple, - * require more thought. Possibly need a new Tcl return code to do it right? - * Questions include: - * (1) How is the objc/objv tailcall to be run? My current thinking is that - * it should essentially be - * [tailcall a b c] <=> [uplevel 1 [list a b c]] - * with two caveats - * (a) the current frame is dropped first, after running all pending - * cleanup tasks and saving its namespace - * (b) 'a' is looked up in the returning frame's namespace, but the - * command is run in the context to which we are returning - * Current implementation does this if [tailcall] is called from within - * a proc, errors otherwise. - * (2) Should a tailcall bypass [catch] in the returning frame? Current - * implementation does not (or does it? Changed, test!) - it causes an - * error. - * - * FIXME NRE! + * The steps of the tailcall dance are as follows: + * + * 1. when [tailcall] is invoked, it stores the corresponding callback in + * the current CallFrame and returns TCL_RETURN + * 2. when the CallFrame is popped, it calls TclSetTailcall to store the + * callback in the proper NRCommand callback - the spot where the command + * that pushed the CallFrame is completely cleaned up + * 3. The NRCommand schedules the tailcall callback to run immediately after + * NRCommand returns + * + * One delicate point is to properly define the NRCommand where the tailcall + * will execute. There are functions whose purpose is to help define the + * precise spot: TclMarkTailcall ("this is the spot") and TclSkipTailcall + * ("skip the next command: we are redirecting to it, tailcalls should run + * after WE return"), TclPushTailcallPoint (special for OO). */ void @@ -8282,8 +8280,7 @@ TclNRTailcallObjCmd( /* * Create the callback to actually evaluate the tailcalled * command, then set it in the varFrame so that PopCallFrame can use it - * at the proper time. Being lazy: exploit the TclNRAddCallBack macro to - * build the callback. + * at the proper time. */ if (objc > 1) { -- cgit v0.12 From ee626d59092153c963025c23f39e9c1fdb49ac77 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Mon, 23 Mar 2015 13:43:37 +0000 Subject: more comments --- generic/tclBasic.c | 44 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e92e8e9..16e7a5d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8181,8 +8181,8 @@ Tcl_NRCmdSwap( * 2. when the CallFrame is popped, it calls TclSetTailcall to store the * callback in the proper NRCommand callback - the spot where the command * that pushed the CallFrame is completely cleaned up - * 3. The NRCommand schedules the tailcall callback to run immediately after - * NRCommand returns + * 3. when the NRCommand callback runs, it schedules the tailcall callback + * to run immediately after it returns * * One delicate point is to properly define the NRCommand where the tailcall * will execute. There are functions whose purpose is to help define the @@ -8222,6 +8222,18 @@ TclPushTailcallPoint( ((Interp *) interp)->numLevels++; } + +/* + *---------------------------------------------------------------------- + * + * TclSetTailcall -- + * + * Splice a tailcall command in the proper spot of the NRE callback + * stack, so that it runs at the right time. + * + *---------------------------------------------------------------------- + */ + void TclSetTailcall( Tcl_Interp *interp, @@ -8246,6 +8258,23 @@ TclSetTailcall( runPtr->data[1] = listPtr; } + +/* + *---------------------------------------------------------------------- + * + * TclNRTailcallObjCmd -- + * + * Prepare the tailcall as a list and store it in the current + * varFrame. When the frame is later popped the tailcall will be spliced + * at the proper place. + * + * Results: + * The first NRCommand callback that is not marked to be skipped is + * updated so that its data[1] field contains the tailcall list. + * + *---------------------------------------------------------------------- + */ + int TclNRTailcallObjCmd( ClientData clientData, @@ -8305,6 +8334,17 @@ TclNRTailcallObjCmd( return TCL_RETURN; } + +/* + *---------------------------------------------------------------------- + * + * TclNRTailcallEval -- + * + * This NREcallback actually causes the tailcall to be evaluated. + * + *---------------------------------------------------------------------- + */ + int TclNRTailcallEval( ClientData data[], -- cgit v0.12 From 63e0947392fd8ac318ca20cd083dfc8d9eb85199 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Mon, 23 Mar 2015 16:05:04 +0000 Subject: fix comments describing tailcall implementation --- generic/tclBasic.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 16e7a5d..f6f66ed 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8289,9 +8289,9 @@ TclNRTailcallObjCmd( return TCL_ERROR; } - if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { /* or is upleveled */ + if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc or lambda", -1)); + "tailcall can only be called from a proc, lambda or method", -1)); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); return TCL_ERROR; } -- cgit v0.12