Slightly chisel down the execution time of the oo init script (backport)

2 files changed, 131 insertions, 145 deletions

diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index ff29535..7b8a69d 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -27,46 +27,41 @@
 static const char *tclOOSetupScript =
 /* !BEGIN!: Do not edit below this line. */
 "::namespace eval ::oo {\n"
-"\t::namespace path {}\n"
-"\tnamespace eval Helpers {\n"
-"\t\tnamespace path {}\n"
-"\t\tproc classvariable {name args} {\n"
-"\t\t\tset ns [info object namespace [uplevel 1 {self class}]]\n"
-"\t\t\tforeach v [list $name {*}$args] {\n"
-"\t\t\t\tif {[string match *(*) $v]} {\n"
-"\t\t\t\t\tset reason \"can\'t create a scalar variable that looks like an array element\"\n"
-"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \\\n"
-"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
-"\t\t\t\t}\n"
-"\t\t\t\tif {[string match *::* $v]} {\n"
-"\t\t\t\t\tset reason \"can\'t create a local variable with a namespace separator in it\"\n"
-"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR INVERTED} \\\n"
-"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
-"\t\t\t\t}\n"
-"\t\t\t\tlappend vs $v $v\n"
+"\tproc Helpers::classvariable {name args} {\n"
+"\t\tset ns [info object namespace [uplevel 1 {self class}]]\n"
+"\t\tforeach v [list $name {*}$args] {\n"
+"\t\t\tif {[string match *(*) $v]} {\n"
+"\t\t\t\tset reason \"can\'t create a scalar variable that looks like an array element\"\n"
+"\t\t\t\treturn -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \\\n"
+"\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
 "\t\t\t}\n"
-"\t\t\ttailcall namespace upvar $ns {*}$vs\n"
+"\t\t\tif {[string match *::* $v]} {\n"
+"\t\t\t\tset reason \"can\'t create a local variable with a namespace separator in it\"\n"
+"\t\t\t\treturn -code error -errorcode {TCL UPVAR INVERTED} \\\n"
+"\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
+"\t\t\t}\n"
+"\t\t\tlappend vs $v $v\n"
 "\t\t}\n"
-"\t\tproc link {args} {\n"
-"\t\t\tset ns [uplevel 1 {::namespace current}]\n"
-"\t\t\tforeach link $args {\n"
-"\t\t\t\tif {[llength $link] == 2} {\n"
-"\t\t\t\t\tlassign $link src dst\n"
-"\t\t\t\t} elseif {[llength $link] == 1} {\n"
-"\t\t\t\t\tlassign $link src\n"
-"\t\t\t\t\tset dst $src\n"
-"\t\t\t\t} else {\n"
-"\t\t\t\t\treturn -code error -errorcode {TCL OO CMDLINK_FORMAT} \\\n"
-"\t\t\t\t\t\t\"bad link description; must only have one or two elements\"\n"
-"\t\t\t\t}\n"
-"\t\t\t\tif {![string match ::* $src]} {\n"
-"\t\t\t\t\tset src [string cat $ns :: $src]\n"
-"\t\t\t\t}\n"
-"\t\t\t\tinterp alias {} $src {} ${ns}::my $dst\n"
-"\t\t\t\ttrace add command ${ns}::my delete [list \\\n"
-"\t\t\t\t\t::oo::UnlinkLinkedCommand $src]\n"
+"\t\ttailcall namespace upvar $ns {*}$vs\n"
+"\t}\n"
+"\tproc Helpers::link {args} {\n"
+"\t\tset ns [uplevel 1 {::namespace current}]\n"
+"\t\tforeach link $args {\n"
+"\t\t\tif {[llength $link] == 2} {\n"
+"\t\t\t\tlassign $link src dst\n"
+"\t\t\t} elseif {[llength $link] == 1} {\n"
+"\t\t\t\tlassign $link src\n"
+"\t\t\t\tset dst $src\n"
+"\t\t\t} else {\n"
+"\t\t\t\treturn -code error -errorcode {TCL OO CMDLINK_FORMAT} \\\n"
+"\t\t\t\t\t\"bad link description; must only have one or two elements\"\n"
 "\t\t\t}\n"
-"\t\t\treturn\n"
+"\t\t\tif {![string match ::* $src]} {\n"
+"\t\t\t\tset src [string cat $ns :: $src]\n"
+"\t\t\t}\n"
+"\t\t\tinterp alias {} $src {} ${ns}::my $dst\n"
+"\t\t\ttrace add command ${ns}::my delete [list \\\n"
+"\t\t\t\t::oo::UnlinkLinkedCommand $src]\n"
 "\t\t}\n"
 "\t}\n"
 "\tproc UnlinkLinkedCommand {cmd args} {\n"
