Move the implementation of [try] from Tcl to C. Not yet bytecoded.

1 files changed, 1 insertions, 183 deletions

diff --git a/library/init.tcl b/library/init.tcl
index 3ec3079..6ca4873 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.120 2009/01/16 20:44:25 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.121 2009/03/09 09:12:39 dkf Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -113,188 +113,6 @@ namespace eval tcl {
     }
 }
 
-# TIP #329: [try]
-# This is a *temporary* implementation, to be replaced with one in C and
-# bytecode at a later date before 8.6.0
-namespace eval ::tcl::control {
-    # These are not local, since this allows us to [uplevel] a [catch] rather
-    # than [catch] the [uplevel]ing of something, resulting in a cleaner
-    # -errorinfo:
-    variable em {}
-    variable opts {}
-
-    variable magicCodes { ok 0 error 1 return 2 break 3 continue 4 }
-
-    namespace export try
-
-    # ::tcl::control::try --
-    #
-    #	Advanced error handling construct.
-    #
-    # Arguments:
-    #	See try(n) for details
-    proc try {args} {
-	variable magicCodes
-
-	# ----- Parse arguments -----
-
-	set trybody [lindex $args 0]
-	set finallybody {}
-	set handlers [list]
-	set i 1
-
-	while {$i < [llength $args]} {
-	    switch -- [lindex $args $i] {
-		"on" {
-		    incr i
-		    set code [lindex $args $i]
-		    if {[dict exists $magicCodes $code]} {
-			set code [dict get $magicCodes $code]
-		    } elseif {![string is integer -strict $code]} {
-			set msgPart [join [dict keys $magicCodes] {", "}]
-			error "bad code '[lindex $args $i]': must be\
-			    integer or \"$msgPart\""
-		    }
-		    lappend handlers [lrange $args $i $i] \
-			[format %d $code] {} {*}[lrange $args $i+1 $i+2]
-		    incr i 3
-		}
-		"trap" {
-		    incr i
-		    if {![string is list [lindex $args $i]]} {
-			error "bad prefix '[lindex $args $i]':\
-			    must be a list"
-		    }
-		    lappend handlers [lrange $args $i $i] 1 \
-			{*}[lrange $args $i $i+2]
-		    incr i 3
-		}
-		"finally" {
-		    incr i
-		    set finallybody [lindex $args $i]
-		    incr i
-		    break
-		}
-		default {
-		    error "bad handler '[lindex $args $i]': must be\
-			\"on code varlist body\", or\
-			\"trap prefix varlist body\""
-		}
-	    }
-	}
-
-	if {($i != [llength $args]) || ([lindex $handlers end] eq "-")} {
-	    error "wrong # args: should be\
-		\"try body ?handler ...? ?finally body?\""
-	}
-
-	# ----- Execute 'try' body -----
-
-	variable em
-	variable opts
-	set EMVAR  [namespace which -variable em]
-	set OPTVAR [namespace which -variable opts]
-	set code [uplevel 1 [list ::catch $trybody $EMVAR $OPTVAR]]
-
-	if {$code == 1} {
-	    set line [dict get $opts -errorline]
-	    dict append opts -errorinfo \
-		"\n    (\"[lindex [info level 0] 0]\" body line $line)"
-	}
-
-	# Keep track of the original error message & options
-	set _em $em
-	set _opts $opts
-
-	# ----- Find and execute handler -----
-
-	set errorcode {}
-	if {[dict exists $opts -errorcode]} {
-	    set errorcode [dict get $opts -errorcode]
-	}
-	set found false
-	foreach {descrip oncode pattern varlist body} $handlers {
-	    if {!$found} {
-		if {
-		    ($code != $oncode) || ([lrange $pattern 0 end] ne
-		    [lrange $errorcode 0 [llength $pattern]-1] )
-		} then {
-		    continue
-		}
-	    }
-	    set found true
-	    if {$body eq "-"} {
-		continue
-	    }
-
-	    # Handler found ...
-
-	    # Assign trybody results into variables
-	    lassign $varlist resultsVarName optionsVarName
-	    if {[llength $varlist] >= 1} {
-		upvar 1 $resultsVarName resultsvar
-		set resultsvar $em
-	    }
-	    if {[llength $varlist] >= 2} {
-		upvar 1 $optionsVarName optsvar
-		set optsvar $opts
-	    }
-
-	    # Execute the handler
-	    set code [uplevel 1 [list ::catch $body $EMVAR $OPTVAR]]
-
-	    if {$code == 1} {
-		set line [dict get $opts -errorline]
-		dict append opts -errorinfo \
-		    "\n    (\"[lindex [info level 0] 0] ... $descrip\"\
-		    body line $line)"
-		# On error chain to original outcome
-		dict set opts -during $_opts
-	    }
-
-	    # Handler result replaces the original result (whether success or
-	    # failure); capture context of original exception for reference.
-	    set _em $em
-	    set _opts $opts
-
-	    # Handler has been executed - stop looking for more
-	    break
-	}
-
-	# No catch handler found -- error falls through to caller
-	# OR catch handler executed -- result falls through to caller
-
-	# ----- If we have a finally block then execute it -----
-
-	if {$finallybody ne {}} {
-	    set code [uplevel 1 [list ::catch $finallybody $EMVAR $OPTVAR]]
-
-	    # Finally result takes precedence except on success
-
-	    if {$code == 1} {
-		set line [dict get $opts -errorline]
-		dict append opts -errorinfo \
-		    "\n    (\"[lindex [info level 0] 0] ... finally\"\
-		    body line $line)"
-		# On error chain to original outcome
-		dict set opts -during $_opts
-	    }
-	    if {$code != 0} {
-		set _em $em
-		set _opts $opts
-	    }
-
-	    # Otherwise our result is not affected
-	}
-
-	# Propagate the error or the result of the executed catch body to the
-	# caller.
-	dict incr _opts -level
-	return -options $_opts $_em
-    }
-}
-namespace import ::tcl::control::try
-
 # Windows specific end of initialization
 
 if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {