Tcl Source Code

2011-04-04 Alexandre Ferrieux  <[email protected]>

	* nacl/...: New branch ferrieux-nacl : a port of Tcl to
	Google's Nacl (Native Client)


2011-04-03  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c, generic/tclObj.c, generic/tclPathObj.c:
	* generic/tclPipe.c, generic/tclPkg.c, generic/tclProc.c:
	* generic/tclScan.c: More generation of error codes (namespace
	creation, path normalization, pipeline creation, package handling,
	procedures, [scan] formats)

--- Makefile	2011-04-04 01:21:50.082364873 +0200
+++ tweaked.Makefile	2011-04-04 01:21:02.141607374 +0200
@@ -102,12 +102,20 @@
 #CFLAGS			= $(CFLAGS_DEBUG)
 #CFLAGS			= $(CFLAGS_OPTIMIZE)
 #CFLAGS			= $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS			= $(CFLAGS_OPTIMIZE) -Wno-long-long -pthread -DNACL -pipe -fvisibility=hidden 
+CFLAGS			= $(CFLAGS_OPTIMIZE) -pipe -fvisibility=hidden 
+
+
+CFLAGS += -Wno-long-long -pthread -DNACL 
 
 # Flags to pass to the linker
 LDFLAGS_DEBUG		= 
 LDFLAGS_OPTIMIZE	= 
-LDFLAGS			= $(LDFLAGS_OPTIMIZE)  -Wl,--export-dynamic 
+LDFLAGS			= $(LDFLAGS_OPTIMIZE)  -Wl,--export-dynamic -lm \
+	  -lppruntime \
+          -lpthread \
+          -lgoogle_nacl_platform \
+          -lgio \
+          -lsrpc
 
 # To disable ANSI-C procedure prototypes reverse the comment characters on the
 # following lines:
@@ -176,7 +184,7 @@
 
 STLIB_LD		= ${AR} cr
 SHLIB_LD		= ${CC} -shared ${CFLAGS} ${LDFLAGS}
-SHLIB_CFLAGS		= -fPIC -DBUILD_tcl
+SHLIB_CFLAGS		= -DBUILD_tcl
 SHLIB_LD_LIBS		= ${LIBS}
 TCL_SHLIB_LD_EXTRAS	= 
 
@@ -216,7 +224,8 @@
 # by hand.
 #--------------------------------------------------------------------------
 
-COMPAT_OBJS		=  waitpid.o fake-rfc2553.o memcmp.o strstr.o strtoul.o strtod.o fixstrtod.o
+#COMPAT_OBJS		=  waitpid.o fake-rfc2553.o memcmp.o strstr.o strtoul.o strtod.o fixstrtod.o
+IGNORE_COMPAT_OBJS		=  waitpid.o fake-rfc2553.o memcmp.o strstr.o strtoul.o strtod.o fixstrtod.o
 
 AC_FLAGS		= -DPACKAGE_NAME=\"tcl\" -DPACKAGE_TARNAME=\"tcl\" -DPACKAGE_VERSION=\"8.6\" -DPACKAGE_STRING=\"tcl\ 8.6\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DNO_VALUES_H=1 -DHAVE_LIMITS_H=1 -DNO_DLFCN_H=1 -DHAVE_SYS_PARAM_H=1 -DTCL_CFGVAL_ENCODING=\"iso8859-1\" -DSTATIC_BUILD=1 -DHAVE_ZLIB=1 -DMODULE_SCOPE=extern -DTCL_SHLIB_EXT=\".so\" -DTCL_CFG_OPTIMIZED=1 -DTCL_CFG_DEBUG=1 -DTCL_TOMMATH=1 -DMP_PREC=4 -DTCL_WIDE_INT_TYPE=long\ long -DUSEGETWD=1 -DHAVE_MKSTEMP=1 -DHAVE_OPENDIR=1 -DHAVE_STRTOL=1 -DNO_GETWD=1 -DNO_WAIT3=1 -DNO_UNAME=1 -DNO_REALPATH=1 -DNEED_FAKE_RFC2553=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_MKTIME=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_STRUCT_STAT_ST_BLOCKS=1 -DHAVE_STRUCT_STAT_ST_BLKSIZE=1 -DHAVE_BLKCNT_T=1 -DNO_FSTATFS=1 -Dstrtod=fixstrtod -Dsocklen_t=int -DHAVE_INTPTR_T=1 -DHAVE_UINTPTR_T=1 -DNO_UNION_WAIT=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DHAVE_MKSTEMPS=1 -DTCL_UNLOAD_DLLS=1 
 AR			= nacl-ar
@@ -229,7 +238,7 @@
 TOMMATH_DIR		= $(TOP_DIR)/libtommath
 COMPAT_DIR		= $(TOP_DIR)/compat
 TOOL_DIR		= $(TOP_DIR)/tools
-UNIX_DIR		= $(TOP_DIR)/unix
+UNIX_DIR		= $(BUILD_DIR)
 MAC_OSX_DIR		= $(TOP_DIR)/macosx
 PKGS_DIR		= $(TOP_DIR)/pkgs
 # Must be absolute because of the cd dltest $(DLTEST_DIR)/configure below.
@@ -241,6 +250,8 @@
 ZLIB_INCLUDE		= -I${ZLIB_DIR}
 
 CC			= nacl-gcc
+CCPLUS			= nacl-g++
+
 #CC			= purify -best-effort nacl-gcc -DPURIFY
 
 # Flags to be passed to installManPage to control how the manpages should be
@@ -335,12 +346,13 @@
 
 STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}
 
-UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
+UNIX_OBJS = naclMissing.o  tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
 	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
 	tclUnixTime.o tclUnixInit.o tclUnixThrd.o \
 	tclUnixCompat.o
 
 NOTIFY_OBJS = tclUnixNotfy.o
+IGN =  
 
 MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o
 
@@ -600,7 +612,7 @@
 
 all: binaries libraries doc packages
 
-binaries: ${LIB_FILE} $(STUB_LIB_FILE) ${TCL_EXE}
+binaries: ${LIB_FILE} $(STUB_LIB_FILE) tcl.nmf
 
 libraries:
 
@@ -634,8 +646,15 @@
 # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above
 ${NATIVE_TCLSH}:
 
-Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
-	$(SHELL) config.status
+tcl.nexe: naclMain.o libtcl8.6.a
+	$(CCPLUS)  $^ $(LDFLAGS) -m32 -o $@
+
+tcl.nmf: tcl.nexe
+	@echo "Creating tcl.nmf..."
+	tools/nexe2nmf tcl.nexe
+
+#Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
+#	$(SHELL) config.status
 #tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
 #	$(SHELL) config.status
 
@@ -794,7 +813,6 @@
 	    echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
 	    $(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)"/$(STUB_LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE)) ; \
 	fi
-	
 	@echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
 	@$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig
 	@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc
@@ -1517,6 +1535,9 @@
 tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c
 
+tclNaclPort.o: $(UNIX_DIR)/tclNaclPort.c
+	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclNaclPort.c
+
 tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c
 
@@ -2031,13 +2052,13 @@
 
 html: ${NATIVE_TCLSH}
 	$(BUILD_HTML)
-	
+
 html-tcl: ${NATIVE_TCLSH}
 	$(BUILD_HTML) --tcl
-	
+
 html-tk: ${NATIVE_TCLSH}
 	$(BUILD_HTML) --tk
-	
+
 
 BUILD_HTML = \
 	@${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \

		Tcl in Nacl


Overview
--------

NaCl == Native Client is Google's neat sandboxing technology, allowing
to  run  untrusted  code  compiled  natively,  in  the  context  of  a
browser. See http://code.google.com/p/nativeclient/.

The idea  is that with Tcl  running in this context,  and a supporting
browser (currently,  Chrome only; possibly FF +  Nacl plugin shortly),
one could  develop client-side  code mainly in  Tcl, with a  very thin
layer of JS in the page; so, basically, Tcl to control the HTML5 DOM !

Building Tcl for Nacl
---------------------

 - install the NaCl SDK (for me native_client_sdk_0_1_721_0)

 - set your PATH so that nacl-gcc et al become reachable

 - untar the present archive as an 'nacl' subdir in a Tcl source tree, as a sibling  of 'unix"

 - cd inside it

 - run './nacl.genconf' (which is a ./configure command line with proper flags)

 - run 'patch -p0 < Makefile.patch' to fix the generated Makefile

 - run 'make'. This creates tcl.nmf and tcl.nexe.

 - launch the NaCl-provided python-based webserver, and make it see your nacl dir somewhere in its document tree: python httpd.py 5103

 - start 'chromedebug' (provided), and point Chrome to the index.html in nacl.

Overview of the porting method
------------------------------

Nacl  comes  with a  very  incomplete libc  and  set  of headers.  The
strategy,  then,  is to  simply  "plug"  missing  syscalls or  library
functions with either explicitly  failing stubs (returning -1 or NULL,
and setting  errno), and  to build a  big include  file (naclcompat.h)
with all the necessary type and macro definitions to compile.
 
Of course,  when one  of the  failing stubs is  called at  runtime, an
error is raised.  But one cannot hope much more, it's  a sandbox for a
reason.

This approach allows to compile Tcl for Nacl without changing a single
line of  the original source distribution;  all new things  are in the
nacl subdir.

<!DOCTYPE html>
<html>
  <!--
  Copyright (c) 2010 The Native Client Authors. All rights reserved.
  Use of this source code is governed by a BSD-style license that can be
  found in the LICENSE file.
  -->
<head>
  <title>Tcl in Nacl</title>

  <script type="text/javascript">
    tclModule = null;  // Global application object.
    statusText = 'NO-STATUS';

    function moduleDidLoad() {
      tclModule = document.getElementById('tcl');
      updateStatus('SUCCESS');
    }

    // If the page loads before the Native Client module loads, then set the
    // status message indicating that the module is still loading.  Otherwise,
    // do not change the status message.
    function pageDidLoad() {
      if (tclModule == null) {
        updateStatus('LOADING...');
      } else {
        // It's possible that the Native Client module onload event fired
        // before the page's onload event.  In this case, the status message
        // will reflect 'SUCCESS', but won't be displayed.  This call will
        // display the current message.
        updateStatus();
      }
    }

    function doeval() {
      try {
        alert(tclModule.eval(this.the_form.input_id.value));
      } catch(e) {
        alert(e.message);
      }
    }

    // Set the global status message.  If the element with id 'statusField'
    // exists, then set its HTML to the status message as well.
    // opt_message The message test.  If this is null or undefined, then
    //     attempt to set the element with id 'statusField' to the value of
    //     |statusText|.
    function updateStatus(opt_message) {
      if (opt_message)
        statusText = opt_message;
      var statusField = document.getElementById('status_field');
      if (statusField) {
        statusField.innerHTML = statusText;
      }
    }
  </script>
</head>
<body onload="pageDidLoad()">

<h1>Native Client Tcl Module</h1>
<p>
  <form name="the_form" action="" method="get">
  <input type="text" id="input_id" name="inputbox" value="list a b c"><p>
  <input type="button" value="Call eval()" onclick="doeval()">
  </form>
  <!-- Load the published .nexe.  This includes the 'nacl' attribute which
  shows how to load multi-architecture modules.  Each entry in the "nexes"
  object in the  .nmf manifest file is a key-value pair: the key is the runtime
  ('x86-32', 'x86-64', etc.); the value is a URL for the desired NaCl module.
  To load the debug versions of your .nexes, set the 'nacl' attribute to the
  _dbg.nmf version of the manifest file.
  -->
  <embed name="nacl_module"
         id="tcl"
         width=0 height=0
         nacl="tcl.nmf"
         type="application/x-nacl"
         onload="moduleDidLoad();" />
</p>

<p>If the module is working correctly, a click on the "Call eval()" button
  should open a popup dialog containing the Tcl result as its value.</p>

<h2>Status</h2>
<div id="status_field">NO-STATUS</div>
</body>
</html>

 "# init.tcl --\n"
 "#\n"
 "# Default system startup file for Tcl-based applications.  Defines\n"
 "# \"unknown\" procedure and auto-load facilities.\n"
 "#\n"
 "# Copyright (c) 1991-1993 The Regents of the University of California.\n"
 "# Copyright (c) 1994-1996 Sun Microsystems, Inc.\n"
 "# Copyright (c) 1998-1999 Scriptics Corporation.\n"
 "# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.\n"
 "#\n"
 "# See the file \"license.terms\" for information on usage and redistribution\n"
 "# of this file, and for a DISCLAIMER OF ALL WARRANTIES.\n"
 "#\n"
 "\n"
 "if {[info commands package] == \"\"} {\n"
 "    error \"version mismatch: library\\nscripts expect Tcl version 7.5b1 or later but the loaded version is\\nonly [info patchlevel]\"\n"
 "}\n"
 "package require -exact Tcl 8.6b1.2\n"
 "\n"
 "# Compute the auto path to use in this interpreter.\n"
 "# The values on the path come from several locations:\n"
 "#\n"
 "# The environment variable TCLLIBPATH\n"
 "#\n"
 "# tcl_library, which is the directory containing this init.tcl script.\n"
 "# [tclInit] (Tcl_Init()) searches around for the directory containing this\n"
 "# init.tcl and defines tcl_library to that location before sourcing it.\n"
 "#\n"
 "# The parent directory of tcl_library. Adding the parent\n"
 "# means that packages in peer directories will be found automatically.\n"
 "#\n"
 "# Also add the directory ../lib relative to the directory where the\n"
 "# executable is located.  This is meant to find binary packages for the\n"
 "# same architecture as the current executable.\n"
 "#\n"
 "# tcl_pkgPath, which is set by the platform-specific initialization routines\n"
 "#	On UNIX it is compiled in\n"
 "#       On Windows, it is not used\n"
 "\n"
 "if {![info exists auto_path]} {\n"
 "    if {[info exists env(TCLLIBPATH)]} {\n"
 "	set auto_path $env(TCLLIBPATH)\n"
 "    } else {\n"
 "	set auto_path \"\"\n"
 "    }\n"
 "}\n"
 "namespace eval tcl {\n"
 "    variable Dir\n"
 "    foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {\n"
 "	if {$Dir ni $::auto_path} {\n"
 "	    lappend ::auto_path $Dir\n"
 "	}\n"
 "    }\n"
 "    set Dir [file join [file dirname [file dirname \\\n"
 "	    [info nameofexecutable]]] lib]\n"
 "    if {$Dir ni $::auto_path} {\n"
 "	lappend ::auto_path $Dir\n"
 "    }\n"
 "    catch {\n"
 "	foreach Dir $::tcl_pkgPath {\n"
 "	    if {$Dir ni $::auto_path} {\n"
 "		lappend ::auto_path $Dir\n"
 "	    }\n"
 "	}\n"
 "    }\n"
 "\n"
 "    if {![interp issafe]} {\n"
 "        variable Path [encoding dirs]\n"
 "        set Dir [file join $::tcl_library encoding]\n"
 "        if {$Dir ni $Path} {\n"
 "	    lappend Path $Dir\n"
 "	    encoding dirs $Path\n"
 "        }\n"
 "    }\n"
 "\n"
 "    # TIP #255 min and max functions\n"
 "    namespace eval mathfunc {\n"
 "	proc min {args} {\n"
 "	    if {![llength $args]} {\n"
 "		return -code error \\\n"
 "		    \"too few arguments to math function \\\"min\\\"\"\n"
 "	    }\n"
 "	    set val Inf\n"
 "	    foreach arg $args {\n"
 "		# This will handle forcing the numeric value without\n"
 "		# ruining the internal type of a numeric object\n"
 "		if {[catch {expr {double($arg)}} err]} {\n"
 "		    return -code error $err\n"
 "		}\n"
 "		if {$arg < $val} {set val $arg}\n"
 "	    }\n"
 "	    return $val\n"
 "	}\n"
 "	proc max {args} {\n"
 "	    if {![llength $args]} {\n"
 "		return -code error \\\n"
 "		    \"too few arguments to math function \\\"max\\\"\"\n"
 "	    }\n"
 "	    set val -Inf\n"
 "	    foreach arg $args {\n"
 "		# This will handle forcing the numeric value without\n"
 "		# ruining the internal type of a numeric object\n"
 "		if {[catch {expr {double($arg)}} err]} {\n"
 "		    return -code error $err\n"
 "		}\n"
 "		if {$arg > $val} {set val $arg}\n"
 "	    }\n"
 "	    return $val\n"
 "	}\n"
 "	namespace export min max\n"
 "    }\n"
 "}\n"
 "\n"
 "# Windows specific end of initialization\n"
 "\n"
 "if {(![interp issafe]) && ($tcl_platform(platform) eq \"windows\")} {\n"
 "    namespace eval tcl {\n"
 "	proc EnvTraceProc {lo n1 n2 op} {\n"
 "	    set x $::env($n2)\n"
 "	    set ::env($lo) $x\n"
 "	    set ::env([string toupper $lo]) $x\n"
 "	}\n"
 "	proc InitWinEnv {} {\n"
 "	    global env tcl_platform\n"
 "	    foreach p [array names env] {\n"
 "		set u [string toupper $p]\n"
 "		if {$u ne $p} {\n"
 "		    switch -- $u {\n"
 "			COMSPEC -\n"
 "			PATH {\n"
 "			    if {![info exists env($u)]} {\n"
 "				set env($u) $env($p)\n"
 "			    }\n"
 "			    trace add variable env($p) write \\\n"
 "				    [namespace code [list EnvTraceProc $p]]\n"
 "			    trace add variable env($u) write \\\n"
 "				    [namespace code [list EnvTraceProc $p]]\n"
 "			}\n"
 "		    }\n"
 "		}\n"
 "	    }\n"
 "	    if {![info exists env(COMSPEC)]} {\n"
 "		if {$tcl_platform(os) eq \"Windows NT\"} {\n"
 "		    set env(COMSPEC) cmd.exe\n"
 "		} else {\n"
 "		    set env(COMSPEC) command.com\n"
 "		}\n"
 "	    }\n"
 "	}\n"
 "	InitWinEnv\n"
 "    }\n"
 "}\n"
 "\n"
 "# Setup the unknown package handler\n"
 "\n"
 "\n"
 "if {[interp issafe]} {\n"
 "    package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}\n"
 "} else {\n"
 "    # Set up search for Tcl Modules (TIP #189).\n"
 "    # and setup platform specific unknown package handlers\n"
 "    if {$::tcl_platform(os) eq \"Darwin\"\n"
 "	    && $::tcl_platform(platform) eq \"unix\"} {\n"
 "	package unknown {::tcl::tm::UnknownHandler \\\n"
 "		{::tcl::MacOSXPkgUnknown ::tclPkgUnknown}}\n"
 "    } else {\n"
 "	package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}\n"
 "    }\n"
 "\n"
 "    # Set up the 'clock' ensemble\n"
 "\n"
 "    namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library]\n"
 "\n"
 "    proc clock args {\n"
 "	namespace eval ::tcl::clock [list namespace ensemble create -command \\\n"
 "		[uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \\\n"
 "		-subcommands {\n"
 "		    add clicks format microseconds milliseconds scan seconds\n"
 "		}]\n"
 "\n"
 "	# Auto-loading stubs for 'clock.tcl'\n"
 "\n"
 "	foreach cmd {add format scan} {\n"
 "	    proc ::tcl::clock::$cmd args {\n"
 "		variable TclLibDir\n"
 "		source -encoding utf-8 [file join $TclLibDir clock.tcl]\n"
 "		return [uplevel 1 [info level 0]]\n"
 "	    }\n"
 "	}\n"
 "\n"
 "	return [uplevel 1 [info level 0]]\n"
 "    }\n"
 "}\n"
 "\n"
 "# Conditionalize for presence of exec.\n"
 "\n"
 "if {[namespace which -command exec] eq \"\"} {\n"
 "\n"
 "    # Some machines do not have exec. Also, on all\n"
 "    # platforms, safe interpreters do not have exec.\n"
 "\n"
 "    set auto_noexec 1\n"
 "}\n"
 "\n"
 "# Define a log command (which can be overwitten to log errors\n"
 "# differently, specially when stderr is not available)\n"
 "\n"
 "if {[namespace which -command tclLog] eq \"\"} {\n"
 "    proc tclLog {string} {\n"
 "	catch {puts stderr $string}\n"
 "    }\n"
 "}\n"
 "\n"
 "# unknown --\n"
 "# This procedure is called when a Tcl command is invoked that doesn't\n"
 "# exist in the interpreter.  It takes the following steps to make the\n"
 "# command available:\n"
 "#\n"
 "#	1. See if the autoload facility can locate the command in a\n"
 "#	   Tcl script file.  If so, load it and execute it.\n"
 "#	2. If the command was invoked interactively at top-level:\n"
 "#	    (a) see if the command exists as an executable UNIX program.\n"
 "#		If so, \"exec\" the command.\n"
 "#	    (b) see if the command requests csh-like history substitution\n"
 "#		in one of the common forms !!, !<number>, or ^old^new.  If\n"
 "#		so, emulate csh's history substitution.\n"
 "#	    (c) see if the command is a unique abbreviation for another\n"
 "#		command.  If so, invoke the command.\n"
 "#\n"
 "# Arguments:\n"
 "# args -	A list whose elements are the words of the original\n"
 "#		command, including the command name.\n"
 "\n"
 "proc unknown args {\n"
 "    variable ::tcl::UnknownPending\n"
 "    global auto_noexec auto_noload env tcl_interactive\n"
 "\n"
 "\n"
 "    if {[info exists ::errorInfo]} {\n"
 "	set savedErrorInfo $::errorInfo\n"
 "    }\n"
 "    if {[info exists ::errorCode]} {\n"
 "	set savedErrorCode $::errorCode\n"
 "    }\n"
 "\n"
 "    set name [lindex $args 0]\n"
 "    if {![info exists auto_noload]} {\n"
 "	#\n"
 "	# Make sure we're not trying to load the same proc twice.\n"
 "	#\n"
 "	if {[info exists UnknownPending($name)]} {\n"
 "	    return -code error \"self-referential recursion\\\n"
 "		    in \\\"unknown\\\" for command \\\"$name\\\"\"\n"
 "	}\n"
 "	set UnknownPending($name) pending\n"
 "	set ret [catch {\n"
 "		auto_load $name [uplevel 1 {::namespace current}]\n"
 "	} msg opts]\n"
 "	unset UnknownPending($name)\n"
 "	if {$ret != 0} {\n"
 "	    dict append opts -errorinfo \"\\n    (autoloading \\\"$name\\\")\"\n"
 "	    return -options $opts $msg\n"
 "	}\n"
 "	if {![array size UnknownPending]} {\n"
 "	    unset UnknownPending\n"
 "	}\n"
 "	if {$msg} {\n"
 "	    if {[info exists savedErrorCode]} {\n"
 "		set ::errorCode $savedErrorCode\n"
 "	    } else {\n"
 "		unset -nocomplain ::errorCode\n"
 "	    }\n"
 "	    if {[info exists savedErrorInfo]} {\n"
 "		set ::errorInfo $savedErrorInfo\n"
 "	    } else {\n"
 "		unset -nocomplain ::errorInfo\n"
 "	    }\n"
 "	    set code [catch {uplevel 1 $args} msg opts]\n"
 "	    if {$code ==  1} {\n"
 "		#\n"
 "		# Compute stack trace contribution from the [uplevel].\n"
 "		# Note the dependence on how Tcl_AddErrorInfo, etc.\n"
 "		# construct the stack trace.\n"
 "		#\n"
 "		set errorInfo [dict get $opts -errorinfo]\n"
 "		set errorCode [dict get $opts -errorcode]\n"
 "		set cinfo $args\n"
 "		if {[string bytelength $cinfo] > 150} {\n"
 "		    set cinfo [string range $cinfo 0 150]\n"
 "		    while {[string bytelength $cinfo] > 150} {\n"
 "			set cinfo [string range $cinfo 0 end-1]\n"
 "		    }\n"
 "		    append cinfo ...\n"
 "		}\n"
 "		append cinfo \"\\\"\\n    (\\\"uplevel\\\" body line 1)\"\n"
 "		append cinfo \"\\n    invoked from within\"\n"
 "		append cinfo \"\\n\\\"uplevel 1 \\$args\\\"\"\n"
 "		#\n"
 "		# Try each possible form of the stack trace\n"
 "		# and trim the extra contribution from the matching case\n"
 "		#\n"
 "		set expect \"$msg\\n    while executing\\n\\\"$cinfo\"\n"
 "		if {$errorInfo eq $expect} {\n"
 "		    #\n"
 "		    # The stack has only the eval from the expanded command\n"
 "		    # Do not generate any stack trace here.\n"
 "		    #\n"
 "		    dict unset opts -errorinfo\n"
 "		    dict incr opts -level\n"
 "		    return -options $opts $msg\n"
 "		}\n"
 "		#\n"
 "		# Stack trace is nested, trim off just the contribution\n"
 "		# from the extra \"eval\" of $args due to the \"catch\" above.\n"
 "		#\n"
 "		set expect \"\\n    invoked from within\\n\\\"$cinfo\"\n"
 "		set exlen [string length $expect]\n"
 "		set eilen [string length $errorInfo]\n"
 "		set i [expr {$eilen - $exlen - 1}]\n"
 "		set einfo [string range $errorInfo 0 $i]\n"
 "		#\n"
 "		# For now verify that $errorInfo consists of what we are about\n"
 "		# to return plus what we expected to trim off.\n"
 "		#\n"
 "		if {$errorInfo ne \"$einfo$expect\"} {\n"
 "		    error \"Tcl bug: unexpected stack trace in \\\"unknown\\\"\" {} \\\n"
 "			[list CORE UNKNOWN BADTRACE $einfo $expect $errorInfo]\n"
 "		}\n"
 "		return -code error -errorcode $errorCode \\\n"
 "			-errorinfo $einfo $msg\n"
 "	    } else {\n"
 "		dict incr opts -level\n"
 "		return -options $opts $msg\n"
 "	    }\n"
 "	}\n"
 "    }\n"
 "\n"
 "    if {([info level] == 1) && ([info script] eq \"\") \\\n"
 "	    && [info exists tcl_interactive] && $tcl_interactive} {\n"
 "	if {![info exists auto_noexec]} {\n"
 "	    set new [auto_execok $name]\n"
 "	    if {$new ne \"\"} {\n"
 "		set redir \"\"\n"
 "		if {[namespace which -command console] eq \"\"} {\n"
 "		    set redir \">&@stdout <@stdin\"\n"
 "		}\n"
 "		uplevel 1 [list ::catch \\\n"
 "			[concat exec $redir $new [lrange $args 1 end]] \\\n"
 "			::tcl::UnknownResult ::tcl::UnknownOptions]\n"
 "		dict incr ::tcl::UnknownOptions -level\n"
 "		return -options $::tcl::UnknownOptions $::tcl::UnknownResult\n"
 "	    }\n"
 "	}\n"
 "	if {$name eq \"!!\"} {\n"
 "	    set newcmd [history event]\n"
 "	} elseif {[regexp {^!(.+)$} $name -> event]} {\n"
 "	    set newcmd [history event $event]\n"
 "	} elseif {[regexp {^\\^([^^]*)\\^([^^]*)\\^?$} $name -> old new]} {\n"
 "	    set newcmd [history event -1]\n"
 "	    catch {regsub -all -- $old $newcmd $new newcmd}\n"
 "	}\n"
 "	if {[info exists newcmd]} {\n"
 "	    tclLog $newcmd\n"
 "	    history change $newcmd 0\n"
 "	    uplevel 1 [list ::catch $newcmd \\\n"
 "		    ::tcl::UnknownResult ::tcl::UnknownOptions]\n"
 "	    dict incr ::tcl::UnknownOptions -level\n"
 "	    return -options $::tcl::UnknownOptions $::tcl::UnknownResult\n"
 "	}\n"
 "\n"
 "	set ret [catch {set candidates [info commands $name*]} msg]\n"
 "	if {$name eq \"::\"} {\n"
 "	    set name \"\"\n"
 "	}\n"
 "	if {$ret != 0} {\n"
 "	    dict append opts -errorinfo \\\n"
 "		    \"\\n    (expanding command prefix \\\"$name\\\" in unknown)\"\n"
 "	    return -options $opts $msg\n"
 "	}\n"
 "	# Filter out bogus matches when $name contained\n"
 "	# a glob-special char [Bug 946952]\n"
 "	if {$name eq \"\"} {\n"
 "	    # Handle empty $name separately due to strangeness\n"
 "	    # in [string first] (See RFE 1243354)\n"
 "	    set cmds $candidates\n"
 "	} else {\n"
 "	    set cmds [list]\n"
 "	    foreach x $candidates {\n"
 "		if {[string first $name $x] == 0} {\n"
 "		    lappend cmds $x\n"
 "		}\n"
 "	    }\n"
 "	}\n"
 "	if {[llength $cmds] == 1} {\n"
 "	    uplevel 1 [list ::catch [lreplace $args 0 0 [lindex $cmds 0]] \\\n"
 "		    ::tcl::UnknownResult ::tcl::UnknownOptions]\n"
 "	    dict incr ::tcl::UnknownOptions -level\n"
 "	    return -options $::tcl::UnknownOptions $::tcl::UnknownResult\n"
 "	}\n"
 "	if {[llength $cmds]} {\n"
 "	    return -code error \"ambiguous command name \\\"$name\\\": [lsort $cmds]\"\n"
 "	}\n"
 "    }\n"
 "    return -code error \"invalid command name \\\"$name\\\"\"\n"
 "}\n"
 "\n"
 "# auto_load --\n"
 "# Checks a collection of library directories to see if a procedure\n"
 "# is defined in one of them.  If so, it sources the appropriate\n"
 "# library file to create the procedure.  Returns 1 if it successfully\n"
 "# loaded the procedure, 0 otherwise.\n"
 "#\n"
 "# Arguments:\n"
 "# cmd -			Name of the command to find and load.\n"
 "# namespace (optional)  The namespace where the command is being used - must be\n"
 "#                       a canonical namespace as returned [namespace current]\n"
 "#                       for instance. If not given, namespace current is used.\n"
 "\n"
 "proc auto_load {cmd {namespace {}}} {\n"
 "    global auto_index auto_path\n"
 "\n"
 "    if {$namespace eq \"\"} {\n"
 "	set namespace [uplevel 1 [list ::namespace current]]\n"
 "    }\n"
 "    set nameList [auto_qualify $cmd $namespace]\n"
 "    # workaround non canonical auto_index entries that might be around\n"
 "    # from older auto_mkindex versions\n"
 "    lappend nameList $cmd\n"
 "    foreach name $nameList {\n"
 "	if {[info exists auto_index($name)]} {\n"
 "	    namespace eval :: $auto_index($name)\n"
 "	    # There's a couple of ways to look for a command of a given\n"
 "	    # name.  One is to use\n"
 "	    #    info commands $name\n"
 "	    # Unfortunately, if the name has glob-magic chars in it like *\n"
 "	    # or [], it may not match.  For our purposes here, a better\n"
 "	    # route is to use\n"
 "	    #    namespace which -command $name\n"
 "	    if {[namespace which -command $name] ne \"\"} {\n"
 "		return 1\n"
 "	    }\n"
 "	}\n"
 "    }\n"
 "    if {![info exists auto_path]} {\n"
 "	return 0\n"
 "    }\n"
 "\n"
 "    if {![auto_load_index]} {\n"
 "	return 0\n"
 "    }\n"
 "    foreach name $nameList {\n"
 "	if {[info exists auto_index($name)]} {\n"
 "	    namespace eval :: $auto_index($name)\n"
 "	    if {[namespace which -command $name] ne \"\"} {\n"
 "		return 1\n"
 "	    }\n"
 "	}\n"
 "    }\n"
 "    return 0\n"
 "}\n"
 "\n"
 "# auto_load_index --\n"
 "# Loads the contents of tclIndex files on the auto_path directory\n"
 "# list.  This is usually invoked within auto_load to load the index\n"
 "# of available commands.  Returns 1 if the index is loaded, and 0 if\n"
 "# the index is already loaded and up to date.\n"
 "#\n"
 "# Arguments:\n"
 "# None.\n"
 "\n"
 "proc auto_load_index {} {\n"
 "    variable ::tcl::auto_oldpath\n"
 "    global auto_index auto_path\n"
 "\n"
 "    if {[info exists auto_oldpath] && ($auto_oldpath eq $auto_path)} {\n"
 "	return 0\n"
 "    }\n"
 "    set auto_oldpath $auto_path\n"
 "\n"
 "    # Check if we are a safe interpreter. In that case, we support only\n"
 "    # newer format tclIndex files.\n"
 "\n"
 "    set issafe [interp issafe]\n"
 "    for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {\n"
 "	set dir [lindex $auto_path $i]\n"
 "	set f \"\"\n"
 "	if {$issafe} {\n"
 "	    catch {source [file join $dir tclIndex]}\n"
 "	} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {\n"
 "	    continue\n"
 "	} else {\n"
 "	    set error [catch {\n"
 "		set id [gets $f]\n"
 "		if {$id eq \"# Tcl autoload index file, version 2.0\"} {\n"
 "		    eval [read $f]\n"
 "		} elseif {$id eq \"# Tcl autoload index file: each line identifies a Tcl\"} {\n"
 "		    while {[gets $f line] >= 0} {\n"
 "			if {([string index $line 0] eq \"#\") \\\n"
 "				|| ([llength $line] != 2)} {\n"
 "			    continue\n"
 "			}\n"
 "			set name [lindex $line 0]\n"
 "			set auto_index($name) \\\n"
 "				\"source [file join $dir [lindex $line 1]]\"\n"
 "		    }\n"
 "		} else {\n"
 "		    error \"[file join $dir tclIndex] isn't a proper Tcl index file\"\n"
 "		}\n"
 "	    } msg opts]\n"
 "	    if {$f ne \"\"} {\n"
 "		close $f\n"
 "	    }\n"
 "	    if {$error} {\n"
 "		return -options $opts $msg\n"
 "	    }\n"
 "	}\n"
 "    }\n"
 "    return 1\n"
 "}\n"
 "\n"
 "# auto_qualify --\n"
 "#\n"
 "# Compute a fully qualified names list for use in the auto_index array.\n"
 "# For historical reasons, commands in the global namespace do not have leading\n"
 "# :: in the index key. The list has two elements when the command name is\n"
 "# relative (no leading ::) and the namespace is not the global one. Otherwise\n"
 "# only one name is returned (and searched in the auto_index).\n"
 "#\n"
 "# Arguments -\n"
 "# cmd		The command name. Can be any name accepted for command\n"
 "#               invocations (Like \"foo::::bar\").\n"
 "# namespace	The namespace where the command is being used - must be\n"
 "#               a canonical namespace as returned by [namespace current]\n"
 "#               for instance.\n"
 "\n"
 "proc auto_qualify {cmd namespace} {\n"
 "\n"
 "    # count separators and clean them up\n"
 "    # (making sure that foo:::::bar will be treated as foo::bar)\n"
 "    set n [regsub -all {::+} $cmd :: cmd]\n"
 "\n"
 "    # Ignore namespace if the name starts with ::\n"
 "    # Handle special case of only leading ::\n"
 "\n"
 "    # Before each return case we give an example of which category it is\n"
 "    # with the following form :\n"
 "    # (inputCmd, inputNameSpace) -> output\n"
 "\n"
 "    if {[string match ::* $cmd]} {\n"
 "	if {$n > 1} {\n"
 "	    # (::foo::bar , *) -> ::foo::bar\n"
 "	    return [list $cmd]\n"
 "	} else {\n"
 "	    # (::global , *) -> global\n"
 "	    return [list [string range $cmd 2 end]]\n"
 "	}\n"
 "    }\n"
 "\n"
 "    # Potentially returning 2 elements to try  :\n"
 "    # (if the current namespace is not the global one)\n"
 "\n"
 "    if {$n == 0} {\n"
 "	if {$namespace eq \"::\"} {\n"
 "	    # (nocolons , ::) -> nocolons\n"
 "	    return [list $cmd]\n"
 "	} else {\n"
 "	    # (nocolons , ::sub) -> ::sub::nocolons nocolons\n"
 "	    return [list ${namespace}::$cmd $cmd]\n"
 "	}\n"
 "    } elseif {$namespace eq \"::\"} {\n"
 "	#  (foo::bar , ::) -> ::foo::bar\n"
 "	return [list ::$cmd]\n"
 "    } else {\n"
 "	# (foo::bar , ::sub) -> ::sub::foo::bar ::foo::bar\n"
 "	return [list ${namespace}::$cmd ::$cmd]\n"
 "    }\n"
 "}\n"
 "\n"
 "# auto_import --\n"
 "#\n"
 "# Invoked during \"namespace import\" to make see if the imported commands\n"
 "# reside in an autoloaded library.  If so, the commands are loaded so\n"
 "# that they will be available for the import links.  If not, then this\n"
 "# procedure does nothing.\n"
 "#\n"
 "# Arguments -\n"
 "# pattern	The pattern of commands being imported (like \"foo::*\")\n"
 "#               a canonical namespace as returned by [namespace current]\n"
 "\n"
 "proc auto_import {pattern} {\n"
 "    global auto_index\n"
 "\n"
 "    # If no namespace is specified, this will be an error case\n"
 "\n"
 "    if {![string match *::* $pattern]} {\n"
 "	return\n"
 "    }\n"
 "\n"
 "    set ns [uplevel 1 [list ::namespace current]]\n"
 "    set patternList [auto_qualify $pattern $ns]\n"
 "\n"
 "    auto_load_index\n"
 "\n"
 "    foreach pattern $patternList {\n"
 "        foreach name [array names auto_index $pattern] {\n"
 "            if {([namespace which -command $name] eq \"\")\n"
 "		    && ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} {\n"
 "                namespace eval :: $auto_index($name)\n"
 "            }\n"
 "        }\n"
 "    }\n"
 "}\n"
 "\n"
 "# auto_execok --\n"
 "#\n"
 "# Returns string that indicates name of program to execute if\n"
 "# name corresponds to a shell builtin or an executable in the\n"
 "# Windows search path, or \"\" otherwise.  Builds an associative\n"
 "# array auto_execs that caches information about previous checks,\n"
 "# for speed.\n"
 "#\n"
 "# Arguments:\n"
 "# name -			Name of a command.\n"
 "\n"
 "if {$tcl_platform(platform) eq \"windows\"} {\n"
 "# Windows version.\n"
 "#\n"
 "# Note that info executable doesn't work under Windows, so we have to\n"
 "# look for files with .exe, .com, or .bat extensions.  Also, the path\n"
 "# may be in the Path or PATH environment variables, and path\n"
 "# components are separated with semicolons, not colons as under Unix.\n"
 "#\n"
 "proc auto_execok name {\n"
 "    global auto_execs env tcl_platform\n"
 "\n"
 "    if {[info exists auto_execs($name)]} {\n"
 "	return $auto_execs($name)\n"
 "    }\n"
 "    set auto_execs($name) \"\"\n"
 "\n"
 "    set shellBuiltins [list cls copy date del erase dir echo mkdir \\\n"
 "	    md rename ren rmdir rd time type ver vol]\n"
 "    if {$tcl_platform(os) eq \"Windows NT\"} {\n"
 "	# NT includes the 'start' built-in\n"
 "	lappend shellBuiltins \"start\"\n"
 "    }\n"
 "    if {[info exists env(PATHEXT)]} {\n"
 "	# Add an initial ; to have the {} extension check first.\n"
 "	set execExtensions [split \";$env(PATHEXT)\" \";\"]\n"
 "    } else {\n"
 "	set execExtensions [list {} .com .exe .bat .cmd]\n"
 "    }\n"
 "\n"
 "    if {$name in $shellBuiltins} {\n"
 "	# When this is command.com for some reason on Win2K, Tcl won't\n"
 "	# exec it unless the case is right, which this corrects.  COMSPEC\n"
 "	# may not point to a real file, so do the check.\n"
 "	set cmd $env(COMSPEC)\n"
 "	if {[file exists $cmd]} {\n"
 "	    set cmd [file attributes $cmd -shortname]\n"
 "	}\n"
 "	return [set auto_execs($name) [list $cmd /c $name]]\n"
 "    }\n"
 "\n"
 "    if {[llength [file split $name]] != 1} {\n"
 "	foreach ext $execExtensions {\n"
 "	    set file ${name}${ext}\n"
 "	    if {[file exists $file] && ![file isdirectory $file]} {\n"
 "		return [set auto_execs($name) [list $file]]\n"
 "	    }\n"
 "	}\n"
 "	return \"\"\n"
 "    }\n"
 "\n"
 "    set path \"[file dirname [info nameof]];.;\"\n"
 "    if {[info exists env(WINDIR)]} {\n"
 "	set windir $env(WINDIR)\n"
 "    }\n"
 "    if {[info exists windir]} {\n"
 "	if {$tcl_platform(os) eq \"Windows NT\"} {\n"
 "	    append path \"$windir/system32;\"\n"
 "	}\n"
 "	append path \"$windir/system;$windir;\"\n"
 "    }\n"
 "\n"
 "    foreach var {PATH Path path} {\n"
 "	if {[info exists env($var)]} {\n"
 "	    append path \";$env($var)\"\n"
 "	}\n"
 "    }\n"
 "\n"
 "    foreach dir [split $path {;}] {\n"
 "	# Skip already checked directories\n"
 "	if {[info exists checked($dir)] || ($dir eq \"\")} {\n"
 "	    continue\n"
 "	}\n"
 "	set checked($dir) {}\n"
 "	foreach ext $execExtensions {\n"
 "	    set file [file join $dir ${name}${ext}]\n"
 "	    if {[file exists $file] && ![file isdirectory $file]} {\n"
 "		return [set auto_execs($name) [list $file]]\n"
 "	    }\n"
 "	}\n"
 "    }\n"
 "    return \"\"\n"
 "}\n"
 "\n"
 "} else {\n"
 "# Unix version.\n"
 "#\n"
 "proc auto_execok name {\n"
 "    global auto_execs env\n"
 "\n"
 "    if {[info exists auto_execs($name)]} {\n"
 "	return $auto_execs($name)\n"
 "    }\n"
 "    set auto_execs($name) \"\"\n"
 "    if {[llength [file split $name]] != 1} {\n"
 "	if {[file executable $name] && ![file isdirectory $name]} {\n"
 "	    set auto_execs($name) [list $name]\n"
 "	}\n"
 "	return $auto_execs($name)\n"
 "    }\n"
 "    foreach dir [split $env(PATH) :] {\n"
 "	if {$dir eq \"\"} {\n"
 "	    set dir .\n"
 "	}\n"
 "	set file [file join $dir $name]\n"
 "	if {[file executable $file] && ![file isdirectory $file]} {\n"
 "	    set auto_execs($name) [list $file]\n"
 "	    return $auto_execs($name)\n"
 "	}\n"
 "    }\n"
 "    return \"\"\n"
 "}\n"
 "\n"
 "}\n"
 "\n"
 "# ::tcl::CopyDirectory --\n"
 "#\n"
 "# This procedure is called by Tcl's core when attempts to call the\n"
 "# filesystem's copydirectory function fail.  The semantics of the call\n"
 "# are that 'dest' does not yet exist, i.e. dest should become the exact\n"
 "# image of src.  If dest does exist, we throw an error.\n"
 "#\n"
 "# Note that making changes to this procedure can change the results\n"
 "# of running Tcl's tests.\n"
 "#\n"
 "# Arguments:\n"
 "# action -              \"renaming\" or \"copying\"\n"
 "# src -			source directory\n"
 "# dest -		destination directory\n"
 "proc tcl::CopyDirectory {action src dest} {\n"
 "    set nsrc [file normalize $src]\n"
 "    set ndest [file normalize $dest]\n"
 "\n"
 "    if {$action eq \"renaming\"} {\n"
 "	# Can't rename volumes.  We could give a more precise\n"
 "	# error message here, but that would break the test suite.\n"
 "	if {$nsrc in [file volumes]} {\n"
 "	    return -code error \"error $action \\\"$src\\\" to\\\n"
 "	      \\\"$dest\\\": trying to rename a volume or move a directory\\\n"
 "	      into itself\"\n"
 "	}\n"
 "    }\n"
 "    if {[file exists $dest]} {\n"
 "	if {$nsrc eq $ndest} {\n"
 "	    return -code error \"error $action \\\"$src\\\" to\\\n"
 "	      \\\"$dest\\\": trying to rename a volume or move a directory\\\n"
 "	      into itself\"\n"
 "	}\n"
 "	if {$action eq \"copying\"} {\n"
 "	    # We used to throw an error here, but, looking more closely\n"
 "	    # at the core copy code in tclFCmd.c, if the destination\n"
 "	    # exists, then we should only call this function if -force\n"
 "	    # is true, which means we just want to over-write.  So,\n"
 "	    # the following code is now commented out.\n"
 "	    #\n"
 "	    # return -code error \"error $action \\\"$src\\\" to\\\n"
 "	    # \\\"$dest\\\": file already exists\"\n"
 "	} else {\n"
 "	    # Depending on the platform, and on the current\n"
 "	    # working directory, the directories '.', '..'\n"
 "	    # can be returned in various combinations.  Anyway,\n"
 "	    # if any other file is returned, we must signal an error.\n"
 "	    set existing [glob -nocomplain -directory $dest * .*]\n"
 "	    lappend existing {*}[glob -nocomplain -directory $dest \\\n"
 "		    -type hidden * .*]\n"
 "	    foreach s $existing {\n"
 "		if {([file tail $s] ne \".\") && ([file tail $s] ne \"..\")} {\n"
 "		    return -code error \"error $action \\\"$src\\\" to\\\n"
 "		      \\\"$dest\\\": file already exists\"\n"
 "		}\n"
 "	    }\n"
 "	}\n"
 "    } else {\n"
 "	if {[string first $nsrc $ndest] != -1} {\n"
 "	    set srclen [expr {[llength [file split $nsrc]] -1}]\n"
 "	    set ndest [lindex [file split $ndest] $srclen]\n"
 "	    if {$ndest eq [file tail $nsrc]} {\n"
 "		return -code error \"error $action \\\"$src\\\" to\\\n"
 "		  \\\"$dest\\\": trying to rename a volume or move a directory\\\n"
 "		  into itself\"\n"
 "	    }\n"
 "	}\n"
 "	file mkdir $dest\n"
 "    }\n"
 "    # Have to be careful to capture both visible and hidden files.\n"
 "    # We will also be more generous to the file system and not\n"
 "    # assume the hidden and non-hidden lists are non-overlapping.\n"
 "    #\n"
 "    # On Unix 'hidden' files begin with '.'.  On other platforms\n"
 "    # or filesystems hidden files may have other interpretations.\n"
 "    set filelist [concat [glob -nocomplain -directory $src *] \\\n"
 "      [glob -nocomplain -directory $src -types hidden *]]\n"
 "\n"
 "    foreach s [lsort -unique $filelist] {\n"
 "	if {([file tail $s] ne \".\") && ([file tail $s] ne \"..\")} {\n"
 "	    file copy -force $s [file join $dest [file tail $s]]\n"
 "	}\n"
 "    }\n"
 "    return\n"
 "}\n"

#! /bin/sh -x
CC=nacl-gcc CPP=nacl-cpp  CFLAGS="-Wno-long-long -pthread -DNACL" ./configure --host nacl --disable-threads --disable-shared

#include <stdlib.h>
#include <string.h>
#include <ppapi/c/dev/ppb_var_deprecated.h>
#include <ppapi/c/dev/ppp_class_deprecated.h>
#include <ppapi/c/pp_errors.h>
#include <ppapi/c/pp_var.h>
#include <ppapi/c/pp_module.h>
#include <ppapi/c/ppb.h>
#include <ppapi/c/ppb_instance.h>
#include <ppapi/c/ppp.h>
#include <ppapi/c/ppp_instance.h>


#include <errno.h>
#include "tcl.h"

static Tcl_Interp *interp = NULL;

const char *init_tcl_contents =
"set ::tcl_library {/}\n"
# include "init.tcl.c"
  ;

static Tcl_Interp *NewTcl(void)
{
  Tcl_Interp *ii;

  printf("DBUG:TclInitSubsystems\n");
  TclInitSubsystems();
  printf("DBUG:TclpSetInitialEncodings\n");
  TclpSetInitialEncodings();

  printf("DBUG:Busyloop-check\n");
  {
    volatile int x;

    x=0;
    if (x) printf("BUSYLOOP : break out by resetting the var (set $eax=0)\n");
    else printf("NO-BUSYLOOP\n");
    while(x) {}
  }
  printf("DBUG:CreateInterp\n");
  ii=Tcl_CreateInterp();
  if (!ii) {
    printf("Tcl CreateInterp Failed !!!\n");
    return NULL;
  }
  printf("DBUG:Tcl_Init2\n");
  if (Tcl_Eval(ii,init_tcl_contents)!=TCL_OK) {
    printf("Tcl Init Failed: %s !!!\n",Tcl_GetStringResult(ii));
    return NULL;
  }
  return ii;
}
static char *EvalTcl(char *s)
{
  if (!interp) return "No Tcl Interp!!!";
  Tcl_Eval(interp,s);
  return Tcl_GetStringResult(interp);
}


static PP_Bool Instance_DidCreate(PP_Instance instance,
                                  uint32_t argc,
                                  const char* argn[],
                                  const char* argv[]);
static void Instance_DidDestroy(PP_Instance instance);
static void Instance_DidChangeView(PP_Instance instance,
                                   const struct PP_Rect* position,
                                   const struct PP_Rect* clip);
static void Instance_DidChangeFocus(PP_Instance instance,
                                    PP_Bool has_focus);
static PP_Bool Instance_HandleInputEvent(PP_Instance instance,
                                         const struct PP_InputEvent* event);
static struct PP_Var Instance_GetInstanceObject(PP_Instance instance);

static PP_Module module_id = 0;
static struct PPB_Var_Deprecated* var_interface = NULL;
static struct PPP_Class_Deprecated ppp_class;
static struct PPP_Instance instance_interface = {
  &Instance_DidCreate,
  &Instance_DidDestroy,
  &Instance_DidChangeView,
  &Instance_DidChangeFocus,
  &Instance_HandleInputEvent,
  NULL,  /* HandleDocumentLoad is not supported by NaCl modules. */
  &Instance_GetInstanceObject,
};


/**
 * Returns C string contained in the @a var or NULL if @a var is not string.
 * @param[in] var PP_Var containing string.
 * @return a C string representation of @a var.
 * @note Returned pointer will be invalid after destruction of @a var.
 */
static const char* VarToCStr(struct PP_Var var) {
  uint32_t len = 0;
  if (NULL != var_interface)
    return var_interface->VarToUtf8(var, &len);
  return NULL;
}

/**
 * Creates new string PP_Var from C string. The resulting object will be a
 * refcounted string object. It will be AddRef()ed for the caller. When the
 * caller is done with it, it should be Release()d.
 * @param[in] str C string to be converted to PP_Var
 * @return PP_Var containing string.
 */
static struct PP_Var StrToVar(const char* str) {
  if (NULL != var_interface)
    return var_interface->VarFromUtf8(module_id, str, strlen(str));
  return PP_MakeUndefined();
}

/**
 * A simple function that always returns 42.
 * @return always returns the integer 42
 */
static struct PP_Var FortyTwo() {
  return PP_MakeInt32(42);
}

/**
 * Called when the NaCl module is instantiated on the web page. The identifier
 * of the new instance will be passed in as the first argument (this value is
 * generated by the browser and is an opaque handle).  This is called for each
 * instantiation of the NaCl module, which is each time the <embed> tag for
 * this module is encountered.
 *
 * If this function reports a failure (by returning @a PP_FALSE), the NaCl
 * module will be deleted and DidDestroy will be called.
 * @param[in] instance The identifier of the new instance representing this
 *     NaCl module.
 * @param[in] argc The number of arguments contained in @a argn and @a argv.
 * @param[in] argn An array of argument names.  These argument names are
 *     supplied in the <embed> tag, for example:
 *       <embed id="nacl_module" dimensions="2">
 *     will produce two arguments, one named "id" and one named "dimensions".
 * @param[in] argv An array of argument values.  These are the values of the
 *     arguments listed in the <embed> tag.  In the above example, there will
 *     be two elements in this array, "nacl_module" and "2".  The indices of
 *     these values match the indices of the corresponding names in @a argn.
 * @return @a PP_TRUE on success.
 */
static PP_Bool Instance_DidCreate(PP_Instance instance,
                                  uint32_t argc,
                                  const char* argn[],
                                  const char* argv[]) {
  return PP_TRUE;
}

/**
 * Called when the NaCl module is destroyed. This will always be called,
 * even if DidCreate returned failure. This routine should deallocate any data
 * associated with the instance.
 * @param[in] instance The identifier of the instance representing this NaCl
 *     module.
 */
static void Instance_DidDestroy(PP_Instance instance) {
}

/**
 * Called when the position, the size, or the clip rect of the element in the
 * browser that corresponds to this NaCl module has changed.
 * @param[in] instance The identifier of the instance representing this NaCl
 *     module.
 * @param[in] position The location on the page of this NaCl module. This is
 *     relative to the top left corner of the viewport, which changes as the
 *     page is scrolled.
 * @param[in] clip The visible region of the NaCl module. This is relative to
 *     the top left of the plugin's coordinate system (not the page).  If the
 *     plugin is invisible, @a clip will be (0, 0, 0, 0).
 */
static void Instance_DidChangeView(PP_Instance instance,
                                   const struct PP_Rect* position,
                                   const struct PP_Rect* clip) {
}

/**
 * Notification that the given NaCl module has gained or lost focus.
 * Having focus means that keyboard events will be sent to the NaCl module
 * represented by @a instance. A NaCl module's default condition is that it
 * will not have focus.
 *
 * Note: clicks on NaCl modules will give focus only if you handle the
 * click event. You signal if you handled it by returning @a true from
 * HandleInputEvent. Otherwise the browser will bubble the event and give
 * focus to the element on the page that actually did end up consuming it.
 * If you're not getting focus, check to make sure you're returning true from
 * the mouse click in HandleInputEvent.
 * @param[in] instance The identifier of the instance representing this NaCl
 *     module.
 * @param[in] has_focus Indicates whether this NaCl module gained or lost
 *     event focus.
 */
static void Instance_DidChangeFocus(PP_Instance instance,
                                    PP_Bool has_focus) {
}

/**
 * General handler for input events. Returns true if the event was handled or
 * false if it was not.
 *
 * If the event was handled, it will not be forwarded to the web page or
 * browser. If it was not handled, it will bubble according to the normal
 * rules. So it is important that the NaCl module respond accurately with
 * whether event propogation should continue.
 *
 * Event propogation also controls focus. If you handle an event like a mouse
 * event, typically your NaCl module will be given focus. Returning false means
 * that the click will be given to a lower part of the page and your NaCl
 * module will not receive focus. This allows a plugin to be partially
 * transparent, where clicks on the transparent areas will behave like clicks
 * to the underlying page.
 * @param[in] instance The identifier of the instance representing this NaCl
 *     module.
 * @param[in] event The event.
 * @return PP_TRUE if @a event was handled, PP_FALSE otherwise.
 */
static PP_Bool Instance_HandleInputEvent(PP_Instance instance,
                                         const struct PP_InputEvent* event) {
  /* We don't handle any events. */
  return PP_FALSE;
}

/**
 * Create scriptable object for the given instance.
 * @param[in] instance The instance ID.
 * @return A scriptable object.
 */
static struct PP_Var Instance_GetInstanceObject(PP_Instance instance) {
  if (var_interface)
    return var_interface->CreateObject(instance, &ppp_class, NULL);
  return PP_MakeUndefined();
}

/**
 * Check existence of the function associated with @a name.
 * @param[in] object unused
 * @param[in] name method name
 * @param[out] exception pointer to the exception object, unused
 * @return If the method does exist, return true.
 * If the method does not exist, return false and don't set the exception.
 */
static bool Tcl_HasMethod(void* object,
                                 struct PP_Var name,
                                 struct PP_Var* exception) {
  const char* method_name = VarToCStr(name);
  if (NULL != method_name) {
    if (strcmp(method_name, "eval") == 0)
      return true;
  }
  return false;
}

/**
 * Invoke the function associated with @a name.
 * @param[in] object unused
 * @param[in] name method name
 * @param[in] argc number of arguments
 * @param[in] argv array of arguments
 * @param[out] exception pointer to the exception object, unused
 * @return If the method does exist, return true.
 */
static struct PP_Var Tcl_Call(void* object,
                                     struct PP_Var name,
                                     uint32_t argc,
                                     struct PP_Var* argv,
                                     struct PP_Var* exception) {
  struct PP_Var v = PP_MakeUndefined();
  const char* method_name = VarToCStr(name);
  if (NULL != method_name) {
    if (strcmp(method_name, "eval") == 0) {
      if (argc == 1) {
        if (argv[0].type != PP_VARTYPE_STRING) {
          v = StrToVar("Arg from Javascript is not a string!");
        } else {
          char* str = strdup(VarToCStr(argv[0]));
	  char* res = EvalTcl(str);
          v = StrToVar(res);
          free(str);
        }
      } else {
        v = StrToVar("Unexpected number of args");
      }
    } else {
      v = StrToVar("Unknown method");
    }
  }
  return v;
}

/**
 * Entrypoints for the module.
 * Initialize instance interface and scriptable object class.
 * @param[in] a_module_id module ID
 * @param[in] get_browser pointer to PPB_GetInterface
 * @return PP_OK on success, any other value on failure.
 */
PP_EXPORT int32_t PPP_InitializeModule(PP_Module a_module_id,
                                       PPB_GetInterface get_browser) {
  module_id = a_module_id;
  var_interface =
      (struct PPB_Var_Deprecated*)(get_browser(PPB_VAR_DEPRECATED_INTERFACE));

  printf("DBUG:begin\n");
  interp = NewTcl();
  if (!interp) return PP_ERROR_FAILED;

  memset(&ppp_class, 0, sizeof(ppp_class));
  ppp_class.Call = Tcl_Call;
  ppp_class.HasMethod = Tcl_HasMethod;
  return PP_OK;
}

/**
 * Returns an interface pointer for the interface of the given name, or NULL
 * if the interface is not supported.
 * @param[in] interface_name name of the interface
 * @return pointer to the interface
 */
PP_EXPORT const void* PPP_GetInterface(const char* interface_name) {
  if (strcmp(interface_name, PPP_INSTANCE_INTERFACE) == 0)
    return &instance_interface;
  return NULL;
}

/**
 * Called before the plugin module is unloaded.
 */
PP_EXPORT void PPP_ShutdownModule() {
  //  if (interp) EndTcl(interp);
}

/*
 *
 *   naclMissing: "implement" all missing syscalls, library funcs and vars.
 *
 */


#include <errno.h>

int timezone;

/* emulated */

char * getwd (char *buf)
{
  printf("*BADSYSCALL:getwd\n");
  strcpy(buf,"/");
  return "/";
}

/* traced */

int access(const char *name, int mode)
{
  struct MyVfs *my;
  printf("*BADSYSCALL:access(\"%s\",%d)\n",name,mode);
  return 0;
  errno=ENOENT;return -1;
}

/* plugged */

int _execve (){printf("BADSYSCALL:_execve\n");errno=EINVAL;return -1;}
int accept (){printf("BADSYSCALL:accept\n");errno=EINVAL;return -1;}
//int access (){printf("BADSYSCALL:access\n");errno=EINVAL;return -1;}
int bind (){printf("BADSYSCALL:bind\n");errno=EINVAL;return -1;}
int chdir (){printf("BADSYSCALL:chdir\n");errno=EINVAL;return -1;}
int chmod (){printf("BADSYSCALL:chmod\n");errno=EINVAL;return -1;}
int chown (){printf("BADSYSCALL:chown\n");errno=EINVAL;return -1;}
int connect (){printf("BADSYSCALL:connect\n");errno=EINVAL;return -1;}
int dlclose (){printf("BADSYSCALL:dlclose\n");errno=EINVAL;return -1;}
int dlerror (){printf("BADSYSCALL:dlerror\n");errno=EINVAL;return -1;}
int dlopen (){printf("BADSYSCALL:dlopen\n");errno=EINVAL;return -1;}
int dlsym (){printf("BADSYSCALL:dlsym\n");errno=EINVAL;return -1;}
int dup2 (){printf("BADSYSCALL:\n");errno=EINVAL;return -1;}
int fcntl (){printf("BADSYSCALL:fcntl\n");errno=EINVAL;return -1;}
int fork (){printf("BADSYSCALL:fork\n");errno=EINVAL;return -1;}
int freeaddrinfo (){printf("BADSYSCALL:freeaddrinfo\n");errno=EINVAL;return -1;}
int ftruncate (){printf("BADSYSCALL:ftruncate\n");errno=EINVAL;return -1;}
char * gai_strerror (){printf("BADSYSCALL:gai_strerror\n");errno=EINVAL;return NULL;}
int getaddrinfo (){printf("BADSYSCALL:getaddrinfo\n");errno=EINVAL;return -1;}
int geteuid (){printf("BADSYSCALL:geteuid\n");errno=EINVAL;return -1;}
int getgrgid (){printf("BADSYSCALL:getgrgid\n");errno=EINVAL;return -1;}
void * getgrnam (){printf("BADSYSCALL:getgrnam\n");errno=EINVAL;return NULL;}
void * gethostbyaddr (){printf("BADSYSCALL:gethostbyaddr\n");errno=EINVAL;return NULL;}
void * gethostbyname (){printf("BADSYSCALL:gethostbyname\n");errno=EINVAL;return NULL;}
int gethostname (){printf("BADSYSCALL:gethostname\n");errno=EINVAL;return -1;}
int getnameinfo (){printf("BADSYSCALL:getnameinfo\n");errno=EINVAL;return -1;}
int getpeername (){printf("BADSYSCALL:getpeername\n");errno=EINVAL;return -1;}
void * getpwnam (){printf("BADSYSCALL:getpwnam\n");errno=EINVAL;return NULL;}
void * getpwuid (){printf("BADSYSCALL:getpwuid\n");errno=EINVAL;return NULL;}
void * getservbyname (){printf("BADSYSCALL:getservbyname\n");errno=EINVAL;return NULL;}
int getsockname (){printf("BADSYSCALL:getsockname\n");errno=EINVAL;return -1;}
int getsockopt (){printf("BADSYSCALL:getsockopt\n");errno=EINVAL;return -1;}
int getuid (){printf("BADSYSCALL:getuid\n");errno=EINVAL;return -1;}
//void * getwd (){printf("BADSYSCALL:getwd\n");errno=EINVAL;return NULL;}
void * inet_ntoa (){printf("BADSYSCALL:inet_ntoa\n");errno=EINVAL;return NULL;}
int kill (){printf("BADSYSCALL:kill\n");errno=EINVAL;return -1;}
int link (){printf("BADSYSCALL:link\n");errno=EINVAL;return -1;}
int listen (){printf("BADSYSCALL:listen\n");errno=EINVAL;return -1;}
int lstat (){printf("BADSYSCALL:lstat\n");errno=EINVAL;return -1;}
int mkdir (){printf("BADSYSCALL:mkdir\n");errno=EINVAL;return -1;}
int mkfifo (){printf("BADSYSCALL:mkfifo\n");errno=EINVAL;return -1;}
int mknod (){printf("BADSYSCALL:mknod\n");errno=EINVAL;return -1;}
int pipe (){printf("BADSYSCALL:pipe\n");errno=EINVAL;return -1;}
int readlink (){printf("BADSYSCALL:readlink\n");errno=EINVAL;return -1;}
int recv (){printf("BADSYSCALL:recv\n");errno=EINVAL;return -1;}
int rmdir (){printf("BADSYSCALL:rmdir\n");errno=EINVAL;return -1;}
int select (){printf("BADSYSCALL:select\n");errno=EINVAL;return -1;}
int send (){printf("BADSYSCALL:send\n");errno=EINVAL;return -1;}
int setsockopt (){printf("BADSYSCALL:setsockopt\n");errno=EINVAL;return -1;}
int shutdown (){printf("BADSYSCALL:shutdown\n");errno=EINVAL;return -1;}
int socket (){printf("BADSYSCALL:socket\n");errno=EINVAL;return -1;}
int symlink (){printf("BADSYSCALL:symlink\n");errno=EINVAL;return -1;}
int umask (){printf("BADSYSCALL:umask\n");errno=EINVAL;return -1;}
int unlink (){printf("BADSYSCALL:unlink\n");errno=EINVAL;return -1;}
int utime (){printf("BADSYSCALL:utime\n");errno=EINVAL;return -1;}
int waitpid (){printf("BADSYSCALL:waitpid\n");errno=EINVAL;return -1;}

typedef __signed__ char __s8;
typedef unsigned char __u8;

typedef __signed__ short __s16;
typedef unsigned short __u16;

typedef __signed__ int __s32;
typedef unsigned int __u32;

typedef __signed__ long __s64;
typedef unsigned long __u64;

#define __bitwise 

typedef __u16 __bitwise __le16;
typedef __u16 __bitwise __be16;
typedef __u32 __bitwise __le32;
typedef __u32 __bitwise __be32;
typedef __u64 __bitwise __le64;
typedef __u64 __bitwise __be64;

typedef __u16 __bitwise __sum16;
typedef __u32 __bitwise __wsum;

/* Description of data base entry for a single service.  */
struct servent
{
  char *s_name;			/* Official service name.  */
  char **s_aliases;		/* Alias list.  */
  int s_port;			/* Port number.  */
  char *s_proto;		/* Protocol to use.  */
};
/* For setsockopt(2) */
#define SOL_SOCKET	1

#define SO_DEBUG	1
#define SO_REUSEADDR	2
#define SO_TYPE		3
#define SO_ERROR	4
#define SO_DONTROUTE	5
#define SO_BROADCAST	6
#define SO_SNDBUF	7
#define SO_RCVBUF	8
#define SO_SNDBUFFORCE	32
#define SO_RCVBUFFORCE	33
#define SO_KEEPALIVE	9
#define SO_OOBINLINE	10
#define SO_NO_CHECK	11
#define SO_PRIORITY	12
#define SO_LINGER	13
#define SO_BSDCOMPAT	14
/* To add :#define SO_REUSEPORT 15 */

#ifndef SO_PASSCRED /* powerpc only differs in these */
#define SO_PASSCRED	16
#define SO_PEERCRED	17
#define SO_RCVLOWAT	18
#define SO_SNDLOWAT	19
#define SO_RCVTIMEO	20
#define SO_SNDTIMEO	21
#endif

/* Security levels - as per NRL IPv6 - don't actually do anything */
#define SO_SECURITY_AUTHENTICATION		22
#define SO_SECURITY_ENCRYPTION_TRANSPORT	23
#define SO_SECURITY_ENCRYPTION_NETWORK		24

#define SO_BINDTODEVICE	25

/* Socket filtering */
#define SO_ATTACH_FILTER	26
#define SO_DETACH_FILTER	27

#define SO_PEERNAME		28
#define SO_TIMESTAMP		29
#define SCM_TIMESTAMP		SO_TIMESTAMP

#define SO_ACCEPTCONN		30

#define SO_PEERSEC		31
#define SO_PASSSEC		34
#define SO_TIMESTAMPNS		35
#define SCM_TIMESTAMPNS		SO_TIMESTAMPNS

#define SO_MARK			36

#define SO_TIMESTAMPING		37
#define SCM_TIMESTAMPING	SO_TIMESTAMPING

#define SO_PROTOCOL		38
#define SO_DOMAIN		39
struct addrinfo
{
  int ai_flags;			/* Input flags.  */
  int ai_family;		/* Protocol family for socket.  */
  int ai_socktype;		/* Socket type.  */
  int ai_protocol;		/* Protocol for socket.  */
  socklen_t ai_addrlen;		/* Length of socket address.  */
  struct sockaddr *ai_addr;	/* Socket address for socket.  */
  char *ai_canonname;		/* Canonical name for service location.  */
  struct addrinfo *ai_next;	/* Pointer to next in list.  */
};

/* Types of sockets.  */
enum __socket_type
{
  SOCK_STREAM = 1,		/* Sequenced, reliable, connection-based
				   byte streams.  */
#define SOCK_STREAM SOCK_STREAM
  SOCK_DGRAM = 2,		/* Connectionless, unreliable datagrams
				   of fixed maximum length.  */
#define SOCK_DGRAM SOCK_DGRAM
  SOCK_RAW = 3,			/* Raw protocol interface.  */
#define SOCK_RAW SOCK_RAW
  SOCK_RDM = 4,			/* Reliably-delivered messages.  */
#define SOCK_RDM SOCK_RDM
  SOCK_SEQPACKET = 5,		/* Sequenced, reliable, connection-based,
				   datagrams of fixed maximum length.  */
#define SOCK_SEQPACKET SOCK_SEQPACKET
  SOCK_DCCP = 6,		/* Datagram Congestion Control Protocol.  */
#define SOCK_DCCP SOCK_DCCP
  SOCK_PACKET = 10,		/* Linux specific way of getting packets
				   at the dev level.  For writing rarp and
				   other similar things on the user level. */
#define SOCK_PACKET SOCK_PACKET

  /* Flags to be ORed into the type parameter of socket and socketpair and
     used for the flags parameter of paccept.  */

  SOCK_CLOEXEC = 02000000,	/* Atomically set close-on-exec flag for the
				   new descriptor(s).  */
#define SOCK_CLOEXEC SOCK_CLOEXEC
  SOCK_NONBLOCK = 04000		/* Atomically mark descriptor(s) as
				   non-blocking.  */
#define SOCK_NONBLOCK SOCK_NONBLOCK
};

/* Protocol families.  */
#define	PF_UNSPEC	0	/* Unspecified.  */
#define	PF_LOCAL	1	/* Local to host (pipes and file-domain).  */
#define	PF_UNIX		PF_LOCAL /* POSIX name for PF_LOCAL.  */
#define	PF_FILE		PF_LOCAL /* Another non-standard name for PF_LOCAL.  */
#define	PF_INET		2	/* IP protocol family.  */
#define	PF_AX25		3	/* Amateur Radio AX.25.  */
#define	PF_IPX		4	/* Novell Internet Protocol.  */
#define	PF_APPLETALK	5	/* Appletalk DDP.  */
#define	PF_NETROM	6	/* Amateur radio NetROM.  */
#define	PF_BRIDGE	7	/* Multiprotocol bridge.  */
#define	PF_ATMPVC	8	/* ATM PVCs.  */
#define	PF_X25		9	/* Reserved for X.25 project.  */
#define	PF_INET6	10	/* IP version 6.  */
#define	PF_ROSE		11	/* Amateur Radio X.25 PLP.  */
#define	PF_DECnet	12	/* Reserved for DECnet project.  */
#define	PF_NETBEUI	13	/* Reserved for 802.2LLC project.  */
#define	PF_SECURITY	14	/* Security callback pseudo AF.  */
#define	PF_KEY		15	/* PF_KEY key management API.  */
#define	PF_NETLINK	16
#define	PF_ROUTE	PF_NETLINK /* Alias to emulate 4.4BSD.  */
#define	PF_PACKET	17	/* Packet family.  */
#define	PF_ASH		18	/* Ash.  */
#define	PF_ECONET	19	/* Acorn Econet.  */
#define	PF_ATMSVC	20	/* ATM SVCs.  */
#define PF_RDS		21	/* RDS sockets.  */
#define	PF_SNA		22	/* Linux SNA Project */
#define	PF_IRDA		23	/* IRDA sockets.  */
#define	PF_PPPOX	24	/* PPPoX sockets.  */
#define	PF_WANPIPE	25	/* Wanpipe API sockets.  */
#define PF_LLC		26	/* Linux LLC.  */
#define PF_CAN		29	/* Controller Area Network.  */
#define PF_TIPC		30	/* TIPC sockets.  */
#define	PF_BLUETOOTH	31	/* Bluetooth sockets.  */
#define	PF_IUCV		32	/* IUCV sockets.  */
#define PF_RXRPC	33	/* RxRPC sockets.  */
#define PF_ISDN		34	/* mISDN sockets.  */
#define PF_PHONET	35	/* Phonet sockets.  */
#define PF_IEEE802154	36	/* IEEE 802.15.4 sockets.  */
#define	PF_MAX		37	/* For now..  */

/* Address families.  */
#define	AF_UNSPEC	PF_UNSPEC
#define	AF_LOCAL	PF_LOCAL
#define	AF_UNIX		PF_UNIX
#define	AF_FILE		PF_FILE
#define	AF_INET		PF_INET
#define	AF_AX25		PF_AX25
#define	AF_IPX		PF_IPX
#define	AF_APPLETALK	PF_APPLETALK
#define	AF_NETROM	PF_NETROM
#define	AF_BRIDGE	PF_BRIDGE
#define	AF_ATMPVC	PF_ATMPVC
#define	AF_X25		PF_X25
#define	AF_INET6	PF_INET6
#define	AF_ROSE		PF_ROSE
#define	AF_DECnet	PF_DECnet
#define	AF_NETBEUI	PF_NETBEUI
#define	AF_SECURITY	PF_SECURITY
#define	AF_KEY		PF_KEY
#define	AF_NETLINK	PF_NETLINK
#define	AF_ROUTE	PF_ROUTE
#define	AF_PACKET	PF_PACKET
#define	AF_ASH		PF_ASH
#define	AF_ECONET	PF_ECONET
#define	AF_ATMSVC	PF_ATMSVC
#define AF_RDS		PF_RDS
#define	AF_SNA		PF_SNA
#define	AF_IRDA		PF_IRDA
#define	AF_PPPOX	PF_PPPOX
#define	AF_WANPIPE	PF_WANPIPE
#define AF_LLC		PF_LLC
#define AF_CAN		PF_CAN
#define AF_TIPC		PF_TIPC
#define	AF_BLUETOOTH	PF_BLUETOOTH
#define	AF_IUCV		PF_IUCV
#define AF_RXRPC	PF_RXRPC
#define AF_ISDN		PF_ISDN
#define AF_PHONET	PF_PHONET
#define AF_IEEE802154	PF_IEEE802154
#define	AF_MAX		PF_MAX

/* Socket level values.  Others are defined in the appropriate headers.

   XXX These definitions also should go into the appropriate headers as
   far as they are available.  */
#define SOL_RAW		255
#define SOL_DECNET      261
#define SOL_X25         262
#define SOL_PACKET	263
#define SOL_ATM		264	/* ATM layer (cell level).  */
#define SOL_AAL		265	/* ATM Adaption Layer (packet level).  */
#define SOL_IRDA	266

/* Maximum queue length specifiable by listen.  */
#define SOMAXCONN	128


/* POSIX.1g specifies this type name for the `sa_family' member.  */
typedef unsigned short int sa_family_t;

/* This macro is used to declare the initial common members
   of the data types used for socket addresses, `struct sockaddr',
   `struct sockaddr_in', `struct sockaddr_un', etc.  */

#define	__SOCKADDR_COMMON(sa_prefix) \
  sa_family_t sa_prefix##family

#define __SOCKADDR_COMMON_SIZE	(sizeof (unsigned short int))

/* Structure describing a generic socket address.  */
struct sockaddr
  {
    __SOCKADDR_COMMON (sa_);	/* Common data: address family and length.  */
    char sa_data[14];		/* Address data.  */
  };


/* Structure large enough to hold any socket address (with the historical
   exception of AF_UNIX).  We reserve 128 bytes.  */
#define __ss_aligntype	unsigned long int
#define _SS_SIZE	128
#define _SS_PADSIZE	(_SS_SIZE - (2 * sizeof (__ss_aligntype)))

struct sockaddr_storage
  {
    __SOCKADDR_COMMON (ss_);	/* Address family, etc.  */
    __ss_aligntype __ss_align;	/* Force desired alignment.  */
    char __ss_padding[_SS_PADSIZE];
  };


/* Bits in the FLAGS argument to `send', `recv', et al.  */
enum
  {
    MSG_OOB		= 0x01,	/* Process out-of-band data.  */
#define MSG_OOB		MSG_OOB
    MSG_PEEK		= 0x02,	/* Peek at incoming messages.  */
#define MSG_PEEK	MSG_PEEK
    MSG_DONTROUTE	= 0x04,	/* Don't use local routing.  */
#define MSG_DONTROUTE	MSG_DONTROUTE
#ifdef __USE_GNU
    /* DECnet uses a different name.  */
    MSG_TRYHARD		= MSG_DONTROUTE,
# define MSG_TRYHARD	MSG_DONTROUTE
#endif
    MSG_CTRUNC		= 0x08,	/* Control data lost before delivery.  */
#define MSG_CTRUNC	MSG_CTRUNC
    MSG_PROXY		= 0x10,	/* Supply or ask second address.  */
#define MSG_PROXY	MSG_PROXY
    MSG_TRUNC		= 0x20,
#define	MSG_TRUNC	MSG_TRUNC
    MSG_DONTWAIT	= 0x40, /* Nonblocking IO.  */
#define	MSG_DONTWAIT	MSG_DONTWAIT
    MSG_EOR		= 0x80, /* End of record.  */
#define	MSG_EOR		MSG_EOR
    MSG_WAITALL		= 0x100, /* Wait for a full request.  */
#define	MSG_WAITALL	MSG_WAITALL
    MSG_FIN		= 0x200,
#define	MSG_FIN		MSG_FIN
    MSG_SYN		= 0x400,
#define	MSG_SYN		MSG_SYN
    MSG_CONFIRM		= 0x800, /* Confirm path validity.  */
#define	MSG_CONFIRM	MSG_CONFIRM
    MSG_RST		= 0x1000,
#define	MSG_RST		MSG_RST
    MSG_ERRQUEUE	= 0x2000, /* Fetch message from error queue.  */
#define	MSG_ERRQUEUE	MSG_ERRQUEUE
    MSG_NOSIGNAL	= 0x4000, /* Do not generate SIGPIPE.  */
#define	MSG_NOSIGNAL	MSG_NOSIGNAL
    MSG_MORE		= 0x8000,  /* Sender will send more.  */
#define	MSG_MORE	MSG_MORE

    MSG_CMSG_CLOEXEC	= 0x40000000	/* Set close_on_exit for file
                                           descriptor received through
                                           SCM_RIGHTS.  */
#define MSG_CMSG_CLOEXEC MSG_CMSG_CLOEXEC
  };


/* Structure describing messages sent by
   `sendmsg' and received by `recvmsg'.  */
struct msghdr
  {
    void *msg_name;		/* Address to send to/receive from.  */
    socklen_t msg_namelen;	/* Length of address data.  */

    struct iovec *msg_iov;	/* Vector of data to send/receive into.  */
    size_t msg_iovlen;		/* Number of elements in the vector.  */

    void *msg_control;		/* Ancillary data (eg BSD filedesc passing). */
    size_t msg_controllen;	/* Ancillary data buffer length.
				   !! The type should be socklen_t but the
				   definition of the kernel is incompatible
				   with this.  */

    int msg_flags;		/* Flags on received message.  */
  };


# define __flexarr	[]



/* Structure used for storage of ancillary data object information.  */
struct cmsghdr
  {
    size_t cmsg_len;		/* Length of data in cmsg_data plus length
				   of cmsghdr structure.
				   !! The type should be socklen_t but the
				   definition of the kernel is incompatible
				   with this.  */
    int cmsg_level;		/* Originating protocol.  */
    int cmsg_type;		/* Protocol specific type.  */
#if (!defined __STRICT_ANSI__ && __GNUC__ >= 2) || __STDC_VERSION__ >= 199901L
    __extension__ unsigned char __cmsg_data __flexarr; /* Ancillary data.  */
#endif
  };

/* Ancillary data object manipulation macros.  */
#if (!defined __STRICT_ANSI__ && __GNUC__ >= 2) || __STDC_VERSION__ >= 199901L
# define CMSG_DATA(cmsg) ((cmsg)->__cmsg_data)
#else
# define CMSG_DATA(cmsg) ((unsigned char *) ((struct cmsghdr *) (cmsg) + 1))
#endif
#define CMSG_NXTHDR(mhdr, cmsg) __cmsg_nxthdr (mhdr, cmsg)
#define CMSG_FIRSTHDR(mhdr) \
  ((size_t) (mhdr)->msg_controllen >= sizeof (struct cmsghdr)		      \
   ? (struct cmsghdr *) (mhdr)->msg_control : (struct cmsghdr *) 0)
#define CMSG_ALIGN(len) (((len) + sizeof (size_t) - 1) \
			 & (size_t) ~(sizeof (size_t) - 1))
