--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/thread2.8.8/ttrace.tcl	Tue Mar 18 16:23:26 2025 -0400
@@ -0,0 +1,942 @@
+#
+# ttrace.tcl --
+#
+# Copyright (C) 2003 Zoran Vasiljevic, Archiware GmbH. All Rights Reserved.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# ----------------------------------------------------------------------------
+#
+# User level commands:
+#
+#   ttrace::eval           top-level wrapper (ttrace-savvy eval)
+#   ttrace::enable         activates registered Tcl command traces
+#   ttrace::disable        terminates tracing of Tcl commands
+#   ttrace::isenabled      returns true if ttrace is enabled
+#   ttrace::cleanup        bring the interp to a pristine state
+#   ttrace::update         update interp to the latest trace epoch
+#   ttrace::config         setup some configuration options
+#   ttrace::getscript      returns a script for initializing interps
+#
+# Commands used for/from trace callbacks:
+#
+#   ttrace::atenable       register callback to be done at trace enable
+#   ttrace::atdisable      register callback to be done at trace disable
+#   ttrace::addtrace       register user-defined tracer callback
+#   ttrace::addscript      register user-defined script generator
+#   ttrace::addresolver    register user-defined command resolver
+#   ttrace::addcleanup     register user-defined cleanup procedures
+#   ttrace::addentry       adds one entry into the named trace store
+#   ttrace::getentry       returns the entry value from the named store
+#   ttrace::delentry       removes the entry from the named store
+#   ttrace::getentries     returns all entries from the named store
+#   ttrace::preload        register procedures to be preloaded always
+#
+#
+# Limitations:
+#
+#   o. [namespace forget] is still not implemented
+#   o. [namespace origin cmd] breaks if cmd is not already defined
+#
+#      I left this deliberately. I didn't want to override the [namespace]
+#      command in order to avoid potential slowdown.
+#
+
+namespace eval ttrace {
+
+    # Setup some compatibility wrappers
+    if {[info commands nsv_set] != ""} {
+        variable tvers 0
+        variable mutex ns_mutex
+        variable elock [$mutex create traceepochmutex]
+        # Import the underlying API; faster than recomputing
+        interp alias {} [namespace current]::_array   {} nsv_array
+        interp alias {} [namespace current]::_incr    {} nsv_incr
+        interp alias {} [namespace current]::_lappend {} nsv_lappend
+        interp alias {} [namespace current]::_names   {} nsv_names
+        interp alias {} [namespace current]::_set     {} nsv_set
+        interp alias {} [namespace current]::_unset   {} nsv_unset
+    } elseif {![catch {
+        variable tvers [package require Thread]
+    }]} {
+        variable mutex thread::mutex
+        variable elock [$mutex create]
+        # Import the underlying API; faster than recomputing
+        interp alias {} [namespace current]::_array   {} tsv::array
+        interp alias {} [namespace current]::_incr    {} tsv::incr
+        interp alias {} [namespace current]::_lappend {} tsv::lappend
+        interp alias {} [namespace current]::_names   {} tsv::names
+        interp alias {} [namespace current]::_set     {} tsv::set
+        interp alias {} [namespace current]::_unset   {} tsv::unset
+    } else {
+        error "requires NaviServer/AOLserver or Tcl threading extension"
+    }
+
+    # Keep in sync with the Thread package
+    package provide Ttrace 2.8.8
+
+    # Package variables
+    variable resolvers ""     ; # List of registered resolvers
+    variable tracers   ""     ; # List of registered cmd tracers
+    variable scripts   ""     ; # List of registered script makers
+    variable enables   ""     ; # List of trace-enable callbacks
+    variable disables  ""     ; # List of trace-disable callbacks
+    variable preloads  ""     ; # List of procedure names to preload
+    variable enabled   0      ; # True if trace is enabled
+    variable config           ; # Array with config options
+
+    variable epoch     -1     ; # The initialization epoch
+    variable cleancnt   0     ; # Counter of registered cleaners
+
+    # Package private namespaces
+    namespace eval resolve "" ; # Commands for resolving commands
+    namespace eval trace   "" ; # Commands registered for tracing
+    namespace eval enable  "" ; # Commands invoked at trace enable
+    namespace eval disable "" ; # Commands invoked at trace disable
+    namespace eval script  "" ; # Commands for generating scripts
+
+    # Exported commands
+    namespace export unknown
+
+    # Initialize ttrace shared state
+    if {[_array exists ttrace] == 0} {
+        _set ttrace lastepoch $epoch
+        _set ttrace epochlist ""
+    }
+
+    # Initially, allow creation of epochs
+    set config(-doepochs) 1
+
+    proc eval {cmd args} {
+        enable
+        set code [catch {uplevel 1 [concat $cmd $args]} result]
+        disable
+        if {$code == 0} {
+            if {[llength [info commands ns_ictl]]} {
+                ns_ictl save [getscript]
+            } else {
+                thread::broadcast {
+                    package require Ttrace
+                    ttrace::update
+                }
+            }
+        }
+        return -code $code \
+            -errorinfo $::errorInfo -errorcode $::errorCode $result
+    }
+
+    proc config {args} {
+        variable config
+        if {[llength $args] == 0} {
+            array get config
+        } elseif {[llength $args] == 1} {
+            set opt [lindex $args 0]
+            set config($opt)
+        } else {
+            set opt [lindex $args 0]
+            set val [lindex $args 1]
+            set config($opt) $val
+        }
+    }
+
+    proc enable {} {
+        variable config
+        variable tracers
+        variable enables
+        variable enabled
+        incr enabled 1
+        if {$enabled > 1} {
+            return
+        }
+        if {$config(-doepochs) != 0} {
+            variable epoch [_newepoch]
+        }
+        set nsp [namespace current]
+        foreach enabler $enables {
+            enable::_$enabler
+        }
+        foreach trace $tracers {
+            if {[info commands $trace] != ""} {
+                trace add execution $trace leave ${nsp}::trace::_$trace
+            }
+        }
+    }
+
+    proc disable {} {
+        variable enabled
+        variable tracers
+        variable disables
+        incr enabled -1
+        if {$enabled > 0} {
+            return
+        }
+        set nsp [namespace current]
+        foreach disabler $disables {
+            disable::_$disabler
+        }
+        foreach trace $tracers {
+            if {[info commands $trace] != ""} {
+                trace remove execution $trace leave ${nsp}::trace::_$trace
+            }
+        }
+    }
+
+    proc isenabled {} {
+        variable enabled
+        expr {$enabled > 0}
+    }
+
+    proc update {{from -1}} {
+        if {$from == -1} {
+            variable epoch [_set ttrace lastepoch]
+        } else {
+            if {[lsearch [_set ttrace epochlist] $from] == -1} {
+                error "no such epoch: $from"
+            }
+            variable epoch $from
+        }
+        uplevel 1 [getscript]
+    }
+
+    proc getscript {} {
+        variable preloads
+        variable epoch
+        variable scripts
+        append script [_serializensp] \n
+        append script "::namespace eval [namespace current] {" \n
+        append script "::namespace export unknown" \n
+        append script "_useepoch $epoch" \n
+        append script "}" \n
+        foreach cmd $preloads {
+            append script [_serializeproc $cmd] \n
+        }
+        foreach maker $scripts {
+            append script [script::_$maker]
+        }
+        return $script
+    }
+
+    proc cleanup {args} {
+        foreach cmd [info commands resolve::cleaner_*] {
+            uplevel 1 $cmd $args
+        }
+    }
+
+    proc preload {cmd} {
+        variable preloads
+        if {[lsearch $preloads $cmd] == -1} {
+            lappend preloads $cmd
+        }
+    }
+
+    proc atenable {cmd arglist body} {
+        variable enables
+        if {[lsearch $enables $cmd] == -1} {
+            lappend enables $cmd
+            set cmd [namespace current]::enable::_$cmd
+            proc $cmd $arglist $body
+            return $cmd
+        }
+    }
+
+    proc atdisable {cmd arglist body} {
+        variable disables
+        if {[lsearch $disables $cmd] == -1} {
+            lappend disables $cmd
+            set cmd [namespace current]::disable::_$cmd
+            proc $cmd $arglist $body
+            return $cmd
+        }
+    }
+
+    proc addtrace {cmd arglist body} {
+        variable tracers
+        if {[lsearch $tracers $cmd] == -1} {
+            lappend tracers $cmd
+            set tracer [namespace current]::trace::_$cmd
+            proc $tracer $arglist $body
+            if {[isenabled]} {
+                trace add execution $cmd leave $tracer
+            }
+            return $tracer
+        }
+    }
+
+    proc addscript {cmd body} {
+        variable scripts
+        if {[lsearch $scripts $cmd] == -1} {
+            lappend scripts $cmd
+            set cmd [namespace current]::script::_$cmd
+            proc $cmd args $body
+            return $cmd
+        }
+    }
+
+    proc addresolver {cmd arglist body} {
+        variable resolvers
+        if {[lsearch $resolvers $cmd] == -1} {
+            lappend resolvers $cmd
+            set cmd [namespace current]::resolve::$cmd
+            proc $cmd $arglist $body
+            return $cmd
+        }
+    }
+
+    proc addcleanup {body} {
+        variable cleancnt
+        set cmd [namespace current]::resolve::cleaner_[incr cleancnt]
+        proc $cmd args $body
+        return $cmd
+    }
+
+    proc addentry {cmd var val} {
+        variable epoch
+        _set ${epoch}-$cmd $var $val
+    }
+
+    proc delentry {cmd var} {
+        variable epoch
+        set ei $::errorInfo
+        set ec $::errorCode
+        catch {_unset ${epoch}-$cmd $var}
+        set ::errorInfo $ei
+        set ::errorCode $ec
+    }
+
+    proc getentry {cmd var} {
+        variable epoch
+        set ei $::errorInfo
+        set ec $::errorCode
+        if {[catch {_set ${epoch}-$cmd $var} val]} {
+            set ::errorInfo $ei
+            set ::errorCode $ec
+            set val ""
+        }
+        return $val
+    }
+
+    proc getentries {cmd {pattern *}} {
+        variable epoch
+        _array names ${epoch}-$cmd $pattern
+    }
+
+    proc unknown {args} {
+        set cmd [lindex $args 0]
+        if {[uplevel 1 ttrace::_resolve [list $cmd]]} {
+            set c [catch {uplevel 1 $cmd [lrange $args 1 end]} r]
+        } else {
+            set c [catch {uplevel 1 ::tcl::unknown $args} r]
+        }
+        return -code $c -errorcode $::errorCode -errorinfo $::errorInfo $r
+    }
+
+    proc _resolve {cmd} {
+        variable resolvers
+        foreach resolver $resolvers {
+            if {[uplevel 1 [info comm resolve::$resolver] [list $cmd]]} {
+                return 1
+            }
+        }
+        return 0
+    }
+
+    proc _getthread {} {
+        if {[info commands ns_thread] == ""} {
+            thread::id
+        } else {
+            ns_thread getid
+        }
+    }
+
+    proc _getthreads {} {
+        if {[info commands ns_thread] == ""} {
+            return [thread::names]
+        } else {
+            foreach entry [ns_info threads] {
+                lappend threads [lindex $entry 2]
+            }
+            return $threads
+        }
+    }
+
+    proc _newepoch {} {
+        variable elock
+        variable mutex
+        $mutex lock $elock
+        set old [_set ttrace lastepoch]
+        set new [_incr ttrace lastepoch]
+        _lappend ttrace $new [_getthread]
+        if {$old >= 0} {
+            _copyepoch $old $new
+            _delepochs
+        }
+        _lappend ttrace epochlist $new
+        $mutex unlock $elock
+        return $new
+    }
+
+    proc _copyepoch {old new} {
+        foreach var [_names $old-*] {
+            set cmd [lindex [split $var -] 1]
+            _array reset $new-$cmd [_array get $var]
+        }
+    }
+
+    proc _delepochs {} {
+        set tlist [_getthreads]
+        set elist ""
+        foreach epoch [_set ttrace epochlist] {
+            if {[_dropepoch $epoch $tlist] == 0} {
+                lappend elist $epoch
+            } else {
+                _unset ttrace $epoch
+            }
+        }
+        _set ttrace epochlist $elist
+    }
+
+    proc _dropepoch {epoch threads} {
+        set self [_getthread]
+        foreach tid [_set ttrace $epoch] {
+            if {$tid != $self && [lsearch $threads $tid] >= 0} {
+                lappend alive $tid
+            }
+        }
+        if {[info exists alive]} {
+            _set ttrace $epoch $alive
+            return 0
+        } else {
+            foreach var [_names $epoch-*] {
+                _unset $var
+            }
+            return 1
+        }
+    }
+
+    proc _useepoch {epoch} {
+        if {$epoch >= 0} {
+            set tid [_getthread]
+            if {[lsearch [_set ttrace $epoch] $tid] == -1} {
+                _lappend ttrace $epoch $tid
+            }
+        }
+    }
+
+    proc _serializeproc {cmd} {
+        set dargs [info args $cmd]
+        set pbody [info body $cmd]
+        set pargs ""
+        foreach arg $dargs {
+            if {![info default $cmd $arg def]} {
+                lappend pargs $arg
+            } else {
+                lappend pargs [list $arg $def]
+            }
+        }
+        set nsp [namespace qual $cmd]
+        if {$nsp == ""} {
+            set nsp "::"
+        }
+        append res [list ::namespace eval $nsp] " {" \n
+        append res [list ::proc [namespace tail $cmd] $pargs $pbody] \n
+        append res "}" \n
+    }
+
+    proc _serializensp {{nsp ""} {result _}} {
+        upvar $result res
+        if {$nsp == ""} {
+            set nsp [namespace current]
+        }
+        append res [list ::namespace eval $nsp] " {" \n
+        foreach var [info vars ${nsp}::*] {
+            set vname [namespace tail $var]
+            if {[array exists $var] == 0} {
+                append res [list ::variable $vname [set $var]] \n
+            } else {
+                append res [list ::variable $vname] \n
+                append res [list ::array set $vname [array get $var]] \n
+            }
+        }
+        foreach cmd [info procs ${nsp}::*] {
+            append res [_serializeproc $cmd] \n
+        }
+        append res "}" \n
+        foreach nn [namespace children $nsp] {
+            _serializensp $nn res
+        }
+        return $res
+    }
+}
+
+#
+# The code below is ment to be run once during the application start.  It
+# provides implementation of tracing callbacks for some Tcl commands.  Users
+# can supply their own tracer implementations on-the-fly.
+#
+# The code below will create traces for the following Tcl commands:
+#    "namespace", "variable", "load", "proc" and "rename"
+#
+# Also, the Tcl object extension XOTcl 1.1.0 is handled and all XOTcl related
+# things, like classes and objects are traced (many thanks to Gustaf Neumann
+# from XOTcl for his kind help and support).
+#
+
+eval {
+
+    #
+    # Register the "load" trace. This will create the following key/value pair
+    # in the "load" store:
+    #
+    #  --- key ----              --- value ---
+    #  <path_of_loaded_image>    <name_of_the_init_proc>
+    #
+    # We normally need only the name_of_the_init_proc for being able to load
+    # the package in other interpreters, but we store the path to the image
+    # file as well.
+    #
+
+    ttrace::addtrace load {cmdline code args} {
+        if {$code != 0} {
+            return
+        }
+        set image [lindex $cmdline 1]
+        set initp [lindex $cmdline 2]
+        if {$initp == ""} {
+            foreach pkg [info loaded] {
+                if {[lindex $pkg 0] == $image} {
+                    set initp [lindex $pkg 1]
+                }
+            }
+        }
+        ttrace::addentry load $image $initp
+    }
+
+    ttrace::addscript load {
+        append res "\n"
+        foreach entry [ttrace::getentries load] {
+            set initp [ttrace::getentry load $entry]
+            append res "::load {} $initp" \n
+        }
+        return $res
+    }
+
+    #
+    # Register the "namespace" trace. This will create the following key/value
+    # entry in "namespace" store:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::namespace  1
+    #
+    # It will also fill the "proc" store for procedures and commands imported
+    # in this namespace with following:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::proc       [list <ns>  "" ""]
+    #
+    # The <ns> is the name of the namespace where the command or procedure is
+    # imported from.
+    #
+
+    ttrace::addtrace namespace {cmdline code args} {
+        if {$code != 0} {
+            return
+        }
+        set nop [lindex $cmdline 1]
+        set cns [uplevel 1 namespace current]
+        if {$cns == "::"} {
+            set cns ""
+        }
+        switch -glob $nop {
+            eva* {
+                set nsp [lindex $cmdline 2]
+                if {![string match "::*" $nsp]} {
+                    set nsp ${cns}::$nsp
+                }
+                ttrace::addentry namespace $nsp 1
+            }
+            imp* {
+                # - parse import arguments (skip opt "-force")
+                set opts [lrange $cmdline 2 end]
+                if {[string match "-fo*" [lindex $opts 0]]} {
+                    set opts [lrange $cmdline 3 end]
+                }
+                # - register all imported procs and commands
+                foreach opt $opts {
+                    if {![string match "::*" [::namespace qual $opt]]} {
+                        set opt ${cns}::$opt
+                    }
+                    # - first import procs
+                    foreach entry [ttrace::getentries proc $opt] {
+                        set cmd ${cns}::[::namespace tail $entry]
+                        set nsp [::namespace qual $entry]
+                        set done($cmd) 1
+                        set entry [list 0 $nsp "" ""]
+                        ttrace::addentry proc $cmd $entry
+                    }
+
+                    # - then import commands
+                    foreach entry [info commands $opt] {
+                        set cmd ${cns}::[::namespace tail $entry]
+                        set nsp [::namespace qual $entry]
+                        if {[info exists done($cmd)] == 0} {
+                            set entry [list 0 $nsp "" ""]
+                            ttrace::addentry proc $cmd $entry
+                        }
+                    }
+                }
+            }
+        }
+    }
+
+    ttrace::addscript namespace {
+        append res \n
+        foreach entry [ttrace::getentries namespace] {
+            append res "::namespace eval $entry {}" \n
+        }
+        return $res
+    }
+
+    #
+    # Register the "variable" trace. This will create the following key/value
+    # entry in the "variable" store:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::variable   1
+    #
+    # The variable value itself is ignored at the time of
+    # trace/collection. Instead, we take the real value at the time of script
+    # generation.
+    #
+
+    ttrace::addtrace variable {cmdline code args} {
+        if {$code != 0} {
+            return
+        }
+        set opts [lrange $cmdline 1 end]
+        if {[llength $opts]} {
+            set cns [uplevel 1 namespace current]
+            if {$cns == "::"} {
+                set cns ""
+            }
+            foreach {var val} $opts {
+                if {![string match "::*" $var]} {
+                    set var ${cns}::$var
+                }
+                ttrace::addentry variable $var 1
+            }
+        }
+    }
+
+    ttrace::addscript variable {
+        append res \n
+        foreach entry [ttrace::getentries variable] {
+            set cns [namespace qual $entry]
+            set var [namespace tail $entry]
+            append res "::namespace eval $cns {" \n
+            append res "::variable $var"
+            if {[array exists $entry]} {
+                append res "\n::array set $var [list [array get $entry]]" \n
+            } elseif {[info exists $entry]} {
+                append res " [list [set $entry]]" \n
+            } else {
+                append res \n
+            }
+            append res "}" \n
+        }
+        return $res
+    }
+
+
+    #
+    # Register the "rename" trace. It will create the following key/value pair
+    # in "rename" store:
+    #
+    #  --- key ----              --- value ---
+    #  ::fully::qualified::old  ::fully::qualified::new
+    #
+    # The "new" value may be empty, for commands that have been deleted. In
+    # such cases we also remove any traced procedure definitions.
+    #
+
+    ttrace::addtrace rename {cmdline code args} {
+        if {$code != 0} {
+            return
+        }
+        set cns [uplevel 1 namespace current]
+        if {$cns == "::"} {
+            set cns ""
+        }
+        set old [lindex $cmdline 1]
+        if {![string match "::*" $old]} {
+            set old ${cns}::$old
+        }
+        set new [lindex $cmdline 2]
+        if {$new != ""} {
+            if {![string match "::*" $new]} {
+                set new ${cns}::$new
+            }
+            ttrace::addentry rename $old $new
+        } else {
+            ttrace::delentry proc $old
+        }
+    }
+
+    ttrace::addscript rename {
+        append res \n
+        foreach old [ttrace::getentries rename] {
+            set new [ttrace::getentry rename $old]
+            append res "::rename $old {$new}" \n
+        }
+        return $res
+    }
+
+    #
+    # Register the "proc" trace. This will create the following key/value pair
+    # in the "proc" store:
+    #
+    #  --- key ----              --- value ---
+    #  ::fully::qualified::proc  [list <epoch> <ns> <arglist> <body>]
+    #
+    # The <epoch> chages anytime one (re)defines a proc.  The <ns> is the
+    # namespace where the command was imported from. If empty, the <arglist>
+    # and <body> will hold the actual procedure definition. See the
+    # "namespace" tracer implementation also.
+    #
+
+    ttrace::addtrace proc {cmdline code args} {
+        if {$code != 0} {
+            return
+        }
+        set cns [uplevel 1 namespace current]
+        if {$cns == "::"} {
+            set cns ""
+        }
+        set cmd [lindex $cmdline 1]
+        if {![string match "::*" $cmd]} {
+            set cmd ${cns}::$cmd
+        }
+        set dargs [info args $cmd]
+        set pbody [info body $cmd]
+        set pargs ""
+        foreach arg $dargs {
+            if {![info default $cmd $arg def]} {
+                lappend pargs $arg
+            } else {
+                lappend pargs [list $arg $def]
+            }
+        }
+        set pdef [ttrace::getentry proc $cmd]
+        if {$pdef == ""} {
+            set epoch -1 ; # never traced before
+        } else {
+            set epoch [lindex $pdef 0]
+        }
+        ttrace::addentry proc $cmd [list [incr epoch] "" $pargs $pbody]
+    }
+
+    ttrace::addscript proc {
+        return {
+            if {[info command ::tcl::unknown] == ""} {
+                rename ::unknown ::tcl::unknown
+                namespace import -force ::ttrace::unknown
+            }
+            if {[info command ::tcl::info] == ""} {
+                rename ::info ::tcl::info
+            }
+            proc ::info args {
+                set cmd [lindex $args 0]
+                set hit [lsearch -glob {commands procs args default body} $cmd*]
+                if {$hit > 1} {
+                    if {[catch {uplevel 1 ::tcl::info $args}]} {
+                        uplevel 1 ttrace::_resolve [list [lindex $args 1]]
+                    }
+                    return [uplevel 1 ::tcl::info $args]
+                }
+                if {$hit == -1} {
+                    return [uplevel 1 ::tcl::info $args]
+                }
+                set cns [uplevel 1 namespace current]
+                if {$cns == "::"} {
+                    set cns ""
+                }
+                set pat [lindex $args 1]
+                if {![string match "::*" $pat]} {
+                    set pat ${cns}::$pat
+                }
+                set fns [ttrace::getentries proc $pat]
+                if {[string match $cmd* commands]} {
+                    set fns [concat $fns [ttrace::getentries xotcl $pat]]
+                }
+                foreach entry $fns {
+                    if {$cns != [namespace qual $entry]} {
+                        set lazy($entry) 1
+                    } else {
+                        set lazy([namespace tail $entry]) 1
+                    }
+                }
+                foreach entry [uplevel 1 ::tcl::info $args] {
+                    set lazy($entry) 1
+                }
+                array names lazy
+            }
+        }
+    }
+
+    #
+    # Register procedure resolver. This will try to resolve the command in the
+    # current namespace first, and if not found, in global namespace.  It also
+    # handles commands imported from other namespaces.
+    #
+
+    ttrace::addresolver resolveprocs {cmd {export 0}} {
+        set cns [uplevel 1 namespace current]
+        set name [namespace tail $cmd]
+        if {$cns == "::"} {
+            set cns ""
+        }
+        if {![string match "::*" $cmd]} {
+            set ncmd ${cns}::$cmd
+            set gcmd ::$cmd
+        } else {
+            set ncmd $cmd
+            set gcmd $cmd
+        }
+        set pdef [ttrace::getentry proc $ncmd]
+        if {$pdef == ""} {
+            set pdef [ttrace::getentry proc $gcmd]
+            if {$pdef == ""} {
+                return 0
+            }
+            set cmd $gcmd
+        } else {
+            set cmd $ncmd
+        }
+        set epoch [lindex $pdef 0]
+        set pnsp  [lindex $pdef 1]
+        if {$pnsp != ""} {
+            set nsp [namespace qual $cmd]
+            if {$nsp == ""} {
+                set nsp ::
+            }
+            set cmd ${pnsp}::$name
+            if {[resolveprocs $cmd 1] == 0 && [info commands $cmd] == ""} {
+                return 0
+            }
+            namespace eval $nsp "namespace import -force $cmd"
+        } else {
+            uplevel 0 [list ::proc $cmd [lindex $pdef 2] [lindex $pdef 3]]
+            if {$export} {
+                set nsp [namespace qual $cmd]
+                if {$nsp == ""} {
+                    set nsp ::
+                }
+                namespace eval $nsp "namespace export $name"
+            }
+        }
+        variable resolveproc
+        set resolveproc($cmd) $epoch
+        return 1
+    }
+
+    #
+    # For XOTcl, the entire item introspection/tracing is delegated to XOTcl
+    # itself. The xotcl store is filled with this:
+    #
+    #  --- key ----               --- value ---
+    #  ::fully::qualified::item   <body>
+    #
+    # The <body> is the script used to generate the entire item (class,
+    # object). Note that we do not fill in this during code tracing. It is
+    # done during the script generation. In this step, only the placeholder is
+    # set.
+    #
+    # NOTE: we assume all XOTcl commands are imported in global namespace
+    #
+
+    ttrace::atenable XOTclEnabler {args} {
+        if {[info commands ::xotcl::Class] == ""} {
+            return
+        }
+        if {[info commands ::xotcl::_creator] == ""} {
+            ::xotcl::Class create ::xotcl::_creator -instproc create {args} {
+                set result [next]
+                if {![string match ::xotcl::_* $result]} {
+                    ttrace::addentry xotcl $result ""
+                }
+                return $result
+            }
+        }
+        ::xotcl::Class instmixin ::xotcl::_creator
+    }
+
+    ttrace::atdisable XOTclDisabler {args} {
+        if {   [info commands ::xotcl::Class] == ""
+            || [info commands ::xotcl::_creator] == ""} {
+            return
+        }
+        ::xotcl::Class instmixin ""
+        ::xotcl::_creator destroy
+    }
+
+    set resolver [ttrace::addresolver resolveclasses {classname} {
+        set cns [uplevel 1 namespace current]
+        set script [ttrace::getentry xotcl $classname]
+        if {$script == ""} {
+            set name [namespace tail $classname]
+            if {$cns == "::"} {
+                set script [ttrace::getentry xotcl ::$name]
+            } else {
+                set script [ttrace::getentry xotcl ${cns}::$name]
+                if {$script == ""} {
+                    set script [ttrace::getentry xotcl ::$name]
+                }
+            }
+            if {$script == ""} {
+                return 0
+            }
+        }
+        uplevel 1 [list namespace eval $cns $script]
+        return 1
+    }]
+
+    ttrace::addscript xotcl [subst -nocommands {
+        if {![catch {Serializer new} ss]} {
+            foreach entry [ttrace::getentries xotcl] {
+                if {[ttrace::getentry xotcl \$entry] == ""} {
+                    ttrace::addentry xotcl \$entry [\$ss serialize \$entry]
+                }
+            }
+            \$ss destroy
+            return {::xotcl::Class proc __unknown name {$resolver \$name}}
+        }
+    }]
+
+    #
+    # Register callback to be called on cleanup. This will trash lazily loaded
+    # procs which have changed since.
+    #
+
+    ttrace::addcleanup {
+        variable resolveproc
+        foreach cmd [array names resolveproc] {
+            set def [ttrace::getentry proc $cmd]
+            if {$def != ""} {
+                set new [lindex $def 0]
+                set old $resolveproc($cmd)
+                if {[info command $cmd] != "" && $new != $old} {
+                    catch {rename $cmd ""}
+                }
+            }
+        }
+    }
+}
+
+# EOF
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# tab-width: 8
+# indent-tabs-mode: nil
+# End: