removed [case]

5 files changed, 33 insertions, 237 deletions

diff --git a/TODO_DONE b/TODO_DONE
index f40a84c..28ce966 100644
--- a/TODO_DONE
+++ b/TODO_DONE
@@ -3,13 +3,11 @@
 *************************************************************************
 
 * remove [info frame] and [info errortsack], as well as all supporting
-  code. These should be recoded using the data that NRE is keeping. nything
-  additional should ALWAYS choose to recompute on demand over precomputing
-  things during normal operation
+  code. These should be recoded using the data that NRE is
+  keeping. Anything additional should ALWAYS choose to recompute on demand
+  over precomputing things during normal operation
 
-* remove interp-result and all supporting code
-
-* remove [case]
+* remove interp->result and all supporting code
 
 * bring up relevant mods (if any) from mig-alloc-reform 
 
@@ -18,4 +16,33 @@
 **** DONE ***************************************************************
 *************************************************************************
 
+* changes to compiler and engine: old .tbc will not run, except with a
+  "sufficiently clever" tbcload. The compiler and tbcload will probably
+  need some work to adapt to the changes. This branch completely ignores
+  these issues.
+
+* tclAssembly.c and related are gone; it was an added burden adapting them
+  while modifying the bytecodes and tebc, the decision was taken to remove
+  it and do the work again "at the end"
+
+* INCOMPATIBILITY - no more cmdCount
+  There is no more [info cmdcount], or cmdCount based interpreter limits
+
+* the compiler was simplified a bit, removing quite a few "premature"
+  optimizations; these are now handled by the optimizer. In particular: all
+  instructions are issued in the 4-byte variant (so that the optimizer can
+  use the extra space), break/continue are not optimized to jumps until
+  later, etc.
+
+* there is a new optimizer that produces better bytecodes, especially in
+  the handling of logic and exceptions. The optimizer itself is extremely
+  suboptimal, the way it works can definitely be improved.
+
+* INCOMPATIBILITY (?) - NRE stack is a real stack
+  Tcl_NRAddCallback now OVERWRITES the currently executing callback!! Users
+  now have to make sure that they save the received data[] in local vars if
+  they plan to use them after pushing a new callback!
+
+* remove [case]
+
 
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index def25c4..6917b68 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -206,9 +206,6 @@ static const CmdInfo builtInCmds[] = {
     {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
     {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
     {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
-#ifndef EXCLUDE_OBSOLETE_COMMANDS
-    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
-#endif
     {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
     {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
     {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 54e0227..ec8ea5f 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -132,142 +132,6 @@ Tcl_BreakObjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_CaseObjCmd --
- *
- *	This procedure is invoked to process the "case" Tcl command. See the
- *	user documentation for details on what it does. THIS COMMAND IS
- *	OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-int
-Tcl_CaseObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    register int i;
-    int body, result, caseObjc;
-    const char *stringPtr, *arg;
-    Tcl_Obj *const *caseObjv;
-    Tcl_Obj *armPtr;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"string ?in? ?pattern body ...? ?default body?");
-	return TCL_ERROR;
-    }
-
-    stringPtr = TclGetString(objv[1]);
-    body = -1;
-
-    arg = TclGetString(objv[2]);
-    if (strcmp(arg, "in") == 0) {
-	i = 3;
-    } else {
-	i = 2;
-    }
-    caseObjc = objc - i;
-    caseObjv = objv + i;
-
-    /*
-     * If all of the pattern/command pairs are lumped into a single argument,
-     * split them out again.
-     */
-
-    if (caseObjc == 1) {
-	Tcl_Obj **newObjv;
-
-	TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
-	caseObjv = newObjv;
-    }
-
-    for (i = 0;  i < caseObjc;  i += 2) {
-	int patObjc, j;
-	const char **patObjv;
-	const char *pat, *p;
-
-	if (i == caseObjc-1) {
-	    Tcl_ResetResult(interp);
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "extra case pattern with no body", -1));
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Check for special case of single pattern (no list) with no
-	 * backslash sequences.
-	 */
-
-	pat = TclGetString(caseObjv[i]);
-	for (p = pat; *p != '\0'; p++) {
-	    if (TclIsSpaceProc(*p) || (*p == '\\')) {
-		break;
-	    }
-	}
-	if (*p == '\0') {
-	    if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
-		body = i + 1;
-	    }
-	    if (Tcl_StringMatch(stringPtr, pat)) {
-		body = i + 1;
-		goto match;
-	    }
-	    continue;
-	}
-
-	/*
-	 * Break up pattern lists, then check each of the patterns in the
-	 * list.
-	 */
-
-	result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	for (j = 0; j < patObjc; j++) {
-	    if (Tcl_StringMatch(stringPtr, patObjv[j])) {
-		body = i + 1;
-		break;
-	    }
-	}
-	ckfree(patObjv);
-	if (j < patObjc) {
-	    break;
-	}
-    }
-
-  match:
-    if (body != -1) {
-	armPtr = caseObjv[body - 1];
-	result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
-	if (result == TCL_ERROR) {
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (\"%.50s\" arm line %d)",
-		    TclGetString(armPtr), Tcl_GetErrorLine(interp)));
-	}
-	return result;
-    }
-
-    /*
-     * Nothing matched: return nothing.
-     */
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_CatchObjCmd --
  *
  *	This object-based procedure is invoked to process the "catch" Tcl
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 798a29a..7e578d8 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3172,9 +3172,6 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
diff --git a/tests/case.test b/tests/case.test
deleted file mode 100644
index 6d63cea..0000000
--- a/tests/case.test
+++ /dev/null
@@ -1,89 +0,0 @@
-# Commands covered:  case
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
-#
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
-
-test case-1.1 {simple pattern} {
-    case a in a {format 1} b {format 2} c {format 3} default {format 4}
-} 1
-test case-1.2 {simple pattern} {
-    case b a {format 1} b {format 2} c {format 3} default {format 4}
-} 2
-test case-1.3 {simple pattern} {
-    case x in a {format 1} b {format 2} c {format 3} default {format 4}
-} 4
-test case-1.4 {simple pattern} {
-    case x a {format 1} b {format 2} c {format 3}
-} {}
-test case-1.5 {simple pattern matches many times} {
-    case b a {format 1} b {format 2} b {format 3} b {format 4}
-} 2
-test case-1.6 {fancier pattern} {
-    case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
-} 3
-test case-1.7 {list of patterns} {
-    case abc in {a b c} {format 1} {def abc ghi} {format 2}
-} 2
-
-test case-2.1 {error in executed command} {
-    list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
-	    $msg $::errorInfo
-} {1 {Just a test} {Just a test
-    while executing
-"error "Just a test""
-    ("a" arm line 1)
-    invoked from within
-"case a in a {error "Just a test"} default {format 1}"}}
-test case-2.2 {error: not enough args} {
-    list [catch {case} msg] $msg
-} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}}
-test case-2.3 {error: pattern with no body} {
-    list [catch {case a b} msg] $msg
-} {1 {extra case pattern with no body}}
-test case-2.4 {error: pattern with no body} {
-    list [catch {case a in b {format 1} c} msg] $msg
-} {1 {extra case pattern with no body}}
-test case-2.5 {error in default command} {
-    list [catch {case foo in a {error case1} default {error case2} \
-	    b {error case 3}} msg] $msg $::errorInfo
-} {1 case2 {case2
-    while executing
-"error case2"
-    ("default" arm line 1)
-    invoked from within
-"case foo in a {error case1} default {error case2}  b {error case 3}"}}
-
-test case-3.1 {single-argument form for pattern/command pairs} {
-    case b in {
-	a {format 1}
-	b {format 2}
-	default {format 6}
-    }
-} {2}
-test case-3.2 {single-argument form for pattern/command pairs} {
-    case b {
-	a {format 1}
-	b {format 2}
-	default {format 6}
-    }
-} {2}
-test case-3.3 {single-argument form for pattern/command pairs} {
-    list [catch {case z in {a 2 b}} msg] $msg
-} {1 {extra case pattern with no body}}
-
-# cleanup
-::tcltest::cleanupTests
-return