#define CMSG_SPACE(len) (CMSG_ALIGN (len) \
			 + CMSG_ALIGN (sizeof (struct cmsghdr)))
#define CMSG_LEN(len)   (CMSG_ALIGN (sizeof (struct cmsghdr)) + (len))
# define __THROW

extern struct cmsghdr *__cmsg_nxthdr (struct msghdr *__mhdr,
				      struct cmsghdr *__cmsg) __THROW;
#ifdef __USE_EXTERN_INLINES
# ifndef _EXTERN_INLINE
#  define _EXTERN_INLINE __extern_inline
# endif
_EXTERN_INLINE struct cmsghdr *
__NTH (__cmsg_nxthdr (struct msghdr *__mhdr, struct cmsghdr *__cmsg))
{
  if ((size_t) __cmsg->cmsg_len < sizeof (struct cmsghdr))
    /* The kernel header does this so there may be a reason.  */
    return 0;

  __cmsg = (struct cmsghdr *) ((unsigned char *) __cmsg
			       + CMSG_ALIGN (__cmsg->cmsg_len));
  if ((unsigned char *) (__cmsg + 1) > ((unsigned char *) __mhdr->msg_control
					+ __mhdr->msg_controllen)
      || ((unsigned char *) __cmsg + CMSG_ALIGN (__cmsg->cmsg_len)
	  > ((unsigned char *) __mhdr->msg_control + __mhdr->msg_controllen)))
    /* No more entries.  */
    return 0;
  return __cmsg;
}
#endif	/* Use `extern inline'.  */

/* Socket level message types.  This must match the definitions in
   <linux/socket.h>.  */
enum
  {
    SCM_RIGHTS = 0x01		/* Transfer file descriptors.  */
#define SCM_RIGHTS SCM_RIGHTS
#ifdef __USE_GNU
    , SCM_CREDENTIALS = 0x02	/* Credentials passing.  */
# define SCM_CREDENTIALS SCM_CREDENTIALS
#endif
  };

#ifdef __USE_GNU
/* User visible structure for SCM_CREDENTIALS message */
struct ucred
{
  pid_t pid;			/* PID of sending process.  */
  uid_t uid;			/* UID of sending process.  */
  gid_t gid;			/* GID of sending process.  */
};
#endif

/* Ugly workaround for unclean kernel headers.  */
#if !defined __USE_MISC && !defined __USE_GNU
# ifndef FIOGETOWN
#  define __SYS_SOCKET_H_undef_FIOGETOWN
# endif
# ifndef FIOSETOWN
#  define __SYS_SOCKET_H_undef_FIOSETOWN
# endif
# ifndef SIOCATMARK
#  define __SYS_SOCKET_H_undef_SIOCATMARK
# endif
# ifndef SIOCGPGRP
#  define __SYS_SOCKET_H_undef_SIOCGPGRP
# endif
# ifndef SIOCGSTAMP
#  define __SYS_SOCKET_H_undef_SIOCGSTAMP
# endif
# ifndef SIOCGSTAMPNS
#  define __SYS_SOCKET_H_undef_SIOCGSTAMPNS
# endif
# ifndef SIOCSPGRP
#  define __SYS_SOCKET_H_undef_SIOCSPGRP
# endif
#endif

/* Get socket manipulation related informations from kernel headers.  */


#if !defined __USE_MISC && !defined __USE_GNU
# ifdef __SYS_SOCKET_H_undef_FIOGETOWN
#  undef __SYS_SOCKET_H_undef_FIOGETOWN
#  undef FIOGETOWN
# endif
# ifdef __SYS_SOCKET_H_undef_FIOSETOWN
#  undef __SYS_SOCKET_H_undef_FIOSETOWN
#  undef FIOSETOWN
# endif
# ifdef __SYS_SOCKET_H_undef_SIOCATMARK
#  undef __SYS_SOCKET_H_undef_SIOCATMARK
#  undef SIOCATMARK
# endif
# ifdef __SYS_SOCKET_H_undef_SIOCGPGRP
#  undef __SYS_SOCKET_H_undef_SIOCGPGRP
#  undef SIOCGPGRP
# endif
# ifdef __SYS_SOCKET_H_undef_SIOCGSTAMP
#  undef __SYS_SOCKET_H_undef_SIOCGSTAMP
#  undef SIOCGSTAMP
# endif
# ifdef __SYS_SOCKET_H_undef_SIOCGSTAMPNS
#  undef __SYS_SOCKET_H_undef_SIOCGSTAMPNS
#  undef SIOCGSTAMPNS
# endif
# ifdef __SYS_SOCKET_H_undef_SIOCSPGRP
#  undef __SYS_SOCKET_H_undef_SIOCSPGRP
#  undef SIOCSPGRP
# endif
#endif

/* Structure used to manipulate the SO_LINGER option.  */
struct linger
  {
    int l_onoff;		/* Nonzero to linger on close.  */
    int l_linger;		/* Time to linger.  */
  };
/* Standard well-defined IP protocols.  */
enum {
  IPPROTO_IP = 0,		/* Dummy protocol for TCP		*/
  IPPROTO_ICMP = 1,		/* Internet Control Message Protocol	*/
  IPPROTO_IGMP = 2,		/* Internet Group Management Protocol	*/
  IPPROTO_IPIP = 4,		/* IPIP tunnels (older KA9Q tunnels use 94) */
  IPPROTO_TCP = 6,		/* Transmission Control Protocol	*/
  IPPROTO_EGP = 8,		/* Exterior Gateway Protocol		*/
  IPPROTO_PUP = 12,		/* PUP protocol				*/
  IPPROTO_UDP = 17,		/* User Datagram Protocol		*/
  IPPROTO_IDP = 22,		/* XNS IDP protocol			*/
  IPPROTO_DCCP = 33,		/* Datagram Congestion Control Protocol */
  IPPROTO_RSVP = 46,		/* RSVP protocol			*/
  IPPROTO_GRE = 47,		/* Cisco GRE tunnels (rfc 1701,1702)	*/

  IPPROTO_IPV6	 = 41,		/* IPv6-in-IPv4 tunnelling		*/

  IPPROTO_ESP = 50,            /* Encapsulation Security Payload protocol */
  IPPROTO_AH = 51,             /* Authentication Header protocol       */
  IPPROTO_BEETPH = 94,	       /* IP option pseudo header for BEET */
  IPPROTO_PIM    = 103,		/* Protocol Independent Multicast	*/

  IPPROTO_COMP   = 108,                /* Compression Header protocol */
  IPPROTO_SCTP   = 132,		/* Stream Control Transport Protocol	*/
  IPPROTO_UDPLITE = 136,	/* UDP-Lite (RFC 3828)			*/

  IPPROTO_RAW	 = 255,		/* Raw IP packets			*/
  IPPROTO_MAX
};


/* Internet address. */
struct in_addr {
	__be32	s_addr;
};

#define IP_TOS		1
#define IP_TTL		2
#define IP_HDRINCL	3
#define IP_OPTIONS	4
#define IP_ROUTER_ALERT	5
#define IP_RECVOPTS	6
#define IP_RETOPTS	7
#define IP_PKTINFO	8
#define IP_PKTOPTIONS	9
#define IP_MTU_DISCOVER	10
#define IP_RECVERR	11
#define IP_RECVTTL	12
#define	IP_RECVTOS	13
#define IP_MTU		14
#define IP_FREEBIND	15
#define IP_IPSEC_POLICY	16
#define IP_XFRM_POLICY	17
#define IP_PASSSEC	18
#define IP_TRANSPARENT	19

/* BSD compatibility */
#define IP_RECVRETOPTS	IP_RETOPTS

/* TProxy original addresses */
#define IP_ORIGDSTADDR       20
#define IP_RECVORIGDSTADDR   IP_ORIGDSTADDR

/* IP_MTU_DISCOVER values */
#define IP_PMTUDISC_DONT		0	/* Never send DF frames */
#define IP_PMTUDISC_WANT		1	/* Use per route hints	*/
#define IP_PMTUDISC_DO			2	/* Always DF		*/
#define IP_PMTUDISC_PROBE		3       /* Ignore dst pmtu      */

#define IP_MULTICAST_IF			32
#define IP_MULTICAST_TTL 		33
#define IP_MULTICAST_LOOP 		34
#define IP_ADD_MEMBERSHIP		35
#define IP_DROP_MEMBERSHIP		36
#define IP_UNBLOCK_SOURCE		37
#define IP_BLOCK_SOURCE			38
#define IP_ADD_SOURCE_MEMBERSHIP	39
#define IP_DROP_SOURCE_MEMBERSHIP	40
#define IP_MSFILTER			41
#define MCAST_JOIN_GROUP		42
#define MCAST_BLOCK_SOURCE		43
#define MCAST_UNBLOCK_SOURCE		44
#define MCAST_LEAVE_GROUP		45
#define MCAST_JOIN_SOURCE_GROUP		46
#define MCAST_LEAVE_SOURCE_GROUP	47
#define MCAST_MSFILTER			48
#define IP_MULTICAST_ALL		49

#define MCAST_EXCLUDE	0
#define MCAST_INCLUDE	1

/* These need to appear somewhere around here */
#define IP_DEFAULT_MULTICAST_TTL        1
#define IP_DEFAULT_MULTICAST_LOOP       1



/*
 * Desired design of maximum size and alignment (see RFC2553)
 */
#define _K_SS_MAXSIZE	128	/* Implementation specific max size */
#define _K_SS_ALIGNSIZE	(__alignof__ (struct sockaddr *))
				/* Implementation specific desired alignment */

struct __kernel_sockaddr_storage {
	unsigned short	ss_family;		/* address family */
	/* Following field(s) are implementation specific */
	char		__data[_K_SS_MAXSIZE - sizeof(unsigned short)];
				/* space to achieve desired size, */
				/* _SS_MAXSIZE value minus size of ss_family */
} __attribute__ ((aligned(_K_SS_ALIGNSIZE)));	/* force desired alignment */

/* Request struct for multicast socket ops */

struct ip_mreq 
{
	struct in_addr imr_multiaddr;	/* IP multicast address of group */
	struct in_addr imr_interface;	/* local IP address of interface */
};

struct ip_mreqn
{
	struct in_addr	imr_multiaddr;		/* IP multicast address of group */
	struct in_addr	imr_address;		/* local IP address of interface */
	int		imr_ifindex;		/* Interface index */
};

struct ip_mreq_source {
	__be32		imr_multiaddr;
	__be32		imr_interface;
	__be32		imr_sourceaddr;
};

struct ip_msfilter {
	__be32		imsf_multiaddr;
	__be32		imsf_interface;
	__u32		imsf_fmode;
	__u32		imsf_numsrc;
	__be32		imsf_slist[1];
};

#define IP_MSFILTER_SIZE(numsrc) \
	(sizeof(struct ip_msfilter) - sizeof(__u32) \
	+ (numsrc) * sizeof(__u32))

struct group_req
{
	__u32				 gr_interface;	/* interface index */
	struct __kernel_sockaddr_storage gr_group;	/* group address */
};

struct group_source_req
{
	__u32				 gsr_interface;	/* interface index */
	struct __kernel_sockaddr_storage gsr_group;	/* group address */
	struct __kernel_sockaddr_storage gsr_source;	/* source address */
};

struct group_filter
{
	__u32				 gf_interface;	/* interface index */
	struct __kernel_sockaddr_storage gf_group;	/* multicast address */
	__u32				 gf_fmode;	/* filter mode */
	__u32				 gf_numsrc;	/* number of sources */
	struct __kernel_sockaddr_storage gf_slist[1];	/* interface index */
};