@@ -239,21 +234,19 @@ static const char *tclOOSetupScript =
 "\t\tsuperclass class\n"
 "\t\tunexport create createWithNamespace new\n"
 "\t}\n"
-"\tnamespace eval configuresupport {\n"
-"\t\t::namespace eval configurableclass {\n"
-"\t\t\t::proc properties args {::tailcall property {*}$args}\n"
-"\t\t\t::namespace path ::oo::define\n"
-"\t\t\t::namespace export property\n"
-"\t\t}\n"
-"\t\t::namespace eval configurableobject {\n"
-"\t\t\t::proc properties args {::tailcall property {*}$args}\n"
-"\t\t\t::namespace path ::oo::objdefine\n"
-"\t\t\t::namespace export property\n"
-"\t\t}\n"
-"\t\t::oo::define configurable {\n"
-"\t\t\tdefinitionnamespace -instance configurableobject\n"
-"\t\t\tdefinitionnamespace -class configurableclass\n"
-"\t\t}\n"
+"\tnamespace eval configuresupport::configurableclass {\n"
+"\t\t::proc properties args {::tailcall property {*}$args}\n"
+"\t\t::namespace path ::oo::define\n"
+"\t\t::namespace export property\n"
+"\t}\n"
+"\tnamespace eval configuresupport::configurableobject {\n"
+"\t\t::proc properties args {::tailcall property {*}$args}\n"
+"\t\t::namespace path ::oo::objdefine\n"
+"\t\t::namespace export property\n"
+"\t}\n"
+"\tdefine configuresupport::configurable {\n"
+"\t\tdefinitionnamespace -instance configuresupport::configurableobject\n"
+"\t\tdefinitionnamespace -class configuresupport::configurableclass\n"
 "\t}\n"
 "\tclass create configurable {\n"
 "\t\tsuperclass class\n"
diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl
index b60542f..442756d 100644
--- a/tools/tclOOScript.tcl
+++ b/tools/tclOOScript.tcl
@@ -12,73 +12,68 @@
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 ::namespace eval ::oo {
-    ::namespace path {}
 
     #
     # Commands that are made available to objects by default.
     #
-    namespace eval Helpers {
-	namespace path {}
 
-	# ------------------------------------------------------------------
-	#
-	# classvariable --
-	#
-	#	Link to a variable in the class of the current object.
-	#
-	# ------------------------------------------------------------------
+    # ------------------------------------------------------------------
+    #
+    # classvariable --
+    #
+    #	Link to a variable in the class of the current object.
+    #
+    # ------------------------------------------------------------------
 
-	proc classvariable {name args} {
-	    # Get a reference to the class's namespace
-	    set ns [info object namespace [uplevel 1 {self class}]]
-	    # Double up the list of variable names
-	    foreach v [list $name {*}$args] {
-		if {[string match *(*) $v]} {
-		    set reason "can't create a scalar variable that looks like an array element"
-		    return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \
-			[format {bad variable name "%s": %s} $v $reason]
-		}
-		if {[string match *::* $v]} {
-		    set reason "can't create a local variable with a namespace separator in it"
-		    return -code error -errorcode {TCL UPVAR INVERTED} \
-			[format {bad variable name "%s": %s} $v $reason]
-		}
-		lappend vs $v $v
+    proc Helpers::classvariable {name args} {
+	# Get a reference to the class's namespace
+	set ns [info object namespace [uplevel 1 {self class}]]
+	# Double up the list of variable names
+	foreach v [list $name {*}$args] {
+	    if {[string match *(*) $v]} {
+		set reason "can't create a scalar variable that looks like an array element"
+		return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \
+		    [format {bad variable name "%s": %s} $v $reason]
+	    }
+	    if {[string match *::* $v]} {
+		set reason "can't create a local variable with a namespace separator in it"
+		return -code error -errorcode {TCL UPVAR INVERTED} \
+		    [format {bad variable name "%s": %s} $v $reason]
 	    }
-	    # Lastly, link the caller's local variables to the class's variables
-	    tailcall namespace upvar $ns {*}$vs
+	    lappend vs $v $v
 	}
+	# Lastly, link the caller's local variables to the class's variables
+	tailcall namespace upvar $ns {*}$vs
+    }
 
-	# ------------------------------------------------------------------
-	#
-	# link --
-	#
-	#	Make a command that invokes a method on the current object.
-	#	The name of the command and the name of the method match by
-	#	default.
-	#
-	# ------------------------------------------------------------------
+    # ------------------------------------------------------------------
+    #
+    # link --
+    #
+    #	Make a command that invokes a method on the current object.
+    #	The name of the command and the name of the method match by
+    #	default.
+    #
+    # ------------------------------------------------------------------
 
-	proc link {args} {
-	    set ns [uplevel 1 {::namespace current}]
-	    foreach link $args {
-		if {[llength $link] == 2} {
-		    lassign $link src dst
-		} elseif {[llength $link] == 1} {
-		    lassign $link src
-		    set dst $src
-		} else {
-		    return -code error -errorcode {TCL OO CMDLINK_FORMAT} \
-			"bad link description; must only have one or two elements"
-		}
-		if {![string match ::* $src]} {
-		    set src [string cat $ns :: $src]
-		}
-		interp alias {} $src {} ${ns}::my $dst
-		trace add command ${ns}::my delete [list \
-		    ::oo::UnlinkLinkedCommand $src]
+    proc Helpers::link {args} {
+	set ns [uplevel 1 {::namespace current}]
+	foreach link $args {
+	    if {[llength $link] == 2} {
+		lassign $link src dst
+	    } elseif {[llength $link] == 1} {
+		lassign $link src
+		set dst $src
+	    } else {
+		return -code error -errorcode {TCL OO CMDLINK_FORMAT} \
+		    "bad link description; must only have one or two elements"
 	    }
-	    return
+	    if {![string match ::* $src]} {
+		set src [string cat $ns :: $src]
+	    }
+	    interp alias {} $src {} ${ns}::my $dst
+	    trace add command ${ns}::my delete [list \
+		::oo::UnlinkLinkedCommand $src]
 	}
     }
 
@@ -437,47 +432,45 @@
     #
     # ----------------------------------------------------------------------
 
-    namespace eval configuresupport {
-	# ------------------------------------------------------------------
-	#
-	# oo::configuresupport::configurableclass,
-	# oo::configuresupport::configurableobject --
-	#
-	#	Namespaces used as implementation vectors for oo::define and
-	#	oo::objdefine when the class/instance is configurable.
-	#	Note that these also contain commands implemented in C,
-	#	especially the [property] definition command.
-	#
-	# ------------------------------------------------------------------
+    # ------------------------------------------------------------------
+    #
+    # oo::configuresupport::configurableclass,
+    # oo::configuresupport::configurableobject --
+    #
+    #	Namespaces used as implementation vectors for oo::define and
+    #	oo::objdefine when the class/instance is configurable.
+    #	Note that these also contain commands implemented in C,
+    #	especially the [property] definition command.
+    #
+    # ------------------------------------------------------------------
 
-	::namespace eval configurableclass {
-	    # Plural alias just in case; deliberately NOT documented!
-	    ::proc properties args {::tailcall property {*}$args}
-	    ::namespace path ::oo::define
-	    ::namespace export property
-	}
+    namespace eval configuresupport::configurableclass {
+	# Plural alias just in case; deliberately NOT documented!
+	::proc properties args {::tailcall property {*}$args}
+	::namespace path ::oo::define
+	::namespace export property
+    }
 
-	::namespace eval configurableobject {
-	    # Plural alias just in case; deliberately NOT documented!
-	    ::proc properties args {::tailcall property {*}$args}
-	    ::namespace path ::oo::objdefine
-	    ::namespace export property
-	}
+    namespace eval configuresupport::configurableobject {
+	# Plural alias just in case; deliberately NOT documented!
+	::proc properties args {::tailcall property {*}$args}
+	::namespace path ::oo::objdefine
+	::namespace export property
+    }
 
-	# ------------------------------------------------------------------
-	#
-	# oo::configuresupport::configurable --
-	#
-	#	The class that contains the implementation of the actual
-	#	'configure' method (mixed into actually configurable classes).
-	#	The 'configure' method is in tclOOBasic.c.
-	#
-	# ------------------------------------------------------------------
+    # ------------------------------------------------------------------
+    #
+    # oo::configuresupport::configurable --
+    #
+    #	The class that contains the implementation of the actual
+    #	'configure' method (mixed into actually configurable classes).
+    #	The 'configure' method is in tclOOBasic.c.
+    #
+    # ------------------------------------------------------------------
 
-	::oo::define configurable {
-	    definitionnamespace -instance configurableobject
-	    definitionnamespace -class configurableclass
-	}
+    define configuresupport::configurable {
+	definitionnamespace -instance configuresupport::configurableobject
+	definitionnamespace -class configuresupport::configurableclass
     }
 
     # ----------------------------------------------------------------------