#define GROUP_FILTER_SIZE(numsrc) \
	(sizeof(struct group_filter) - sizeof(struct __kernel_sockaddr_storage) \
	+ (numsrc) * sizeof(struct __kernel_sockaddr_storage))

struct in_pktinfo
{
	int		ipi_ifindex;
	struct in_addr	ipi_spec_dst;
	struct in_addr	ipi_addr;
};

/* Structure describing an Internet (IP) socket address. */
#define __SOCK_SIZE__	16		/* sizeof(struct sockaddr)	*/
struct sockaddr_in {
  sa_family_t		sin_family;	/* Address family		*/
  __be16		sin_port;	/* Port number			*/
  struct in_addr	sin_addr;	/* Internet address		*/

  /* Pad to size of `struct sockaddr'. */
  unsigned char		__pad[__SOCK_SIZE__ - sizeof(short int) -
			sizeof(unsigned short int) - sizeof(struct in_addr)];
};
#define sin_zero	__pad		/* for BSD UNIX comp. -FvK	*/


/*
 * Definitions of the bits in an Internet address integer.
 * On subnets, host and network parts are found according
 * to the subnet mask, not these masks.
 */
#define	IN_CLASSA(a)		((((long int) (a)) & 0x80000000) == 0)
#define	IN_CLASSA_NET		0xff000000
#define	IN_CLASSA_NSHIFT	24
#define	IN_CLASSA_HOST		(0xffffffff & ~IN_CLASSA_NET)
#define	IN_CLASSA_MAX		128

#define	IN_CLASSB(a)		((((long int) (a)) & 0xc0000000) == 0x80000000)
#define	IN_CLASSB_NET		0xffff0000
#define	IN_CLASSB_NSHIFT	16
#define	IN_CLASSB_HOST		(0xffffffff & ~IN_CLASSB_NET)
#define	IN_CLASSB_MAX		65536

#define	IN_CLASSC(a)		((((long int) (a)) & 0xe0000000) == 0xc0000000)
#define	IN_CLASSC_NET		0xffffff00
#define	IN_CLASSC_NSHIFT	8
#define	IN_CLASSC_HOST		(0xffffffff & ~IN_CLASSC_NET)

#define	IN_CLASSD(a)		((((long int) (a)) & 0xf0000000) == 0xe0000000)
#define	IN_MULTICAST(a)		IN_CLASSD(a)
#define IN_MULTICAST_NET	0xF0000000

#define	IN_EXPERIMENTAL(a)	((((long int) (a)) & 0xf0000000) == 0xf0000000)
#define	IN_BADCLASS(a)		IN_EXPERIMENTAL((a))

/* Address to accept any incoming messages. */
#define	INADDR_ANY		((unsigned long int) 0x00000000)

/* Address to send to all hosts. */
#define	INADDR_BROADCAST	((unsigned long int) 0xffffffff)

/* Address indicating an error return. */
#define	INADDR_NONE		((unsigned long int) 0xffffffff)

/* Network number for local host loopback. */
#define	IN_LOOPBACKNET		127

/* Address to loopback in software to local host.  */
#define	INADDR_LOOPBACK		0x7f000001	/* 127.0.0.1   */
#define	IN_LOOPBACK(a)		((((long int) (a)) & 0xff000000) == 0x7f000000)

/* Defines for Multicast INADDR */
#define INADDR_UNSPEC_GROUP   	0xe0000000U	/* 224.0.0.0   */
#define INADDR_ALLHOSTS_GROUP 	0xe0000001U	/* 224.0.0.1   */
#define INADDR_ALLRTRS_GROUP    0xe0000002U	/* 224.0.0.2 */
#define INADDR_MAX_LOCAL_GROUP  0xe00000ffU	/* 224.0.0.255 */

/*
 *	IPv6 address structure
 */

struct in6_addr
{
	union 
	{
		__u8		u6_addr8[16];
		__be16		u6_addr16[8];
		__be32		u6_addr32[4];
	} in6_u;
#define s6_addr			in6_u.u6_addr8
#define s6_addr16		in6_u.u6_addr16
#define s6_addr32		in6_u.u6_addr32
};

/* IPv6 Wildcard Address (::) and Loopback Address (::1) defined in RFC2553
 * NOTE: Be aware the IN6ADDR_* constants and in6addr_* externals are defined
 * in network byte order, not in host byte order as are the IPv4 equivalents
 */

struct sockaddr_in6 {
	unsigned short int	sin6_family;    /* AF_INET6 */
	__be16			sin6_port;      /* Transport layer port # */
	__be32			sin6_flowinfo;  /* IPv6 flow information */
	struct in6_addr		sin6_addr;      /* IPv6 address */
	__u32			sin6_scope_id;  /* scope id (new in RFC2553) */
};

struct ipv6_mreq {
	/* IPv6 multicast address of group */
	struct in6_addr ipv6mr_multiaddr;

	/* local IPv6 address of interface */
	int		ipv6mr_ifindex;
};

#define ipv6mr_acaddr	ipv6mr_multiaddr

struct in6_flowlabel_req
{
	struct in6_addr	flr_dst;
	__be32	flr_label;
	__u8	flr_action;
	__u8	flr_share;
	__u16	flr_flags;
	__u16 	flr_expires;
	__u16	flr_linger;
	__u32	__flr_pad;
	/* Options in format of IPV6_PKTOPTIONS */
};

#define IPV6_FL_A_GET	0
#define IPV6_FL_A_PUT	1
#define IPV6_FL_A_RENEW	2

#define IPV6_FL_F_CREATE	1
#define IPV6_FL_F_EXCL		2

#define IPV6_FL_S_NONE		0
#define IPV6_FL_S_EXCL		1
#define IPV6_FL_S_PROCESS	2
#define IPV6_FL_S_USER		3
#define IPV6_FL_S_ANY		255


/*
 *	Bitmask constant declarations to help applications select out the 
 *	flow label and priority fields.
 *
 *	Note that this are in host byte order while the flowinfo field of
 *	sockaddr_in6 is in network byte order.
 */

#define IPV6_FLOWINFO_FLOWLABEL		0x000fffff
#define IPV6_FLOWINFO_PRIORITY		0x0ff00000

/* These defintions are obsolete */
#define IPV6_PRIORITY_UNCHARACTERIZED	0x0000
#define IPV6_PRIORITY_FILLER		0x0100
#define IPV6_PRIORITY_UNATTENDED	0x0200
#define IPV6_PRIORITY_RESERVED1		0x0300
#define IPV6_PRIORITY_BULK		0x0400
#define IPV6_PRIORITY_RESERVED2		0x0500
#define IPV6_PRIORITY_INTERACTIVE	0x0600
#define IPV6_PRIORITY_CONTROL		0x0700
#define IPV6_PRIORITY_8			0x0800
#define IPV6_PRIORITY_9			0x0900
#define IPV6_PRIORITY_10		0x0a00
#define IPV6_PRIORITY_11		0x0b00
#define IPV6_PRIORITY_12		0x0c00
#define IPV6_PRIORITY_13		0x0d00
#define IPV6_PRIORITY_14		0x0e00
#define IPV6_PRIORITY_15		0x0f00

/*
 *	IPV6 extension headers
 */
#define IPPROTO_HOPOPTS		0	/* IPv6 hop-by-hop options	*/
#define IPPROTO_ROUTING		43	/* IPv6 routing header		*/
#define IPPROTO_FRAGMENT	44	/* IPv6 fragmentation header	*/
#define IPPROTO_ICMPV6		58	/* ICMPv6			*/
#define IPPROTO_NONE		59	/* IPv6 no next header		*/
#define IPPROTO_DSTOPTS		60	/* IPv6 destination options	*/
#define IPPROTO_MH		135	/* IPv6 mobility header		*/

/*
 *	IPv6 TLV options.
 */
#define IPV6_TLV_PAD0		0
#define IPV6_TLV_PADN		1
#define IPV6_TLV_ROUTERALERT	5
#define IPV6_TLV_JUMBO		194
#define IPV6_TLV_HAO		201	/* home address option */

/*
 *	IPV6 socket options
 */

#define IPV6_ADDRFORM		1
#define IPV6_2292PKTINFO	2
#define IPV6_2292HOPOPTS	3
#define IPV6_2292DSTOPTS	4
#define IPV6_2292RTHDR		5
#define IPV6_2292PKTOPTIONS	6
#define IPV6_CHECKSUM		7
#define IPV6_2292HOPLIMIT	8
#define IPV6_NEXTHOP		9
#define IPV6_AUTHHDR		10	/* obsolete */
#define IPV6_FLOWINFO		11

#define IPV6_UNICAST_HOPS	16
#define IPV6_MULTICAST_IF	17
#define IPV6_MULTICAST_HOPS	18
#define IPV6_MULTICAST_LOOP	19
#define IPV6_ADD_MEMBERSHIP	20
#define IPV6_DROP_MEMBERSHIP	21
#define IPV6_ROUTER_ALERT	22
#define IPV6_MTU_DISCOVER	23
#define IPV6_MTU		24
#define IPV6_RECVERR		25
#define IPV6_V6ONLY		26
#define IPV6_JOIN_ANYCAST	27
#define IPV6_LEAVE_ANYCAST	28

/* IPV6_MTU_DISCOVER values */
#define IPV6_PMTUDISC_DONT		0
#define IPV6_PMTUDISC_WANT		1
#define IPV6_PMTUDISC_DO		2
#define IPV6_PMTUDISC_PROBE		3

/* Flowlabel */
#define IPV6_FLOWLABEL_MGR	32
#define IPV6_FLOWINFO_SEND	33

#define IPV6_IPSEC_POLICY	34
#define IPV6_XFRM_POLICY	35

/*
 * Multicast:
 * Following socket options are shared between IPv4 and IPv6.
 *
 * MCAST_JOIN_GROUP		42
 * MCAST_BLOCK_SOURCE		43
 * MCAST_UNBLOCK_SOURCE		44
 * MCAST_LEAVE_GROUP		45
 * MCAST_JOIN_SOURCE_GROUP	46
 * MCAST_LEAVE_SOURCE_GROUP	47
 * MCAST_MSFILTER		48
 */

/*
 * Advanced API (RFC3542) (1)
 *
 * Note: IPV6_RECVRTHDRDSTOPTS does not exist. see net/ipv6/datagram.c.
 */

#define IPV6_RECVPKTINFO	49
#define IPV6_PKTINFO		50
#define IPV6_RECVHOPLIMIT	51
#define IPV6_HOPLIMIT		52
#define IPV6_RECVHOPOPTS	53
#define IPV6_HOPOPTS		54
#define IPV6_RTHDRDSTOPTS	55
#define IPV6_RECVRTHDR		56
#define IPV6_RTHDR		57
#define IPV6_RECVDSTOPTS	58
#define IPV6_DSTOPTS		59
#if 0	/* not yet */
#define IPV6_RECVPATHMTU	60
#define IPV6_PATHMTU		61
#define IPV6_DONTFRAG		62
#define IPV6_USE_MIN_MTU	63
#endif

/*
 * Netfilter (1)
 *
 * Following socket options are used in ip6_tables;
 * see include/linux/netfilter_ipv6/ip6_tables.h.
 *
 * IP6T_SO_SET_REPLACE / IP6T_SO_GET_INFO		64
 * IP6T_SO_SET_ADD_COUNTERS / IP6T_SO_GET_ENTRIES	65
 */

/*
 * Advanced API (RFC3542) (2)
 */
#define IPV6_RECVTCLASS		66
#define IPV6_TCLASS		67

/*
 * Netfilter (2)
 *
 * Following socket options are used in ip6_tables;
 * see include/linux/netfilter_ipv6/ip6_tables.h.
 *
 * IP6T_SO_GET_REVISION_MATCH	68
 * IP6T_SO_GET_REVISION_TARGET	69
 */

/* RFC5014: Source address selection */
#define IPV6_ADDR_PREFERENCES	72

#define IPV6_PREFER_SRC_TMP		0x0001
#define IPV6_PREFER_SRC_PUBLIC		0x0002
#define IPV6_PREFER_SRC_PUBTMP_DEFAULT	0x0100
#define IPV6_PREFER_SRC_COA		0x0004
#define IPV6_PREFER_SRC_HOME		0x0400
#define IPV6_PREFER_SRC_CGA		0x0008
#define IPV6_PREFER_SRC_NONCGA		0x0800

/*
 * Multicast Routing:
 * see include/linux/mroute6.h.
 *
 * MRT6_INIT			200
 * MRT6_DONE			201
 * MRT6_ADD_MIF			202
 * MRT6_DEL_MIF			203
 * MRT6_ADD_MFC			204
 * MRT6_DEL_MFC			205
 * MRT6_VERSION			206
 * MRT6_ASSERT			207
 * MRT6_PIM			208
 * (reserved)			209
 */



/* The following constants should be used for the second parameter of
   `shutdown'.  */
enum
{
  SHUT_RD = 0,		/* No more receptions.  */
#define SHUT_RD		SHUT_RD
  SHUT_WR,		/* No more transmissions.  */
#define SHUT_WR		SHUT_WR
  SHUT_RDWR		/* No more receptions or transmissions.  */
#define SHUT_RDWR	SHUT_RDWR
};

/* Add more `struct sockaddr_AF' types here as necessary.
   These are all the ones I found on NetBSD and Linux.  */
# define __SOCKADDR_ALLTYPES \
  __SOCKADDR_ONETYPE (sockaddr) \
  __SOCKADDR_ONETYPE (sockaddr_at) \
  __SOCKADDR_ONETYPE (sockaddr_ax25) \
  __SOCKADDR_ONETYPE (sockaddr_dl) \
  __SOCKADDR_ONETYPE (sockaddr_eon) \
  __SOCKADDR_ONETYPE (sockaddr_in) \
  __SOCKADDR_ONETYPE (sockaddr_in6) \
  __SOCKADDR_ONETYPE (sockaddr_inarp) \
  __SOCKADDR_ONETYPE (sockaddr_ipx) \
  __SOCKADDR_ONETYPE (sockaddr_iso) \
  __SOCKADDR_ONETYPE (sockaddr_ns) \
  __SOCKADDR_ONETYPE (sockaddr_un) \
  __SOCKADDR_ONETYPE (sockaddr_x25)

# define __SOCKADDR_ONETYPE(type) struct type *__restrict __##type##__;
typedef union { __SOCKADDR_ALLTYPES
	      } __SOCKADDR_ARG __attribute__ ((__transparent_union__));
# undef __SOCKADDR_ONETYPE
# define __SOCKADDR_ONETYPE(type) __const struct type *__restrict __##type##__;
typedef union { __SOCKADDR_ALLTYPES
	      } __CONST_SOCKADDR_ARG __attribute__ ((__transparent_union__));
# undef __SOCKADDR_ONETYPE


/* Create a new socket of type TYPE in domain DOMAIN, using
   protocol PROTOCOL.  If PROTOCOL is zero, one is chosen automatically.
   Returns a file descriptor for the new socket, or -1 for errors.  */
extern int socket (int __domain, int __type, int __protocol) __THROW;

/* Create two new sockets, of type TYPE in domain DOMAIN and using
   protocol PROTOCOL, which are connected to each other, and put file
   descriptors for them in FDS[0] and FDS[1].  If PROTOCOL is zero,
   one will be chosen automatically.  Returns 0 on success, -1 for errors.  */
extern int socketpair (int __domain, int __type, int __protocol,
		       int __fds[2]) __THROW;

/* Give the socket FD the local address ADDR (which is LEN bytes long).  */
extern int bind (int __fd, __CONST_SOCKADDR_ARG __addr, socklen_t __len)
     __THROW;

/* Put the local address of FD into *ADDR and its length in *LEN.  */
extern int getsockname (int __fd, __SOCKADDR_ARG __addr,
			socklen_t *__restrict __len) __THROW;

/* Open a connection on socket FD to peer at ADDR (which LEN bytes long).
   For connectionless socket types, just set the default address to send to
   and the only address from which to accept transmissions.
   Return 0 on success, -1 for errors.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern int connect (int __fd, __CONST_SOCKADDR_ARG __addr, socklen_t __len);

/* Put the address of the peer connected to socket FD into *ADDR
   (which is *LEN bytes long), and its actual length into *LEN.  */
extern int getpeername (int __fd, __SOCKADDR_ARG __addr,
			socklen_t *__restrict __len) __THROW;


/* Send N bytes of BUF to socket FD.  Returns the number sent or -1.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern ssize_t send (int __fd, __const void *__buf, size_t __n, int __flags);

/* Read N bytes into BUF from socket FD.
   Returns the number read or -1 for errors.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern ssize_t recv (int __fd, void *__buf, size_t __n, int __flags);

/* Send N bytes of BUF on socket FD to peer at address ADDR (which is
   ADDR_LEN bytes long).  Returns the number sent, or -1 for errors.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern ssize_t sendto (int __fd, __const void *__buf, size_t __n,
		       int __flags, __CONST_SOCKADDR_ARG __addr,
		       socklen_t __addr_len);

/* Read N bytes into BUF through socket FD.
   If ADDR is not NULL, fill in *ADDR_LEN bytes of it with tha address of
   the sender, and store the actual size of the address in *ADDR_LEN.
   Returns the number of bytes read or -1 for errors.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern ssize_t recvfrom (int __fd, void *__restrict __buf, size_t __n,
			 int __flags, __SOCKADDR_ARG __addr,
			 socklen_t *__restrict __addr_len);


/* Send a message described MESSAGE on socket FD.
   Returns the number of bytes sent, or -1 for errors.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern ssize_t sendmsg (int __fd, __const struct msghdr *__message,
			int __flags);

/* Receive a message as described by MESSAGE from socket FD.
   Returns the number of bytes read or -1 for errors.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern ssize_t recvmsg (int __fd, struct msghdr *__message, int __flags);


/* Put the current value for socket FD's option OPTNAME at protocol level LEVEL
   into OPTVAL (which is *OPTLEN bytes long), and set *OPTLEN to the value's
   actual length.  Returns 0 on success, -1 for errors.  */
extern int getsockopt (int __fd, int __level, int __optname,
		       void *__restrict __optval,
		       socklen_t *__restrict __optlen) __THROW;

/* Set socket FD's option OPTNAME at protocol level LEVEL
   to *OPTVAL (which is OPTLEN bytes long).
   Returns 0 on success, -1 for errors.  */
extern int setsockopt (int __fd, int __level, int __optname,
		       __const void *__optval, socklen_t __optlen) __THROW;


/* Prepare to accept connections on socket FD.
   N connection requests will be queued before further requests are refused.
   Returns 0 on success, -1 for errors.  */
extern int listen (int __fd, int __n) __THROW;

/* Await a connection on socket FD.
   When a connection arrives, open a new socket to communicate with it,
   set *ADDR (which is *ADDR_LEN bytes long) to the address of the connecting
   peer and *ADDR_LEN to the address's actual length, and return the
   new socket's descriptor, or -1 for errors.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern int accept (int __fd, __SOCKADDR_ARG __addr,
		   socklen_t *__restrict __addr_len);

#ifdef __USE_GNU
/* Similar to 'accept' but takes an additional parameter to specify flags.

   This function is a cancellation point and therefore not marked with
   __THROW.  */
extern int accept4 (int __fd, __SOCKADDR_ARG __addr,
		    socklen_t *__restrict __addr_len, int __flags);
#endif

/* Shut down all or part of the connection open on socket FD.
   HOW determines what to shut down:
     SHUT_RD   = No more receptions;
     SHUT_WR   = No more transmissions;
     SHUT_RDWR = No more receptions or transmissions.
   Returns 0 on success, -1 for errors.  */
extern int shutdown (int __fd, int __how) __THROW;


#ifdef __USE_XOPEN2K
/* Determine wheter socket is at a out-of-band mark.  */
extern int sockatmark (int __fd) __THROW;
#endif


#ifdef __USE_MISC
/* FDTYPE is S_IFSOCK or another S_IF* macro defined in <sys/stat.h>;
   returns 1 if FD is open on an object of the indicated type, 0 if not,
   or -1 for errors (setting errno).  */
extern int isfdtype (int __fd, int __fdtype) __THROW;
#endif


/* Define some macros helping to catch buffer overflows.  */
#if __USE_FORTIFY_LEVEL > 0 && defined __extern_always_inline
# include <bits/socket2.h>
#endif


#define __USE_POSIX
/* Extension from POSIX.1g.  */
#ifdef	__USE_POSIX

# ifdef __USE_GNU

/* Lookup mode.  */
#  define GAI_WAIT	0
#  define GAI_NOWAIT	1
# endif

/* Possible values for `ai_flags' field in `addrinfo' structure.  */
# define AI_PASSIVE	0x0001	/* Socket address is intended for `bind'.  */
# define AI_CANONNAME	0x0002	/* Request for canonical name.  */
# define AI_NUMERICHOST	0x0004	/* Don't use name resolution.  */
# define AI_V4MAPPED	0x0008	/* IPv4 mapped addresses are acceptable.  */
# define AI_ALL		0x0010	/* Return IPv4 mapped and IPv6 addresses.  */
# define AI_ADDRCONFIG	0x0020	/* Use configuration of this host to choose
				   returned address type..  */
# ifdef __USE_GNU
#  define AI_IDN	0x0040	/* IDN encode input (assuming it is encoded
				   in the current locale's character set)
				   before looking it up. */
#  define AI_CANONIDN	0x0080	/* Translate canonical name from IDN format. */
#  define AI_IDN_ALLOW_UNASSIGNED 0x0100 /* Don't reject unassigned Unicode
					    code points.  */
#  define AI_IDN_USE_STD3_ASCII_RULES 0x0200 /* Validate strings according to
						STD3 rules.  */
# endif
# define AI_NUMERICSERV	0x0400	/* Don't use name resolution.  */

/* Error values for `getaddrinfo' function.  */
# define EAI_BADFLAGS	  -1	/* Invalid value for `ai_flags' field.  */
# define EAI_NONAME	  -2	/* NAME or SERVICE is unknown.  */
# define EAI_AGAIN	  -3	/* Temporary failure in name resolution.  */
# define EAI_FAIL	  -4	/* Non-recoverable failure in name res.  */
# define EAI_FAMILY	  -6	/* `ai_family' not supported.  */
# define EAI_SOCKTYPE	  -7	/* `ai_socktype' not supported.  */
# define EAI_SERVICE	  -8	/* SERVICE not supported for `ai_socktype'.  */
# define EAI_MEMORY	  -10	/* Memory allocation failure.  */
# define EAI_SYSTEM	  -11	/* System error returned in `errno'.  */
# define EAI_OVERFLOW	  -12	/* Argument buffer overflow.  */
# ifdef __USE_GNU
#  define EAI_NODATA	  -5	/* No address associated with NAME.  */
#  define EAI_ADDRFAMILY  -9	/* Address family for NAME not supported.  */
#  define EAI_INPROGRESS  -100	/* Processing request in progress.  */
#  define EAI_CANCELED	  -101	/* Request canceled.  */
#  define EAI_NOTCANCELED -102	/* Request not canceled.  */
#  define EAI_ALLDONE	  -103	/* All requests done.  */
#  define EAI_INTR	  -104	/* Interrupted by a signal.  */
#  define EAI_IDN_ENCODE  -105	/* IDN encoding failed.  */
# endif

#define __USE_MISC
# ifdef __USE_MISC
#  define NI_MAXHOST      1025
#  define NI_MAXSERV      32
# endif

# define NI_NUMERICHOST	1	/* Don't try to look up hostname.  */
# define NI_NUMERICSERV 2	/* Don't convert port number to name.  */
# define NI_NOFQDN	4	/* Only return nodename portion.  */
# define NI_NAMEREQD	8	/* Don't return numeric addresses.  */
# define NI_DGRAM	16	/* Look up UDP service rather than TCP.  */
# ifdef __USE_GNU
#  define NI_IDN	32	/* Convert name from IDN format.  */
#  define NI_IDN_ALLOW_UNASSIGNED 64 /* Don't reject unassigned Unicode
					code points.  */
#  define NI_IDN_USE_STD3_ASCII_RULES 128 /* Validate strings according to
					     STD3 rules.  */
# endif

#endif
/* We can optimize calls to the conversion functions.  Either nothing has
   to be done or we are using directly the byte-swapping functions which
   often can be inlined.  */
# if __BYTE_ORDER == __BIG_ENDIAN
/* The host byte order is the same as network byte order,
   so these functions are all just identity.  */
# define ntohl(x)	(x)
# define ntohs(x)	(x)
# define htonl(x)	(x)
# define htons(x)	(x)
# else
#  if __BYTE_ORDER == __LITTLE_ENDIAN
#   define ntohl(x)	__bswap_32 (x)
#   define ntohs(x)	__bswap_16 (x)
#   define htonl(x)	__bswap_32 (x)
#   define htons(x)	__bswap_16 (x)
#  endif
# endif
extern int timezone;

# tclConfig.sh --
# 
# This shell script (for sh) is generated automatically by Tcl's
# configure script.  It will create shell variables for most of
# the configuration options discovered by the configure script.
# This script is intended to be included by the configure scripts
# for Tcl extensions so that they don't have to figure this all
# out for themselves.
#
# The information in this file is specific to a single platform.

# Tcl's version number.
TCL_VERSION='8.6'
TCL_MAJOR_VERSION='8'
TCL_MINOR_VERSION='6'
TCL_PATCH_LEVEL='b1.2'

# C compiler to use for compilation.
TCL_CC='nacl-gcc'

# -D flags for use with the C compiler.
TCL_DEFS='-DPACKAGE_NAME=\"tcl\" -DPACKAGE_TARNAME=\"tcl\" -DPACKAGE_VERSION=\"8.6\" -DPACKAGE_STRING=\"tcl\ 8.6\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DNO_VALUES_H=1 -DHAVE_LIMITS_H=1 -DNO_DLFCN_H=1 -DHAVE_SYS_PARAM_H=1 -DTCL_CFGVAL_ENCODING=\"iso8859-1\" -DSTATIC_BUILD=1 -DHAVE_ZLIB=1 -DMODULE_SCOPE=extern -DTCL_SHLIB_EXT=\".so\" -DTCL_CFG_OPTIMIZED=1 -DTCL_CFG_DEBUG=1 -DTCL_TOMMATH=1 -DMP_PREC=4 -DTCL_WIDE_INT_TYPE=long\ long -DUSEGETWD=1 -DHAVE_MKSTEMP=1 -DHAVE_OPENDIR=1 -DHAVE_STRTOL=1 -DNO_GETWD=1 -DNO_WAIT3=1 -DNO_UNAME=1 -DNO_REALPATH=1 -DNEED_FAKE_RFC2553=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_MKTIME=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_STRUCT_STAT_ST_BLOCKS=1 -DHAVE_STRUCT_STAT_ST_BLKSIZE=1 -DHAVE_BLKCNT_T=1 -DNO_FSTATFS=1 -Dstrtod=fixstrtod -Dsocklen_t=int -DHAVE_INTPTR_T=1 -DHAVE_UINTPTR_T=1 -DNO_UNION_WAIT=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DHAVE_MKSTEMPS=1 -DTCL_UNLOAD_DLLS=1 '

# TCL_DBGX used to be used to distinguish debug vs. non-debug builds.
# This was a righteous pain so the core doesn't do that any more.
TCL_DBGX=

# Default flags used in an optimized and debuggable build, respectively.
TCL_CFLAGS_DEBUG='-g'
TCL_CFLAGS_OPTIMIZE='-O2'

# Default linker flags used in an optimized and debuggable build, respectively.
TCL_LDFLAGS_DEBUG=''
TCL_LDFLAGS_OPTIMIZE=''

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=0

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='libtcl8.6.a'

# Additional libraries to use when linking Tcl.
TCL_LIBS='-ldl  -lm'

# Top-level directory in which Tcl's platform-independent files are
# installed.
TCL_PREFIX='/usr/local'

# Top-level directory in which Tcl's platform-specific files (e.g.
# executables) are installed.
TCL_EXEC_PREFIX='/usr/local'

# Flags to pass to cc when compiling the components of a shared library:
TCL_SHLIB_CFLAGS='-fPIC'

# Flags to pass to cc to get warning messages
TCL_CFLAGS_WARNING='-Wall'

# Extra flags to pass to cc:
TCL_EXTRA_CFLAGS='-Wno-long-long -pthread -DNACL -pipe -fvisibility=hidden '

# Base command to use for combining object files into a shared library:
TCL_SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}'

# Base command to use for combining object files into a static library:
TCL_STLIB_LD='${AR} cr'

# Either '$LIBS' (if dependent libraries should be included when linking
# shared libraries) or an empty string.  See Tcl's configure.in for more
# explanation.
TCL_SHLIB_LD_LIBS='${LIBS}'

# Suffix to use for the name of a shared library.
TCL_SHLIB_SUFFIX='.so'

# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
TCL_DL_LIBS='-ldl'

# Flags to pass to the compiler when linking object files into
# an executable tclsh or tcltest binary.
TCL_LD_FLAGS=' -Wl,--export-dynamic '

# Flags to pass to ld, such as "-R /usr/local/tcl/lib", that tell the
# run-time dynamic linker where to look for shared libraries such as
# libtcl.so.  Used when linking applications.  Only works if there
# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
TCL_CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
TCL_LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'

# Additional object files linked with Tcl to provide compatibility
# with standard facilities from ANSI C or POSIX.
TCL_COMPAT_OBJS=' waitpid.o fake-rfc2553.o memcmp.o strstr.o strtoul.o strtod.o fixstrtod.o'

# Name of the ranlib program to use.
TCL_RANLIB='nacl-ranlib'

# -l flag to pass to the linker to pick up the Tcl library
TCL_LIB_FLAG='-ltcl8.6'

# String to pass to linker to pick up the Tcl library from its
# build directory.
TCL_BUILD_LIB_SPEC='-L/home/alex/src/fos/tcl/nacl -ltcl8.6'

# String to pass to linker to pick up the Tcl library from its
# installed directory.
TCL_LIB_SPEC='-L/usr/local/lib -ltcl8.6'

# String to pass to the compiler so that an extension can
# find installed Tcl headers.
TCL_INCLUDE_SPEC='-I/usr/local/include'

# Indicates whether a version numbers should be used in -l switches
# ("ok" means it's safe to use switches like -ltcl7.5;  "nodots" means
# use switches like -ltcl75).  SunOS and FreeBSD require "nodots", for
# example.
TCL_LIB_VERSIONS_OK='ok'

# String that can be evaluated to generate the part of a shared library
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed).  May depend on the variables
# VERSION and SHLIB_SUFFIX.  On most UNIX systems this is
# ${VERSION}${SHLIB_SUFFIX}.
TCL_SHARED_LIB_SUFFIX='${VERSION}.so'

# String that can be evaluated to generate the part of an unshared library
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed).  May depend on the variable
# VERSION.  On most UNIX systems this is ${VERSION}.a.
TCL_UNSHARED_LIB_SUFFIX='${VERSION}.a'

# Location of the top-level source directory from which Tcl was built.
# This is the directory that contains a README file as well as
# subdirectories such as generic, unix, etc.  If Tcl was compiled in a
# different place than the directory containing the source files, this
# points to the location of the sources, not the location where Tcl was
# compiled.
TCL_SRC_DIR='/home/alex/src/fos/tcl'

# List of standard directories in which to look for packages during
# "package require" commands.  Contains the "prefix" directory plus also
# the "exec_prefix" directory, if it is different.
TCL_PACKAGE_PATH='/usr/local/lib '

# Tcl supports stub.
TCL_SUPPORTS_STUBS=1

# The name of the Tcl stub library (.a):
TCL_STUB_LIB_FILE='libtclstub8.6.a'

# -l flag to pass to the linker to pick up the Tcl stub library
TCL_STUB_LIB_FLAG='-ltclstub8.6'

# String to pass to linker to pick up the Tcl stub library from its
# build directory.
TCL_BUILD_STUB_LIB_SPEC='-L/home/alex/src/fos/tcl/nacl -ltclstub8.6'

# String to pass to linker to pick up the Tcl stub library from its
# installed directory.
TCL_STUB_LIB_SPEC='-L/usr/local/lib -ltclstub8.6'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='/home/alex/src/fos/tcl/nacl/libtclstub8.6.a'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='/usr/local/lib/libtclstub8.6.a'

# Flag, 1: we built Tcl with threads enables, 0 we didn't
TCL_THREADS=0

/*
 * tclLoadDl.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	the "dlopen" and "dlsym" library procedures for dynamic loading.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifdef NO_DLFCN_H
#   include "../compat/dlfcn.h"
#else
#   include <dlfcn.h>
#endif

/*
 * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined and this
 * argument to dlopen must always be 1. The RTLD_LOCAL flag doesn't exist on
 * some platforms; if it doesn't exist, set it to 0 so it has no effect.
 * See [Bug #3216070]
 */

#ifndef RTLD_NOW
#   define RTLD_NOW 1
#endif

#ifndef RTLD_LOCAL
#   define RTLD_LOCAL 0
#endif

/*
 * Static procedures defined within this file.
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
static void		UnloadFile(Tcl_LoadHandle loadHandle);

/*
 *---------------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
 *	to the new code.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs, an error message
 *	is left in the interp's result.
 *
 * Side effects:
 *	New code suddenly appears in memory.
 *
 *---------------------------------------------------------------------------
 */

int
TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
{
    void *handle;
    Tcl_LoadHandle newHandle;
    const char *native;

    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    native = Tcl_FSGetNativePath(pathPtr);
    /*
     * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070]
     */
    handle = dlopen(native, RTLD_NOW | RTLD_LOCAL);
    if (handle == NULL) {
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;
	const char *fileName = Tcl_GetString(pathPtr);

	native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
	/*
	 * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070]
	 */
	handle = dlopen(native, RTLD_NOW | RTLD_LOCAL);
	Tcl_DStringFree(&ds);
    }

    if (handle == NULL) {
	/*
	 * Write the string to a variable first to work around a compiler bug
	 * in the Sun Forte 6 compiler. [Bug 1503729]
	 */

	const char *errorStr = dlerror();

	Tcl_AppendResult(interp, "couldn't load file \"",
		Tcl_GetString(pathPtr), "\": ", errorStr, NULL);
	return TCL_ERROR;
    }
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	Returns a pointer to the function associated with 'symbol' if it is
 *	found. Otherwise returns NULL and may leave an error message in the
 *	interp's result.
 *
 *----------------------------------------------------------------------
 */

static void *
FindSymbol(
    Tcl_Interp *interp,		/* Place to put error messages. */
    Tcl_LoadHandle loadHandle,	/* Value from TcpDlopen(). */
    const char *symbol)		/* Symbol to look up. */
{
    const char *native;		/* Name of the library to be loaded, in
				 * system encoding */
    Tcl_DString newName, ds;	/* Buffers for converting the name to
				 * system encoding and prepending an 
				 * underscore*/
    void *handle = (void *) loadHandle->clientData;
				/* Native handle to the loaded library */
    void *proc;			/* Address corresponding to the resolved
				 * symbol */

    /*
     * Some platforms still add an underscore to the beginning of symbol
     * names. If we can't find a name without an underscore, try again with
     * the underscore.
     */

    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
    proc = dlsym(handle, native);	/* INTL: Native. */
    if (proc == NULL) {
	Tcl_DStringInit(&newName);
	Tcl_DStringAppend(&newName, "_", 1);
	native = Tcl_DStringAppend(&newName, native, -1);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
    Tcl_DStringFree(&ds);
    if (proc == NULL && interp != NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\": ",
		dlerror(), NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
		NULL);
    }
    return proc;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 *
 *	Unloads a dynamically loaded binary code file from memory. Code
 *	pointers in the formerly loaded file are no longer valid after calling
 *	this function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    void *handle = loadHandle->clientData;

    dlclose(handle);
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * tclUnixChan.c
 *
 *	Common channel driver for Unix channels based on files, command pipes
 *	and TCP sockets.
 *
 * Copyright (c) 1995-1997 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.
 */

#include "tclInt.h"	/* Internal definitions for Tcl. */
#include "tclIO.h"	/* To get Channel type declaration. */

#define SUPPORTS_TTY

#undef DIRECT_BAUD
#ifdef B4800
#   if (B4800 == 4800)
#	define DIRECT_BAUD
#   endif /* B4800 == 4800 */
#endif /* B4800 */

#ifdef USE_TERMIOS
#   include <termios.h>
#   ifdef HAVE_SYS_IOCTL_H
#	include <sys/ioctl.h>
#   endif /* HAVE_SYS_IOCTL_H */
#   ifdef HAVE_SYS_MODEM_H
#	include <sys/modem.h>
#   endif /* HAVE_SYS_MODEM_H */
#   define IOSTATE			struct termios
#   define GETIOSTATE(fd, statePtr)	tcgetattr((fd), (statePtr))
#   define SETIOSTATE(fd, statePtr)	tcsetattr((fd), TCSADRAIN, (statePtr))
#   define GETCONTROL(fd, intPtr)	ioctl((fd), TIOCMGET, (intPtr))
#   define SETCONTROL(fd, intPtr)	ioctl((fd), TIOCMSET, (intPtr))

#   ifdef FIONREAD
#	define GETREADQUEUE(fd, int)	ioctl((fd), FIONREAD, &(int))
#   elif defined(FIORDCHK)
#	define GETREADQUEUE(fd, int)	int = ioctl((fd), FIORDCHK, NULL)
#   endif /* FIONREAD */
#   ifdef TIOCOUTQ
#	define GETWRITEQUEUE(fd, int)	ioctl((fd), TIOCOUTQ, &(int))
#   endif /* TIOCOUTQ */
#   if defined(TIOCSBRK) && defined(TIOCCBRK)

/*
 * Can't use ?: operator below because that messes up types on either Linux or
 * Solaris (the two are mutually exclusive!)
 */

#	define SETBREAK(fd, flag) \
		if (flag) {				\
		    ioctl((fd), TIOCSBRK, NULL);	\
		} else {				\
		    ioctl((fd), TIOCCBRK, NULL);	\
		}
#   endif /* TIOCSBRK&TIOCCBRK */
#   if !defined(CRTSCTS) && defined(CNEW_RTSCTS)
#	define CRTSCTS CNEW_RTSCTS
#   endif /* !CRTSCTS&CNEW_RTSCTS */
#   if !defined(PAREXT) && defined(CMSPAR)
#	define PAREXT CMSPAR
#   endif /* !PAREXT&&CMSPAR */
#else	/* !USE_TERMIOS */

#ifdef USE_TERMIO
#   include <termio.h>
#   define IOSTATE			struct termio
#   define GETIOSTATE(fd, statePtr)	ioctl((fd), TCGETA, (statePtr))
#   define SETIOSTATE(fd, statePtr)	ioctl((fd), TCSETAW, (statePtr))
#else	/* !USE_TERMIO */

#ifdef USE_SGTTY
#   include <sgtty.h>
#   define IOSTATE			struct sgttyb
#   define GETIOSTATE(fd, statePtr)	ioctl((fd), TIOCGETP, (statePtr))
#   define SETIOSTATE(fd, statePtr)	ioctl((fd), TIOCSETP, (statePtr))
#else	/* !USE_SGTTY */
#   undef SUPPORTS_TTY
#endif	/* !USE_SGTTY */

#endif	/* !USE_TERMIO */
#endif	/* !USE_TERMIOS */

/*
 * Helper macros to make parts of this file clearer. The macros do exactly
 * what they say on the tin. :-) They also only ever refer to their arguments
 * once, and so can be used without regard to side effects.
 */

#define SET_BITS(var, bits)	((var) |= (bits))
#define CLEAR_BITS(var, bits)	((var) &= ~(bits))

/*
 * This structure describes per-instance state of a file based channel.
 */

typedef struct FileState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    int fd;			/* File handle. */
    int validMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which operations are valid on the file. */
} FileState;

#ifdef SUPPORTS_TTY

/*
 * The following structure describes per-instance state of a tty-based
 * channel.
 */

typedef struct TtyState {
    FileState fs;		/* Per-instance state of the file descriptor.
				 * Must be the first field. */
    IOSTATE savedState;		/* Initial state of device. Used to reset
				 * state when device closed. */
} TtyState;

/*
 * The following structure is used to set or get the serial port attributes in
 * a platform-independant manner.
 */

typedef struct TtyAttrs {
    int baud;
    int parity;
    int data;
    int stop;
} TtyAttrs;

#endif	/* !SUPPORTS_TTY */

#define UNSUPPORTED_OPTION(detail) \
    if (interp) {						\
	Tcl_AppendResult(interp, (detail),			\
		" not supported for this platform", NULL);	\
    }

/*
 * Static routines for this file:
 */

static int		FileBlockModeProc(ClientData instanceData, int mode);
static int		FileCloseProc(ClientData instanceData,
			    Tcl_Interp *interp);
static int		FileGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		FileInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
static int		FileSeekProc(ClientData instanceData, long offset,
			    int mode, int *errorCode);
static int		FileTruncateProc(ClientData instanceData,
			    Tcl_WideInt length);
static Tcl_WideInt	FileWideSeekProc(ClientData instanceData,
			    Tcl_WideInt offset, int mode, int *errorCode);
static void		FileWatchProc(ClientData instanceData, int mask);
#ifdef SUPPORTS_TTY
static void		TtyGetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtyGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
#ifndef DIRECT_BAUD
static int		TtyGetBaud(unsigned long speed);
static unsigned long	TtyGetSpeed(int baud);
#endif /* DIRECT_BAUD */
static FileState *	TtyInit(int fd, int initialize);
static void		TtyModemStatusStr(int status, Tcl_DString *dsPtr);
static int		TtyParseMode(Tcl_Interp *interp, const char *mode,
			    int *speedPtr, int *parityPtr, int *dataPtr,
			    int *stopPtr);
static void		TtySetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtySetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
#endif	/* SUPPORTS_TTY */

/*
 * This structure describes the channel type structure for file based IO:
 */

static const Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    FileCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
    FileSeekProc,		/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* wide seek proc. */
    NULL,
    FileTruncateProc		/* truncate proc. */
};

#ifdef SUPPORTS_TTY
/*
 * This structure describes the channel type structure for serial IO.
 * Note that this type is a subclass of the "file" type.
 */

static const Tcl_ChannelType ttyChannelType = {
    "tty",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    FileCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    TtySetOptionProc,		/* Set option proc. */
    TtyGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc. */
    NULL,			/* thread action proc. */
    NULL			/* truncate proc. */
};
#endif	/* SUPPORTS_TTY */

/*
 *----------------------------------------------------------------------
 *
 * FileBlockModeProc --
 *
 *	Helper function to set blocking and nonblocking modes on a file based
 *	channel. Invoked by generic IO level code.
 *
 * Results:
 *	0 if successful, errno when failed.
 *
 * Side effects:
 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
FileBlockModeProc(
    ClientData instanceData,	/* File state. */
    int mode)			/* The mode to set. Can be TCL_MODE_BLOCKING
				 * or TCL_MODE_NONBLOCKING. */
{
    FileState *fsPtr = instanceData;

    if (TclUnixSetBlockingMode(fsPtr->fd, mode) < 0) {
	return errno;
    }

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * FileInputProc --
 *
 *	This function is invoked from the generic IO level to read input from
 *	a file based channel.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains a POSIX error code if an error occurs, or zero.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileInputProc(
    ClientData instanceData,	/* File state. */
    char *buf,			/* Where to store data read. */
    int toRead,			/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    FileState *fsPtr = instanceData;
    int bytesRead;		/* How many bytes were actually read from the
				 * input device? */

    *errorCodePtr = 0;

    /*
     * Assume there is always enough input available. This will block
     * appropriately, and read will unblock as soon as a short read is
     * possible, if the channel is in blocking mode. If the channel is
     * nonblocking, the read will never block.
     */

    bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
    if (bytesRead > -1) {
	return bytesRead;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * FileOutputProc--
 *
 *	This function is invoked from the generic IO level to write output to
 *	a file channel.
 *
 * Results:
 *	The number of bytes written is returned or -1 on error. An output
 *	argument contains a POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileOutputProc(
    ClientData instanceData,	/* File state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    FileState *fsPtr = instanceData;
    int written;

    *errorCodePtr = 0;

    if (toWrite == 0) {
	/*
	 * SF Tcl Bug 465765. Do not try to write nothing into a file. STREAM
	 * based implementations will considers this as EOF (if there is a
	 * pipe behind the file).
	 */

	return 0;
    }
    written = write(fsPtr->fd, buf, (size_t) toWrite);
    if (written > -1) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * FileCloseProc --
 *
 *	This function is called from the generic IO level to perform
 *	channel-type-specific cleanup when a file based channel is closed.
 *
 * Results:
 *	0 if successful, errno if failed.
 *
 * Side effects:
 *	Closes the device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileCloseProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp)		/* For error reporting - unused. */
{
    FileState *fsPtr = instanceData;
    int errorCode = 0;

    Tcl_DeleteFileHandler(fsPtr->fd);

    /*
     * Do not close standard channels while in thread-exit.
     */

    if (!TclInThreadExit()
	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
	if (close(fsPtr->fd) < 0) {
	    errorCode = errno;
	}
    }
    ckfree(fsPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * FileSeekProc --
 *
 *	This function is called by the generic IO level to move the access
 *	point in a file based channel.
 *
 * Results:
 *	-1 if failed, the new position if successful. An output argument
 *	contains the POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Moves the location at which the channel will be accessed in future
 *	operations.
 *
 *----------------------------------------------------------------------
 */

static int
FileSeekProc(
    ClientData instanceData,	/* File state. */
    long offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? Can be
				 * one of SEEK_START, SEEK_SET or SEEK_END. */
    int *errorCodePtr)		/* To store error code. */
{
    FileState *fsPtr = instanceData;
    Tcl_WideInt oldLoc, newLoc;

    /*
     * Save our current place in case we need to roll-back the seek.
     */

    oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
    if (oldLoc == Tcl_LongAsWide(-1)) {
	/*
	 * Bad things are happening. Error out...
	 */

	*errorCodePtr = errno;
	return -1;
    }

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    /*
     * Check for expressability in our return type, and roll-back otherwise.
     */

    if (newLoc > Tcl_LongAsWide(INT_MAX)) {
	*errorCodePtr = EOVERFLOW;
	TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
	return -1;
    } else {
	*errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
    }
    return (int) Tcl_WideAsLong(newLoc);
}

/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *
 *	This function is called by the generic IO level to move the access
 *	point in a file based channel, with offsets expressed as wide
 *	integers.
 *
 * Results:
 *	-1 if failed, the new position if successful. An output argument
 *	contains the POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Moves the location at which the channel will be accessed in future
 *	operations.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
FileWideSeekProc(
    ClientData instanceData,	/* File state. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? Can be
				 * one of SEEK_START, SEEK_CUR or SEEK_END. */
    int *errorCodePtr)		/* To store error code. */
{
    FileState *fsPtr = instanceData;
    Tcl_WideInt newLoc;

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    *errorCodePtr = (newLoc == -1) ? errno : 0;
    return newLoc;
}

/*
 *----------------------------------------------------------------------
 *
 * FileWatchProc --
 *
 *	Initialize the notifier to watch the fd from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel will
 *	be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
FileWatchProc(
    ClientData instanceData,	/* The file state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    FileState *fsPtr = instanceData;

    /*
     * Make sure we only register for events that are valid on this file. Note
     * that we are passing Tcl_NotifyChannel directly to Tcl_CreateFileHandler
     * with the channel pointer as the client data.
     */

    mask &= fsPtr->validMask;
    if (mask) {
	Tcl_CreateFileHandler(fsPtr->fd, mask,
		(Tcl_FileProc *) Tcl_NotifyChannel, fsPtr->channel);
    } else {
	Tcl_DeleteFileHandler(fsPtr->fd);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FileGetHandleProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS handles from a file
 *	based channel.
 *
 * Results:
 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
 *	handle for the specified direction.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileGetHandleProc(
    ClientData instanceData,	/* The file state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    FileState *fsPtr = instanceData;

    if (direction & fsPtr->validMask) {
	*handlePtr = INT2PTR(fsPtr->fd);
	return TCL_OK;
    }
    return TCL_ERROR;
}

#ifdef SUPPORTS_TTY
#ifdef USE_TERMIOS
/*
 *----------------------------------------------------------------------
 *
 * TtyModemStatusStr --
 *
 *	Converts a RS232 modem status list of readable flags
 *
 *----------------------------------------------------------------------
 */

static void
TtyModemStatusStr(
    int status,			/* RS232 modem status */
    Tcl_DString *dsPtr)		/* Where to store string */
{
#ifdef TIOCM_CTS
    Tcl_DStringAppendElement(dsPtr, "CTS");
    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CTS) ? "1" : "0");
#endif /* TIOCM_CTS */
#ifdef TIOCM_DSR
    Tcl_DStringAppendElement(dsPtr, "DSR");
    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_DSR) ? "1" : "0");
#endif /* TIOCM_DSR */
#ifdef TIOCM_RNG
    Tcl_DStringAppendElement(dsPtr, "RING");
    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_RNG) ? "1" : "0");
#endif /* TIOCM_RNG */
#ifdef TIOCM_CD
    Tcl_DStringAppendElement(dsPtr, "DCD");
    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CD) ? "1" : "0");
#endif /* TIOCM_CD */
}
#endif /* USE_TERMIOS */

/*
 *----------------------------------------------------------------------
 *
 * TtySetOptionProc --
 *
 *	Sets an option on a channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the interp's result on error if
 *	interp is not NULL.
 *
 * Side effects:
 *	May modify an option on a device. Sets Error message if needed (by
 *	calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
TtySetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    FileState *fsPtr = instanceData;
    unsigned int len, vlen;
    TtyAttrs tty;
#ifdef USE_TERMIOS
    int flag, control, argc;
    const char **argv;
    IOSTATE iostate;
#endif /* USE_TERMIOS */

    len = strlen(optionName);
    vlen = strlen(value);

    /*
     * Option -mode baud,parity,databits,stopbits
     */

    if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
	if (TtyParseMode(interp, value, &tty.baud, &tty.parity, &tty.data,
		&tty.stop) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * system calls results should be checked there. - dl
	 */

	TtySetAttributes(fsPtr->fd, &tty);
	return TCL_OK;
    }

#ifdef USE_TERMIOS

    /*
     * Option -handshake none|xonxoff|rtscts|dtrdsr
     */

    if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
	/*
	 * Reset all handshake options. DTR and RTS are ON by default.
	 */

	GETIOSTATE(fsPtr->fd, &iostate);
	CLEAR_BITS(iostate.c_iflag, IXON | IXOFF | IXANY);
#ifdef CRTSCTS
	CLEAR_BITS(iostate.c_cflag, CRTSCTS);
#endif /* CRTSCTS */
	if (strncasecmp(value, "NONE", vlen) == 0) {
	    /*
	     * Leave all handshake options disabled.
	     */
	} else if (strncasecmp(value, "XONXOFF", vlen) == 0) {
	    SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY);
	} else if (strncasecmp(value, "RTSCTS", vlen) == 0) {
#ifdef CRTSCTS
	    SET_BITS(iostate.c_cflag, CRTSCTS);
#else /* !CRTSTS */
	    UNSUPPORTED_OPTION("-handshake RTSCTS");
	    return TCL_ERROR;
#endif /* CRTSCTS */
	} else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
	    UNSUPPORTED_OPTION("-handshake DTRDSR");
	    return TCL_ERROR;
	} else {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -handshake: "
			"must be one of xonxoff, rtscts, dtrdsr or none",
			NULL);
	    }
	    return TCL_ERROR;
	}
	SETIOSTATE(fsPtr->fd, &iostate);
	return TCL_OK;
    }

    /*
     * Option -xchar {\x11 \x13}
     */

    if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
	Tcl_DString ds;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	} else if (argc != 2) {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -xchar: "
			"should be a list of two elements", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	GETIOSTATE(fsPtr->fd, &iostate);

	Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
	iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
	Tcl_DStringSetLength(&ds, 0);

	Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
	iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
	Tcl_DStringFree(&ds);
	ckfree(argv);

	SETIOSTATE(fsPtr->fd, &iostate);
	return TCL_OK;
    }

    /*
     * Option -timeout msec
     */

    if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
	int msec;

	GETIOSTATE(fsPtr->fd, &iostate);
	if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
	    return TCL_ERROR;
	}
	iostate.c_cc[VMIN] = 0;
	iostate.c_cc[VTIME] = (msec==0) ? 0 : (msec<100) ? 1 : (msec+50)/100;
	SETIOSTATE(fsPtr->fd, &iostate);
	return TCL_OK;
    }

    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
	int i;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -ttycontrol: "
			"should be a list of signal,value pairs", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	GETCONTROL(fsPtr->fd, &control);
	for (i = 0; i < argc-1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		ckfree(argv);
		return TCL_ERROR;
	    }
	    if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
#ifdef TIOCM_DTR
		if (flag) {
		    SET_BITS(control, TIOCM_DTR);
		} else {
		    CLEAR_BITS(control, TIOCM_DTR);
		}
#else /* !TIOCM_DTR */
		UNSUPPORTED_OPTION("-ttycontrol DTR");
		ckfree(argv);
		return TCL_ERROR;
#endif /* TIOCM_DTR */
	    } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
#ifdef TIOCM_RTS
		if (flag) {
		    SET_BITS(control, TIOCM_RTS);
		} else {
		    CLEAR_BITS(control, TIOCM_RTS);
		}
#else /* !TIOCM_RTS*/
		UNSUPPORTED_OPTION("-ttycontrol RTS");
		ckfree(argv);
		return TCL_ERROR;
#endif /* TIOCM_RTS*/
	    } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
#ifdef SETBREAK
		SETBREAK(fsPtr->fd, flag);
#else /* !SETBREAK */
		UNSUPPORTED_OPTION("-ttycontrol BREAK");
		ckfree(argv);
		return TCL_ERROR;
#endif /* SETBREAK */
	    } else {
		if (interp) {
		    Tcl_AppendResult(interp, "bad signal \"", argv[i],
			    "\" for -ttycontrol: must be "
			    "DTR, RTS or BREAK", NULL);
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	} /* -ttycontrol options loop */

	SETCONTROL(fsPtr->fd, &control);
	ckfree(argv);
	return TCL_OK;
    }

    return Tcl_BadChannelOption(interp, optionName,
	    "mode handshake timeout ttycontrol xchar");

#else /* !USE_TERMIOS */
    return Tcl_BadChannelOption(interp, optionName, "mode");
#endif /* USE_TERMIOS */
}

/*
 *----------------------------------------------------------------------
 *
 * TtyGetOptionProc --
 *
 *	Gets a mode associated with an IO channel. If the optionName arg is
 *	non-NULL, retrieves the value of that option. If the optionName arg is
 *	NULL, retrieves a list of alternating option names and values for the
 *	given channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the supplied DString to the string
 *	value of the option(s) returned.
 *
 * Side effects:
 *	The string returned by this function is in static storage and may be
 *	reused at any time subsequent to the call. Sets error message if
 *	needed (by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
TtyGetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    FileState *fsPtr = instanceData;
    unsigned int len;
    char buf[3*TCL_INTEGER_SPACE + 16];
    int valid = 0;		/* Flag if valid option parsed. */

    if (optionName == NULL) {
	len = 0;
    } else {
	len = strlen(optionName);
    }
    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-mode");
    }
    if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) {
	TtyAttrs tty;

	valid = 1;
	TtyGetAttributes(fsPtr->fd, &tty);
	sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

#ifdef USE_TERMIOS
    /*
     * Get option -xchar
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-xchar");
	Tcl_DStringStartSublist(dsPtr);
    }
    if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) {
	IOSTATE iostate;
	Tcl_DString ds;

	valid = 1;
	GETIOSTATE(fsPtr->fd, &iostate);
	Tcl_DStringInit(&ds);

	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	Tcl_DStringSetLength(&ds, 0);

	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);
    }

    /*
     * Get option -queue
     * Option is readonly and returned by [fconfigure chan -queue] but not
     * returned by unnamed [fconfigure chan].
     */

    if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) {
	int inQueue=0, outQueue=0, inBuffered, outBuffered;

	valid = 1;
#ifdef GETREADQUEUE
	GETREADQUEUE(fsPtr->fd, inQueue);
#endif /* GETREADQUEUE */
#ifdef GETWRITEQUEUE
	GETWRITEQUEUE(fsPtr->fd, outQueue);
#endif /* GETWRITEQUEUE */
	inBuffered = Tcl_InputBuffered(fsPtr->channel);
	outBuffered = Tcl_OutputBuffered(fsPtr->channel);

	sprintf(buf, "%d", inBuffered+inQueue);
	Tcl_DStringAppendElement(dsPtr, buf);
	sprintf(buf, "%d", outBuffered+outQueue);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * Get option -ttystatus
     * Option is readonly and returned by [fconfigure chan -ttystatus] but not
     * returned by unnamed [fconfigure chan].
     */

    if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) {
	int status;

	valid = 1;
	GETCONTROL(fsPtr->fd, &status);
	TtyModemStatusStr(status, dsPtr);
    }
#endif /* USE_TERMIOS */

    if (valid) {
	return TCL_OK;
    }
    return Tcl_BadChannelOption(interp, optionName, "mode"
#ifdef USE_TERMIOS
	    " queue ttystatus xchar"
#endif /* USE_TERMIOS */
	    );
}

#ifdef DIRECT_BAUD
#   define TtyGetSpeed(baud)	((unsigned) (baud))
#   define TtyGetBaud(speed)	((int) (speed))
#else /* !DIRECT_BAUD */

static struct {int baud; unsigned long speed;} speeds[] = {
#ifdef B0
    {0, B0},
#endif
#ifdef B50
    {50, B50},
#endif
#ifdef B75
    {75, B75},
#endif
#ifdef B110
    {110, B110},
#endif
#ifdef B134
    {134, B134},
#endif
#ifdef B150
    {150, B150},
#endif
#ifdef B200
    {200, B200},
#endif
#ifdef B300
    {300, B300},
#endif
#ifdef B600
    {600, B600},
#endif
#ifdef B1200
    {1200, B1200},
#endif
#ifdef B1800
    {1800, B1800},
#endif
#ifdef B2400
    {2400, B2400},
#endif
#ifdef B4800
    {4800, B4800},
#endif
#ifdef B9600
    {9600, B9600},
#endif
#ifdef B14400
    {14400, B14400},
#endif
#ifdef B19200
    {19200, B19200},
#endif
#ifdef EXTA
    {19200, EXTA},
#endif
#ifdef B28800
    {28800, B28800},
#endif
#ifdef B38400
    {38400, B38400},
#endif
#ifdef EXTB
    {38400, EXTB},
#endif
#ifdef B57600
    {57600, B57600},
#endif
#ifdef _B57600
    {57600, _B57600},
#endif
#ifdef B76800
    {76800, B76800},
#endif
#ifdef B115200
    {115200, B115200},
#endif
#ifdef _B115200
    {115200, _B115200},
#endif
#ifdef B153600
    {153600, B153600},
#endif
#ifdef B230400
    {230400, B230400},
#endif
#ifdef B307200
    {307200, B307200},
#endif
#ifdef B460800
    {460800, B460800},
#endif
    {-1, 0}
};

/*
 *---------------------------------------------------------------------------
 *
 * TtyGetSpeed --
 *
 *	Given a baud rate, get the mask value that should be stored in the
 *	termios, termio, or sgttyb structure in order to select that baud
 *	rate.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static unsigned long
TtyGetSpeed(
    int baud)			/* The baud rate to look up. */
{
    int bestIdx, bestDiff, i, diff;

    bestIdx = 0;
    bestDiff = 1000000;

    /*
     * If the baud rate does not correspond to one of the known mask values,
     * choose the mask value whose baud rate is closest to the specified baud
     * rate.
     */

    for (i = 0; speeds[i].baud >= 0; i++) {
	diff = speeds[i].baud - baud;
	if (diff < 0) {
	    diff = -diff;
	}
	if (diff < bestDiff) {
	    bestIdx = i;
	    bestDiff = diff;
	}
    }
    return speeds[bestIdx].speed;
}

/*
 *---------------------------------------------------------------------------
 *
 * TtyGetBaud --
 *
 *	Given a speed mask value from a termios, termio, or sgttyb structure,
 *	get the baus rate that corresponds to that mask value.
 *
 * Results:
 *	As above. If the mask value was not recognized, 0 is returned.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
TtyGetBaud(
    unsigned long speed)	/* Speed mask value to look up. */
{
    int i;

    for (i = 0; speeds[i].baud >= 0; i++) {
	if (speeds[i].speed == speed) {
	    return speeds[i].baud;
	}
    }
    return 0;
}
#endif /* !DIRECT_BAUD */

/*
 *---------------------------------------------------------------------------
 *
 * TtyGetAttributes --
 *
 *	Get the current attributes of the specified serial device.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static void
TtyGetAttributes(
    int fd,			/* Open file descriptor for serial port to be
				 * queried. */
    TtyAttrs *ttyPtr)		/* Buffer filled with serial port
				 * attributes. */
{
    IOSTATE iostate;
    int baud, parity, data, stop;

    GETIOSTATE(fd, &iostate);

#ifdef USE_TERMIOS
    baud = TtyGetBaud(cfgetospeed(&iostate));

    parity = 'n';
#ifdef PAREXT
    switch ((int) (iostate.c_cflag & (PARENB | PARODD | PAREXT))) {
    case PARENB			  : parity = 'e'; break;
    case PARENB | PARODD	  : parity = 'o'; break;
    case PARENB |	   PAREXT : parity = 's'; break;
    case PARENB | PARODD | PAREXT : parity = 'm'; break;
    }
#else /* !PAREXT */
    switch ((int) (iostate.c_cflag & (PARENB | PARODD))) {
    case PARENB		 : parity = 'e'; break;
    case PARENB | PARODD : parity = 'o'; break;
    }
#endif /* PAREXT */

    data = iostate.c_cflag & CSIZE;
    data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;

    stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
#endif /* USE_TERMIOS */

#ifdef USE_TERMIO
    baud = TtyGetBaud(iostate.c_cflag & CBAUD);

    parity = 'n';
    switch (iostate.c_cflag & (PARENB | PARODD | PAREXT)) {
    case PARENB			  : parity = 'e'; break;
    case PARENB | PARODD	  : parity = 'o'; break;
    case PARENB |	   PAREXT : parity = 's'; break;
    case PARENB | PARODD | PAREXT : parity = 'm'; break;
    }

    data = iostate.c_cflag & CSIZE;
    data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;

    stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
#endif /* USE_TERMIO */

#ifdef USE_SGTTY
    baud = TtyGetBaud(iostate.sg_ospeed);

    parity = 'n';
    if (iostate.sg_flags & EVENP) {
	parity = 'e';
    } else if (iostate.sg_flags & ODDP) {
	parity = 'o';
    }

    data = (iostate.sg_flags & (EVENP | ODDP)) ? 7 : 8;

    stop = 1;
#endif /* USE_SGTTY */

    ttyPtr->baud    = baud;
    ttyPtr->parity  = parity;
    ttyPtr->data    = data;
    ttyPtr->stop    = stop;
}

/*
 *---------------------------------------------------------------------------
 *
 * TtySetAttributes --
 *
 *	Set the current attributes of the specified serial device.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static void
TtySetAttributes(
    int fd,			/* Open file descriptor for serial port to be
				 * modified. */
    TtyAttrs *ttyPtr)		/* Buffer containing new attributes for serial
				 * port. */
{
    IOSTATE iostate;

#ifdef USE_TERMIOS
    int parity, data, flag;

    GETIOSTATE(fd, &iostate);
    cfsetospeed(&iostate, TtyGetSpeed(ttyPtr->baud));
    cfsetispeed(&iostate, TtyGetSpeed(ttyPtr->baud));

    flag = 0;
    parity = ttyPtr->parity;
    if (parity != 'n') {
	SET_BITS(flag, PARENB);
#ifdef PAREXT
	CLEAR_BITS(iostate.c_cflag, PAREXT);
	if ((parity == 'm') || (parity == 's')) {
	    SET_BITS(flag, PAREXT);
	}
#endif /* PAREXT */
	if ((parity == 'm') || (parity == 'o')) {
	    SET_BITS(flag, PARODD);
	}
    }
    data = ttyPtr->data;
    SET_BITS(flag,
	    (data == 5) ? CS5 :
	    (data == 6) ? CS6 :
	    (data == 7) ? CS7 : CS8);
    if (ttyPtr->stop == 2) {
	SET_BITS(flag, CSTOPB);
    }

    CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | CSIZE | CSTOPB);
    SET_BITS(iostate.c_cflag, flag);

#endif	/* USE_TERMIOS */

#ifdef USE_TERMIO
    int parity, data, flag;

    GETIOSTATE(fd, &iostate);
    CLEAR_BITS(iostate.c_cflag, CBAUD);
    SET_BITS(iostate.c_cflag, TtyGetSpeed(ttyPtr->baud));

    flag = 0;
    parity = ttyPtr->parity;
    if (parity != 'n') {
	SET_BITS(flag, PARENB);
	if ((parity == 'm') || (parity == 's')) {
	    SET_BITS(flag, PAREXT);
	}
	if ((parity == 'm') || (parity == 'o')) {
	    SET_BITS(flag, PARODD);
	}
    }
    data = ttyPtr->data;
    SET_BITS(flag,
	    (data == 5) ? CS5 :
	    (data == 6) ? CS6 :
	    (data == 7) ? CS7 : CS8);
    if (ttyPtr->stop == 2) {
	SET_BITS(flag, CSTOPB);
    }

    CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | PAREXT | CSIZE | CSTOPB);
    SET_BITS(iostate.c_cflag, flag);

#endif	/* USE_TERMIO */

#ifdef USE_SGTTY
    int parity;

    GETIOSTATE(fd, &iostate);
    iostate.sg_ospeed = TtyGetSpeed(ttyPtr->baud);
    iostate.sg_ispeed = TtyGetSpeed(ttyPtr->baud);

    parity = ttyPtr->parity;
    if (parity == 'e') {
	CLEAR_BITS(iostate.sg_flags, ODDP);
	SET_BITS(iostate.sg_flags, EVENP);
    } else if (parity == 'o') {
	CLEAR_BITS(iostate.sg_flags, EVENP);
	SET_BITS(iostate.sg_flags, ODDP);
    }
#endif	/* USE_SGTTY */

    SETIOSTATE(fd, &iostate);
}

/*
 *---------------------------------------------------------------------------
 *
 * TtyParseMode --
 *
 *	Parse the "-mode" argument to the fconfigure command. The argument is
 *	of the form baud,parity,data,stop.
 *
 * Results:
 *	The return value is TCL_OK if the argument was successfully parsed,
 *	TCL_ERROR otherwise. If TCL_ERROR is returned, an error message is
 *	left in the interp's result (if interp is non-NULL).
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
TtyParseMode(
    Tcl_Interp *interp,		/* If non-NULL, interp for error return. */
    const char *mode,		/* Mode string to be parsed. */
    int *speedPtr,		/* Filled with baud rate from mode string. */
    int *parityPtr,		/* Filled with parity from mode string. */
    int *dataPtr,		/* Filled with data bits from mode string. */
    int *stopPtr)		/* Filled with stop bits from mode string. */
{
    int i, end;
    char parity;
    static const char *bad = "bad value for -mode";

    i = sscanf(mode, "%d,%c,%d,%d%n", speedPtr, &parity, dataPtr,
	    stopPtr, &end);
    if ((i != 4) || (mode[end] != '\0')) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, bad, ": should be baud,parity,data,stop",
		    NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Only allow setting mark/space parity on platforms that support it Make
     * sure to allow for the case where strchr is a macro. [Bug: 5089]
     *
     * We cannot if/else/endif the strchr arguments, it has to be the whole
     * function. On AIX this function is apparently a macro, and macros do
     * not allow pre-processor directives in their arguments.
     */

    if (
#if defined(PAREXT) || defined(USE_TERMIO)
        strchr("noems", parity)
#else
        strchr("noe", parity)
#endif /* PAREXT|USE_TERMIO */
                               == NULL) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, bad, " parity: should be ",
#if defined(PAREXT) || defined(USE_TERMIO)
		    "n, o, e, m, or s",
#else
		    "n, o, or e",
#endif /* PAREXT|USE_TERMIO */
		    NULL);
	}
	return TCL_ERROR;
    }
    *parityPtr = parity;
    if ((*dataPtr < 5) || (*dataPtr > 8)) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, bad, " data: should be 5, 6, 7, or 8",
		    NULL);
	}
	return TCL_ERROR;
    }
    if ((*stopPtr < 0) || (*stopPtr > 2)) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, bad, " stop: should be 1 or 2", NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TtyInit --
 *
 *	Given file descriptor that refers to a serial port, initialize the
 *	serial port to a set of sane values so that Tcl can talk to a device
 *	located on the serial port. Note that no initialization happens if the
 *	initialize flag is not set; this is necessary for the correct handling
 *	of UNIX console TTYs at startup.
 *
 * Results:
 *	A pointer to a FileState suitable for use with Tcl_CreateChannel and
 *	the ttyChannelType structure.
 *
 * Side effects:
 *	Serial device initialized to non-blocking raw mode, similar to sockets
 *	(if initialize flag is non-zero.) All other modes can be simulated on
 *	top of this in Tcl.
 *
 *---------------------------------------------------------------------------
 */

static FileState *
TtyInit(
    int fd,			/* Open file descriptor for serial port to be
				 * initialized. */
    int initialize)
{
    TtyState *ttyPtr = ckalloc(sizeof(TtyState));
    int stateUpdated = 0;

    GETIOSTATE(fd, &ttyPtr->savedState);
    if (initialize) {
	IOSTATE iostate = ttyPtr->savedState;

#if defined(USE_TERMIOS) || defined(USE_TERMIO)
	if (iostate.c_iflag != IGNBRK
		|| iostate.c_oflag != 0
		|| iostate.c_lflag != 0
		|| iostate.c_cflag & CREAD
		|| iostate.c_cc[VMIN] != 1
		|| iostate.c_cc[VTIME] != 0) {
	    stateUpdated = 1;
	}
	iostate.c_iflag = IGNBRK;
	iostate.c_oflag = 0;
	iostate.c_lflag = 0;
	SET_BITS(iostate.c_cflag, CREAD);
	iostate.c_cc[VMIN] = 1;
	iostate.c_cc[VTIME] = 0;
#endif	/* USE_TERMIOS|USE_TERMIO */

#ifdef USE_SGTTY
	if ((iostate.sg_flags & (EVENP | ODDP))
		|| !(iostate.sg_flags & RAW)) {
	    ttyPtr->stateUpdated = 1;
	}
	iostate.sg_flags &= EVENP | ODDP;
	SET_BITS(iostate.sg_flags, RAW);
#endif	/* USE_SGTTY */

	/*
	 * Only update if we're changing anything to avoid possible blocking.
	 */

	if (stateUpdated) {
	    SETIOSTATE(fd, &iostate);
	}
    }

    return &ttyPtr->fs;
}
#endif	/* SUPPORTS_TTY */

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenFileChannel --
 *
 *	Open an file based channel on Unix systems.
 *
 * Results:
 *	The new channel or NULL. If NULL, the output argument errorCodePtr is
 *	set to a POSIX error and an error message is left in the interp's
 *	result if interp is not NULL.
 *
 * Side effects:
 *	May open the channel and may cause creation of a file on the file
 *	system.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
TclpOpenFileChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    Tcl_Obj *pathPtr,		/* Name of file to open. */
    int mode,			/* POSIX open mode. */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    int fd, channelPermissions;
    FileState *fsPtr;
    const char *native, *translation;
    char channelName[16 + TCL_INTEGER_SPACE];
    const Tcl_ChannelType *channelTypePtr;

    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
    case O_RDONLY:
	channelPermissions = TCL_READABLE;
	break;
    case O_WRONLY:
	channelPermissions = TCL_WRITABLE;
	break;
    case O_RDWR:
	channelPermissions = (TCL_READABLE | TCL_WRITABLE);
	break;
    default:
	/*
	 * This may occurr if modeString was "", for example.
	 */

	Tcl_Panic("TclpOpenFileChannel: invalid mode value");
	return NULL;
    }

    native = Tcl_FSGetNativePath(pathPtr);
    if (native == NULL) {
	return NULL;
    }

#ifdef DJGPP
    SET_BITS(mode, O_BINARY);
#endif

    fd = TclOSopen(native, mode, permissions);

    if (fd < 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
		    "\": ", Tcl_PosixError(interp), NULL);
	}
	return NULL;
    }

    /*
     * Set close-on-exec flag on the fd so that child processes will not
     * inherit this fd.
     */

    fcntl(fd, F_SETFD, FD_CLOEXEC);

    sprintf(channelName, "file%d", fd);

#ifdef SUPPORTS_TTY
    if (strcmp(native, "/dev/tty") != 0 && isatty(fd)) {
	/*
	 * Initialize the serial port to a set of sane parameters. Especially
	 * important if the remote device is set to echo and the serial port
	 * driver was also set to echo -- as soon as a char were sent to the
	 * serial port, the remote device would echo it, then the serial
	 * driver would echo it back to the device, etc.
	 *
	 * Note that we do not do this if we're dealing with /dev/tty itself,
	 * as that tends to cause Bad Things To Happen when you're working
	 * interactively. Strictly a better check would be to see if the FD
	 * being set up is a device and has the same major/minor as the
	 * initial std FDs (beware reopening!) but that's nearly as messy.
	 */

	translation = "auto crlf";
	channelTypePtr = &ttyChannelType;
	fsPtr = TtyInit(fd, 1);
    } else
#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
	fsPtr = ckalloc(sizeof(FileState));
    }

    fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fd = fd;

    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, channelPermissions);

    if (translation != NULL) {
	/*
	 * Gotcha. Most modems need a "\r" at the end of the command sequence.
	 * If you just send "at\n", the modem will not respond with "OK"
	 * because it never got a "\r" to actually invoke the command. So, by
	 * default, newlines are translated to "\r\n" on output to avoid "bug"
	 * reports that the serial port isn't working.
	 */

	if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation",
		translation) != TCL_OK) {
	    Tcl_Close(NULL, fsPtr->channel);
	    return NULL;
	}
    }

    return fsPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeFileChannel --
 *
 *	Makes a Tcl_Channel from an existing OS level file handle.
 *
 * Results:
 *	The Tcl_Channel created around the preexisting OS level file handle.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeFileChannel(
    ClientData handle,		/* OS level handle. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    FileState *fsPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    int fd = PTR2INT(handle);
    const Tcl_ChannelType *channelTypePtr;
    struct sockaddr sockaddr;
    socklen_t sockaddrLen = sizeof(sockaddr);

    if (mode == 0) {
	return NULL;
    }

    sockaddr.sa_family = AF_UNSPEC;

#ifdef SUPPORTS_TTY
    if (isatty(fd)) {
	fsPtr = TtyInit(fd, 0);
	channelTypePtr = &ttyChannelType;
	sprintf(channelName, "serial%d", fd);
    } else
#endif /* SUPPORTS_TTY */
    if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0)
	&& (sockaddrLen > 0)
	&& (sockaddr.sa_family == AF_INET || sockaddr.sa_family == AF_INET6)) {
	return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
    } else {
	channelTypePtr = &fileChannelType;
	fsPtr = ckalloc(sizeof(FileState));
	sprintf(channelName, "file%d", fd);
    }

    fsPtr->fd = fd;
    fsPtr->validMask = mode | TCL_EXCEPTION;
    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, mode);

    return fsPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetDefaultStdChannel --
 *
 *	Creates channels for standard input, standard output or standard error
 *	output if they do not already exist.
 *
 * Results:
 *	Returns the specified default standard channel, or NULL.
 *
 * Side effects:
 *	May cause the creation of a standard channel and the underlying file.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
TclpGetDefaultStdChannel(
    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
    Tcl_Channel channel = NULL;
    int fd = 0;			/* Initializations needed to prevent */
    int mode = 0;		/* compiler warning (used before set). */
    const char *bufMode = NULL;

    /*
     * Some #def's to make the code a little clearer!
     */

#define ZERO_OFFSET	((Tcl_SeekOffset) 0)
#define ERROR_OFFSET	((Tcl_SeekOffset) -1)

    switch (type) {
    case TCL_STDIN:
	if ((TclOSseek(0, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
		&& (errno == EBADF)) {
	    return NULL;
	}
	fd = 0;
	mode = TCL_READABLE;
	bufMode = "line";
	break;
    case TCL_STDOUT:
	if ((TclOSseek(1, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
		&& (errno == EBADF)) {
	    return NULL;
	}
	fd = 1;
	mode = TCL_WRITABLE;
	bufMode = "line";
	break;
    case TCL_STDERR:
	if ((TclOSseek(2, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
		&& (errno == EBADF)) {
	    return NULL;
	}
	fd = 2;
	mode = TCL_WRITABLE;
	bufMode = "none";
	break;
    default:
	Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type");
	break;
    }

#undef ZERO_OFFSET
#undef ERROR_OFFSET

    channel = Tcl_MakeFileChannel(INT2PTR(fd), mode);
    if (channel == NULL) {
	return NULL;
    }

    /*
     * Set up the normal channel options for stdio handles.
     */

    if (Tcl_GetChannelType(channel) == &fileChannelType) {
	Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
    } else {
	Tcl_SetChannelOption(NULL, channel, "-translation", "auto crlf");
    }
    Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
    return channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetOpenFile --
 *
 *	Given a name of a channel registered in the given interpreter, returns
 *	a FILE * for it.
 *
 * Results:
 *	A standard Tcl result. If the channel is registered in the given
 *	interpreter and it is managed by the "file" channel driver, and it is
 *	open for the requested mode, then the output parameter filePtr is set
 *	to a FILE * for the underlying file. On error, the filePtr is not set,
 *	TCL_ERROR is returned and an error message is left in the interp's
 *	result.
 *
 * Side effects:
 *	May invoke fdopen to create the FILE * for the requested file.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetOpenFile(
    Tcl_Interp *interp,		/* Interpreter in which to find file. */
    const char *chanID,		/* String that identifies file. */
    int forWriting,		/* 1 means the file is going to be used for
				 * writing, 0 means for reading. */
    int checkUsage,		/* 1 means verify that the file was opened in
				 * a mode that allows the access specified by
				 * "forWriting". Ignored, we always check that
				 * the channel is open for the requested
				 * mode. */
    ClientData *filePtr)	/* Store pointer to FILE structure here. */
{
    Tcl_Channel chan;
    int chanMode, fd;
    const Tcl_ChannelType *chanTypePtr;
    ClientData data;
    FILE *f;

    chan = Tcl_GetChannel(interp, chanID, &chanMode);
    if (chan == NULL) {
	return TCL_ERROR;
    }
    if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
	Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for writing",
		NULL);
	return TCL_ERROR;
    } else if ((!forWriting) && ((chanMode & TCL_READABLE) == 0)) {
	Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for reading",
		NULL);
	return TCL_ERROR;
    }

    /*
     * We allow creating a FILE * out of file based, pipe based and socket
     * based channels. We currently do not allow any other channel types,
     * because it is likely that stdio will not know what to do with them.
     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if ((chanTypePtr == &fileChannelType)
#ifdef SUPPORTS_TTY
	    || (chanTypePtr == &ttyChannelType)
#endif /* SUPPORTS_TTY */
	    || (strcmp(chanTypePtr->typeName, "tcp") == 0)
	    || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
	if (Tcl_GetChannelHandle(chan,
		(forWriting ? TCL_WRITABLE : TCL_READABLE), &data) == TCL_OK) {
	    fd = PTR2INT(data);

	    /*
	     * The call to fdopen below is probably dangerous, since it will
	     * truncate an existing file if the file is being opened for
	     * writing....
	     */

	    f = fdopen(fd, (forWriting ? "w" : "r"));
	    if (f == NULL) {
		Tcl_AppendResult(interp, "cannot get a FILE * for \"", chanID,
			"\"", NULL);
		return TCL_ERROR;
	    }
	    *filePtr = f;
	    return TCL_OK;
	}
    }

    Tcl_AppendResult(interp, "\"", chanID,
	    "\" cannot be used to get a FILE *", NULL);
    return TCL_ERROR;
}

#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
/*
 *----------------------------------------------------------------------
 *
 * TclUnixWaitForFile --
 *
 *	This function waits synchronously for a file to become readable or
 *	writable, with an optional timeout.
 *
 * Results:
 *	The return value is an OR'ed combination of TCL_READABLE,
 *	TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are
 *	present on file at the time of the return. This function will not
 *	return until either "timeout" milliseconds have elapsed or at least
 *	one of the conditions given by mask has occurred for file (a return
 *	value of 0 means that a timeout occurred). No normal events will be
 *	serviced during the execution of this function.
 *
 * Side effects:
 *	Time passes.
 *
 *----------------------------------------------------------------------
 */

int
TclUnixWaitForFile(
    int fd,			/* Handle for file on which to wait. */
    int mask,			/* What to wait for: OR'ed combination of
				 * TCL_READABLE, TCL_WRITABLE, and
				 * TCL_EXCEPTION. */
    int timeout)		/* Maximum amount of time to wait for one of
				 * the conditions in mask to occur, in
				 * milliseconds. A value of 0 means don't wait
				 * at all, and a value of -1 means wait
				 * forever. */
{
    Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
    struct timeval blockTime, *timeoutPtr;
    int numFound, result = 0;
    fd_set readableMask;
    fd_set writableMask;
    fd_set exceptionMask;

#ifndef _DARWIN_C_SOURCE
    /*
     * Sanity check fd.
     */

    if (fd >= FD_SETSIZE) {
	Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd);
	/* must never get here, or select masks overrun will occur below */
    }
#endif

    /*
     * If there is a non-zero finite timeout, compute the time when we give
     * up.
     */

    if (timeout > 0) {
	Tcl_GetTime(&now);
	abortTime.sec = now.sec + timeout/1000;
	abortTime.usec = now.usec + (timeout%1000)*1000;
	if (abortTime.usec >= 1000000) {
	    abortTime.usec -= 1000000;
	    abortTime.sec += 1;
	}
	timeoutPtr = &blockTime;
    } else if (timeout == 0) {
	timeoutPtr = &blockTime;
	blockTime.tv_sec = 0;
	blockTime.tv_usec = 0;
    } else {
	timeoutPtr = NULL;
    }

    /*
     * Initialize the select masks.
     */

    FD_ZERO(&readableMask);
    FD_ZERO(&writableMask);
    FD_ZERO(&exceptionMask);

    /*
     * Loop in a mini-event loop of our own, waiting for either the file to
     * become ready or a timeout to occur.
     */

    while (1) {
	if (timeout > 0) {
	    blockTime.tv_sec = abortTime.sec - now.sec;
	    blockTime.tv_usec = abortTime.usec - now.usec;
	    if (blockTime.tv_usec < 0) {
		blockTime.tv_sec -= 1;
		blockTime.tv_usec += 1000000;
	    }
	    if (blockTime.tv_sec < 0) {
		blockTime.tv_sec = 0;
		blockTime.tv_usec = 0;
	    }
	}

	/*
	 * Setup the select masks for the fd.
	 */

	if (mask & TCL_READABLE) {
	    FD_SET(fd, &readableMask);
	}
	if (mask & TCL_WRITABLE) {
	    FD_SET(fd, &writableMask);
	}
	if (mask & TCL_EXCEPTION) {
	    FD_SET(fd, &exceptionMask);
	}

	/*
	 * Wait for the event or a timeout.
	 */

	numFound = select(fd + 1, &readableMask, &writableMask,
		&exceptionMask, timeoutPtr);
	if (numFound == 1) {
	    if (FD_ISSET(fd, &readableMask)) {
		SET_BITS(result, TCL_READABLE);
	    }
	    if (FD_ISSET(fd, &writableMask)) {
		SET_BITS(result, TCL_WRITABLE);
	    }
	    if (FD_ISSET(fd, &exceptionMask)) { 
		SET_BITS(result, TCL_EXCEPTION);
	    }
	    result &= mask;
	    if (result) {
		break;
	    }
	}
	if (timeout == 0) {
	    break;
	}
	if (timeout < 0) {
	    continue;
	}

	/*
	 * The select returned early, so we need to recompute the timeout.
	 */

	Tcl_GetTime(&now);
	if ((abortTime.sec < now.sec)
		|| (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
	    break;
	}
    }
    return result;
}
#endif /* HAVE_COREFOUNDATION */

/*
 *----------------------------------------------------------------------
 *
 * FileTruncateProc --
 *
 *	Truncates a file to a given length.
 *
 * Results:
 *	0 if the operation succeeded, and -1 if it failed (in which case
 *	*errorCodePtr will be set to errno).
 *
 * Side effects:
 *	The underlying file is potentially truncated. This can have a wide
 *	variety of side effects, including moving file pointers that point at
 *	places later in the file than the truncate point.
 *
 *----------------------------------------------------------------------
 */

static int
FileTruncateProc(
    ClientData instanceData,
    Tcl_WideInt length)
{
    FileState *fsPtr = instanceData;
    int result;

#ifdef HAVE_TYPE_OFF64_T
    /*
     * We assume this goes with the type for now...
     */

    result = ftruncate64(fsPtr->fd, (off64_t) length);
#else
    result = ftruncate(fsPtr->fd, (off_t) length);
#endif
    if (result) {
	return errno;
    }
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * tclUnixCompat.c
 *
 * Written by: Zoran Vasiljevic ([email protected]).
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <pwd.h>
#include <grp.h>
#include <errno.h>
#include <string.h>

/* See also: SC_BLOCKING_STYLE in unix/tcl.m4
 */
#ifdef	USE_FIONBIO
#   ifdef HAVE_SYS_FILIO_H
#	include	<sys/filio.h>	/* For FIONBIO. */
#   endif
#   ifdef HAVE_SYS_IOCTL_H
#	include	<sys/ioctl.h>
#   endif
#endif	/* USE_FIONBIO */

/*
 *---------------------------------------------------------------------------
 *
 * TclUnixSetBlockingMode --
 *
 *	Set the blocking mode of a file descriptor.
 *
 * Results:
 *
 *	0 on success, -1 (with errno set) on error.
 *
 *---------------------------------------------------------------------------
 */
int
TclUnixSetBlockingMode(
    int fd,		/* File descriptor */
    int mode)		/* TCL_MODE_BLOCKING or TCL_MODE_NONBLOCKING */
{
#ifndef USE_FIONBIO
    int flags = fcntl(fd, F_GETFL);

    if (mode == TCL_MODE_BLOCKING) {
	flags &= ~O_NONBLOCK;
    } else {
	flags |= O_NONBLOCK;
    }
    return fcntl(fd, F_SETFL, flags);
#else /* USE_FIONBIO */
    int state = (mode == TCL_MODE_NONBLOCKING);
    return ioctl(fd, FIONBIO, &state);
#endif /* !USE_FIONBIO */
}

/*
 * Used to pad structures at size'd boundaries
 *
 * This macro assumes that the pointer 'buffer' was created from an aligned
 * pointer by adding the 'length'. If this 'length' was not a multiple of the
 * 'size' the result is unaligned and PadBuffer corrects both the pointer,
 * _and_ the 'length'. The latter means that future increments of 'buffer' by
 * 'length' stay aligned.
 */

#define PadBuffer(buffer, length, size)			\
    if (((length) % (size))) {				\
	(buffer) += ((size) - ((length) % (size)));	\
	(length) += ((size) - ((length) % (size)));	\
    }

/*
 * Per-thread private storage used to store values returned from MT-unsafe
 * library calls.
 */

#ifdef TCL_THREADS

typedef struct ThreadSpecificData {
    struct passwd pwd;
    char pbuf[2048];

    struct group grp;
    char gbuf[2048];

#if !defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR)
    struct hostent hent;
    char hbuf[2048];
#endif
}  ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#if ((!defined(HAVE_GETHOSTBYNAME_R) || !defined(HAVE_GETHOSTBYADDR_R)) && \
     (!defined(HAVE_MTSAFE_GETHOSTBYNAME) || \
      !defined(HAVE_MTSAFE_GETHOSTBYADDR))) || \
      !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || \
      !defined(HAVE_GETGRNAM_R) || !defined(HAVE_GETGRGID_R)
/*
 * Mutex to lock access to MT-unsafe calls. This is just to protect our own
 * usage. It does not protect us from others calling the same functions
 * without (or using some different) lock.
 */

static Tcl_Mutex compatLock;

/*
 * Helper function declarations. Note that these are only used if needed and
 * only defined if used (via the NEED_* macros).
 */

#undef NEED_COPYARRAY
#undef NEED_COPYGRP
#undef NEED_COPYHOSTENT
#undef NEED_COPYPWD
#undef NEED_COPYSTRING

static int		CopyArray(char **src, int elsize, char *buf,
			    int buflen);
static int		CopyGrp(struct group *tgtPtr, char *buf, int buflen);
static int		CopyHostent(struct hostent *tgtPtr, char *buf,
			    int buflen);
static int		CopyPwd(struct passwd *tgtPtr, char *buf, int buflen);
static int		CopyString(const char *src, char *buf, int buflen);

#endif
#endif /* TCL_THREADS */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetPwNam --
 *
 *      Thread-safe wrappers for getpwnam(). See "man getpwnam" for more
 *      details.
 *
 * Results:
 *      Pointer to struct passwd on success or NULL on error.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwNam(
    const char *name)
{
#if !defined(TCL_THREADS)
    return getpwnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWNAM_R_5)
    struct passwd *pwPtr = NULL;

    return (getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf),
		       &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL;

#elif defined(HAVE_GETPWNAM_R_4)
    return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else
#define NEED_COPYPWD 1
    struct passwd *pwPtr;

    Tcl_MutexLock(&compatLock);
    pwPtr = getpwnam(name);
    if (pwPtr != NULL) {
	tsdPtr->pwd = *pwPtr;
	pwPtr = &tsdPtr->pwd;
	if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) {
	    pwPtr = NULL;
	}
    }
    Tcl_MutexUnlock(&compatLock);
    return pwPtr;
#endif

    return NULL;		/* Not reached. */
#endif /* TCL_THREADS */
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetPwUid --
 *
 *      Thread-safe wrappers for getpwuid(). See "man getpwuid" for more
 *      details.
 *
 * Results:
 *      Pointer to struct passwd on success or NULL on error.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwUid(
    uid_t uid)
{
#if !defined(TCL_THREADS)
    return getpwuid(uid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWUID_R_5)
    struct passwd *pwPtr = NULL;

    return (getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf),
		       &pwPtr) == 0 && pwPtr != NULL) ? &tsdPtr->pwd : NULL;

#elif defined(HAVE_GETPWUID_R_4)
    return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else
#define NEED_COPYPWD 1
    struct passwd *pwPtr;

    Tcl_MutexLock(&compatLock);
    pwPtr = getpwuid(uid);
    if (pwPtr != NULL) {
	tsdPtr->pwd = *pwPtr;
	pwPtr = &tsdPtr->pwd;
	if (CopyPwd(&tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf)) == -1) {
	    pwPtr = NULL;
	}
    }
    Tcl_MutexUnlock(&compatLock);
    return pwPtr;
#endif

    return NULL;		/* Not reached. */
#endif /* TCL_THREADS */
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrNam --
 *
 *      Thread-safe wrappers for getgrnam(). See "man getgrnam" for more
 *      details.
 *
 * Results:
 *      Pointer to struct group on success or NULL on error.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrNam(
    const char *name)
{
#if !defined(TCL_THREADS)
    return getgrnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRNAM_R_5)
    struct group *grPtr = NULL;

    return (getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf),
		       &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL;

#elif defined(HAVE_GETGRNAM_R_4)
    return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else
#define NEED_COPYGRP 1
    struct group *grPtr;

    Tcl_MutexLock(&compatLock);
    grPtr = getgrnam(name);
    if (grPtr != NULL) {
	tsdPtr->grp = *grPtr;
	grPtr = &tsdPtr->grp;
	if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) {
	    grPtr = NULL;
	}
    }
    Tcl_MutexUnlock(&compatLock);
    return grPtr;
#endif

    return NULL;		/* Not reached. */
#endif /* TCL_THREADS */
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrGid --
 *
 *      Thread-safe wrappers for getgrgid(). See "man getgrgid" for more
 *      details.
 *
 * Results:
 *      Pointer to struct group on success or NULL on error.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrGid(
    gid_t gid)
{
#if !defined(TCL_THREADS)
    return getgrgid(gid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRGID_R_5)
    struct group *grPtr = NULL;

    return (getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf),
		       &grPtr) == 0 && grPtr != NULL) ? &tsdPtr->grp : NULL;

#elif defined(HAVE_GETGRGID_R_4)
    return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else
#define NEED_COPYGRP 1
    struct group *grPtr;

    Tcl_MutexLock(&compatLock);
    grPtr = getgrgid(gid);
    if (grPtr != NULL) {
	tsdPtr->grp = *grPtr;
	grPtr = &tsdPtr->grp;
	if (CopyGrp(&tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf)) == -1) {
	    grPtr = NULL;
	}
    }
    Tcl_MutexUnlock(&compatLock);
    return grPtr;
#endif

    return NULL;		/* Not reached. */
#endif /* TCL_THREADS */
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByName --
 *
 *      Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for
 *      more details.
 *
 * Results:
 *      Pointer to struct hostent on success or NULL on error.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

struct hostent *
TclpGetHostByName(
    const char *name)
{
#if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME)
    return gethostbyname(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYNAME_R_5)
    int h_errno;

    return gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
			   sizeof(tsdPtr->hbuf), &h_errno);

#elif defined(HAVE_GETHOSTBYNAME_R_6)
    struct hostent *hePtr = NULL;
    int h_errno, result;

    result = gethostbyname_r(name, &tsdPtr->hent, tsdPtr->hbuf,
	    sizeof(tsdPtr->hbuf), &hePtr, &h_errno);
    return (result == 0) ? hePtr : NULL;

#elif defined(HAVE_GETHOSTBYNAME_R_3)
    struct hostent_data data;

    return (gethostbyname_r(name, &tsdPtr->hent, &data) == 0)
	    ? &tsdPtr->hent : NULL;

#else
#define NEED_COPYHOSTENT 1
    struct hostent *hePtr;

    Tcl_MutexLock(&compatLock);
    hePtr = gethostbyname(name);
    if (hePtr != NULL) {
	tsdPtr->hent = *hePtr;
	hePtr = &tsdPtr->hent;
	if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf,
		sizeof(tsdPtr->hbuf)) == -1) {
	    hePtr = NULL;
	}
    }
    Tcl_MutexUnlock(&compatLock);
    return hePtr;
#endif

    return NULL;		/* Not reached. */
#endif /* TCL_THREADS */
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByAddr --
 *
 *      Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for
 *      more details.
 *
 * Results:
 *      Pointer to struct hostent on success or NULL on error.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

struct hostent *
TclpGetHostByAddr(
    const char *addr,
    int length,
    int type)
{
#if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR)
    return gethostbyaddr(addr, length, type);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYADDR_R_7)
    int h_errno;

    return gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
	    sizeof(tsdPtr->hbuf), &h_errno);

#elif defined(HAVE_GETHOSTBYADDR_R_8)
    struct hostent *hePtr;
    int h_errno;

    return (gethostbyaddr_r(addr, length, type, &tsdPtr->hent, tsdPtr->hbuf,
		sizeof(tsdPtr->hbuf), &hePtr, &h_errno) == 0)
	    ? &tsdPtr->hent : NULL;
#else
#define NEED_COPYHOSTENT 1
    struct hostent *hePtr;

    Tcl_MutexLock(&compatLock);
    hePtr = gethostbyaddr(addr, length, type);
    if (hePtr != NULL) {
	tsdPtr->hent = *hePtr;
	hePtr = &tsdPtr->hent;
	if (CopyHostent(&tsdPtr->hent, tsdPtr->hbuf,
		sizeof(tsdPtr->hbuf)) == -1) {
	    hePtr = NULL;
	}
    }
    Tcl_MutexUnlock(&compatLock);
    return hePtr;
#endif

    return NULL;		/* Not reached. */
#endif /* TCL_THREADS */
}

/*
 *---------------------------------------------------------------------------
 *
 * CopyGrp --
 *
 *      Copies string fields of the group structure to the private buffer,
 *      honouring the size of the buffer.
 *
 * Results:
 *      0 on success or -1 on error (errno = ERANGE).
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYGRP
#define NEED_COPYARRAY 1
#define NEED_COPYSTRING 1

static int
CopyGrp(
    struct group *tgtPtr,
    char *buf,
    int buflen)
{
    register char *p = buf;
    register int copied, len = 0;

    /*
     * Copy username.
     */

    copied = CopyString(tgtPtr->gr_name, p, buflen - len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->gr_name = (copied > 0) ? p : NULL;
    len += copied;
    p = buf + len;

    /*
     * Copy password.
     */

    copied = CopyString(tgtPtr->gr_passwd, p, buflen - len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->gr_passwd = (copied > 0) ? p : NULL;
    len += copied;
    p = buf + len;

    /*
     * Copy group members.
     */

    PadBuffer(p, len, sizeof(char *));
    copied = CopyArray((char **)tgtPtr->gr_mem, -1, p, buflen - len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->gr_mem = (copied > 0) ? (char **)p : NULL;

    return 0;

  range:
    errno = ERANGE;
    return -1;
}
#endif /* NEED_COPYGRP */

/*
 *---------------------------------------------------------------------------
 *
 * CopyHostent --
 *
 *      Copies string fields of the hostnent structure to the private buffer,
 *      honouring the size of the buffer.
 *
 * Results:
 *      Number of bytes copied on success or -1 on error (errno = ERANGE)
 *
 * Side effects:
 *      None
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYHOSTENT
#define NEED_COPYSTRING 1
#define NEED_COPYARRAY 1

static int
CopyHostent(
    struct hostent *tgtPtr,
    char *buf,
    int buflen)
{
    char *p = buf;
    int copied, len = 0;

    copied = CopyString(tgtPtr->h_name, p, buflen - len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->h_name = (copied > 0) ? p : NULL;
    len += copied;
    p = buf + len;

    PadBuffer(p, len, sizeof(char *));
    copied = CopyArray(tgtPtr->h_aliases, -1, p, buflen - len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->h_aliases = (copied > 0) ? (char **)p : NULL;
    len += copied;
    p += len;

    PadBuffer(p, len, sizeof(char *));
    copied = CopyArray(tgtPtr->h_addr_list, tgtPtr->h_length, p, buflen-len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->h_addr_list = (copied > 0) ? (char **)p : NULL;

    return 0;

  range:
    errno = ERANGE;
    return -1;
}
#endif /* NEED_COPYHOSTENT */

/*
 *---------------------------------------------------------------------------
 *
 * CopyPwd --
 *
 *      Copies string fields of the passwd structure to the private buffer,
 *      honouring the size of the buffer.
 *
 * Results:
 *      0 on success or -1 on error (errno = ERANGE).
 *
 * Side effects:
 *      We are not copying the gecos field as it may not be supported on all
 *      platforms.
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYPWD
#define NEED_COPYSTRING 1

static int
CopyPwd(
    struct passwd *tgtPtr,
    char *buf,
    int buflen)
{
    char *p = buf;
    int copied, len = 0;

    copied = CopyString(tgtPtr->pw_name, p, buflen - len);
    if (copied == -1) {
    range:
	errno = ERANGE;
	return -1;
    }
    tgtPtr->pw_name = (copied > 0) ? p : NULL;
    len += copied;
    p = buf + len;

    copied = CopyString(tgtPtr->pw_passwd, p, buflen - len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->pw_passwd = (copied > 0) ? p : NULL;
    len += copied;
    p = buf + len;

    copied = CopyString(tgtPtr->pw_dir, p, buflen - len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->pw_dir = (copied > 0) ? p : NULL;
    len += copied;
    p = buf + len;

    copied = CopyString(tgtPtr->pw_shell, p, buflen - len);
    if (copied == -1) {
	goto range;
    }
    tgtPtr->pw_shell = (copied > 0) ? p : NULL;

    return 0;
}
#endif /* NEED_COPYPWD */

/*
 *---------------------------------------------------------------------------
 *
 * CopyArray --
 *
 *      Copies array of NULL-terminated or fixed-length strings to the private
 *      buffer, honouring the size of the buffer.
 *
 * Results:
 *      Number of bytes copied on success or -1 on error (errno = ERANGE)
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYARRAY
static int
CopyArray(
    char **src,			/* Array of elements to copy. */
    int elsize,			/* Size of each element, or -1 to indicate
				 * that they are C strings of dynamic
				 * length. */
    char *buf,			/* Buffer to copy into. */
    int buflen)			/* Size of buffer. */
{
    int i, j, len = 0;
    char *p, **new;

    if (src == NULL) {
	return 0;
    }

    for (i = 0; src[i] != NULL; i++) {
	/*
	 * Empty loop to count how many.
	 */
    }
    len = sizeof(char *) * (i + 1);	/* Leave place for the array. */
    if (len >  buflen) {
	return -1;
    }

    new = (char **) buf;
    p = buf + len;

    for (j = 0; j < i; j++) {
	int sz = (elsize<0 ? (int) strlen(src[j]) + 1 : elsize);

	len += sz;
	if (len > buflen) {
	    return -1;
	}
	memcpy(p, src[j], sz);
	new[j] = p;
	p = buf + len;
    }
    new[j] = NULL;

    return len;
}
#endif /* NEED_COPYARRAY */

/*
 *---------------------------------------------------------------------------
 *
 * CopyString --
 *
 *      Copies a NULL-terminated string to the private buffer, honouring the
 *      size of the buffer
 *
 * Results:
 *      0 success or -1 on error (errno = ERANGE)
 *
 * Side effects:
 *      None
 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_COPYSTRING
static int
CopyString(
    const char *src,	/* String to copy. */
    char *buf,			/* Buffer to copy into. */
    int buflen)			/* Size of buffer. */
{
    int len = 0;

    if (src != NULL) {
	len = strlen(src) + 1;
	if (len > buflen) {
	    return -1;
	}
	memcpy(buf, src, len);
    }

    return len;
}
#endif /* NEED_COPYSTRING */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * tclUnixEvent.c --
 *
 *	This file implements Unix specific event related routines.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Sleep --
 *
 *	Delay execution for the specified number of milliseconds.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Time passes.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Sleep(
    int ms)			/* Number of milliseconds to sleep. */
{
    struct timeval delay;
    Tcl_Time before, after, vdelay;

    /*
     * The only trick here is that select appears to return early under some
     * conditions, so we have to check to make sure that the right amount of
     * time really has elapsed.  If it's too early, go back to sleep again.
     */

    Tcl_GetTime(&before);
    after = before;
    after.sec += ms/1000;
    after.usec += (ms%1000)*1000;
    if (after.usec > 1000000) {
	after.usec -= 1000000;
	after.sec += 1;
    }
    while (1) {
	/*
	 * TIP #233: Scale from virtual time to real-time for select.
	 */

	vdelay.sec  = after.sec  - before.sec;
	vdelay.usec = after.usec - before.usec;

	if (vdelay.usec < 0) {
	    vdelay.usec += 1000000;
	    vdelay.sec  -= 1;
	}

	if ((vdelay.sec != 0) || (vdelay.usec != 0)) {
	    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
	}

	delay.tv_sec  = vdelay.sec;
	delay.tv_usec = vdelay.usec;

	/*
	 * Special note: must convert delay.tv_sec to int before comparing to
	 * zero, since delay.tv_usec is unsigned on some platforms.
	 */

	if ((((int) delay.tv_sec) < 0)
		|| ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
	    break;
	}
	(void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
		(SELECT_MASK *) 0, &delay);
	Tcl_GetTime(&before);
    }
}

#endif /* HAVE_COREFOUNDATION */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * tclUnixFCmd.c
 *
 *	This file implements the unix specific portion of file manipulation
 *	subcommands of the "file" command. All filename arguments should
 *	already be translated to native format.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Portions of this code were derived from NetBSD source code which has the
 * following copyright notice:
 *
 * Copyright (c) 1988, 1993, 1994
 *      The Regents of the University of California. All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 * 1. Redistributions of source code must retain the above copyright notice,
 *    this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. Neither the name of the University nor the names of its contributors may
 *    be used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY
 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY
 * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 * DAMAGE.
 */

#include "tclInt.h"
#include <utime.h>
#include <grp.h>
#ifndef HAVE_STRUCT_STAT_ST_BLKSIZE
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */
#ifdef HAVE_FTS
#include <fts.h>
#endif

/*
 * The following constants specify the type of callback when
 * TraverseUnixTree() calls the traverseProc()
 */

#define DOTREE_PRED	1	/* pre-order directory */
#define DOTREE_POSTD	2	/* post-order directory */
#define DOTREE_F	3	/* regular file */

/*
 * Callbacks for file attributes code.
 */

static int		GetGroupAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
static int		GetOwnerAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
static int		GetPermissionsAttribute(Tcl_Interp *interp,
			    int objIndex, Tcl_Obj *fileName,
			    Tcl_Obj **attributePtrPtr);
static int		SetGroupAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
static int		SetOwnerAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
static int		SetPermissionsAttribute(Tcl_Interp *interp,
			    int objIndex, Tcl_Obj *fileName,
			    Tcl_Obj *attributePtr);
static int		GetModeFromPermString(Tcl_Interp *interp,
			    const char *modeStringPtr, mode_t *modePtr);
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
static int		GetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
static int		SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
#endif

/*
 * Prototype for the TraverseUnixTree callback function.
 */

typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
	const Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr);

/*
 * Constants and variables necessary for file attributes subcommand.
 *
 * IMPORTANT: The permissions attribute is assumed to be the third item (i.e.
 * to be indexed with '2' in arrays) in code in tclIOUtil.c and possibly
 * elsewhere in Tcl's core.
 */

#ifdef DJGPP

/*
 * See contrib/djgpp/tclDjgppFCmd.c for definition.
 */

extern TclFileAttrProcs tclpFileAttrProcs[];
extern const char *const tclpFileAttrStrings[];

#else /* !DJGPP */
enum {
    UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
    UNIX_READONLY_ATTRIBUTE,
#endif
#ifdef MAC_OSX_TCL
    MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE,
    MACOSX_RSRCLENGTH_ATTRIBUTE,
#endif
    UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */
};

MODULE_SCOPE const char *const tclpFileAttrStrings[];
const char *const tclpFileAttrStrings[] = {
    "-group", "-owner", "-permissions",
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
    "-readonly",
#endif
#ifdef MAC_OSX_TCL
    "-creator", "-type", "-hidden", "-rsrclength",
#endif
    NULL
};

MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
const TclFileAttrProcs tclpFileAttrProcs[] = {
    {GetGroupAttribute, SetGroupAttribute},
    {GetOwnerAttribute, SetOwnerAttribute},
    {GetPermissionsAttribute, SetPermissionsAttribute},
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
    {GetReadOnlyAttribute, SetReadOnlyAttribute},
#endif
#ifdef MAC_OSX_TCL
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
#endif
};
#endif /* DJGPP */

/*
 * This is the maximum number of consecutive readdir/unlink calls that can be
 * made (with no intervening rewinddir or closedir/opendir) before triggering
 * a bug that makes readdir return NULL even though some directory entries
 * have not been processed. The bug afflicts SunOS's readdir when applied to
 * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the
 * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We
 * can't do a general rewind on failure as NFS can create special files that
 * recreate themselves when you try and delete them. 8.4.8 added a solution
 * that was affected by a single such NFS file, this solution should not be
 * affected by less than THRESHOLD such files. [Bug 1034337]
 */

#define MAX_READDIR_UNLINK_THRESHOLD 130

/*
 * Declarations for local procedures defined in this file:
 */

static int		CopyFileAtts(const char *src,
			    const char *dst, const Tcl_StatBuf *statBufPtr);
static const char *	DefaultTempDir(void);
static int		DoCopyFile(const char *srcPtr, const char *dstPtr,
			    const Tcl_StatBuf *statBufPtr);
static int		DoCreateDirectory(const char *pathPtr);
static int		DoRemoveDirectory(Tcl_DString *pathPtr,
			    int recursive, Tcl_DString *errorPtr);
static int		DoRenameFile(const char *src, const char *dst);
static int		TraversalCopy(Tcl_DString *srcPtr,
			    Tcl_DString *dstPtr,
			    const Tcl_StatBuf *statBufPtr, int type,
			    Tcl_DString *errorPtr);
static int		TraversalDelete(Tcl_DString *srcPtr,
			    Tcl_DString *dstPtr,
			    const Tcl_StatBuf *statBufPtr, int type,
			    Tcl_DString *errorPtr);
static int		TraverseUnixTree(TraversalProc *traversalProc,
			    Tcl_DString *sourcePtr, Tcl_DString *destPtr,
			    Tcl_DString *errorPtr, int doRewind);

#ifdef PURIFY
/*
 * realpath and purify don't mix happily. It has been noted that realpath
 * should not be used with purify because of bogus warnings, but just
 * memset'ing the resolved path will squelch those. This assumes we are
 * passing the standard MAXPATHLEN size resolved arg.
 */

static char *		Realpath(const char *path, char *resolved);

char *
Realpath(
    const char *path,
    char *resolved)
{
    memset(resolved, 0, MAXPATHLEN);
    return realpath(path, resolved);
}
#else
#   define Realpath	realpath
#endif /* PURIFY */

#ifndef NO_REALPATH
#if defined(__APPLE__) && defined(TCL_THREADS) && \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
	MAC_OS_X_VERSION_MIN_REQUIRED < 1030
/*
 * Prior to Darwin 7, realpath is not thread-safe, c.f. Bug 711232; if we
 * might potentially be running on pre-10.3 OSX, check Darwin release at
 * runtime before using realpath.
 */

MODULE_SCOPE long tclMacOSXDarwinRelease;
#   define haveRealpath	(tclMacOSXDarwinRelease >= 7)
#else
#   define haveRealpath	1
#endif
#endif /* NO_REALPATH */

#ifdef HAVE_FTS
#ifdef HAVE_STRUCT_STAT64
/* fts doesn't do stat64 */
#   define noFtsStat	1
#elif defined(__APPLE__) && defined(__LP64__) && \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
	MAC_OS_X_VERSION_MIN_REQUIRED < 1050
/*
 * Prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a
 * 64bit-unsafe ALIGN macro); if we could be running on pre-10.5 OSX, check
 * Darwin release at runtime and do a separate stat() if necessary.
 */

MODULE_SCOPE long tclMacOSXDarwinRelease;
#   define noFtsStat	(tclMacOSXDarwinRelease < 9)
#else
#   define noFtsStat	0
#endif
#endif /* HAVE_FTS */

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjRenameFile, DoRenameFile --
 *
 *	Changes the name of an existing file or directory, from src to dst. If
 *	src and dst refer to the same file or directory, does nothing and
 *	returns success. Otherwise if dst already exists, it will be deleted
 *	and replaced by src subject to the following conditions:
 *	    If src is a directory, dst may be an empty directory.
 *	    If src is a file, dst may be a file.
 *	In any other situation where dst already exists, the rename will fail.
 *
 * Results:
 *	If the directory was successfully created, returns TCL_OK. Otherwise
 *	the return value is TCL_ERROR and errno is set to indicate the error.
 *	Some possible values for errno are:
 *
 *	EACCES:	    src or dst parent directory can't be read and/or written.
 *	EEXIST:	    dst is a non-empty directory.
 *	EINVAL:	    src is a root directory or dst is a subdirectory of src.
 *	EISDIR:	    dst is a directory, but src is not.
 *	ENOENT:	    src doesn't exist, or src or dst is "".
 *	ENOTDIR:    src is a directory, but dst is not.
 *	EXDEV:	    src and dst are on different filesystems.
 *
 * Side effects:
 *	The implementation of rename may allow cross-filesystem renames, but
 *	the caller should be prepared to emulate it with copy and delete if
 *	errno is EXDEV.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjRenameFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
	    Tcl_FSGetNativePath(destPathPtr));
}

static int
DoRenameFile(
    const char *src,		/* Pathname of file or dir to be renamed
				 * (native). */
    const char *dst)		/* New pathname of file or directory
				 * (native). */
{
    if (rename(src, dst) == 0) {			/* INTL: Native. */
	return TCL_OK;
    }
    if (errno == ENOTEMPTY) {
	errno = EEXIST;
    }

    /*
     * IRIX returns EIO when you attept to move a directory into itself. We
     * just map EIO to EINVAL get the right message on SGI. Most platforms
     * don't return EIO except in really strange cases.
     */

    if (errno == EIO) {
	errno = EINVAL;
    }

#ifndef NO_REALPATH
    /*
     * SunOS 4.1.4 reports overwriting a non-empty directory with a directory
     * as EINVAL instead of EEXIST (first rule out the correct EINVAL result
     * code for moving a directory into itself). Must be conditionally
     * compiled because realpath() not defined on all systems.
     */

    if (errno == EINVAL && haveRealpath) {
	char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
	DIR *dirPtr;
	Tcl_DirEntry *dirEntPtr;

	if ((Realpath((char *) src, srcPath) != NULL)	/* INTL: Native. */
		&& (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native */
		&& (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
	    dirPtr = opendir(dst);			/* INTL: Native. */
	    if (dirPtr != NULL) {
		while (1) {
		    dirEntPtr = TclOSreaddir(dirPtr);	/* INTL: Native. */
		    if (dirEntPtr == NULL) {
			break;
		    }
		    if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
			    (strcmp(dirEntPtr->d_name, "..") != 0)) {
			errno = EEXIST;
			closedir(dirPtr);
			return TCL_ERROR;
		    }
		}
		closedir(dirPtr);
	    }
	}
	errno = EINVAL;
    }
#endif	/* !NO_REALPATH */

    if (strcmp(src, "/") == 0) {
	/*
	 * Alpha reports renaming / as EBUSY and Linux reports it as EACCES,
	 * instead of EINVAL.
	 */

	errno = EINVAL;
    }

    /*
     * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a file
     * across filesystems and the parent directory of that file is not
     * writable. Most other systems return EXDEV. Does nothing to correct this
     * behavior.
     */

    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjCopyFile, DoCopyFile --
 *
 *	Copy a single file (not a directory). If dst already exists and is not
 *	a directory, it is removed.
 *
 * Results:
 *	If the file was successfully copied, returns TCL_OK. Otherwise the
 *	return value is TCL_ERROR and errno is set to indicate the error. Some
 *	possible values for errno are:
 *
 *	EACCES:	    src or dst parent directory can't be read and/or written.
 *	EISDIR:	    src or dst is a directory.
 *	ENOENT:	    src doesn't exist. src or dst is "".
 *
 * Side effects:
 *	This procedure will also copy symbolic links, block, and character
 *	devices, and fifos. For symbolic links, the links themselves will be
 *	copied and not what they point to. For the other special file types,
 *	the directory entry will be copied and not the contents of the device
 *	that it refers to.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjCopyFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    const char *src = Tcl_FSGetNativePath(srcPathPtr);
    Tcl_StatBuf srcStatBuf;

    if (TclOSlstat(src, &srcStatBuf) != 0) {		/* INTL: Native. */
	return TCL_ERROR;
    }

    return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf);
}

static int
DoCopyFile(
    const char *src,		/* Pathname of file to be copied (native). */
    const char *dst,		/* Pathname of file to copy to (native). */
    const Tcl_StatBuf *statBufPtr)
				/* Used to determine filetype. */
{
    Tcl_StatBuf dstStatBuf;

    if (S_ISDIR(statBufPtr->st_mode)) {
	errno = EISDIR;
	return TCL_ERROR;
    }

    /*
     * Symlink, and some of the other calls will fail if the target exists, so
     * we remove it first.
     */

    if (TclOSlstat(dst, &dstStatBuf) == 0) {		/* INTL: Native. */
	if (S_ISDIR(dstStatBuf.st_mode)) {
	    errno = EISDIR;
	    return TCL_ERROR;
	}
    }
    if (unlink(dst) != 0) {				/* INTL: Native. */
	if (errno != ENOENT) {
	    return TCL_ERROR;
	}
    }

    switch ((int) (statBufPtr->st_mode & S_IFMT)) {
#ifndef DJGPP
    case S_IFLNK: {
	char linkBuf[MAXPATHLEN];
	int length;

	length = readlink(src, linkBuf, sizeof(linkBuf));
							/* INTL: Native. */
	if (length == -1) {
	    return TCL_ERROR;
	}
	linkBuf[length] = '\0';
	if (symlink(linkBuf, dst) < 0) {		/* INTL: Native. */
	    return TCL_ERROR;
	}
#ifdef MAC_OSX_TCL
	TclMacOSXCopyFileAttributes(src, dst, statBufPtr);
#endif
	break;
    }
#endif /* !DJGPP */
    case S_IFBLK:
    case S_IFCHR:
	if (mknod(dst, statBufPtr->st_mode,		/* INTL: Native. */
		statBufPtr->st_rdev) < 0) {
	    return TCL_ERROR;
	}
	return CopyFileAtts(src, dst, statBufPtr);
    case S_IFIFO:
	if (mkfifo(dst, statBufPtr->st_mode) < 0) {	/* INTL: Native. */
	    return TCL_ERROR;
	}
	return CopyFileAtts(src, dst, statBufPtr);
    default:
	return TclUnixCopyFile(src, dst, statBufPtr, 0);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclUnixCopyFile -
 *
 *	Helper function for TclpCopyFile. Copies one regular file, using
 *	read() and write().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A file is copied. Dst will be overwritten if it exists.
 *
 *----------------------------------------------------------------------
 */

int
TclUnixCopyFile(
    const char *src,		/* Pathname of file to copy (native). */
    const char *dst,		/* Pathname of file to create/overwrite
				 * (native). */
    const Tcl_StatBuf *statBufPtr,
				/* Used to determine mode and blocksize. */
    int dontCopyAtts)		/* If flag set, don't copy attributes. */
{
    int srcFd, dstFd;
    unsigned blockSize;		/* Optimal I/O blocksize for filesystem */
    char *buffer;		/* Data buffer for copy */
    size_t nread;

#ifdef DJGPP
#define BINMODE |O_BINARY
#else
#define BINMODE
#endif /* DJGPP */

#define DEFAULT_COPY_BLOCK_SIZE 4069

    if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native */
	return TCL_ERROR;
    }

    dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY BINMODE, /* INTL: Native */
	    statBufPtr->st_mode);
    if (dstFd < 0) {
	close(srcFd);
	return TCL_ERROR;
    }

    /*
     * Try to work out the best size of buffer to use for copying. If we
     * can't, it's no big deal as we can just use a (32-bit) page, since
     * that's likely to be fairly efficient anyway.
     */

#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    blockSize = statBufPtr->st_blksize;
#elif !defined(NO_FSTATFS)
    {
	struct statfs fs;

	if (fstatfs(srcFd, &fs) == 0) {
	    blockSize = fs.f_bsize;
	} else {
	    blockSize = DEFAULT_COPY_BLOCK_SIZE;
	}
    }
#else
    blockSize = DEFAULT_COPY_BLOCK_SIZE;
#endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */

    /*
     * [SF Tcl Bug 1586470] Even if we HAVE_STRUCT_STAT_ST_BLKSIZE, there are
     * filesystems which report a bogus value for the blocksize. An example
     * is the Andrew Filesystem (afs), reporting a blocksize of 0. When
     * detecting such a situation we now simply fall back to a hardwired
     * default size.
     */

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
    }
    buffer = ckalloc(blockSize);
    while (1) {
	nread = (size_t) read(srcFd, buffer, blockSize);
	if ((nread == (size_t) -1) || (nread == 0)) {
	    break;
	}
	if ((size_t) write(dstFd, buffer, nread) != nread) {
	    nread = (size_t) -1;
	    break;
	}
    }

    ckfree(buffer);
    close(srcFd);
    if ((close(dstFd) != 0) || (nread == (size_t) -1)) {
	unlink(dst);					/* INTL: Native. */
	return TCL_ERROR;
    }
    if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
	/*
	 * The copy succeeded, but setting the permissions failed, so be in a
	 * consistent state, we remove the file that was created by the copy.
	 */

	unlink(dst);					/* INTL: Native. */
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjDeleteFile, TclpDeleteFile --
 *
 *	Removes a single file (not a directory).
 *
 * Results:
 *	If the file was successfully deleted, returns TCL_OK. Otherwise the
 *	return value is TCL_ERROR and errno is set to indicate the error. Some
 *	possible values for errno are:
 *
 *	EACCES:	    a parent directory can't be read and/or written.
 *	EISDIR:	    path is a directory.
 *	ENOENT:	    path doesn't exist or is "".
 *
 * Side effects:
 *	The file is deleted, even if it is read-only.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjDeleteFile(
    Tcl_Obj *pathPtr)
{
    return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
}

int
TclpDeleteFile(
    const void *path)		/* Pathname of file to be removed (native). */
{
    if (unlink((const char *)path) != 0) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpCreateDirectory, DoCreateDirectory --
 *
 *	Creates the specified directory. All parent directories of the
 *	specified directory must already exist. The directory is automatically
 *	created with permissions so that user can access the new directory and
 *	create new files or subdirectories in it.
 *
 * Results:
 *	If the directory was successfully created, returns TCL_OK. Otherwise
 *	the return value is TCL_ERROR and errno is set to indicate the error.
 *	Some possible values for errno are:
 *
 *	EACCES:	    a parent directory can't be read and/or written.
 *	EEXIST:	    path already exists.
 *	ENOENT:	    a parent directory doesn't exist.
 *
 * Side effects:
 *	A directory is created with the current umask, except that permission
 *	for u+rwx will always be added.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjCreateDirectory(
    Tcl_Obj *pathPtr)
{
    return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}

static int
DoCreateDirectory(
    const char *path)		/* Pathname of directory to create (native). */
{
    mode_t mode;

    mode = umask(0);
    umask(mode);

    /*
     * umask return value is actually the inverse of the permissions.
     */

    mode = (0777 & ~mode) | S_IRUSR | S_IWUSR | S_IXUSR;

    if (mkdir(path, mode) != 0) {			/* INTL: Native. */
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjCopyDirectory --
 *
 *	Recursively copies a directory. The target directory dst must not
 *	already exist. Note that this function does not merge two directory
 *	hierarchies, even if the target directory is an an empty directory.
 *
 * Results:
 *	If the directory was successfully copied, returns TCL_OK. Otherwise
 *	the return value is TCL_ERROR, errno is set to indicate the error, and
 *	the pathname of the file that caused the error is stored in errorPtr.
 *	See TclpObjCreateDirectory and TclpObjCopyFile for a description of
 *	possible values for errno.
 *
 * Side effects:
 *	An exact copy of the directory hierarchy src will be created with the
 *	name dst. If an error occurs, the error will be returned immediately,
 *	and remaining files will not be processed.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjCopyDirectory(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr,
    Tcl_Obj **errorPtr)
{
    Tcl_DString ds;
    Tcl_DString srcString, dstString;
    int ret;
    Tcl_Obj *transPtr;

    transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
    Tcl_UtfToExternalDString(NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, &srcString);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
    Tcl_UtfToExternalDString(NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, &dstString);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }

    ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);

    Tcl_DStringFree(&srcString);
    Tcl_DStringFree(&dstString);

    if (ret != TCL_OK) {
	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
	Tcl_DStringFree(&ds);
	Tcl_IncrRefCount(*errorPtr);
    }
    return ret;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpRemoveDirectory, DoRemoveDirectory --
 *
 *	Removes directory (and its contents, if the recursive flag is set).
 *
 * Results:
 *	If the directory was successfully removed, returns TCL_OK. Otherwise
 *	the return value is TCL_ERROR, errno is set to indicate the error, and
 *	the pathname of the file that caused the error is stored in errorPtr.
 *	Some possible values for errno are:
 *
 *	EACCES:	    path directory can't be read and/or written.
 *	EEXIST:	    path is a non-empty directory.
 *	EINVAL:	    path is a root directory.
 *	ENOENT:	    path doesn't exist or is "".
 * 	ENOTDIR:    path is not a directory.
 *
 * Side effects:
 *	Directory removed. If an error occurs, the error will be returned
 *	immediately, and remaining files will not be deleted.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjRemoveDirectory(
    Tcl_Obj *pathPtr,
    int recursive,
    Tcl_Obj **errorPtr)
{
    Tcl_DString ds;
    Tcl_DString pathString;
    int ret;
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

    Tcl_UtfToExternalDString(NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, &pathString);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    ret = DoRemoveDirectory(&pathString, recursive, &ds);
    Tcl_DStringFree(&pathString);

    if (ret != TCL_OK) {
	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
	Tcl_DStringFree(&ds);
	Tcl_IncrRefCount(*errorPtr);
    }
    return ret;
}

static int
DoRemoveDirectory(
    Tcl_DString *pathPtr,	/* Pathname of directory to be removed
				 * (native). */
    int recursive,		/* If non-zero, removes directories that are
				 * nonempty. Otherwise, will only remove empty
				 * directories. */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    const char *path;
    mode_t oldPerm = 0;
    int result;

    path = Tcl_DStringValue(pathPtr);

    if (recursive != 0) {
	/*
	 * We should try to change permissions so this can be deleted.
	 */

	Tcl_StatBuf statBuf;
	int newPerm;

	if (TclOSstat(path, &statBuf) == 0) {
	    oldPerm = (mode_t) (statBuf.st_mode & 0x00007FFF);
	}

	newPerm = oldPerm | (64+128+256);
	chmod(path, (mode_t) newPerm);
    }

    if (rmdir(path) == 0) {				/* INTL: Native. */
	return TCL_OK;
    }
    if (errno == ENOTEMPTY) {
	errno = EEXIST;
    }

    result = TCL_OK;
    if ((errno != EEXIST) || (recursive == 0)) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDString(NULL, path, -1, errorPtr);
	}
	result = TCL_ERROR;
    }

    /*
     * The directory is nonempty, but the recursive flag has been specified,
     * so we recursively remove all the files in the directory.
     */

    if (result == TCL_OK) {
	result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr, 1);
    }

    if ((result != TCL_OK) && (recursive != 0)) {
	/*
	 * Try to restore permissions.
	 */

	chmod(path, oldPerm);
    }
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * TraverseUnixTree --
 *
 *	Traverse directory tree specified by sourcePtr, calling the function
 *	traverseProc for each file and directory encountered. If destPtr is
 *	non-null, each of name in the sourcePtr directory is appended to the
 *	directory specified by destPtr and passed as the second argument to
 *	traverseProc().
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	None caused by TraverseUnixTree, however the user specified
 *	traverseProc() may change state. If an error occurs, the error will be
 *	returned immediately, and remaining files will not be processed.
 *
 *---------------------------------------------------------------------------
 */

static int
TraverseUnixTree(
    TraversalProc *traverseProc,/* Function to call for every file and
				 * directory in source hierarchy. */
    Tcl_DString *sourcePtr,	/* Pathname of source directory to be
				 * traversed (native). */
    Tcl_DString *targetPtr,	/* Pathname of directory to traverse in
				 * parallel with source directory (native). */
    Tcl_DString *errorPtr,	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
    int doRewind)		/* Flag indicating that to ensure complete
    				 * traversal of source hierarchy, the readdir
    				 * loop should be rewound whenever
    				 * traverseProc has returned TCL_OK; this is
    				 * required when traverseProc modifies the
    				 * source hierarchy, e.g. by deleting
    				 * files. */
{
    Tcl_StatBuf statBuf;
    const char *source, *errfile;
    int result, sourceLen;
    int targetLen;
#ifndef HAVE_FTS
    int numProcessed = 0;
    Tcl_DirEntry *dirEntPtr;
    DIR *dirPtr;
#else
    const char *paths[2] = {NULL, NULL};
    FTS *fts = NULL;
    FTSENT *ent;
#endif

    errfile = NULL;
    result = TCL_OK;
    targetLen = 0;		/* lint. */

    source = Tcl_DStringValue(sourcePtr);
    if (TclOSlstat(source, &statBuf) != 0) {		/* INTL: Native. */
	errfile = source;
	goto end;
    }
    if (!S_ISDIR(statBuf.st_mode)) {
	/*
	 * Process the regular file
	 */

	return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F,
		errorPtr);
    }
#ifndef HAVE_FTS
    dirPtr = opendir(source);				/* INTL: Native. */
    if (dirPtr == NULL) {
	/*
	 * Can't read directory
	 */

	errfile = source;
	goto end;
    }
    result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,
	    errorPtr);
    if (result != TCL_OK) {
	closedir(dirPtr);
	return result;
    }

    Tcl_DStringAppend(sourcePtr, "/", 1);
    sourceLen = Tcl_DStringLength(sourcePtr);

    if (targetPtr != NULL) {
	Tcl_DStringAppend(targetPtr, "/", 1);
	targetLen = Tcl_DStringLength(targetPtr);
    }

    while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */
	if ((dirEntPtr->d_name[0] == '.')
		&& ((dirEntPtr->d_name[1] == '\0')
			|| (strcmp(dirEntPtr->d_name, "..") == 0))) {
	    continue;
	}

	/*
	 * Append name after slash, and recurse on the file.
	 */

	Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1);
	if (targetPtr != NULL) {
	    Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1);
	}
	result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
		errorPtr, doRewind);
	if (result != TCL_OK) {
	    break;
	} else {
	    numProcessed++;
	}

	/*
	 * Remove name after slash.
	 */

	Tcl_DStringSetLength(sourcePtr, sourceLen);
	if (targetPtr != NULL) {
	    Tcl_DStringSetLength(targetPtr, targetLen);
	}
	if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) {
	    /*
	     * Call rewinddir if we've called unlink or rmdir so many times
	     * (since the opendir or the previous rewinddir), to avoid a
	     * NULL-return that may a symptom of a buggy readdir.
	     */

	    rewinddir(dirPtr);
	    numProcessed = 0;
	}
    }
    closedir(dirPtr);

    /*
     * Strip off the trailing slash we added
     */

    Tcl_DStringSetLength(sourcePtr, sourceLen - 1);
    if (targetPtr != NULL) {
	Tcl_DStringSetLength(targetPtr, targetLen - 1);
    }

    if (result == TCL_OK) {
	/*
	 * Call traverseProc() on a directory after visiting all the files in
	 * that directory.
	 */

	result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD,
		errorPtr);
    }
#else /* HAVE_FTS */
    paths[0] = source;
    fts = fts_open((char **) paths, FTS_PHYSICAL | FTS_NOCHDIR |
	    (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL);
    if (fts == NULL) {
	errfile = source;
	goto end;
    }

    sourceLen = Tcl_DStringLength(sourcePtr);
    if (targetPtr != NULL) {
	targetLen = Tcl_DStringLength(targetPtr);
    }

    while ((ent = fts_read(fts)) != NULL) {
	unsigned short info = ent->fts_info;
	char *path = ent->fts_path + sourceLen;
	unsigned short pathlen = ent->fts_pathlen - sourceLen;
	int type;
	Tcl_StatBuf *statBufPtr = NULL;

	if (info == FTS_DNR || info == FTS_ERR || info == FTS_NS) {
	    errfile = ent->fts_path;
	    break;
	}
	Tcl_DStringAppend(sourcePtr, path, pathlen);
	if (targetPtr != NULL) {
	    Tcl_DStringAppend(targetPtr, path, pathlen);
	}
	switch (info) {
	case FTS_D:
	    type = DOTREE_PRED;
	    break;
	case FTS_DP:
	    type = DOTREE_POSTD;
	    break;
	default:
	    type = DOTREE_F;
	    break;
	}
	if (!doRewind) { /* no need to stat for delete */
	    if (noFtsStat) {
		statBufPtr = &statBuf;
		if (TclOSlstat(ent->fts_path, statBufPtr) != 0) {
		    errfile = ent->fts_path;
		    break;
		}
	    } else {
		statBufPtr = (Tcl_StatBuf *) ent->fts_statp;
	    }
	}
	result = traverseProc(sourcePtr, targetPtr, statBufPtr, type,
		errorPtr);
	if (result != TCL_OK) {
	    break;
	}
	Tcl_DStringSetLength(sourcePtr, sourceLen);
	if (targetPtr != NULL) {
	    Tcl_DStringSetLength(targetPtr, targetLen);
	}
    }
#endif /* !HAVE_FTS */

  end:
    if (errfile != NULL) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr);
	}
	result = TCL_ERROR;
    }
#ifdef HAVE_FTS
    if (fts != NULL) {
	fts_close(fts);
    }
#endif

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TraversalCopy
 *
 *	Called from TraverseUnixTree in order to execute a recursive copy of a
 *	directory.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	The file or directory src may be copied to dst, depending on the value
 *	of type.
 *
 *----------------------------------------------------------------------
 */

static int
TraversalCopy(
    Tcl_DString *srcPtr,	/* Source pathname to copy (native). */
    Tcl_DString *dstPtr,	/* Destination pathname of copy (native). */
    const Tcl_StatBuf *statBufPtr,
				/* Stat info for file specified by srcPtr. */
    int type,			/* Reason for call - see TraverseUnixTree(). */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    switch (type) {
    case DOTREE_F:
	if (DoCopyFile(Tcl_DStringValue(srcPtr), Tcl_DStringValue(dstPtr),
		statBufPtr) == TCL_OK) {
	    return TCL_OK;
	}
	break;

    case DOTREE_PRED:
	if (DoCreateDirectory(Tcl_DStringValue(dstPtr)) == TCL_OK) {
	    return TCL_OK;
	}
	break;

    case DOTREE_POSTD:
	if (CopyFileAtts(Tcl_DStringValue(srcPtr),
		Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) {
	    return TCL_OK;
	}
	break;
    }

    /*
     * There shouldn't be a problem with src, because we already checked it to
     * get here.
     */

    if (errorPtr != NULL) {
	Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(dstPtr),
		Tcl_DStringLength(dstPtr), errorPtr);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TraversalDelete --
 *
 *	Called by procedure TraverseUnixTree for every file and directory that
 *	it encounters in a directory hierarchy. This procedure unlinks files,
 *	and removes directories after all the containing files have been
 *	processed.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	Files or directory specified by src will be deleted.
 *
 *----------------------------------------------------------------------
 */

static int
TraversalDelete(
    Tcl_DString *srcPtr,	/* Source pathname (native). */
    Tcl_DString *ignore,	/* Destination pathname (not used). */
    const Tcl_StatBuf *statBufPtr,
				/* Stat info for file specified by srcPtr. */
    int type,			/* Reason for call - see TraverseUnixTree(). */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    switch (type) {
    case DOTREE_F:
	if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) {
	    return TCL_OK;
	}
	break;
    case DOTREE_PRED:
	return TCL_OK;
    case DOTREE_POSTD:
	if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) {
	    return TCL_OK;
	}
	break;
    }
    if (errorPtr != NULL) {
	Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr),
		Tcl_DStringLength(srcPtr), errorPtr);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * CopyFileAtts --
 *
 *	Copy the file attributes such as owner, group, permissions, and
 *	modification date from one file to another.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	User id, group id, permission bits, last modification time, and last
 *	access time are updated in the new file to reflect the old file.
 *
 *---------------------------------------------------------------------------
 */

static int
CopyFileAtts(
    const char *src,		/* Path name of source file (native). */
    const char *dst,		/* Path name of target file (native). */
    const Tcl_StatBuf *statBufPtr)
				/* Stat info for source file */
{
    struct utimbuf tval;
    mode_t newMode;

    newMode = statBufPtr->st_mode
	    & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO);

    /*
     * Note that if you copy a setuid file that is owned by someone else, and
     * you are not root, then the copy will be setuid to you. The most correct
     * implementation would probably be to have the copy not setuid to anyone
     * if the original file was owned by someone else, but this corner case
     * isn't currently handled. It would require another lstat(), or getuid().
     */

    if (chmod(dst, newMode)) {				/* INTL: Native. */
	newMode &= ~(S_ISUID | S_ISGID);
	if (chmod(dst, newMode)) {			/* INTL: Native. */
	    return TCL_ERROR;
	}
    }

    tval.actime = statBufPtr->st_atime;
    tval.modtime = statBufPtr->st_mtime;

    if (utime(dst, &tval)) {				/* INTL: Native. */
	return TCL_ERROR;
    }
#ifdef MAC_OSX_TCL
    TclMacOSXCopyFileAttributes(src, dst, statBufPtr);
#endif
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetGroupAttribute
 *
 *	Gets the group attribute of a file.
 *
 * Results:
 *	Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there
 *	is no error.
 *
 * Side effects:
 *	A new object is allocated.
 *
 *----------------------------------------------------------------------
 */

static int
GetGroupAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    struct group *groupPtr;
    int result;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }

    groupPtr = TclpGetGrGid(statBuf.st_gid);

    if (groupPtr == NULL) {
	*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid);
    } else {
	Tcl_DString ds;
	const char *utf;

	utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds);
	*attributePtrPtr = Tcl_NewStringObj(utf, -1);
	Tcl_DStringFree(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetOwnerAttribute
 *
 *	Gets the owner attribute of a file.
 *
 * Results:
 *	Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there
 *	is no error.
 *
 * Side effects:
 *	A new object is allocated.
 *
 *----------------------------------------------------------------------
 */

static int
GetOwnerAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    struct passwd *pwPtr;
    int result;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }

    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
    } else {
	Tcl_DString ds;
	const char *utf;

	utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
	*attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetPermissionsAttribute
 *
 *	Gets the group attribute of a file.
 *
 * Results:
 *	Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there
 *	is no error. The object will have ref count 0.
 *
 * Side effects:
 *	A new object is allocated.
 *
 *----------------------------------------------------------------------
 */

static int
GetPermissionsAttribute(
    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    int objIndex,		    /* The index of the attribute. */
    Tcl_Obj *fileName,		    /* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    int result;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_ObjPrintf(
	    "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF));
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetGroupAttribute --
 *
 *	Sets the group of the file to the specified group.
 *
 * Results:
 *	Standard TCL result.
 *
 * Side effects:
 *	As above.
 *
 *---------------------------------------------------------------------------
 */

static int
SetGroupAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New group for file. */
{
    long gid;
    int result;
    const char *native;

    if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;
	int length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	groupPtr = TclpGetGrNam(native); /* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (groupPtr == NULL) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "could not set group for file \"",
			TclGetString(fileName), "\": group \"", string,
			"\" does not exist", NULL);
	    }
	    return TCL_ERROR;
	}
	gid = groupPtr->gr_gid;
    }

    native = Tcl_FSGetNativePath(fileName);
    result = chown(native, (uid_t) -1, (gid_t) gid);	/* INTL: Native. */

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not set group for file \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetOwnerAttribute --
 *
 *	Sets the owner of the file to the specified owner.
 *
 * Results:
 *	Standard TCL result.
 *
 * Side effects:
 *	As above.
 *
 *---------------------------------------------------------------------------
 */

static int
SetOwnerAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New owner for file. */
{
    long uid;
    int result;
    const char *native;

    if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;
	int length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (pwPtr == NULL) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "could not set owner for file \"",
			TclGetString(fileName), "\": user \"", string,
			"\" does not exist", NULL);
	    }
	    return TCL_ERROR;
	}
	uid = pwPtr->pw_uid;
    }

    native = Tcl_FSGetNativePath(fileName);
    result = chown(native, (uid_t) uid, (gid_t) -1);	/* INTL: Native. */

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not set owner for file \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetPermissionsAttribute
 *
 *	Sets the file to the given permission.
 *
 * Results:
 *	Standard TCL result.
 *
 * Side effects:
 *	The permission of the file is changed.
 *
 *---------------------------------------------------------------------------
 */

static int
SetPermissionsAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    long mode;
    mode_t newMode;
    int result = TCL_ERROR;
    const char *native;
    const char *modeStringPtr = TclGetString(attributePtr);
    int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);

    /*
     * First supply support for octal number format
     */

    if ((modeStringPtr[scanned] == '0')
	    && (modeStringPtr[scanned+1] >= '0')
	    && (modeStringPtr[scanned+1] <= '7')) {
	/* Leading zero - attempt octal interpretation */
	Tcl_Obj *modeObj;

	TclNewLiteralStringObj(modeObj, "0o");
	Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
	result = Tcl_GetLongFromObj(NULL, modeObj, &mode);
	Tcl_DecrRefCount(modeObj);
    }
    if (result == TCL_OK
	    || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	newMode = (mode_t) (mode & 0x00007FFF);
    } else {
	Tcl_StatBuf buf;

	/*
	 * Try the forms "rwxrwxrwx" and "ugo=rwx"
	 *
	 * We get the current mode of the file, in order to allow for ug+-=rwx
	 * style chmod strings.
	 */

	result = TclpObjStat(fileName, &buf);
	if (result != 0) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "could not read \"",
			TclGetString(fileName), "\": ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	newMode = (mode_t) (buf.st_mode & 0x00007FFF);

	if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "unknown permission string format \"",
			modeStringPtr, "\"", NULL);
	    }
	    return TCL_ERROR;
	}
    }

    native = Tcl_FSGetNativePath(fileName);
    result = chmod(native, newMode);		/* INTL: Native. */
    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not set permissions for file \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

#ifndef DJGPP
/*
 *---------------------------------------------------------------------------
 *
 * TclpObjListVolumes --
 *
 *	Lists the currently mounted volumes, which on UNIX is just /.
 *
 * Results:
 *	The list of volumes.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclpObjListVolumes(void)
{
    Tcl_Obj *resultPtr;
    TclNewLiteralStringObj(resultPtr, "/");

    Tcl_IncrRefCount(resultPtr);
    return resultPtr;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * GetModeFromPermString --
 *
 *	This procedure is invoked to process the "file permissions" Tcl
 *	command, to check for a "rwxrwxrwx" or "ugoa+-=rwxst" string. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
GetModeFromPermString(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    const char *modeStringPtr, /* Permissions string */
    mode_t *modePtr)		/* pointer to the mode value */
{
    mode_t newMode;
    mode_t oldMode;		/* Storage for the value of the old mode (that
				 * is passed in), to allow for the chmod style
				 * manipulation. */
    int i,n, who, op, what, op_found, who_found;

    /*
     * We start off checking for an "rwxrwxrwx" style permissions string
     */

    if (strlen(modeStringPtr) != 9) {
	goto chmodStyleCheck;
    }

    newMode = 0;
    for (i = 0; i < 9; i++) {
	switch (*(modeStringPtr+i)) {
	case 'r':
	    if ((i%3) != 0) {
		goto chmodStyleCheck;
	    }
	    newMode |= (1<<(8-i));
	    break;
	case 'w':
	    if ((i%3) != 1) {
		goto chmodStyleCheck;
	    }
	    newMode |= (1<<(8-i));
	    break;
	case 'x':
	    if ((i%3) != 2) {
		goto chmodStyleCheck;
	    }
	    newMode |= (1<<(8-i));
	    break;
	case 's':
	    if (((i%3) != 2) || (i > 5)) {
		goto chmodStyleCheck;
	    }
	    newMode |= (1<<(8-i));
	    newMode |= (1<<(11-(i/3)));
	    break;
	case 'S':
	    if (((i%3) != 2) || (i > 5)) {
		goto chmodStyleCheck;
	    }
	    newMode |= (1<<(11-(i/3)));
	    break;
	case 't':
	    if (i != 8) {
		goto chmodStyleCheck;
	    }
	    newMode |= (1<<(8-i));
	    newMode |= (1<<9);
	    break;
	case 'T':
	    if (i != 8) {
		goto chmodStyleCheck;
	    }
	    newMode |= (1<<9);
	    break;
	case '-':
	    break;
	default:
	    /*
	     * Oops, not what we thought it was, so go on
	     */
	    goto chmodStyleCheck;
	}
    }
    *modePtr = newMode;
    return TCL_OK;

  chmodStyleCheck:
    /*
     * We now check for an "ugoa+-=rwxst" style permissions string
     */

    for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) {
	oldMode = *modePtr;
	who = op = what = op_found = who_found = 0;
	for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) {
	    if (!who_found) {
		/* who */
		switch (*(modeStringPtr+n+i)) {
		case 'u':
		    who |= 0x9c0;
		    continue;
		case 'g':
		    who |= 0x438;
		    continue;
		case 'o':
		    who |= 0x207;
		    continue;
		case 'a':
		    who |= 0xfff;
		    continue;
		}
	    }
	    who_found = 1;
	    if (who == 0) {
		who = 0xfff;
	    }
	    if (!op_found) {
		/* op */
		switch (*(modeStringPtr+n+i)) {
		case '+':
		    op = 1;
		    op_found = 1;
		    continue;
		case '-':
		    op = 2;
		    op_found = 1;
		    continue;
		case '=':
		    op = 3;
		    op_found = 1;
		    continue;
		default:
		    return TCL_ERROR;
		}
	    }
	    /* what */
	    switch (*(modeStringPtr+n+i)) {
	    case 'r':
		what |= 0x124;
		continue;
	    case 'w':
		what |= 0x92;
		continue;
	    case 'x':
		what |= 0x49;
		continue;
	    case 's':
		what |= 0xc00;
		continue;
	    case 't':
		what |= 0x200;
		continue;
	    case ',':
		break;
	    default:
		return TCL_ERROR;
	    }
	    if (*(modeStringPtr+n+i) == ',') {
		i++;
		break;
	    }
	}
	switch (op) {
	case 1:
	    *modePtr = oldMode | (who & what);
	    continue;
	case 2:
	    *modePtr = oldMode & ~(who & what);
	    continue;
	case 3:
	    *modePtr = (oldMode & ~who) | (who & what);
	    continue;
	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjNormalizePath --
 *
 *	This function scans through a path specification and replaces it, in
 *	place, with a normalized version. A normalized version is one in which
 *	all symlinks in the path are replaced with their expanded form (except
 *	a symlink at the very end of the path).
 *
 * Results:
 *	The new 'nextCheckpoint' value, giving as far as we could understand
 *	in the path.
 *
 * Side effects:
 *	The pathPtr string, is modified.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr,
    int nextCheckpoint)
{
    const char *currentPathEndPosition;
    int pathLen;
    char cur;
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
#endif

    /*
     * We add '1' here because if nextCheckpoint is zero we know that '/'
     * exists, and if it isn't zero, it must point at a directory separator
     * which we also know exists.
     */

    currentPathEndPosition = path + nextCheckpoint;
    if (*currentPathEndPosition == '/') {
	currentPathEndPosition++;
    }

#ifndef NO_REALPATH
    /*
     * For speed, try to get the entire path in one go.
     */

    if (nextCheckpoint == 0 && haveRealpath) {
	char *lastDir = strrchr(currentPathEndPosition, '/');

	if (lastDir != NULL) {
	    nativePath = Tcl_UtfToExternalDString(NULL, path,
		    lastDir-path, &ds);
	    if (Realpath(nativePath, normPath) != NULL) {
		if (*nativePath != '/' && *normPath == '/') {
		    /*
		     * realpath has transformed a relative path into an
		     * absolute path, we do not know how to handle this.
		     */
		} else {
		    nextCheckpoint = lastDir - path;
		    goto wholeStringOk;
		}
	    }
	    Tcl_DStringFree(&ds);
	}
    }

    /*
     * Else do it the slow way.
     */
#endif

    while (1) {
	cur = *currentPathEndPosition;
	if ((cur == '/') && (path != currentPathEndPosition)) {
	    /*
	     * Reached directory separator.
	     */

	    int accessOk;

	    nativePath = Tcl_UtfToExternalDString(NULL, path,
		    currentPathEndPosition - path, &ds);
	    accessOk = access(nativePath, F_OK);
	    Tcl_DStringFree(&ds);

	    if (accessOk != 0) {
		/*
		 * File doesn't exist.
		 */

		break;
	    }

	    /*
	     * Update the acceptable point.
	     */

	    nextCheckpoint = currentPathEndPosition - path;
	} else if (cur == 0) {
	    /*
	     * Reached end of string.
	     */

	    break;
	}
	currentPathEndPosition++;
    }

    /*
     * We should really now convert this to a canonical path. We do that with
     * 'realpath' if we have it available. Otherwise we could step through
     * every single path component, checking whether it is a symlink, but that
     * would be a lot of work, and most modern OSes have 'realpath'.
     */

#ifndef NO_REALPATH
    if (haveRealpath) {
	/*
	 * If we only had '/foo' or '/' then we never increment nextCheckpoint
	 * and we don't need or want to go through 'Realpath'. Also, on some
	 * platforms, passing an empty string to 'Realpath' will give us the
	 * normalized pwd, which is not what we want at all!
	 */

	if (nextCheckpoint == 0) {
	    return 0;
	}

	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    int newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {
		/*
		 * String is unchanged.
		 */

		Tcl_DStringFree(&ds);

		/*
		 * Enable this to have the native FS claim normalization of
		 * the whole path for existing files. That would permit the
		 * caller to declare normalization complete without calls to
		 * additional filesystems. Saving lots of calls is probably
		 * worth the extra access() time here. When no other FS's are
		 * registered though, things are less clear.
		 *
		if (0 == access(normPath, F_OK)) {
		    return pathLen;
		}
		 */

		return nextCheckpoint;
	    }

	    /*
	     * Free up the native path and put in its place the converted,
	     * normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Not at end, append remaining path.
		 */

		int normLen = Tcl_DStringLength(&ds);

		Tcl_DStringAppend(&ds, path + nextCheckpoint,
			pathLen - nextCheckpoint);

		/*
		 * We recognise up to and including the directory separator.
		 */

		nextCheckpoint = normLen + 1;
	    } else {
		/*
		 * We recognise the whole string.
		 */

		nextCheckpoint = Tcl_DStringLength(&ds);
	    }

	    /*
	     * Overwrite with the normalized path.
	     */

	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds),
		    Tcl_DStringLength(&ds));
	}
	Tcl_DStringFree(&ds);
    }
#endif	/* !NO_REALPATH */

    return nextCheckpoint;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenTemporaryFile --
 *
 *	Creates a temporary file, possibly based on the supplied bits and
 *	pieces of template supplied in the first three arguments. If the
 *	fourth argument is non-NULL, it contains a Tcl_Obj to store the name
 *	of the temporary file in (and it is caller's responsibility to clean
 *	up). If the fourth argument is NULL, try to arrange for the temporary
 *	file to go away once it is no longer needed.
 *
 * Results:
 *	A read-write Tcl Channel open on the file.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
TclpOpenTemporaryFile(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj,
    Tcl_Obj *extensionObj,
    Tcl_Obj *resultingNameObj)
{
    Tcl_Channel chan;
    Tcl_DString template, tmp;
    const char *string;
    int len, fd;

    if (dirObj) {
	string = Tcl_GetStringFromObj(dirObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &template);
    } else {
	Tcl_DStringInit(&template);
	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
    }

    Tcl_DStringAppend(&template, "/", -1);

    if (basenameObj) {
	string = Tcl_GetStringFromObj(basenameObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
	Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
	Tcl_DStringFree(&tmp);
    } else {
	Tcl_DStringAppend(&template, "tcl", -1);
    }

    Tcl_DStringAppend(&template, "_XXXXXX", -1);

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = Tcl_GetStringFromObj(extensionObj, &len);
	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
	Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
	fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&template));
    }

    if (fd == -1) {
	return NULL;
    }
    chan = Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE);
    if (resultingNameObj) {
	Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template),
		Tcl_DStringLength(&template), &tmp);
	Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp),
		Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else {
	/*
	 * Try to delete the file immediately since we're not reporting the
	 * name to anyone. Note that we're *not* handling any errors from
	 * this!
	 */

	unlink(Tcl_DStringValue(&template));
	errno = 0;
    }
    Tcl_DStringFree(&template);

    return chan;
}

/*
 * Helper that does *part* of what tempnam() does.
 */

static const char *
DefaultTempDir(void)
{
    const char *dir;
    struct stat buf;

    dir = getenv("TMPDIR");
    if (dir && dir[0] && stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode)
	    && access(dir, W_OK)) {
	return dir;
    }

#ifdef P_tmpdir
    dir = P_tmpdir;
    if (stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)) {
	return dir;
    }
#endif

    /*
     * Assume that "/tmp" is always an existing writable directory; we've no
     * recovery mechanism if it isn't.
     */

    return "/tmp";
}

#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
 *----------------------------------------------------------------------
 *
 * GetReadOnlyAttribute
 *
 *	Gets the readonly attribute (user immutable flag) of a file.
 *
 * Results:
 *	Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there
 *	is no error. The object will have ref count 0.
 *
 * Side effects:
 *	A new object is allocated.
 *
 *----------------------------------------------------------------------
 */

static int
GetReadOnlyAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    int result;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0);

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetReadOnlyAttribute
 *
 *	Sets the readonly attribute (user immutable flag) of a file.
 *
 * Results:
 *	Standard TCL result.
 *
 * Side effects:
 *	The readonly attribute of the file is changed.
 *
 *---------------------------------------------------------------------------
 */

static int
SetReadOnlyAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    Tcl_StatBuf statBuf;
    int result, readonly;
    const char *native;

    if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) {
	return TCL_ERROR;
    }

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }

    if (readonly) {
	statBuf.st_flags |= UF_IMMUTABLE;
    } else {
	statBuf.st_flags &= ~UF_IMMUTABLE;
    }

    native = Tcl_FSGetNativePath(fileName);
    result = chflags(native, statBuf.st_flags);		/* INTL: Native. */
    if (result != 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "could not set flags for file \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}
#endif /* defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */