summaryrefslogtreecommitdiffstats
path: root/unix
diff options
context:
space:
mode:
authorrjohnson <rjohnson>1998-03-26 14:56:55 (GMT)
committerrjohnson <rjohnson>1998-03-26 14:56:55 (GMT)
commit72d823b9193f9ee2b0318563b49363cd08c11f24 (patch)
treec168cc164a71f320db9dcdfe7518ba7bd0d2c8d9 /unix
parent2b5738da524e944cda39e24c0a87b745a43bd8c3 (diff)
downloadtcl-72d823b9193f9ee2b0318563b49363cd08c11f24.zip
tcl-72d823b9193f9ee2b0318563b49363cd08c11f24.tar.gz
tcl-72d823b9193f9ee2b0318563b49363cd08c11f24.tar.bz2
Initial revision
Diffstat (limited to 'unix')
-rw-r--r--unix/Makefile.in1014
-rw-r--r--unix/README110
-rw-r--r--unix/configure.in1232
-rw-r--r--unix/dltest/Makefile.in45
-rw-r--r--unix/dltest/README12
-rw-r--r--unix/dltest/configure.in29
-rw-r--r--unix/dltest/pkga.c130
-rw-r--r--unix/dltest/pkgb.c153
-rw-r--r--unix/dltest/pkgc.c153
-rw-r--r--unix/dltest/pkgd.c154
-rw-r--r--unix/dltest/pkge.c49
-rw-r--r--unix/dltest/pkgf.c49
-rwxr-xr-xunix/install-sh119
-rwxr-xr-xunix/ldAix72
-rw-r--r--unix/mkLinks1010
-rw-r--r--unix/porting.notes412
-rw-r--r--unix/porting.old384
-rw-r--r--unix/tclAppInit.c136
-rw-r--r--unix/tclConfig.sh.in116
-rw-r--r--unix/tclLoadAix.c549
-rw-r--r--unix/tclLoadAout.c470
-rw-r--r--unix/tclLoadDl.c135
-rw-r--r--unix/tclLoadDld.c125
-rw-r--r--unix/tclLoadNext.c111
-rw-r--r--unix/tclLoadOSF.c128
-rw-r--r--unix/tclLoadShl.c129
-rw-r--r--unix/tclMtherr.c86
-rw-r--r--unix/tclUnixChan.c2565
-rw-r--r--unix/tclUnixEvent.c76
-rw-r--r--unix/tclUnixFCmd.c1224
-rw-r--r--unix/tclUnixFile.c528
-rw-r--r--unix/tclUnixInit.c317
-rw-r--r--unix/tclUnixNotfy.c518
-rw-r--r--unix/tclUnixPipe.c1149
-rw-r--r--unix/tclUnixPort.h480
-rw-r--r--unix/tclUnixSock.c100
-rw-r--r--unix/tclUnixTest.c431
-rw-r--r--unix/tclUnixTime.c236
-rw-r--r--unix/tclXtTest.c113
39 files changed, 14849 insertions, 0 deletions
diff --git a/unix/Makefile.in b/unix/Makefile.in
new file mode 100644
index 0000000..6b15ff5
--- /dev/null
+++ b/unix/Makefile.in
@@ -0,0 +1,1014 @@
+#
+# This file is a Makefile for Tcl. If it has the name "Makefile.in"
+# then it is a template for a Makefile; to generate the actual Makefile,
+# run "./configure", which is a configuration script generated by the
+# "autoconf" program (constructs like "@foo@" will get replaced in the
+# actual Makefile.
+#
+# SCCS: @(#) Makefile.in 1.190 97/11/05 10:57:38
+
+# Current Tcl version; used in various names.
+
+VERSION = @TCL_VERSION@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+# The following definition can be set to non-null for special systems
+# like AFS with replication. It allows the pathnames used for installation
+# to be different than those used for actually reference files at
+# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
+# when installing files.
+INSTALL_ROOT =
+
+# Directory from which applications will reference the library of Tcl
+# scripts (note: you can set the TCL_LIBRARY environment variable at
+# run-time to override this value):
+TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION)
+
+# Package search path.
+TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@
+
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
+
+# Directory in which to install libtcl.so or libtcl.a:
+LIB_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/lib
+
+# Path to use at runtime to refer to LIB_INSTALL_DIR:
+LIB_RUNTIME_DIR = $(exec_prefix)/lib
+
+# Directory in which to install the program tclsh:
+BIN_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/bin
+
+# Directory in which to install the include file tcl.h:
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/include
+
+# Top-level directory in which to install manual entries:
+MAN_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/man
+
+# Directory in which to install manual entry for tclsh:
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+
+# Directory in which to install manual entries for Tcl's C library
+# procedures:
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tcl commands:
+MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+CFLAGS = -O
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# Mathematical functions like sin and atan2 are enabled for expressions
+# by default. To disable them, reverse the comment characters on the
+# following pairs of lines:
+MATH_FLAGS =
+#MATH_FLAGS = -DTCL_NO_MATH
+MATH_LIBS = @MATH_LIBS@
+#MATH_LIBS =
+
+# If you use the setenv, putenv, or unsetenv procedures to modify
+# environment variables in your application and you'd like those
+# modifications to appear in the "env" Tcl variable, switch the
+# comments on the two lines below so that Tcl provides these
+# procedures instead of your standard C library.
+
+ENV_FLAGS =
+#ENV_FLAGS = -DTclSetEnv=setenv -DTcl_PutEnv=putenv -DTclUnsetEnv=unsetenv
+
+# To compile for non-UNIX systems (so that only the non-UNIX-specific
+# commands are available), reverse the comment characters on the
+# following pairs of lines. In addition, you'll have to provide your
+# own replacement for the "panic" procedure (see panic.c for what
+# the current one does).
+GENERIC_FLAGS =
+#GENERIC_FLAGS = -DTCL_GENERIC_ONLY
+UNIX_OBJS = tclMtherr.o tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
+ tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
+ tclUnixTime.o tclUnixInit.o
+#UNIX_OBJS =
+NOTIFY_OBJS = tclUnixNotfy.o
+#NOTIFY_OBJS =
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# To enable compilation debugging reverse the comment characters on
+# one of the following lines.
+COMPILE_DEBUG_FLAGS =
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_STATS
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+
+# Tcl used to let the configure script choose which program to use
+# for installing, but there are just too many different versions of
+# "install" around; better to use the install-sh script that comes
+# with the distribution, which is slower but guaranteed to work.
+
+INSTALL = @srcdir@/install-sh -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+
+# The following symbol defines additional compiler flags to enable
+# Tcl itself to be a shared library. If Tcl isn't going to be a
+# shared library then the symbol has an empty definition.
+
+TCL_SHLIB_CFLAGS = @TCL_SHLIB_CFLAGS@
+#TCL_SHLIB_CFLAGS =
+
+# The symbols below provide support for dynamic loading and shared
+# libraries. See configure.in for a description of what the
+# symbols mean. The values of the symbols are normally set by the
+# configure script. You shouldn't normally need to modify any of
+# these definitions by hand.
+
+SHLIB_LD = @SHLIB_LD@
+
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+#SHLIB_SUFFIX =
+
+DLTEST_TARGETS = dltest/pkg5${SHLIB_SUFFIX} dltest/Makefile
+
+# The following symbol is defined to "$(DLTEST_TARGETS)" if dynamic
+# loading is available; this causes everything in the "dltest"
+# subdirectory to be built when making "tcltest. If dynamic loading
+# isn't available, configure defines this symbol to an empty string,
+# in which case the shared libraries aren't built.
+BUILD_DLTEST = @BUILD_DLTEST@
+#BUILD_DLTEST =
+
+TCL_LIB_FILE = @TCL_LIB_FILE@
+#TCL_LIB_FILE = libtcl.a
+
+#----------------------------------------------------------------
+# The information below is modified by the configure script when
+# Makefile is generated from Makefile.in. You shouldn't normally
+# modify any of this stuff by hand.
+#----------------------------------------------------------------
+
+COMPAT_OBJS = @LIBOBJS@
+
+AC_FLAGS = @DEFS@
+RANLIB = @RANLIB@
+SRC_DIR = @srcdir@
+TOP_DIR = @srcdir@/..
+GENERIC_DIR = $(TOP_DIR)/generic
+COMPAT_DIR = $(TOP_DIR)/compat
+TOOL_DIR = $(TOP_DIR)/tools
+DLTEST_DIR = @srcdir@/dltest
+UNIX_DIR = @srcdir@
+CC = @CC@
+
+#----------------------------------------------------------------
+# The information below should be usable as is. The configure
+# script won't modify it and you shouldn't need to modify it
+# either.
+#----------------------------------------------------------------
+
+
+CC_SWITCHES = ${CFLAGS} ${TCL_SHLIB_CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \
+${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
+${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
+
+LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS) -lc
+
+DEPEND_SWITCHES = ${CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \
+${AC_FLAGS} ${MATH_FLAGS} \
+${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
+-DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
+
+TCLSH_OBJS = tclAppInit.o
+
+TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclUnixTest.o
+
+XTTEST_OBJS = tclTest.o tclTestObj.o tclUnixTest.o tclXtNotify.o \
+ tclXtTest.o xtTestInit.o
+
+GENERIC_OBJS = panic.o regexp.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
+ tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclCompExpr.o \
+ tclCompile.o tclDate.o tclEnv.o tclEvent.o tclExecute.o \
+ tclFCmd.o tclFileName.o tclGet.o tclHash.o tclHistory.o \
+ tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o tclIOSock.o \
+ tclIOUtil.o tclLink.o tclListObj.o tclLoad.o tclMain.o tclNamesp.o \
+ tclNotify.o tclObj.o tclParse.o tclPipe.o tclPkg.o tclPosixStr.o \
+ tclPreserve.o tclProc.o tclStringObj.o tclTimer.o tclUtil.o tclVar.o
+
+OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} @DL_OBJS@
+
+GENERIC_HDRS = \
+ $(GENERIC_DIR)/tclRegexp.h \
+ $(GENERIC_DIR)/tcl.h \
+ $(GENERIC_DIR)/tclInt.h \
+ $(GENERIC_DIR)/tclPort.h \
+ $(GENERIC_DIR)/tclPatch.h
+
+GENERIC_SRCS = \
+ $(GENERIC_DIR)/regexp.c \
+ $(GENERIC_DIR)/tclAsync.c \
+ $(GENERIC_DIR)/tclBasic.c \
+ $(GENERIC_DIR)/tclBinary.c \
+ $(GENERIC_DIR)/tclCkalloc.c \
+ $(GENERIC_DIR)/tclClock.c \
+ $(GENERIC_DIR)/tclCmdAH.c \
+ $(GENERIC_DIR)/tclCmdIL.c \
+ $(GENERIC_DIR)/tclCmdMZ.c \
+ $(GENERIC_DIR)/tclCompExpr.c \
+ $(GENERIC_DIR)/tclCompile.c \
+ $(GENERIC_DIR)/tclDate.c \
+ $(GENERIC_DIR)/tclEnv.c \
+ $(GENERIC_DIR)/tclEvent.c \
+ $(GENERIC_DIR)/tclExecute.c \
+ $(GENERIC_DIR)/tclFCmd.c \
+ $(GENERIC_DIR)/tclFileName.c \
+ $(GENERIC_DIR)/tclGet.c \
+ $(GENERIC_DIR)/tclHash.c \
+ $(GENERIC_DIR)/tclHistory.c \
+ $(GENERIC_DIR)/tclIndexObj.c \
+ $(GENERIC_DIR)/tclInterp.c \
+ $(GENERIC_DIR)/tclIO.c \
+ $(GENERIC_DIR)/tclIOCmd.c \
+ $(GENERIC_DIR)/tclIOSock.c \
+ $(GENERIC_DIR)/tclIOUtil.c \
+ $(GENERIC_DIR)/tclLink.c \
+ $(GENERIC_DIR)/tclListObj.c \
+ $(GENERIC_DIR)/tclLoad.c \
+ $(GENERIC_DIR)/tclMain.c \
+ $(GENERIC_DIR)/tclNamesp.c \
+ $(GENERIC_DIR)/tclNotify.c \
+ $(GENERIC_DIR)/tclObj.c \
+ $(GENERIC_DIR)/tclParse.c \
+ $(GENERIC_DIR)/tclPipe.c \
+ $(GENERIC_DIR)/tclPkg.c \
+ $(GENERIC_DIR)/tclPosixStr.c \
+ $(GENERIC_DIR)/tclPreserve.c \
+ $(GENERIC_DIR)/tclProc.c \
+ $(GENERIC_DIR)/tclStringObj.c \
+ $(GENERIC_DIR)/tclTest.c \
+ $(GENERIC_DIR)/tclTestObj.c \
+ $(GENERIC_DIR)/tclTimer.c \
+ $(GENERIC_DIR)/tclUtil.c \
+ $(GENERIC_DIR)/tclVar.c
+
+UNIX_HDRS = \
+ $(UNIX_DIR)/tclUnixPort.h
+
+UNIX_SRCS = \
+ $(UNIX_DIR)/tclAppInit.c \
+ $(UNIX_DIR)/tclMtherr.c \
+ $(UNIX_DIR)/tclUnixChan.c \
+ $(UNIX_DIR)/tclUnixEvent.c \
+ $(UNIX_DIR)/tclUnixFCmd.c \
+ $(UNIX_DIR)/tclUnixFile.c \
+ $(UNIX_DIR)/tclUnixNotfy.c \
+ $(UNIX_DIR)/tclUnixPipe.c \
+ $(UNIX_DIR)/tclUnixSock.c \
+ $(UNIX_DIR)/tclUnixTest.c \
+ $(UNIX_DIR)/tclUnixTime.c \
+ $(UNIX_DIR)/tclUnixInit.c
+
+DL_SRCS = \
+ $(UNIX_DIR)/tclLoadAix.c \
+ $(UNIX_DIR)/tclLoadAout.c \
+ $(UNIX_DIR)/tclLoadDl.c \
+ $(UNIX_DIR)/tclLoadDl2.c \
+ $(UNIX_DIR)/tclLoadDld.c \
+ $(GENERIC_DIR)/tclLoadNone.c \
+ $(UNIX_DIR)/tclLoadOSF.c \
+ $(UNIX_DIR)/tclLoadShl.c
+
+# Note: don't include DL_SRCS in SRCS: most of those files won't
+# compile on the current machine, and they will cause problems for
+# things like "make depend".
+
+SRCS = $(GENERIC_SRCS) $(UNIX_SRCS)
+
+all: ${TCL_LIB_FILE} tclsh
+
+# The following target is configured by autoconf to generate either
+# a shared library or non-shared library for Tcl.
+${TCL_LIB_FILE}: ${OBJS}
+ rm -f ${TCL_LIB_FILE}
+ @MAKE_LIB@
+ $(RANLIB) ${TCL_LIB_FILE}
+
+# Make target which outputs the list of the .o contained in the Tcl lib
+# usefull to build a single big shared library containing Tcl and other
+# extensions. used for the Tcl Plugin. -- dl
+# The dependency on OBJS is not there because we just want the list
+# of objects here, not actually building them
+tclLibObjs:
+ @echo ${OBJS}
+# This targets actually build the objects needed for the lib in the above
+# case
+objs: ${OBJS}
+
+
+tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE}
+ ${CC} @LD_FLAGS@ ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+ @TCL_LD_SEARCH_FLAGS@ -o tclsh
+
+tcltest: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST}
+ ${CC} @LD_FLAGS@ ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+ @TCL_LD_SEARCH_FLAGS@ -o tcltest
+
+xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
+ @DL_OBJS@ ${BUILD_DLTEST}
+ ${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
+ @DL_OBJS@ @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+ @TCL_LD_SEARCH_FLAGS@ -lXt -o xttest
+
+
+# Note, in the target below TCL_LIBRARY needs to be set or else
+# "make test" won't work in the case where the compilation directory
+# isn't the same as the source directory.
+
+test: tcltest
+ LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
+ TCL_LIBRARY=${TOP_DIR}/library; export TCL_LIBRARY; \
+ ( echo cd $(TOP_DIR)/tests\; source all ) | ./tcltest
+
+# Useful target to launch a built tcltest with the proper path,...
+runtest:
+ LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
+ TCL_LIBRARY=${TOP_DIR}/library; export TCL_LIBRARY; \
+ ./tcltest
+
+# The following target outputs the name of the top-level source directory
+# for Tcl (it is used by Tk's configure script, for example). The
+# .NO_PARALLEL line is needed to avoid problems under Sun's "pmake".
+# Note: this target is now obsolete (use the autoconf variable
+# TCL_SRC_DIR from tclConfig.sh instead).
+
+.NO_PARALLEL: topDirName
+topDirName:
+ @cd $(TOP_DIR); pwd
+
+# The following target generates the file generic/tclDate.c
+# from the yacc grammar found in generic/tclGetDate.y. This is
+# only run by hand as yacc is not available in all environments.
+# The name of the .c file is different than the name of the .y file
+# so that make doesn't try to automatically regenerate the .c file.
+
+gendate:
+ yacc -l $(GENERIC_DIR)/tclGetDate.y
+ sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
+ -e 's/SCCSID/%Z\% %M\% %I\% %E\% %U\%/g' \
+ -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
+ -e '/TclDatenewstate:/d' -e '/#pragma/d' \
+ <y.tab.c >$(GENERIC_DIR)/tclDate.c
+ rm y.tab.c
+
+# The following targets generate the shared libraries in dltest that
+# are used for testing; they are included as part of the "tcltest"
+# target (via the BUILD_DLTEST variable) if dynamic loading is supported
+# on this platform. The ".." environment variable stuff is needed
+# because on some platforms tclsh scripts will be executed as part of
+# building the shared libraries, and they need to be able to use the
+# uninstalled tclsh that is present in this directory. The "make tclsh"
+# command is needed for the same reason (must make sure that it exists).
+
+dltest/pkg5${SHLIB_SUFFIX}: dltest/Makefile
+ if test ! -f tclsh; then $(MAKE) tclsh; else true; fi
+ cd dltest; PATH=..:${PATH} TCL_LIBRARY=../../library $(MAKE)
+
+dltest/Makefile: $(DLTEST_DIR)/configure $(DLTEST_DIR)/Makefile.in tclConfig.sh
+ if test ! -d dltest; then mkdir dltest; else true; fi
+ cd dltest; if test -f configure; then ./configure; else \
+ $(DLTEST_DIR)/configure; fi
+
+install: install-binaries install-libraries install-man
+
+# Note: before running ranlib below, must cd to target directory because
+# some ranlibs write to current directory, and this might not always be
+# possible (e.g. if installing as root).
+
+install-binaries: $(TCL_LIB_FILE) tclsh
+ @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TCL_LIB_FILE)"
+ @$(INSTALL_DATA) $(TCL_LIB_FILE) $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE)
+ @(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TCL_LIB_FILE))
+ @chmod 555 $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE)
+ @echo "Installing tclsh"
+ @$(INSTALL_PROGRAM) tclsh $(BIN_INSTALL_DIR)/tclsh$(VERSION)
+ @echo "Installing tclConfig.sh"
+ @$(INSTALL_DATA) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
+
+install-libraries:
+ @for i in $(INSTALL_ROOT)$(prefix)/lib $(INCLUDE_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR); \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in http2.0 http1.0 opt0.1; \
+ do \
+ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
+ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
+ mkdir $(SCRIPT_INSTALL_DIR)/$$i; \
+ chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing tcl.h"
+ @$(INSTALL_DATA) $(GENERIC_DIR)/tcl.h $(INCLUDE_INSTALL_DIR)/tcl.h
+ @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+ @for i in http2.0 http1.0 opt0.1; \
+ do \
+ for j in $(TOP_DIR)/library/$$i/*.tcl ; \
+ do \
+ echo "Installing $$j"; \
+ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
+ done; \
+ done;
+
+install-man:
+ @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) $(MANN_INSTALL_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @cd $(TOP_DIR)/doc; for i in *.1; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MAN1_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MAN1_INSTALL_DIR)/$$i; \
+ chmod 444 $(MAN1_INSTALL_DIR)/$$i; \
+ done;
+ $(UNIX_DIR)/mkLinks $(MAN1_INSTALL_DIR)
+ @cd $(TOP_DIR)/doc; for i in *.3; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MAN3_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MAN3_INSTALL_DIR)/$$i; \
+ chmod 444 $(MAN3_INSTALL_DIR)/$$i; \
+ done;
+ $(UNIX_DIR)/mkLinks $(MAN3_INSTALL_DIR)
+ @cd $(TOP_DIR)/doc; for i in *.n; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MANN_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MANN_INSTALL_DIR)/$$i; \
+ chmod 444 $(MANN_INSTALL_DIR)/$$i; \
+ done;
+ $(UNIX_DIR)/mkLinks $(MANN_INSTALL_DIR)
+
+Makefile: $(UNIX_DIR)/Makefile.in
+ $(SHELL) config.status
+
+clean:
+ rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
+ errors tclsh tcltest lib.exp
+ if test -f dltest/Makefile; then cd dltest; $(MAKE) clean; fi
+
+distclean: clean
+ rm -rf Makefile config.status config.cache config.log tclConfig.sh \
+ SUNWtcl.* prototype
+ if test -f dltest/Makefile; then cd dltest; $(MAKE) distclean; fi
+
+depend:
+ makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)
+
+bp: $(UNIX_DIR)/bp.c
+ $(CC) $(CC_SWITCHES) $(UNIX_DIR)/bp.c -o bp
+
+# Test binaries. The rules for tclTestInit.o and xtTestInit.o are
+# complicated because they are compiled from tclAppInit.c. Can't use
+# the "-o" option because this doesn't work on some strange compilers
+# (e.g. UnixWare).
+
+tclTestInit.o: $(UNIX_DIR)/tclAppInit.c
+ @if test -f tclAppInit.o ; then \
+ rm -f tclAppInit.sav; \
+ mv tclAppInit.o tclAppInit.sav; \
+ fi;
+ $(CC) -c $(CC_SWITCHES) -DTCL_TEST $(UNIX_DIR)/tclAppInit.c
+ rm -f tclTestInit.o
+ mv tclAppInit.o tclTestInit.o
+ @if test -f tclAppInit.sav ; then \
+ mv tclAppInit.sav tclAppInit.o; \
+ fi;
+
+xtTestInit.o: $(UNIX_DIR)/tclAppInit.c
+ @if test -f tclAppInit.o ; then \
+ rm -f tclAppInit.sav; \
+ mv tclAppInit.o tclAppInit.sav; \
+ fi;
+ $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DTCL_XT_TEST \
+ $(UNIX_DIR)/tclAppInit.c
+ rm -f xtTestInit.o
+ mv tclAppInit.o xtTestInit.o
+ @if test -f tclAppInit.sav ; then \
+ mv tclAppInit.sav tclAppInit.o; \
+ fi;
+
+# Object files used on all Unix systems:
+
+panic.o: $(GENERIC_DIR)/panic.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/panic.c
+
+regexp.o: $(GENERIC_DIR)/regexp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regexp.c
+
+tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
+
+tclAsync.o: $(GENERIC_DIR)/tclAsync.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c
+
+tclBasic.o: $(GENERIC_DIR)/tclBasic.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBasic.c
+
+tclBinary.o: $(GENERIC_DIR)/tclBinary.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBinary.c
+
+tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c
+
+tclClock.o: $(GENERIC_DIR)/tclClock.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c
+
+tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c
+
+tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c
+
+tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdMZ.c
+
+tclDate.o: $(GENERIC_DIR)/tclDate.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDate.c
+
+tclCompExpr.o: $(GENERIC_DIR)/tclCompExpr.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompExpr.c
+
+tclCompile.o: $(GENERIC_DIR)/tclCompile.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompile.c
+
+tclEnv.o: $(GENERIC_DIR)/tclEnv.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c
+
+tclEvent.o: $(GENERIC_DIR)/tclEvent.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c
+
+tclExecute.o: $(GENERIC_DIR)/tclExecute.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.c
+
+tclFCmd.o: $(GENERIC_DIR)/tclFCmd.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFCmd.c
+
+tclFileName.o: $(GENERIC_DIR)/tclFileName.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFileName.c
+
+tclGet.o: $(GENERIC_DIR)/tclGet.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclGet.c
+
+tclHash.o: $(GENERIC_DIR)/tclHash.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHash.c
+
+tclHistory.o: $(GENERIC_DIR)/tclHistory.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclHistory.c
+
+tclIndexObj.o: $(GENERIC_DIR)/tclIndexObj.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIndexObj.c
+
+tclInterp.o: $(GENERIC_DIR)/tclInterp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclInterp.c
+
+tclIO.o: $(GENERIC_DIR)/tclIO.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIO.c
+
+tclIOCmd.o: $(GENERIC_DIR)/tclIOCmd.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOCmd.c
+
+tclIOSock.o: $(GENERIC_DIR)/tclIOSock.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOSock.c
+
+tclIOUtil.o: $(GENERIC_DIR)/tclIOUtil.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOUtil.c
+
+tclLink.o: $(GENERIC_DIR)/tclLink.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLink.c
+
+tclListObj.o: $(GENERIC_DIR)/tclListObj.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclListObj.c
+
+tclObj.o: $(GENERIC_DIR)/tclObj.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c
+
+tclLoad.o: $(GENERIC_DIR)/tclLoad.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoad.c
+
+tclLoadAix.o: $(UNIX_DIR)/tclLoadAix.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadAix.c
+
+tclLoadAout.o: $(UNIX_DIR)/tclLoadAout.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadAout.c
+
+tclLoadDl.o: $(UNIX_DIR)/tclLoadDl.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl.c
+
+tclLoadDl2.o: $(UNIX_DIR)/tclLoadDl2.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDl2.c
+
+tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c
+
+tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoadNone.c
+
+tclLoadOSF.o: $(UNIX_DIR)/tclLoadOSF.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadOSF.c
+
+tclLoadShl.o: $(UNIX_DIR)/tclLoadShl.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadShl.c
+
+tclMain.o: $(GENERIC_DIR)/tclMain.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclMain.c
+
+tclMtherr.o: $(UNIX_DIR)/tclMtherr.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclMtherr.c
+
+tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c
+
+tclNotify.o: $(GENERIC_DIR)/tclNotify.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c
+
+tclParse.o: $(GENERIC_DIR)/tclParse.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c
+
+tclPipe.o: $(GENERIC_DIR)/tclPipe.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPipe.c
+
+tclPkg.o: $(GENERIC_DIR)/tclPkg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPkg.c
+
+tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c
+
+tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c
+
+tclProc.o: $(GENERIC_DIR)/tclProc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c
+
+tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c
+
+tclUtil.o: $(GENERIC_DIR)/tclUtil.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
+
+tclVar.o: $(GENERIC_DIR)/tclVar.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c
+
+tclTest.o: $(GENERIC_DIR)/tclTest.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
+
+tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c
+
+tclTimer.o: $(GENERIC_DIR)/tclTimer.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTimer.c
+
+tclUnixChan.o: $(UNIX_DIR)/tclUnixChan.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixChan.c
+
+tclUnixEvent.o: $(UNIX_DIR)/tclUnixEvent.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixEvent.c
+
+tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFCmd.c
+
+tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c
+
+tclUnixNotfy.o: $(UNIX_DIR)/tclUnixNotfy.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixNotfy.c
+
+tclUnixPipe.o: $(UNIX_DIR)/tclUnixPipe.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixPipe.c
+
+tclUnixSock.o: $(UNIX_DIR)/tclUnixSock.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixSock.c
+
+tclUnixTest.o: $(UNIX_DIR)/tclUnixTest.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTest.c
+
+tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c
+
+tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
+ $(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \
+ -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \
+ $(UNIX_DIR)/tclUnixInit.c
+
+# compat binaries
+
+fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c
+
+getcwd.o: $(COMPAT_DIR)/getcwd.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/getcwd.c
+
+opendir.o: $(COMPAT_DIR)/opendir.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/opendir.c
+
+strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c
+
+strstr.o: $(COMPAT_DIR)/strstr.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strstr.c
+
+strtod.o: $(COMPAT_DIR)/strtod.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtod.c
+
+strtol.o: $(COMPAT_DIR)/strtol.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtol.c
+
+strtoul.o: $(COMPAT_DIR)/strtoul.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtoul.c
+
+tmpnam.o: $(COMPAT_DIR)/tmpnam.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/tmpnam.c
+
+waitpid.o: $(COMPAT_DIR)/waitpid.c
+ $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/waitpid.c
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+#
+# Target to check for proper usage of UCHAR macro.
+#
+
+checkuchar:
+ -egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR
+
+#
+# Target to make sure that only symbols with "Tcl" prefixes are
+# exported.
+#
+
+checkexports: $(TCL_LIB_FILE)
+ -nm -p $(TCL_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]cl'
+
+#
+# Target to create a proper Tcl distribution from information in the
+# master source directory. DISTDIR must be defined to indicate where
+# to put the distribution.
+#
+
+DISTNAME = tcl@TCL_VERSION@@TCL_PATCH_LEVEL@
+ZIPNAME = tcl@TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@@TCL_PATCH_LEVEL@.zip
+DISTDIR = /proj/tcl/dist/$(DISTNAME)
+$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in
+ autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure
+dist: $(UNIX_DIR)/configure
+ rm -rf $(DISTDIR)
+ mkdir $(DISTDIR)
+ mkdir $(DISTDIR)/unix
+ cp -p $(UNIX_DIR)/*.c $(UNIX_DIR)/*.h $(DISTDIR)/unix
+ rm -f $(DISTDIR)/unix/bp.c $(DISTDIR)/unix/tclXtNotify.c
+ cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
+ chmod 664 $(DISTDIR)/unix/Makefile.in
+ cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \
+ $(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
+ $(UNIX_DIR)/porting.notes $(UNIX_DIR)/porting.old \
+ $(UNIX_DIR)/README $(UNIX_DIR)/ldAix \
+ $(DISTDIR)/unix
+ chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
+ chmod 775 $(DISTDIR)/unix/ldAix
+ chmod +x $(DISTDIR)/unix/install-sh
+ tclsh $(UNIX_DIR)/mkLinks.tcl \
+ $(UNIX_DIR)/../doc/*.[13n] > $(DISTDIR)/unix/mkLinks
+ chmod +x $(DISTDIR)/unix/mkLinks
+ mkdir $(DISTDIR)/generic
+ cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(DISTDIR)/generic
+ cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
+ cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
+ cp -p $(TOP_DIR)/changes $(TOP_DIR)/README $(TOP_DIR)/license.terms \
+ $(DISTDIR)
+ mkdir $(DISTDIR)/library
+ cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
+ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library
+ for i in http2.0 http1.0 opt0.1; \
+ do \
+ mkdir $(DISTDIR)/library/$$i ;\
+ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
+ done;
+ mkdir $(DISTDIR)/doc
+ cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
+ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
+ mkdir $(DISTDIR)/compat
+ cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/compat/*.c \
+ $(TOP_DIR)/compat/*.h $(TOP_DIR)/compat/README \
+ $(DISTDIR)/compat
+ mkdir $(DISTDIR)/tests
+ cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests
+ cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
+ $(TOP_DIR)/tests/all $(TOP_DIR)/tests/remote.tcl \
+ $(TOP_DIR)/tests/defs $(DISTDIR)/tests
+ mkdir $(DISTDIR)/win
+ cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(TOP_DIR)/win/*.rc \
+ $(DISTDIR)/win
+ cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
+ cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
+ cp -p $(TOP_DIR)/win/pkgIndex.tcl $(DISTDIR)/win
+ cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
+ mkdir $(DISTDIR)/mac
+ sccs edit -s $(TOP_DIR)/mac/tclMacProjects.sit.hqx
+ cp -p tclMacProjects.sit.hqx $(DISTDIR)/mac
+ sccs unedit $(TOP_DIR)/mac/tclMacProjects.sit.hqx
+ rm -f tclMacProjects.sit.hqx
+ cp -p $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
+ $(DISTDIR)/mac
+ cp -p $(TOP_DIR)/mac/porting.notes $(TOP_DIR)/mac/README $(DISTDIR)/mac
+ cp -p $(TOP_DIR)/mac/*.exp $(TOP_DIR)/mac/*.pch $(DISTDIR)/mac
+ cp -p $(TOP_DIR)/mac/*.doc $(DISTDIR)/mac
+ cp -p $(TOP_DIR)/mac/*.html $(DISTDIR)/mac
+ cp -p $(TOP_DIR)/license.terms $(DISTDIR)/mac
+ mkdir $(DISTDIR)/unix/dltest
+ cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \
+ $(DISTDIR)/unix/dltest
+ cp -p $(UNIX_DIR)/dltest/configure.in $(UNIX_DIR)/dltest/configure \
+ $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest
+
+#
+# The following target can only be used for non-patch releases. Use
+# the "allpatch" target below for patch releases.
+#
+
+alldist: dist
+ rm -f /proj/tcl/dist/$(DISTNAME).tar.Z \
+ /proj/tcl/dist/$(DISTNAME).tar.gz \
+ /proj/tcl/dist/$(ZIPNAME)
+ cd /proj/tcl/dist; tar cf $(DISTNAME).tar $(DISTNAME); \
+ gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
+ compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) $(DISTNAME)
+
+#
+# The target below is similar to "alldist" except it works for patch
+# releases. It is needed because patch releases are peculiar: the
+# patch designation appears in the name of the compressed file
+# (e.g. tcl8.0p1.tar.gz) but the extracted source directory doesn't
+# include the patch designation (e.g. tcl8.0).
+#
+
+allpatch: dist
+ rm -f /proj/tcl/dist/$(DISTNAME).tar.Z \
+ /proj/tcl/dist/$(DISTNAME).tar.gz \
+ /proj/tcl/dist/$(ZIPNAME)
+ mv /proj/tcl/dist/tcl${VERSION} /proj/tcl/dist/old
+ mv /proj/tcl/dist/$(DISTNAME) /proj/tcl/dist/tcl${VERSION}
+ cd /proj/tcl/dist; tar cf $(DISTNAME).tar tcl${VERSION}; \
+ gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
+ compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) tcl${VERSION}
+ mv /proj/tcl/dist/tcl${VERSION} /proj/tcl/dist/$(DISTNAME)
+ mv /proj/tcl/dist/old /proj/tcl/dist/tcl${VERSION}
+
+#
+# Target to create a Macintosh version of the distribution. This will
+# do a normal distribution and then massage the output to prepare it
+# for moving to the Mac platform. This requires a few scripts and
+# programs found only in the Tcl group's tool workspace.
+#
+
+macdist: dist
+ rm -f $(DISTDIR)/mac/tclMacProjects.sit.hqx
+ tclsh $(TOOL_DIR)/man2html.tcl $(DISTDIR)/tmp ../.. tcl$(VERSION)
+ mv $(DISTDIR)/tmp/tcl$(VERSION) $(DISTDIR)/html
+ rm -rf $(DISTDIR)/doc
+ rm -rf $(DISTDIR)/tmp
+ tclsh $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)
+
+#
+# Targets to build Solaris package of the distribution for the current
+# architecture. To build stream packages for both sun4 and i86pc
+# architectures:
+#
+# On the sun4 machine, execute the following:
+# make distclean; ./configure
+# make DISTDIR=<distdir> package
+#
+# Once the build is complete, execute the following on the i86pc
+# machine:
+# make DISTDIR=<distdir> package-quick
+#
+# <distdir> is the absolute path to a directory where the build should
+# take place. These steps will generate the SUNWtcl.sun4 and
+# SUNWtcl.i86pc stream packages. It is important that the packages be
+# built in this fashion in order to ensure that the architecture
+# independent files are exactly the same, including timestamps, in
+# both packages.
+#
+
+package: dist package-config package-common package-binaries package-generate
+package-quick: package-config package-binaries package-generate
+
+#
+# Configure for the current architecture in the dist directory.
+#
+package-config:
+ mkdir -p $(DISTDIR)/unix/`arch`
+ cd $(DISTDIR)/unix/`arch`; \
+ ../configure --prefix=/opt/SUNWtcl/$(VERSION) \
+ --exec_prefix=/opt/SUNWtcl/$(VERSION)/`arch` \
+ --enable-shared
+ mkdir -p $(DISTDIR)/SUNWtcl/$(VERSION)
+ mkdir -p $(DISTDIR)/SUNWtcl/$(VERSION)/`arch`
+
+#
+# Build and install the architecture independent files in the dist directory.
+#
+
+package-common:
+ cd $(DISTDIR)/unix/`arch`;\
+ $(MAKE); \
+ $(MAKE) prefix=$(DISTDIR)/SUNWtcl/$(VERSION) \
+ exec_prefix=$(DISTDIR)/SUNWtcl/$(VERSION)/`arch` \
+ install-libraries install-man
+ mkdir -p $(DISTDIR)/SUNWtcl/$(VERSION)/bin
+ sed -e "s/TCLVERSION/$(VERSION)/g" < $(UNIX_DIR)/tclsh.sh \
+ > $(DISTDIR)/SUNWtcl/$(VERSION)/bin/tclsh$(VERSION)
+ chmod 755 $(DISTDIR)/SUNWtcl/$(VERSION)/bin/tclsh$(VERSION)
+
+#
+# Build and install the architecture specific files in the dist directory.
+#
+
+package-binaries:
+ cd $(DISTDIR)/unix/`arch`; \
+ $(MAKE); \
+ $(MAKE) install-binaries prefix=$(DISTDIR)/SUNWtcl/$(VERSION) \
+ exec_prefix=$(DISTDIR)/SUNWtcl/$(VERSION)/`arch`
+
+#
+# Generate a package from the installed files in the dist directory for the
+# current architecture.
+#
+
+package-generate:
+ pkgproto $(DISTDIR)/SUNWtcl/$(VERSION)/bin=bin \
+ $(DISTDIR)/SUNWtcl/$(VERSION)/include=include \
+ $(DISTDIR)/SUNWtcl/$(VERSION)/lib=lib \
+ $(DISTDIR)/SUNWtcl/$(VERSION)/man=man \
+ $(DISTDIR)/SUNWtcl/$(VERSION)/`arch`=`arch` \
+ | tclsh $(UNIX_DIR)/mkProto.tcl \
+ $(VERSION) $(UNIX_DIR) > prototype
+ pkgmk -o -d . -f prototype -a `arch`
+ pkgtrans -s . SUNWtcl.`arch` SUNWtcl
+ rm -rf SUNWtcl
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/unix/README b/unix/README
new file mode 100644
index 0000000..96c79c1
--- /dev/null
+++ b/unix/README
@@ -0,0 +1,110 @@
+This is the directory where you configure, compile, test, and install
+UNIX versions of Tcl. This directory also contains source files for Tcl
+that are specific to UNIX. Some of the files in this directory are
+used on the PC or Mac platform too, but they all depend on UNIX
+(POSIX/ANSI C) interfaces and some of them only make sense under UNIX.
+
+The rest of this file contains instructions on how to do this. The
+release should compile and run either "out of the box" or with trivial
+changes on any UNIX-like system that approximates POSIX, BSD, or System
+V. We know that it runs on workstations from Sun, H-P, DEC, IBM, and
+SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for
+a PC running Windows, see the README file in the directory ../win. To
+compile for a Macintosh, see the README file in the directory ../mac.
+
+SCCS: @(#) README 1.15 96/12/19 14:02:23
+
+How To Compile And Install Tcl:
+-------------------------------
+
+(a) Check for patches as described in ../README.
+
+(b) If you have already compiled Tcl once in this directory and are now
+ preparing to compile again in the same directory but for a different
+ platform, or if you have applied patches, type "make distclean" to
+ discard all the configuration information computed previously.
+
+(c) Type "./configure". This runs a configuration script created by GNU
+ autoconf, which configures Tcl for your system and creates a
+ Makefile. The configure script allows you to customize the Tcl
+ configuration for your site; for details on how you can do this,
+ type "./configure -help" or refer to the autoconf documentation (not
+ included here). Tcl's "configure" supports the following special
+ switches in addition to the standard ones:
+ --enable-gcc If this switch is set, Tcl will configure
+ itself to use gcc if it is available on your
+ system. Note: it is not safe to modify the
+ Makefile to use gcc after configure is run;
+ if you do this, then information related to
+ dynamic linking will be incorrect.
+ --disable-load If this switch is specified then Tcl will
+ configure itself not to allow dynamic loading,
+ even if your system appears to support it.
+ Normally you can leave this switch out and
+ Tcl will build itself for dynamic loading
+ if your system supports it.
+ --enable-shared If this switch is specified, Tcl will compile
+ itself as a shared library if it can figure
+ out how to do that on this platform.
+ Note: be sure to use only absolute path names (those starting with "/")
+ in the --prefix and --exec_prefix options.
+
+(d) Type "make". This will create a library archive called "libtcl.a"
+ or "libtcl.so" and an interpreter application called "tclsh" that
+ allows you to type Tcl commands interactively or execute script files.
+
+(e) If the make fails then you'll have to personalize the Makefile
+ for your site or possibly modify the distribution in other ways.
+ First check the file "porting.notes" to see if there are hints
+ for compiling on your system. Then look at the porting Web page
+ described later in this file. If you need to modify Makefile, there
+ are comments at the beginning of it that describe the things you
+ might want to change and how to change them.
+
+(f) Type "make install" to install Tcl binaries and script files in
+ standard places. You'll need write permission on the installation
+ directories to do this. The installation directories are
+ determined by the "configure" script and may be specified with
+ the --prefix and --exec_prefix options to "configure". See the
+ Makefile for information on what directories were chosen; you
+ can override these choices by modifying the "prefix" and
+ "exec_prefix" variables in the Makefile.
+
+(g) At this point you can play with Tcl by invoking the "tclsh"
+ program and typing Tcl commands. However, if you haven't installed
+ Tcl then you'll first need to set your TCL_LIBRARY variable to
+ hold the full path name of the "library" subdirectory. Note that
+ the installed versions of tclsh, libtcl.a, and libtcl.so have a
+ version number in their names, such as "tclsh8.0" or "libtcl8.0.so";
+ to use the installed versions, either specify the version number
+ or create a symbolic link (e.g. from "tclsh" to "tclsh8.0").
+
+If you have trouble compiling Tcl, read through the file" porting.notes".
+It contains information that people have provided about changes they had
+to make to compile Tcl in various environments. Or, check out the
+following Web URL:
+ http://www.sunlabs.com/cgi-bin/tcl/info.8.0
+This is an on-line database of porting information. We make no guarantees
+that this information is accurate, complete, or up-to-date, but you may
+find it useful. If you get Tcl running on a new configuration, we would
+be happy to receive new information to add to "porting.notes". You can
+also make a new entry into the on-line Web database. We're also interested
+in hearing how to change the configuration setup so that Tcl compiles out
+of the box on more platforms.
+
+Test suite
+----------
+
+There is a relatively complete test suite for all of the Tcl core in
+the subdirectory "tests". To use it just type "make test" in this
+directory. You should then see a printout of the test files processed.
+If any errors occur, you'll see a much more substantial printout for
+each error. See the README file in the "tests" directory for more
+information on the test suite. Note: don't run the tests as superuser:
+this will cause several of them to fail.
+
+The Tcl test suite is very sensitive to proper implementation of
+ANSI C library procedures such as sprintf and sscanf. If the test
+suite generates errors, most likely they are due to non-conformance
+of your system's ANSI C library; such problems are unlikely to
+affect any real applications so it's probably safe to ignore them.
diff --git a/unix/configure.in b/unix/configure.in
new file mode 100644
index 0000000..ee36dc4
--- /dev/null
+++ b/unix/configure.in
@@ -0,0 +1,1232 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run during Tcl installation
+dnl to configure the system for the local environment.
+AC_INIT(../generic/tcl.h)
+# SCCS: @(#) configure.in 1.144 97/11/20 12:39:44
+
+TCL_VERSION=8.0
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=0
+TCL_PATCH_LEVEL="p2"
+VERSION=${TCL_VERSION}
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+TCL_SRC_DIR=`cd $srcdir/..; pwd`
+
+AC_PROG_RANLIB
+AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+ [tcl_ok=$enableval], [tcl_ok=no])
+if test "$tcl_ok" = "yes"; then
+ AC_PROG_CC
+else
+ CC=${CC-cc}
+AC_SUBST(CC)
+fi
+AC_C_CROSS
+
+#--------------------------------------------------------------------
+# Supply substitutes for missing POSIX library procedures, or
+# set flags so Tcl uses alternate procedures.
+#--------------------------------------------------------------------
+
+# Check if Posix compliant getcwd exists, if not we'll use getwd.
+AC_CHECK_FUNCS(getcwd, , AC_DEFINE(USEGETWD))
+# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
+# define USEGETWD even if the posix getcwd exists. Add a test ?
+
+AC_REPLACE_FUNCS(opendir strstr)
+
+AC_REPLACE_FUNCS(strtol tmpnam waitpid)
+AC_CHECK_FUNC(strerror, , AC_DEFINE(NO_STRERROR))
+AC_CHECK_FUNC(getwd, , AC_DEFINE(NO_GETWD))
+AC_CHECK_FUNC(wait3, , AC_DEFINE(NO_WAIT3))
+AC_CHECK_FUNC(uname, , AC_DEFINE(NO_UNAME))
+
+#--------------------------------------------------------------------
+# On a few very rare systems, all of the libm.a stuff is
+# already in libc.a. Set compiler flags accordingly.
+# Also, Linux requires the "ieee" library for math to work
+# right (and it must appear before "-lm").
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
+AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
+
+#--------------------------------------------------------------------
+# On AIX systems, libbsd.a has to be linked in to support
+# non-blocking file IO. This library has to be linked in after
+# the MATH_LIBS or it breaks the pow() function. The way to
+# insure proper sequencing, is to add it to the tail of MATH_LIBS.
+# This library also supplies gettimeofday.
+#--------------------------------------------------------------------
+libbsd=no
+if test "`uname -s`" = "AIX" ; then
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ if test $libbsd = yes; then
+ MATH_LIBS="$MATH_LIBS -lbsd"
+ fi
+fi
+
+#--------------------------------------------------------------------
+# Supply substitutes for missing POSIX header files. Special
+# notes:
+# - stdlib.h doesn't define strtol, strtoul, or
+# strtod insome versions of SunOS
+# - some versions of string.h don't declare procedures such
+# as strstr
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING(dirent.h)
+AC_TRY_LINK([#include <sys/types.h>
+#include <dirent.h>], [
+#ifndef _POSIX_SOURCE
+# ifdef __Lynx__
+ /*
+ * Generate compilation error to make the test fail: Lynx headers
+ * are only valid if really in the POSIX environment.
+ */
+
+ missing_procedure();
+# endif
+#endif
+DIR *d;
+struct dirent *entryPtr;
+char *p;
+d = opendir("foobar");
+entryPtr = readdir(d);
+p = entryPtr->d_name;
+closedir(d);
+], tcl_ok=yes, tcl_ok=no)
+if test $tcl_ok = no; then
+ AC_DEFINE(NO_DIRENT_H)
+fi
+AC_MSG_RESULT($tcl_ok)
+AC_CHECK_HEADER(errno.h, , AC_DEFINE(NO_ERRNO_H))
+AC_CHECK_HEADER(float.h, , AC_DEFINE(NO_FLOAT_H))
+AC_CHECK_HEADER(values.h, , AC_DEFINE(NO_VALUES_H))
+AC_CHECK_HEADER(limits.h, , AC_DEFINE(NO_LIMITS_H))
+AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
+AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
+AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
+AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0)
+if test $tcl_ok = 0; then
+ AC_DEFINE(NO_STDLIB_H)
+fi
+AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
+AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
+AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)
+if test $tcl_ok = 0; then
+ AC_DEFINE(NO_STRING_H)
+fi
+AC_CHECK_HEADER(sys/wait.h, , AC_DEFINE(NO_SYS_WAIT_H))
+AC_CHECK_HEADER(dlfcn.h, , AC_DEFINE(NO_DLFCN_H))
+AC_HAVE_HEADERS(unistd.h)
+
+#---------------------------------------------------------------------------
+# Determine which interface to use to talk to the serial port.
+# Note that #include lines must begin in leftmost column for
+# some compilers to recognize them as preprocessor directives.
+#---------------------------------------------------------------------------
+
+AC_MSG_CHECKING([termios vs. termio vs. sgtty])
+AC_TRY_RUN([
+#include <termios.h>
+
+main()
+{
+ struct termios t;
+ if (tcgetattr(0, &t) == 0) {
+ cfsetospeed(&t, 0);
+ t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+}], tk_ok=termios, tk_ok=no, tk_ok=no)
+if test $tk_ok = termios; then
+ AC_DEFINE(USE_TERMIOS)
+else
+AC_TRY_RUN([
+#include <termio.h>
+
+main()
+{
+ struct termio t;
+ if (ioctl(0, TCGETA, &t) == 0) {
+ t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+}], tk_ok=termio, tk_ok=no, tk_ok=no)
+if test $tk_ok = termio; then
+ AC_DEFINE(USE_TERMIO)
+else
+AC_TRY_RUN([
+#include <sgtty.h>
+
+main()
+{
+ struct sgttyb t;
+ if (ioctl(0, TIOCGETP, &t) == 0) {
+ t.sg_ospeed = 0;
+ t.sg_flags |= ODDP | EVENP | RAW;
+ return 0;
+ }
+ return 1;
+}], tk_ok=sgtty, tk_ok=none, tk_ok=none)
+if test $tk_ok = sgtty; then
+ AC_DEFINE(USE_SGTTY)
+fi
+fi
+fi
+AC_MSG_RESULT($tk_ok)
+
+#--------------------------------------------------------------------
+# Include sys/select.h if it exists and if it supplies things
+# that appear to be useful and aren't already in sys/types.h.
+# This appears to be true only on the RS/6000 under AIX. Some
+# systems like OSF/1 have a sys/select.h that's of no use, and
+# other systems like SCO UNIX have a sys/select.h that's
+# pernicious. If "fd_set" isn't defined anywhere then set a
+# special flag.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([fd_set and sys/select])
+AC_TRY_COMPILE([#include <sys/types.h>],
+ [fd_set readMask, writeMask;], tk_ok=yes, tk_ok=no)
+if test $tk_ok = no; then
+ AC_HEADER_EGREP(fd_mask, sys/select.h, tk_ok=yes)
+ if test $tk_ok = yes; then
+ AC_DEFINE(HAVE_SYS_SELECT_H)
+ fi
+fi
+AC_MSG_RESULT($tk_ok)
+if test $tk_ok = no; then
+ AC_DEFINE(NO_FD_SET)
+fi
+
+#------------------------------------------------------------------------------
+# Find out all about time handling differences.
+#------------------------------------------------------------------------------
+
+AC_CHECK_HEADERS(sys/time.h)
+AC_HEADER_TIME
+AC_STRUCT_TIMEZONE
+
+AC_MSG_CHECKING([tm_tzadj in struct tm])
+AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
+ [AC_DEFINE(HAVE_TM_TZADJ)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+AC_MSG_CHECKING([tm_gmtoff in struct tm])
+AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
+ [AC_DEFINE(HAVE_TM_GMTOFF)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+#
+# Its important to include time.h in this check, as some systems (like convex)
+# have timezone functions, etc.
+#
+have_timezone=no
+AC_MSG_CHECKING([long timezone variable])
+AC_TRY_COMPILE([#include <time.h>],
+ [extern long timezone;
+ timezone += 1;
+ exit (0);],
+ [have_timezone=yes
+ AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+#
+# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+#
+if test "$have_timezone" = no; then
+ AC_MSG_CHECKING([time_t timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern time_t timezone;
+ timezone += 1;
+ exit (0);],
+ [AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+fi
+
+#
+# AIX does not have a timezone field in struct tm. When the AIX bsd
+# library is used, the timezone global and the gettimeofday methods are
+# to be avoided for timezone deduction instead, we deduce the timezone
+# by comparing the localtime result on a known GMT value.
+#
+if test $libbsd = yes; then
+ AC_DEFINE(USE_DELTA_FOR_TZ)
+fi
+
+#--------------------------------------------------------------------
+# Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
+# in struct stat.
+#--------------------------------------------------------------------
+AC_STRUCT_ST_BLKSIZE
+
+#--------------------------------------------------------------------
+# On some systems strstr is broken: it returns a pointer even
+# even if the original string is empty.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([proper strstr implementation])
+AC_TRY_RUN([
+extern int strstr();
+int main()
+{
+ exit(strstr("\0test", "test") ? 1 : 0);
+}
+], tcl_ok=yes, tcl_ok=no, tcl_ok=no)
+if test $tcl_ok = yes; then
+ AC_MSG_RESULT(yes)
+else
+ AC_MSG_RESULT([broken, using substitute])
+ LIBOBJS="$LIBOBJS strstr.o"
+fi
+
+#--------------------------------------------------------------------
+# Check for strtoul function. This is tricky because under some
+# versions of AIX strtoul returns an incorrect terminator
+# pointer for the string "0".
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strtoul, tcl_ok=1, tcl_ok=0)
+AC_TRY_RUN([
+extern int strtoul();
+int main()
+{
+ char *string = "0";
+ char *term;
+ int value;
+ value = strtoul(string, &term, 0);
+ if ((value != 0) || (term != (string+1))) {
+ exit(1);
+ }
+ exit(0);
+}], , tcl_ok=0, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+ test -n "$verbose" && echo " Adding strtoul.o."
+ LIBOBJS="$LIBOBJS strtoul.o"
+fi
+
+#--------------------------------------------------------------------
+# Check for the strtod function. This is tricky because in some
+# versions of Linux strtod mis-parses strings starting with "+".
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strtod, tcl_ok=1, tcl_ok=0)
+AC_TRY_RUN([
+extern double strtod();
+int main()
+{
+ char *string = " +69";
+ char *term;
+ double value;
+ value = strtod(string, &term);
+ if ((value != 69) || (term != (string+4))) {
+ exit(1);
+ }
+ exit(0);
+}], , tcl_ok=0, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+ test -n "$verbose" && echo " Adding strtod.o."
+ LIBOBJS="$LIBOBJS strtod.o"
+fi
+
+#--------------------------------------------------------------------
+# Under Solaris 2.4, strtod returns the wrong value for the
+# terminating character under some conditions. Check for this
+# and if the problem exists use a substitute procedure
+# "fixstrtod" that corrects the error.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
+if test "$tcl_strtod" = 1; then
+ AC_MSG_CHECKING([for Solaris strtod bug])
+ AC_TRY_RUN([
+extern double strtod();
+int main()
+{
+ char *string = "NaN";
+ char *term;
+ strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ exit(0);
+}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
+ if test $tcl_ok = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT(buggy)
+ LIBOBJS="$LIBOBJS fixstrtod.o"
+ AC_DEFINE(strtod, fixstrtod)
+ fi
+fi
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+AC_TYPE_MODE_T
+AC_TYPE_PID_T
+AC_TYPE_SIZE_T
+AC_TYPE_UID_T
+
+#--------------------------------------------------------------------
+# If a system doesn't have an opendir function (man, that's old!)
+# then we have to supply a different version of dirent.h which
+# is compatible with the substitute version of opendir that's
+# provided. This version only works with V7-style directories.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(opendir, , AC_DEFINE(USE_DIRENT2_H))
+
+#--------------------------------------------------------------------
+# The check below checks whether <sys/wait.h> defines the type
+# "union wait" correctly. It's needed because of weirdness in
+# HP-UX where "union wait" is defined in both the BSD and SYS-V
+# environments. Checking the usability of WIFEXITED seems to do
+# the trick.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([union wait])
+AC_TRY_LINK([#include <sys/types.h>
+#include <sys/wait.h>], [
+union wait x;
+WIFEXITED(x); /* Generates compiler error if WIFEXITED
+ * uses an int. */
+], tcl_ok=yes, tcl_ok=no)
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = no; then
+ AC_DEFINE(NO_UNION_WAIT)
+fi
+
+#--------------------------------------------------------------------
+# Check to see whether the system supports the matherr function
+# and its associated type "struct exception".
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([matherr support])
+AC_TRY_COMPILE([#include <math.h>], [
+struct exception x;
+x.type = DOMAIN;
+x.type = SING;
+], tcl_ok=yes, tcl_ok=no)
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = yes; then
+ AC_DEFINE(NEED_MATHERR)
+fi
+
+#--------------------------------------------------------------------
+# Check to see whether the system provides a vfork kernel call.
+# If not, then use fork instead. Also, check for a problem with
+# vforks and signals that can cause core dumps if a vforked child
+# resets a signal handler. If the problem exists, then use fork
+# instead of vfork.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(vfork, tcl_ok=1, tcl_ok=0)
+if test "$tcl_ok" = 1; then
+ AC_MSG_CHECKING([vfork/signal bug]);
+ AC_TRY_RUN([
+#include <stdio.h>
+#include <signal.h>
+#include <sys/wait.h>
+int gotSignal = 0;
+sigProc(sig)
+ int sig;
+{
+ gotSignal = 1;
+}
+main()
+{
+ int pid, sts;
+ (void) signal(SIGCHLD, sigProc);
+ pid = vfork();
+ if (pid < 0) {
+ exit(1);
+ } else if (pid == 0) {
+ (void) signal(SIGCHLD, SIG_DFL);
+ _exit(0);
+ } else {
+ (void) wait(&sts);
+ }
+ exit((gotSignal) ? 0 : 1);
+}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
+ if test "$tcl_ok" = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT([buggy, using fork instead])
+ fi
+fi
+rm -f core
+if test "$tcl_ok" = 0; then
+ AC_DEFINE(vfork, fork)
+fi
+
+#--------------------------------------------------------------------
+# Check whether there is an strncasecmp function on this system.
+# This is a bit tricky because under SCO it's in -lsocket and
+# under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strncasecmp, tcl_ok=1, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(socket, strncasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(inet, strncasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ LIBOBJS="$LIBOBJS strncasecmp.o"
+fi
+
+#--------------------------------------------------------------------
+# The code below deals with several issues related to gettimeofday:
+# 1. Some systems don't provide a gettimeofday function at all
+# (set NO_GETTOD if this is the case).
+# 2. SGI systems don't use the BSD form of the gettimeofday function,
+# but they have a BSDgettimeofday function that can be used instead.
+# 3. See if gettimeofday is declared in the <sys/time.h> header file.
+# if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
+# declare it.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(BSDgettimeofday, AC_DEFINE(HAVE_BSDGETTIMEOFDAY),
+ AC_CHECK_FUNC(gettimeofday, , AC_DEFINE(NO_GETTOD)))
+AC_MSG_CHECKING([for gettimeofday declaration])
+AC_EGREP_HEADER(gettimeofday, sys/time.h, AC_MSG_RESULT(present), [
+ AC_MSG_RESULT(missing)
+ AC_DEFINE(GETTOD_NOT_DECLARED)
+])
+
+#--------------------------------------------------------------------
+# Interactive UNIX requires -linet instead of -lsocket, plus it
+# needs net/errno.h to define the socket-related error codes.
+#--------------------------------------------------------------------
+
+AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
+AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H))
+
+#--------------------------------------------------------------------
+# The following code checks to see whether it is possible to get
+# signed chars on this platform. This is needed in order to
+# properly generate sign-extended ints from character values.
+#--------------------------------------------------------------------
+
+AC_C_CHAR_UNSIGNED
+AC_MSG_CHECKING([signed char declarations])
+AC_TRY_COMPILE(, [
+signed char *p;
+p = 0;
+], tcl_ok=yes, tcl_ok=no)
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = yes; then
+ AC_DEFINE(HAVE_SIGNED_CHAR)
+fi
+
+#--------------------------------------------------------------------
+# Check for the existence of the -lsocket and -lnsl libraries.
+# The order here is important, so that they end up in the right
+# order in the command line generated by make. Here are some
+# special considerations:
+# 1. Use "connect" and "accept" to check for -lsocket, and
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+tcl_checkBoth=0
+AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+if test "$tcl_checkSocket" = 1; then
+ AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", tcl_checkBoth=1)
+fi
+if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs])
+fi
+AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# dynamic loading and shared libraries:
+#
+# DL_OBJS - Name of the object file that implements dynamic
+# loading for Tcl on this system.
+# DL_LIBS - Library file(s) to include in tclsh and other base
+# applications in order for the "load" command to work.
+# LD_FLAGS - Flags to pass to the compiler when linking object
+# files into an executable application binary such
+# as tclsh.
+# LD_SEARCH_FLAGS-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. Depends on
+# the variable LIB_RUNTIME_DIR in the Makefile.
+# MAKE_LIB - Command to execute to build the Tcl library;
+# differs depending on whether or not Tcl is being
+# compiled as a shared library.
+# SHLIB_CFLAGS - Flags to pass to cc when compiling the components
+# of a shared library (may request position-independent
+# code, among other things).
+# SHLIB_LD - Base command to use for combining object files
+# into a shared library.
+# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
+# creating shared libraries. This symbol typically
+# goes at the end of the "ld" commands that build
+# shared libraries. The value of the symbol is
+# "${LIBS}" if all of the dependent libraries should
+# be specified when creating a shared library. If
+# dependent libraries should not be specified (as on
+# SunOS 4.x, where they cause the link to fail, or in
+# general if Tcl and Tk aren't themselves shared
+# libraries), then this symbol has an empty string
+# as its value.
+# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable
+# extensions. An empty string means we don't know how
+# to use shared libraries on this platform.
+# TCL_LIB_FILE - Name of the file that contains the Tcl library, such
+# as libtcl7.8.so or libtcl7.8.a.
+# TCL_LIB_SUFFIX -Specifies everything that comes after the "libtcl"
+# in the shared library name, using the $VERSION variable
+# to put the version in the right place. This is used
+# by platforms that need non-standard library names.
+# Examples: ${VERSION}.so.1.1 on NetBSD, since it needs
+# to have a version after the .so, and ${VERSION}.a
+# on AIX, since the Tcl shared library needs to have
+# a .a extension whereas shared objects for loadable
+# extensions have a .so extension. Defaults to
+# ${VERSION}${SHLIB_SUFFIX}.
+#--------------------------------------------------------------------
+
+# Step 1: set the variable "system" to hold the name and version number
+# for the system. This can usually be done via the "uname" command, but
+# there are a few systems, like Next, where this doesn't work.
+
+AC_MSG_CHECKING([system version (for dynamic loading)])
+if test -f /usr/lib/NextStep/software_version; then
+ system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+else
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ AC_MSG_RESULT([unknown (can't find uname command)])
+ system=unknown
+ else
+ # Special check for weird MP-RAS system (uname returns weird
+ # results, and the version is kept in special file).
+
+ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+ system=MP-RAS-`awk '{print $3}' /etc/.relid'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
+ AC_MSG_RESULT($system)
+ fi
+fi
+
+# Step 2: check for existence of -ldl library. This is needed because
+# Linux can use either -ldl or -ldld for dynamic loading.
+
+AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
+
+# Step 3: set configuration options based on system name and version.
+
+fullSrcDir=`cd $srcdir; pwd`
+TCL_SHARED_LIB_SUFFIX=""
+TCL_UNSHARED_LIB_SUFFIX=""
+TCL_LIB_VERSIONS_OK=ok
+case $system in
+ AIX-4.[[2-9]])
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ AIX=yes
+ TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+ ;;
+ AIX-*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o tclLoadAix.o"
+ DL_LIBS="-lld"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+ ;;
+ BSD/OS-2.1*|BSD/OS-3*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="shlicc -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ dgux*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
+ AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no)
+ if test "$tcl_ok" = yes; then
+ SHLIB_CFLAGS="+z"
+ SHLIB_LD="ld -b"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".sl"
+ DL_OBJS="tclLoadShl.o"
+ DL_LIBS="-ldld"
+ LD_FLAGS="-Wl,-E"
+ LD_SEARCH_FLAGS='-Wl,+b,${LIB_RUNTIME_DIR}:.'
+ fi
+ ;;
+ IRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LD_FLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+ ;;
+ IRIX-5.*|IRIX-6.*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -shared -rdata_shared"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ ;;
+ IRIX64-6.*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -32 -shared -rdata_shared -rpath /usr/local/lib"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ ;;
+ Linux*)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ if test "$have_dl" = yes; then
+ SHLIB_LD="${CC} -shared"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS="-rdynamic"
+ LD_SEARCH_FLAGS=""
+ else
+ AC_CHECK_HEADER(dld.h, [
+ SHLIB_LD="ld -shared"
+ DL_OBJS="tclLoadDld.o"
+ DL_LIBS="-ldld"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""])
+ fi
+ ;;
+ MP-RAS-02*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ MP-RAS-*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS="-Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ NetBSD-*|FreeBSD-*|OpenBSD-*)
+ # Not available on all versions: check for include file.
+ AC_CHECK_HEADER(dlfcn.h, [
+ SHLIB_CFLAGS="-fpic"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
+ ], [
+ SHLIB_CFLAGS=""
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+ ])
+
+ # FreeBSD doesn't handle version numbers with dots.
+
+ TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ NEXTSTEP-*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="cc -nostdlib -r"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadNext.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-1.0|OSF1-1.1|OSF1-1.2)
+ # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
+ SHLIB_CFLAGS=""
+ # Hack: make package name same as library name
+ SHLIB_LD='ld -R -export $@:'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadOSF.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-1.*)
+ # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+ SHLIB_CFLAGS="-fpic"
+ SHLIB_LD="ld -shared"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-V*)
+ # Digital OSF/1
+ SHLIB_CFLAGS=""
+ SHLIB_LD='ld -shared -expect_unresolved "*"'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ ;;
+ RISCos-*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LD_FLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ ;;
+ SCO_SV-3.2*)
+ # Note, dlopen is available only on SCO 3.2.5 and greater. However,
+ # this test works, since "uname -s" was non-standard in 3.2.4 and
+ # below.
+ SHLIB_CFLAGS="-Kpic -belf"
+ SHLIB_LD="ld -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_FLAGS="-belf -Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ SINIX*5.4*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ SunOS-4*)
+ SHLIB_CFLAGS="-PIC"
+ SHLIB_LD="ld"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+
+ # SunOS can't handle version numbers with dots in them in library
+ # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
+ # requires an extra version number at the end of .so file names.
+ # So, the library has to have a name like libtcl75.so.1.0
+
+ TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
+ TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ SunOS-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ ;;
+ ULTRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LD_FLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ ;;
+ UNIX_SV*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
+ # that don't grok the -Bexport option. Test that it does.
+ hold_ldflags=$LDFLAGS
+ AC_MSG_CHECKING(for ld accepts -Bexport flag)
+ LDFLAGS="${LDFLAGS} -Wl,-Bexport"
+ AC_TRY_LINK(, [int i;], found=yes, found=no)
+ LDFLAGS=$hold_ldflags
+ AC_MSG_RESULT($found)
+ if test $found = yes; then
+ LD_FLAGS="-Wl,-Bexport"
+ else
+ LD_FLAGS=""
+ fi
+ LD_SEARCH_FLAGS=""
+ ;;
+esac
+
+# Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic
+# Loading for Tcl -- What Became of It?". Proc. 2nd Tcl/Tk Workshop,
+# New Orleans, LA, Computerized Processes Unlimited, 1994), then we need
+# to determine which of several header files defines the a.out file
+# format (a.out.h, sys/exec.h, or sys/exec_aout.h). At present, we
+# support only a file format that is more or less version-7-compatible.
+# In particular,
+# - a.out files must begin with `struct exec'.
+# - the N_TXTOFF on the `struct exec' must compute the seek address
+# of the text segment
+# - The `struct exec' must contain a_magic, a_text, a_data, a_bss
+# and a_entry fields.
+# The following compilation should succeed if and only if either sys/exec.h
+# or a.out.h is usable for the purpose.
+#
+# Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
+# `struct exec' includes a second header that contains information that
+# duplicates the v7 fields that are needed.
+
+if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
+ AC_MSG_CHECKING(sys/exec.h)
+ AC_TRY_COMPILE([#include <sys/exec.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_magic == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_SYS_EXEC_H)
+ else
+ AC_MSG_CHECKING(a.out.h)
+ AC_TRY_COMPILE([#include <a.out.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_magic == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ ], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_A_OUT_H)
+ else
+ AC_MSG_CHECKING(sys/exec_aout.h)
+ AC_TRY_COMPILE([#include <sys/exec_aout.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_midmag == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ ], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_SYS_EXEC_AOUT_H)
+ else
+ DL_OBJS=""
+ fi
+ fi
+ fi
+fi
+
+# Step 5: disable dynamic loading if requested via a command-line switch.
+
+AC_ARG_ENABLE(load, [ --disable-load disallow dynamic loading and "load" command],
+ [tcl_ok=$enableval], [tcl_ok=yes])
+if test "$tcl_ok" = "no"; then
+ DL_OBJS=""
+fi
+
+if test "x$DL_OBJS" != "x" ; then
+ BUILD_DLTEST="\$(DLTEST_TARGETS)"
+else
+ echo "Can't figure out how to do dynamic loading or shared libraries"
+ echo "on this system."
+ SHLIB_CFLAGS=""
+ SHLIB_LD=""
+ SHLIB_SUFFIX=""
+ DL_OBJS="tclLoadNone.o"
+ DL_LIBS=""
+ LD_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ BUILD_DLTEST=""
+fi
+
+# If we're running gcc, then change the C flags for compiling shared
+# libraries to the right flags for gcc, instead of those for the
+# standard manufacturer compiler.
+
+if test "$DL_OBJS" != "tclLoadNone.o" ; then
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ case $system in
+ AIX-*)
+ ;;
+ BSD/OS*)
+ ;;
+ IRIX*)
+ ;;
+ NetBSD-*|FreeBSD-*|OpenBSD-*)
+ ;;
+ RISCos-*)
+ ;;
+ ULTRIX-4.*)
+ ;;
+ *)
+ SHLIB_CFLAGS="-fPIC"
+ ;;
+ esac
+ fi
+fi
+
+#--------------------------------------------------------------------
+# The statements below check for systems where POSIX-style
+# non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented.
+# On these systems (mostly older ones), use the old BSD-style
+# FIONBIO approach instead.
+#--------------------------------------------------------------------
+
+AC_CHECK_HEADERS(sys/ioctl.h)
+AC_CHECK_HEADERS(sys/filio.h)
+AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O])
+if test -f /usr/lib/NextStep/software_version; then
+ system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+else
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ system=unknown
+ else
+ # Special check for weird MP-RAS system (uname returns weird
+ # results, and the version is kept in special file).
+
+ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+ system=MP-RAS-`awk '{print $3}' /etc/.relid'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
+ fi
+fi
+case $system in
+ # There used to be code here to use FIONBIO under AIX. However, it
+ # was reported that FIONBIO doesn't work under AIX 3.2.5. Since
+ # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO
+ # code (JO, 5/31/97).
+
+ OSF*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ SunOS-4*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ ULTRIX-4.*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ *)
+ AC_MSG_RESULT(O_NONBLOCK)
+ ;;
+esac
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libtcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+realRanlib=$RANLIB
+if test "$TCL_SHARED_LIB_SUFFIX" = "" ; then
+ TCL_SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
+fi
+if test "$TCL_UNSHARED_LIB_SUFFIX" = "" ; then
+ TCL_UNSHARED_LIB_SUFFIX='${VERSION}.a'
+fi
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build libtcl as a shared library],
+ [tcl_ok=$enableval], [tcl_ok=no])
+if test "$tcl_ok" = "yes" -a "${SHLIB_SUFFIX}" != "" ; then
+ TCL_SHARED_BUILD=1
+ TCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
+ eval "TCL_LIB_FILE=libtcl${TCL_SHARED_LIB_SUFFIX}"
+ if test "x$DL_OBJS" = "xtclLoadAout.o"; then
+ MAKE_LIB="ar cr ${TCL_LIB_FILE} \${OBJS}"
+ else
+ MAKE_LIB="\${SHLIB_LD} -o ${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+ RANLIB=":"
+ fi
+else
+ TCL_SHARED_BUILD=0
+ case $system in
+ BSD/OS*)
+ ;;
+
+ AIX-*)
+ ;;
+
+ *)
+ SHLIB_LD_LIBS=""
+ ;;
+ esac
+ TCL_SHLIB_CFLAGS=""
+ TCL_LD_SEARCH_FLAGS=""
+ eval "TCL_LIB_FILE=libtcl${TCL_UNSHARED_LIB_SUFFIX}"
+ MAKE_LIB="ar cr ${TCL_LIB_FILE} \${OBJS}"
+fi
+
+# Note: in the following variable, it's important to use the absolute
+# path name of the Tcl directory rather than "..": this is because
+# AIX remembers this path and will attempt to use it at run-time to look
+# up the Tcl library.
+
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl${VERSION}"
+ TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl${VERSION}"
+else
+ TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
+ TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
+fi
+
+#--------------------------------------------------------------------
+# The statements below define the symbol TCL_PACKAGE_PATH, which
+# gives a list of directories that may contain packages. The list
+# consists of one directory for machine-dependent binaries and
+# another for platform-independent scripts.
+#--------------------------------------------------------------------
+
+if test "$prefix" != "$exec_prefix"; then
+ TCL_PACKAGE_PATH="${exec_prefix}/lib ${prefix}/lib"
+else
+ TCL_PACKAGE_PATH="${prefix}/lib"
+fi
+
+AC_SUBST(BUILD_DLTEST)
+AC_SUBST(DL_LIBS)
+AC_SUBST(DL_OBJS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(MAKE_LIB)
+AC_SUBST(MATH_LIBS)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LD_SEARCH_FLAGS)
+AC_SUBST(TCL_LIB_FILE)
+AC_SUBST(TCL_LIB_SPEC)
+AC_SUBST(TCL_LIB_VERSIONS_OK)
+AC_SUBST(TCL_MAJOR_VERSION)
+AC_SUBST(TCL_MINOR_VERSION)
+AC_SUBST(TCL_PACKAGE_PATH)
+AC_SUBST(TCL_PATCH_LEVEL)
+AC_SUBST(TCL_SHARED_LIB_SUFFIX)
+AC_SUBST(TCL_SHARED_BUILD)
+AC_SUBST(TCL_SHLIB_CFLAGS)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
+AC_SUBST(TCL_VERSION)
+
+AC_OUTPUT(Makefile tclConfig.sh)
diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in
new file mode 100644
index 0000000..2197b4b
--- /dev/null
+++ b/unix/dltest/Makefile.in
@@ -0,0 +1,45 @@
+# This Makefile is used to create several test cases for Tcl's load
+# command. It also illustrates how to take advantage of configuration
+# exported by Tcl to set up Makefiles for shared libraries.
+# SCCS: @(#) Makefile.in 1.12 97/02/22 14:13:54
+
+CC = @CC@
+LIBS = @TCL_BUILD_LIB_SPEC@ @TCL_LIBS@ -lc
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+SHLIB_VERSION = @SHLIB_VERSION@
+SRC_DIR = @srcdir@
+TCL_VERSION= @TCL_VERSION@
+
+CFLAGS = -g
+CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
+ ${SHLIB_CFLAGS}
+
+all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX}
+
+pkga${SHLIB_SUFFIX}: $(SRC_DIR)/pkga.c
+ $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c
+ ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o @SHLIB_LD_LIBS@
+
+pkgb${SHLIB_SUFFIX}: $(SRC_DIR)/pkgb.c
+ $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c
+ ${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o @SHLIB_LD_LIBS@
+
+pkgc${SHLIB_SUFFIX}: $(SRC_DIR)/pkgc.c
+ $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c
+ ${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o @SHLIB_LD_LIBS@
+
+pkgd${SHLIB_SUFFIX}: $(SRC_DIR)/pkgd.c
+ $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c
+ ${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o @SHLIB_LD_LIBS@
+
+pkge${SHLIB_SUFFIX}: $(SRC_DIR)/pkge.c
+ $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c
+ ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o @SHLIB_LD_LIBS@
+
+clean:
+ rm -f *.o *${SHLIB_SUFFIX} config.cache config.log config.status lib.exp
+
+distclean: clean
+ rm -f Makefile
diff --git a/unix/dltest/README b/unix/dltest/README
new file mode 100644
index 0000000..f4e54d4
--- /dev/null
+++ b/unix/dltest/README
@@ -0,0 +1,12 @@
+This directory contains several files for testing Tcl's dynamic
+loading capabilities. If this directory is present and the files
+in here have been compiled, then the "load" test will use the shared
+libraries present here to run a series of tests. To compile the
+shared libraries, first type "./configure". This will read
+configuration information created when Tcl was configured and
+create Makefile from Makefile.in. Be sure that you have configured
+Tcl before configuring here, since information learned during Tcl's
+configure is needed here. Then type "make" to create the shared
+libraries.
+
+sccsid: @(#) README 1.2 95/08/22 08:13:23
diff --git a/unix/dltest/configure.in b/unix/dltest/configure.in
new file mode 100644
index 0000000..29924e9
--- /dev/null
+++ b/unix/dltest/configure.in
@@ -0,0 +1,29 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run to configure the
+dnl Makefile in this directory.
+AC_INIT(pkga.c)
+# SCCS: @(#) configure.in 1.9 96/04/15 09:50:20
+
+# Recover information that Tcl computed with its configure script.
+
+. ../tclConfig.sh
+
+CC=$TCL_CC
+AC_SUBST(CC)
+SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
+AC_SUBST(SHLIB_CFLAGS)
+SHLIB_LD=$TCL_SHLIB_LD
+AC_SUBST(SHLIB_LD)
+SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
+AC_SUBST(SHLIB_LD_LIBS)
+SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
+AC_SUBST(SHLIB_SUFFIX)
+SHLIB_VERSION=$TCL_SHLIB_VERSION
+AC_SUBST(SHLIB_VERSION)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+TCL_LIBS=$TCL_LIBS
+AC_SUBST(TCL_LIBS)
+TCL_VERSION=$TCL_VERSION
+AC_SUBST(TCL_VERSION)
+
+AC_OUTPUT(Makefile)
diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c
new file mode 100644
index 0000000..ab48522
--- /dev/null
+++ b/unix/dltest/pkga.c
@@ -0,0 +1,130 @@
+/*
+ * pkga.c --
+ *
+ * This file contains a simple Tcl package "pkga" that is intended
+ * for testing the Tcl dynamic loading facilities.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) pkga.c 1.4 96/02/15 12:30:35
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int Pkga_EqCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int Pkga_QuoteCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkga_EqCmd --
+ *
+ * This procedure is invoked to process the "pkga_eq" Tcl command.
+ * It expects two arguments and returns 1 if they are the same,
+ * 0 if they are different.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkga_EqCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " string1 string2\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[1], argv[2]) == 0) {
+ interp->result = "1";
+ } else {
+ interp->result = "0";
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkga_quoteCmd --
+ *
+ * This procedure is invoked to process the "pkga_quote" Tcl command.
+ * It expects one argument, which it returns as result.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkga_QuoteCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " value\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ strcpy(interp->result, argv[1]);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkga_Init --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkga_Init(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ int code;
+
+ code = Tcl_PkgProvide(interp, "Pkga", "1.0");
+ if (code != TCL_OK) {
+ return code;
+ }
+ Tcl_CreateCommand(interp, "pkga_eq", Pkga_EqCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "pkga_quote", Pkga_QuoteCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c
new file mode 100644
index 0000000..1da9575
--- /dev/null
+++ b/unix/dltest/pkgb.c
@@ -0,0 +1,153 @@
+/*
+ * pkgb.c --
+ *
+ * This file contains a simple Tcl package "pkgb" that is intended
+ * for testing the Tcl dynamic loading facilities. It can be used
+ * in both safe and unsafe interpreters.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) pkgb.c 1.4 96/02/15 12:30:34
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int Pkgb_SubCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int Pkgb_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgb_SubCmd --
+ *
+ * This procedure is invoked to process the "pkgb_sub" Tcl command.
+ * It expects two arguments and returns their difference.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgb_SubCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int first, second;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " num num\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ sprintf(interp->result, "%d", first - second);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgb_UnsafeCmd --
+ *
+ * This procedure is invoked to process the "pkgb_unsafe" Tcl command.
+ * It just returns a constant string.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgb_UnsafeCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ interp->result = "unsafe command invoked";
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgb_Init --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgb_Init(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ int code;
+
+ code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
+ if (code != TCL_OK) {
+ return code;
+ }
+ Tcl_CreateCommand(interp, "pkgb_sub", Pkgb_SubCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "pkgb_unsafe", Pkgb_UnsafeCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgb_SafeInit --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an unsafe interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgb_SafeInit(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ Tcl_CreateCommand(interp, "pkgb_sub", Pkgb_SubCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c
new file mode 100644
index 0000000..c35189a
--- /dev/null
+++ b/unix/dltest/pkgc.c
@@ -0,0 +1,153 @@
+/*
+ * pkgc.c --
+ *
+ * This file contains a simple Tcl package "pkgc" that is intended
+ * for testing the Tcl dynamic loading facilities. It can be used
+ * in both safe and unsafe interpreters.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) pkgc.c 1.4 96/02/15 12:30:35
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int Pkgc_SubCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int Pkgc_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgc_SubCmd --
+ *
+ * This procedure is invoked to process the "pkgc_sub" Tcl command.
+ * It expects two arguments and returns their difference.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgc_SubCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int first, second;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " num num\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ sprintf(interp->result, "%d", first - second);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgc_UnsafeCmd --
+ *
+ * This procedure is invoked to process the "pkgc_unsafe" Tcl command.
+ * It just returns a constant string.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgc_UnsafeCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ interp->result = "unsafe command invoked";
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgc_Init --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgc_Init(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ int code;
+
+ code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
+ if (code != TCL_OK) {
+ return code;
+ }
+ Tcl_CreateCommand(interp, "pkgc_sub", Pkgc_SubCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "pkgc_unsafe", Pkgc_UnsafeCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgc_SafeInit --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an unsafe interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgc_SafeInit(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ Tcl_CreateCommand(interp, "pkgc_sub", Pkgc_SubCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c
new file mode 100644
index 0000000..56821cc
--- /dev/null
+++ b/unix/dltest/pkgd.c
@@ -0,0 +1,154 @@
+/*
+ * pkgd.c --
+ *
+ * This file contains a simple Tcl package "pkgd" that is intended
+ * for testing the Tcl dynamic loading facilities. It can be used
+ * in both safe and unsafe interpreters.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) pkgd.c 1.4 96/02/15 12:30:32
+ */
+
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgd_SubCmd --
+ *
+ * This procedure is invoked to process the "pkgd_sub" Tcl command.
+ * It expects two arguments and returns their difference.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgd_SubCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int first, second;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " num num\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ sprintf(interp->result, "%d", first - second);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgd_UnsafeCmd --
+ *
+ * This procedure is invoked to process the "pkgd_unsafe" Tcl command.
+ * It just returns a constant string.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgd_UnsafeCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ interp->result = "unsafe command invoked";
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgd_Init --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgd_Init(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ int code;
+
+ code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
+ if (code != TCL_OK) {
+ return code;
+ }
+ Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "pkgd_unsafe", Pkgd_UnsafeCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgd_SafeInit --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an unsafe interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgd_SafeInit(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c
new file mode 100644
index 0000000..1d585ca
--- /dev/null
+++ b/unix/dltest/pkge.c
@@ -0,0 +1,49 @@
+/*
+ * pkge.c --
+ *
+ * This file contains a simple Tcl package "pkge" that is intended
+ * for testing the Tcl dynamic loading facilities. Its Init
+ * procedure returns an error in order to test how this is handled.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) pkge.c 1.5 96/03/07 09:34:27
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkge_Init --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ * Returns TCL_ERROR and leaves an error message in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkge_Init(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ return Tcl_Eval(interp, "if 44 {open non_existent}");
+}
diff --git a/unix/dltest/pkgf.c b/unix/dltest/pkgf.c
new file mode 100644
index 0000000..d7c641a
--- /dev/null
+++ b/unix/dltest/pkgf.c
@@ -0,0 +1,49 @@
+/*
+ * pkgf.c --
+ *
+ * This file contains a simple Tcl package "pkgf" that is intended
+ * for testing the Tcl dynamic loading facilities. Its Init
+ * procedure returns an error in order to test how this is handled.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) pkgf.c 1.2 96/02/15 12:30:32
+ */
+#include "tcl.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgf_Init --
+ *
+ * This is a package initialization procedure, which is called
+ * by Tcl when this package is to be added to an interpreter.
+ *
+ * Results:
+ * Returns TCL_ERROR and leaves an error message in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Pkgf_Init(interp)
+ Tcl_Interp *interp; /* Interpreter in which the package is
+ * to be made available. */
+{
+ return Tcl_Eval(interp, "if 44 {open non_existent}");
+}
diff --git a/unix/install-sh b/unix/install-sh
new file mode 100755
index 0000000..0ff4b6a
--- /dev/null
+++ b/unix/install-sh
@@ -0,0 +1,119 @@
+#!/bin/sh
+
+#
+# install - install a program, script, or datafile
+# This comes from X11R5; it is not part of GNU.
+#
+# $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+#
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+
+instcmd="$mvprog"
+chmodcmd=""
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+fi
+
+if [ x"$dst" = x ]
+then
+ echo "install: no destination specified"
+ exit 1
+fi
+
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+if [ -d $dst ]
+then
+ dst="$dst"/`basename $src`
+fi
+
+# Make a temp file name in the proper directory.
+
+dstdir=`dirname $dst`
+dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+$doit $instcmd $src $dsttmp
+
+# and set any options; do chmod last to preserve setuid bits
+
+if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi
+if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi
+if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi
+if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi
+
+# Now rename the file to the real destination.
+
+$doit $rmcmd $dst
+$doit $mvcmd $dsttmp $dst
+
+
+exit 0
diff --git a/unix/ldAix b/unix/ldAix
new file mode 100755
index 0000000..4da2b20
--- /dev/null
+++ b/unix/ldAix
@@ -0,0 +1,72 @@
+#!/bin/sh
+#
+# ldAix ldCmd ldArg ldArg ...
+#
+# This shell script provides a wrapper for ld under AIX in order to
+# create the .exp file required for linking. Its arguments consist
+# of the name and arguments that would normally be provided to the
+# ld command. This script extracts the names of the object files
+# from the argument list, creates a .exp file describing all of the
+# symbols exported by those files, and then invokes "ldCmd" to
+# perform the real link.
+#
+# SCCS: @(#) ldAix 1.8 97/02/21 14:50:27
+
+# Extract from the arguments the names of all of the object files.
+
+args=$*
+ofiles=""
+for i do
+ x=`echo $i | grep '[^.].o$'`
+ if test "$x" != ""; then
+ ofiles="$ofiles $i"
+ fi
+done
+
+# Create the export file from all of the object files, using nm followed
+# by sed editing. Here are some tricky aspects of this:
+#
+# 1. Nm produces different output under AIX 4.1 than under AIX 3.2.5;
+# the following statements handle both versions.
+# 2. Use the -g switch to nm instead of -e under 4.1 (this shows just
+# externals, not statics; -g isn't available under 3.2.5, though).
+# 3. Eliminate lines that end in ":": these are the names of object
+# files (relevant in 4.1 only).
+# 4. Eliminate entries with the "U" key letter; these are undefined
+# symbols (relevant in 4.1 only).
+# 5. Eliminate lines that contain the string "0|extern" preceded by space;
+# in 3.2.5, these are undefined symbols (address 0).
+# 6. Eliminate lines containing the "unamex" symbol. In 3.2.5, these
+# are also undefined symbols.
+# 7. If a line starts with ".", delete the leading ".", since this will
+# just cause confusion later.
+# 8. Eliminate everything after the first field in a line, so that we're
+# left with just the symbol name.
+
+nmopts="-g -C"
+osver=`uname -v`
+if test $osver -eq 3; then
+ nmopts="-e"
+fi
+rm -f lib.exp
+echo "#! " >lib.exp
+/usr/ccs/bin/nm $nmopts -h $ofiles | sed -e '/:$/d' -e '/ U /d' -e '/[ ]0|extern/d' -e '/unamex/d' -e 's/^\.//' -e 's/[ |].*//' | sort | uniq >>lib.exp
+
+# Extract the name of the object file that we're linking. If it's a .a
+# file, then link all the objects together into a single file "shr.o"
+# and then put that into the archive. Otherwise link the object files
+# directly into the .a file.
+
+outputFile=`echo $args | sed -e 's/.*-o \([^ ]*\).*/\1/'`
+noDotA=`echo $outputFile | sed -e '/\.a$/d'`
+echo "noDotA=\"$noDotA\""
+if test "$noDotA" = "" ; then
+ linkArgs=`echo $args | sed -e 's/-o .*\.a /-o shr.o /'`
+ echo $linkArgs
+ eval $linkArgs
+ echo ar cr $outputFile shr.o
+ ar cr $outputFile shr.o
+ rm -f shr.o
+else
+ eval $args
+fi
diff --git a/unix/mkLinks b/unix/mkLinks
new file mode 100644
index 0000000..b4da360
--- /dev/null
+++ b/unix/mkLinks
@@ -0,0 +1,1010 @@
+#!/bin/sh
+# This script is invoked when installing manual entries. It generates
+# additional links to manual entries, corresponding to the procedure
+# and command names described by the manual entry. For example, the
+# Tcl manual entry Hash.3 describes procedures Tcl_InitHashTable,
+# Tcl_CreateHashEntry, and many more. This script will make hard
+# links so that Tcl_InitHashTable.3, Tcl_CreateHashEntry.3, and so
+# on all refer to Hash.3 in the installed directory.
+#
+# Because of the length of command and procedure names, this mechanism
+# only works on machines that support file names longer than 14 characters.
+# This script checks to see if long file names are supported, and it
+# doesn't make any links if they are not.
+#
+# The script takes one argument, which is the name of the directory
+# where the manual entries have been installed.
+
+if test $# != 1; then
+ echo "Usage: mkLinks dir"
+ exit 1
+fi
+
+cd $1
+echo foo > xyzzyTestingAVeryLongFileName.foo
+x=`echo xyzzyTe*`
+rm xyzzyTe*
+if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then
+ exit
+fi
+if test -r safe.n; then
+ rm -f Base.n
+ ln safe.n Base.n
+fi
+if test -r http.n; then
+ rm -f Http.n
+ ln http.n Http.n
+fi
+if test -r safe.n; then
+ rm -f Safe.n
+ ln safe.n Safe.n
+fi
+if test -r StringObj.3; then
+ rm -f TclConcatObj.3
+ ln StringObj.3 TclConcatObj.3
+fi
+if test -r AddErrInfo.3; then
+ rm -f Tcl_AddErrorInfo.3
+ ln AddErrInfo.3 Tcl_AddErrorInfo.3
+fi
+if test -r AddErrInfo.3; then
+ rm -f Tcl_AddObjErrorInfo.3
+ ln AddErrInfo.3 Tcl_AddObjErrorInfo.3
+fi
+if test -r Alloc.3; then
+ rm -f Tcl_Alloc.3
+ ln Alloc.3 Tcl_Alloc.3
+fi
+if test -r AllowExc.3; then
+ rm -f Tcl_AllowExceptions.3
+ ln AllowExc.3 Tcl_AllowExceptions.3
+fi
+if test -r AppInit.3; then
+ rm -f Tcl_AppInit.3
+ ln AppInit.3 Tcl_AppInit.3
+fi
+if test -r ObjectType.3; then
+ rm -f Tcl_AppendAllObjTypes.3
+ ln ObjectType.3 Tcl_AppendAllObjTypes.3
+fi
+if test -r SetResult.3; then
+ rm -f Tcl_AppendElement.3
+ ln SetResult.3 Tcl_AppendElement.3
+fi
+if test -r SetResult.3; then
+ rm -f Tcl_AppendResult.3
+ ln SetResult.3 Tcl_AppendResult.3
+fi
+if test -r StringObj.3; then
+ rm -f Tcl_AppendStringsToObj.3
+ ln StringObj.3 Tcl_AppendStringsToObj.3
+fi
+if test -r StringObj.3; then
+ rm -f Tcl_AppendToObj.3
+ ln StringObj.3 Tcl_AppendToObj.3
+fi
+if test -r Async.3; then
+ rm -f Tcl_AsyncCreate.3
+ ln Async.3 Tcl_AsyncCreate.3
+fi
+if test -r Async.3; then
+ rm -f Tcl_AsyncDelete.3
+ ln Async.3 Tcl_AsyncDelete.3
+fi
+if test -r Async.3; then
+ rm -f Tcl_AsyncInvoke.3
+ ln Async.3 Tcl_AsyncInvoke.3
+fi
+if test -r Async.3; then
+ rm -f Tcl_AsyncMark.3
+ ln Async.3 Tcl_AsyncMark.3
+fi
+if test -r BackgdErr.3; then
+ rm -f Tcl_BackgroundError.3
+ ln BackgdErr.3 Tcl_BackgroundError.3
+fi
+if test -r Backslash.3; then
+ rm -f Tcl_Backslash.3
+ ln Backslash.3 Tcl_Backslash.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_BadChannelOption.3
+ ln CrtChannel.3 Tcl_BadChannelOption.3
+fi
+if test -r CallDel.3; then
+ rm -f Tcl_CallWhenDeleted.3
+ ln CallDel.3 Tcl_CallWhenDeleted.3
+fi
+if test -r DoWhenIdle.3; then
+ rm -f Tcl_CancelIdleCall.3
+ ln DoWhenIdle.3 Tcl_CancelIdleCall.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_Close.3
+ ln OpenFileChnl.3 Tcl_Close.3
+fi
+if test -r CmdCmplt.3; then
+ rm -f Tcl_CommandComplete.3
+ ln CmdCmplt.3 Tcl_CommandComplete.3
+fi
+if test -r Concat.3; then
+ rm -f Tcl_Concat.3
+ ln Concat.3 Tcl_Concat.3
+fi
+if test -r SplitList.3; then
+ rm -f Tcl_ConvertElement.3
+ ln SplitList.3 Tcl_ConvertElement.3
+fi
+if test -r ObjectType.3; then
+ rm -f Tcl_ConvertToType.3
+ ln ObjectType.3 Tcl_ConvertToType.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_CreateAlias.3
+ ln CrtSlave.3 Tcl_CreateAlias.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_CreateAliasObj.3
+ ln CrtSlave.3 Tcl_CreateAliasObj.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_CreateChannel.3
+ ln CrtChannel.3 Tcl_CreateChannel.3
+fi
+if test -r CrtChnlHdlr.3; then
+ rm -f Tcl_CreateChannelHandler.3
+ ln CrtChnlHdlr.3 Tcl_CreateChannelHandler.3
+fi
+if test -r CrtCloseHdlr.3; then
+ rm -f Tcl_CreateCloseHandler.3
+ ln CrtCloseHdlr.3 Tcl_CreateCloseHandler.3
+fi
+if test -r CrtCommand.3; then
+ rm -f Tcl_CreateCommand.3
+ ln CrtCommand.3 Tcl_CreateCommand.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_CreateEventSource.3
+ ln Notifier.3 Tcl_CreateEventSource.3
+fi
+if test -r Exit.3; then
+ rm -f Tcl_CreateExitHandler.3
+ ln Exit.3 Tcl_CreateExitHandler.3
+fi
+if test -r CrtFileHdlr.3; then
+ rm -f Tcl_CreateFileHandler.3
+ ln CrtFileHdlr.3 Tcl_CreateFileHandler.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_CreateHashEntry.3
+ ln Hash.3 Tcl_CreateHashEntry.3
+fi
+if test -r CrtInterp.3; then
+ rm -f Tcl_CreateInterp.3
+ ln CrtInterp.3 Tcl_CreateInterp.3
+fi
+if test -r CrtMathFnc.3; then
+ rm -f Tcl_CreateMathFunc.3
+ ln CrtMathFnc.3 Tcl_CreateMathFunc.3
+fi
+if test -r CrtObjCmd.3; then
+ rm -f Tcl_CreateObjCommand.3
+ ln CrtObjCmd.3 Tcl_CreateObjCommand.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_CreateSlave.3
+ ln CrtSlave.3 Tcl_CreateSlave.3
+fi
+if test -r CrtTimerHdlr.3; then
+ rm -f Tcl_CreateTimerHandler.3
+ ln CrtTimerHdlr.3 Tcl_CreateTimerHandler.3
+fi
+if test -r CrtTrace.3; then
+ rm -f Tcl_CreateTrace.3
+ ln CrtTrace.3 Tcl_CreateTrace.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringAppend.3
+ ln DString.3 Tcl_DStringAppend.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringAppendElement.3
+ ln DString.3 Tcl_DStringAppendElement.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringEndSublist.3
+ ln DString.3 Tcl_DStringEndSublist.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringFree.3
+ ln DString.3 Tcl_DStringFree.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringGetResult.3
+ ln DString.3 Tcl_DStringGetResult.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringInit.3
+ ln DString.3 Tcl_DStringInit.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringLength.3
+ ln DString.3 Tcl_DStringLength.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringResult.3
+ ln DString.3 Tcl_DStringResult.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringSetLength.3
+ ln DString.3 Tcl_DStringSetLength.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringStartSublist.3
+ ln DString.3 Tcl_DStringStartSublist.3
+fi
+if test -r DString.3; then
+ rm -f Tcl_DStringValue.3
+ ln DString.3 Tcl_DStringValue.3
+fi
+if test -r Object.3; then
+ rm -f Tcl_DecrRefCount.3
+ ln Object.3 Tcl_DecrRefCount.3
+fi
+if test -r AssocData.3; then
+ rm -f Tcl_DeleteAssocData.3
+ ln AssocData.3 Tcl_DeleteAssocData.3
+fi
+if test -r CrtChnlHdlr.3; then
+ rm -f Tcl_DeleteChannelHandler.3
+ ln CrtChnlHdlr.3 Tcl_DeleteChannelHandler.3
+fi
+if test -r CrtCloseHdlr.3; then
+ rm -f Tcl_DeleteCloseHandler.3
+ ln CrtCloseHdlr.3 Tcl_DeleteCloseHandler.3
+fi
+if test -r CrtObjCmd.3; then
+ rm -f Tcl_DeleteCommand.3
+ ln CrtObjCmd.3 Tcl_DeleteCommand.3
+fi
+if test -r CrtObjCmd.3; then
+ rm -f Tcl_DeleteCommandFromToken.3
+ ln CrtObjCmd.3 Tcl_DeleteCommandFromToken.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_DeleteEventSource.3
+ ln Notifier.3 Tcl_DeleteEventSource.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_DeleteEvents.3
+ ln Notifier.3 Tcl_DeleteEvents.3
+fi
+if test -r Exit.3; then
+ rm -f Tcl_DeleteExitHandler.3
+ ln Exit.3 Tcl_DeleteExitHandler.3
+fi
+if test -r CrtFileHdlr.3; then
+ rm -f Tcl_DeleteFileHandler.3
+ ln CrtFileHdlr.3 Tcl_DeleteFileHandler.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_DeleteHashEntry.3
+ ln Hash.3 Tcl_DeleteHashEntry.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_DeleteHashTable.3
+ ln Hash.3 Tcl_DeleteHashTable.3
+fi
+if test -r CrtInterp.3; then
+ rm -f Tcl_DeleteInterp.3
+ ln CrtInterp.3 Tcl_DeleteInterp.3
+fi
+if test -r CrtTimerHdlr.3; then
+ rm -f Tcl_DeleteTimerHandler.3
+ ln CrtTimerHdlr.3 Tcl_DeleteTimerHandler.3
+fi
+if test -r CrtTrace.3; then
+ rm -f Tcl_DeleteTrace.3
+ ln CrtTrace.3 Tcl_DeleteTrace.3
+fi
+if test -r DetachPids.3; then
+ rm -f Tcl_DetachPids.3
+ ln DetachPids.3 Tcl_DetachPids.3
+fi
+if test -r DoOneEvent.3; then
+ rm -f Tcl_DoOneEvent.3
+ ln DoOneEvent.3 Tcl_DoOneEvent.3
+fi
+if test -r DoWhenIdle.3; then
+ rm -f Tcl_DoWhenIdle.3
+ ln DoWhenIdle.3 Tcl_DoWhenIdle.3
+fi
+if test -r CallDel.3; then
+ rm -f Tcl_DontCallWhenDeleted.3
+ ln CallDel.3 Tcl_DontCallWhenDeleted.3
+fi
+if test -r Object.3; then
+ rm -f Tcl_DuplicateObj.3
+ ln Object.3 Tcl_DuplicateObj.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_Eof.3
+ ln OpenFileChnl.3 Tcl_Eof.3
+fi
+if test -r Eval.3; then
+ rm -f Tcl_Eval.3
+ ln Eval.3 Tcl_Eval.3
+fi
+if test -r Eval.3; then
+ rm -f Tcl_EvalFile.3
+ ln Eval.3 Tcl_EvalFile.3
+fi
+if test -r EvalObj.3; then
+ rm -f Tcl_EvalObj.3
+ ln EvalObj.3 Tcl_EvalObj.3
+fi
+if test -r Preserve.3; then
+ rm -f Tcl_EventuallyFree.3
+ ln Preserve.3 Tcl_EventuallyFree.3
+fi
+if test -r Exit.3; then
+ rm -f Tcl_Exit.3
+ ln Exit.3 Tcl_Exit.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_ExposeCommand.3
+ ln CrtSlave.3 Tcl_ExposeCommand.3
+fi
+if test -r ExprLong.3; then
+ rm -f Tcl_ExprBoolean.3
+ ln ExprLong.3 Tcl_ExprBoolean.3
+fi
+if test -r ExprLongObj.3; then
+ rm -f Tcl_ExprBooleanObj.3
+ ln ExprLongObj.3 Tcl_ExprBooleanObj.3
+fi
+if test -r ExprLong.3; then
+ rm -f Tcl_ExprDouble.3
+ ln ExprLong.3 Tcl_ExprDouble.3
+fi
+if test -r ExprLongObj.3; then
+ rm -f Tcl_ExprDoubleObj.3
+ ln ExprLongObj.3 Tcl_ExprDoubleObj.3
+fi
+if test -r ExprLong.3; then
+ rm -f Tcl_ExprLong.3
+ ln ExprLong.3 Tcl_ExprLong.3
+fi
+if test -r ExprLongObj.3; then
+ rm -f Tcl_ExprLongObj.3
+ ln ExprLongObj.3 Tcl_ExprLongObj.3
+fi
+if test -r ExprLongObj.3; then
+ rm -f Tcl_ExprObj.3
+ ln ExprLongObj.3 Tcl_ExprObj.3
+fi
+if test -r ExprLong.3; then
+ rm -f Tcl_ExprString.3
+ ln ExprLong.3 Tcl_ExprString.3
+fi
+if test -r Exit.3; then
+ rm -f Tcl_Finalize.3
+ ln Exit.3 Tcl_Finalize.3
+fi
+if test -r FindExec.3; then
+ rm -f Tcl_FindExecutable.3
+ ln FindExec.3 Tcl_FindExecutable.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_FindHashEntry.3
+ ln Hash.3 Tcl_FindHashEntry.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_FirstHashEntry.3
+ ln Hash.3 Tcl_FirstHashEntry.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_Flush.3
+ ln OpenFileChnl.3 Tcl_Flush.3
+fi
+if test -r Alloc.3; then
+ rm -f Tcl_Free.3
+ ln Alloc.3 Tcl_Free.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_GetAlias.3
+ ln CrtSlave.3 Tcl_GetAlias.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_GetAliasObj.3
+ ln CrtSlave.3 Tcl_GetAliasObj.3
+fi
+if test -r AssocData.3; then
+ rm -f Tcl_GetAssocData.3
+ ln AssocData.3 Tcl_GetAssocData.3
+fi
+if test -r GetInt.3; then
+ rm -f Tcl_GetBoolean.3
+ ln GetInt.3 Tcl_GetBoolean.3
+fi
+if test -r BoolObj.3; then
+ rm -f Tcl_GetBooleanFromObj.3
+ ln BoolObj.3 Tcl_GetBooleanFromObj.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_GetChannel.3
+ ln OpenFileChnl.3 Tcl_GetChannel.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_GetChannelBufferSize.3
+ ln CrtChannel.3 Tcl_GetChannelBufferSize.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_GetChannelHandle.3
+ ln CrtChannel.3 Tcl_GetChannelHandle.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_GetChannelInstanceData.3
+ ln CrtChannel.3 Tcl_GetChannelInstanceData.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_GetChannelMode.3
+ ln CrtChannel.3 Tcl_GetChannelMode.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_GetChannelName.3
+ ln CrtChannel.3 Tcl_GetChannelName.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_GetChannelOption.3
+ ln OpenFileChnl.3 Tcl_GetChannelOption.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_GetChannelType.3
+ ln CrtChannel.3 Tcl_GetChannelType.3
+fi
+if test -r CrtObjCmd.3; then
+ rm -f Tcl_GetCommandInfo.3
+ ln CrtObjCmd.3 Tcl_GetCommandInfo.3
+fi
+if test -r CrtObjCmd.3; then
+ rm -f Tcl_GetCommandName.3
+ ln CrtObjCmd.3 Tcl_GetCommandName.3
+fi
+if test -r GetInt.3; then
+ rm -f Tcl_GetDouble.3
+ ln GetInt.3 Tcl_GetDouble.3
+fi
+if test -r DoubleObj.3; then
+ rm -f Tcl_GetDoubleFromObj.3
+ ln DoubleObj.3 Tcl_GetDoubleFromObj.3
+fi
+if test -r SetErrno.3; then
+ rm -f Tcl_GetErrno.3
+ ln SetErrno.3 Tcl_GetErrno.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_GetHashKey.3
+ ln Hash.3 Tcl_GetHashKey.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_GetHashValue.3
+ ln Hash.3 Tcl_GetHashValue.3
+fi
+if test -r GetIndex.3; then
+ rm -f Tcl_GetIndexFromObj.3
+ ln GetIndex.3 Tcl_GetIndexFromObj.3
+fi
+if test -r GetInt.3; then
+ rm -f Tcl_GetInt.3
+ ln GetInt.3 Tcl_GetInt.3
+fi
+if test -r IntObj.3; then
+ rm -f Tcl_GetIntFromObj.3
+ ln IntObj.3 Tcl_GetIntFromObj.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_GetInterpPath.3
+ ln CrtSlave.3 Tcl_GetInterpPath.3
+fi
+if test -r IntObj.3; then
+ rm -f Tcl_GetLongFromObj.3
+ ln IntObj.3 Tcl_GetLongFromObj.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_GetMaster.3
+ ln CrtSlave.3 Tcl_GetMaster.3
+fi
+if test -r SetResult.3; then
+ rm -f Tcl_GetObjResult.3
+ ln SetResult.3 Tcl_GetObjResult.3
+fi
+if test -r ObjectType.3; then
+ rm -f Tcl_GetObjType.3
+ ln ObjectType.3 Tcl_GetObjType.3
+fi
+if test -r GetOpnFl.3; then
+ rm -f Tcl_GetOpenFile.3
+ ln GetOpnFl.3 Tcl_GetOpenFile.3
+fi
+if test -r SplitPath.3; then
+ rm -f Tcl_GetPathType.3
+ ln SplitPath.3 Tcl_GetPathType.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_GetServiceMode.3
+ ln Notifier.3 Tcl_GetServiceMode.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_GetSlave.3
+ ln CrtSlave.3 Tcl_GetSlave.3
+fi
+if test -r GetStdChan.3; then
+ rm -f Tcl_GetStdChannel.3
+ ln GetStdChan.3 Tcl_GetStdChannel.3
+fi
+if test -r StringObj.3; then
+ rm -f Tcl_GetStringFromObj.3
+ ln StringObj.3 Tcl_GetStringFromObj.3
+fi
+if test -r SetResult.3; then
+ rm -f Tcl_GetStringResult.3
+ ln SetResult.3 Tcl_GetStringResult.3
+fi
+if test -r SetVar.3; then
+ rm -f Tcl_GetVar.3
+ ln SetVar.3 Tcl_GetVar.3
+fi
+if test -r SetVar.3; then
+ rm -f Tcl_GetVar2.3
+ ln SetVar.3 Tcl_GetVar2.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_Gets.3
+ ln OpenFileChnl.3 Tcl_Gets.3
+fi
+if test -r Eval.3; then
+ rm -f Tcl_GlobalEval.3
+ ln Eval.3 Tcl_GlobalEval.3
+fi
+if test -r EvalObj.3; then
+ rm -f Tcl_GlobalEvalObj.3
+ ln EvalObj.3 Tcl_GlobalEvalObj.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_HashStats.3
+ ln Hash.3 Tcl_HashStats.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_HideCommand.3
+ ln CrtSlave.3 Tcl_HideCommand.3
+fi
+if test -r Object.3; then
+ rm -f Tcl_IncrRefCount.3
+ ln Object.3 Tcl_IncrRefCount.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_InitHashTable.3
+ ln Hash.3 Tcl_InitHashTable.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_InputBlocked.3
+ ln OpenFileChnl.3 Tcl_InputBlocked.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_InputBuffered.3
+ ln OpenFileChnl.3 Tcl_InputBuffered.3
+fi
+if test -r Interp.3; then
+ rm -f Tcl_Interp.3
+ ln Interp.3 Tcl_Interp.3
+fi
+if test -r CrtInterp.3; then
+ rm -f Tcl_InterpDeleted.3
+ ln CrtInterp.3 Tcl_InterpDeleted.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_IsSafe.3
+ ln CrtSlave.3 Tcl_IsSafe.3
+fi
+if test -r Object.3; then
+ rm -f Tcl_IsShared.3
+ ln Object.3 Tcl_IsShared.3
+fi
+if test -r SplitPath.3; then
+ rm -f Tcl_JoinPath.3
+ ln SplitPath.3 Tcl_JoinPath.3
+fi
+if test -r LinkVar.3; then
+ rm -f Tcl_LinkVar.3
+ ln LinkVar.3 Tcl_LinkVar.3
+fi
+if test -r ListObj.3; then
+ rm -f Tcl_ListObjAppendElement.3
+ ln ListObj.3 Tcl_ListObjAppendElement.3
+fi
+if test -r ListObj.3; then
+ rm -f Tcl_ListObjAppendList.3
+ ln ListObj.3 Tcl_ListObjAppendList.3
+fi
+if test -r ListObj.3; then
+ rm -f Tcl_ListObjGetElements.3
+ ln ListObj.3 Tcl_ListObjGetElements.3
+fi
+if test -r ListObj.3; then
+ rm -f Tcl_ListObjIndex.3
+ ln ListObj.3 Tcl_ListObjIndex.3
+fi
+if test -r ListObj.3; then
+ rm -f Tcl_ListObjLength.3
+ ln ListObj.3 Tcl_ListObjLength.3
+fi
+if test -r ListObj.3; then
+ rm -f Tcl_ListObjReplace.3
+ ln ListObj.3 Tcl_ListObjReplace.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_MakeFileChannel.3
+ ln OpenFileChnl.3 Tcl_MakeFileChannel.3
+fi
+if test -r CrtSlave.3; then
+ rm -f Tcl_MakeSafe.3
+ ln CrtSlave.3 Tcl_MakeSafe.3
+fi
+if test -r OpenTcp.3; then
+ rm -f Tcl_MakeTcpClientChannel.3
+ ln OpenTcp.3 Tcl_MakeTcpClientChannel.3
+fi
+if test -r SplitList.3; then
+ rm -f Tcl_Merge.3
+ ln SplitList.3 Tcl_Merge.3
+fi
+if test -r BoolObj.3; then
+ rm -f Tcl_NewBooleanObj.3
+ ln BoolObj.3 Tcl_NewBooleanObj.3
+fi
+if test -r DoubleObj.3; then
+ rm -f Tcl_NewDoubleObj.3
+ ln DoubleObj.3 Tcl_NewDoubleObj.3
+fi
+if test -r IntObj.3; then
+ rm -f Tcl_NewIntObj.3
+ ln IntObj.3 Tcl_NewIntObj.3
+fi
+if test -r ListObj.3; then
+ rm -f Tcl_NewListObj.3
+ ln ListObj.3 Tcl_NewListObj.3
+fi
+if test -r IntObj.3; then
+ rm -f Tcl_NewLongObj.3
+ ln IntObj.3 Tcl_NewLongObj.3
+fi
+if test -r Object.3; then
+ rm -f Tcl_NewObj.3
+ ln Object.3 Tcl_NewObj.3
+fi
+if test -r StringObj.3; then
+ rm -f Tcl_NewStringObj.3
+ ln StringObj.3 Tcl_NewStringObj.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_NextHashEntry.3
+ ln Hash.3 Tcl_NextHashEntry.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_NotifyChannel.3
+ ln CrtChannel.3 Tcl_NotifyChannel.3
+fi
+if test -r ObjSetVar.3; then
+ rm -f Tcl_ObjGetVar2.3
+ ln ObjSetVar.3 Tcl_ObjGetVar2.3
+fi
+if test -r ObjSetVar.3; then
+ rm -f Tcl_ObjSetVar2.3
+ ln ObjSetVar.3 Tcl_ObjSetVar2.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_OpenCommandChannel.3
+ ln OpenFileChnl.3 Tcl_OpenCommandChannel.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_OpenFileChannel.3
+ ln OpenFileChnl.3 Tcl_OpenFileChannel.3
+fi
+if test -r OpenTcp.3; then
+ rm -f Tcl_OpenTcpClient.3
+ ln OpenTcp.3 Tcl_OpenTcpClient.3
+fi
+if test -r OpenTcp.3; then
+ rm -f Tcl_OpenTcpServer.3
+ ln OpenTcp.3 Tcl_OpenTcpServer.3
+fi
+if test -r PkgRequire.3; then
+ rm -f Tcl_PkgProvide.3
+ ln PkgRequire.3 Tcl_PkgProvide.3
+fi
+if test -r PkgRequire.3; then
+ rm -f Tcl_PkgRequire.3
+ ln PkgRequire.3 Tcl_PkgRequire.3
+fi
+if test -r AddErrInfo.3; then
+ rm -f Tcl_PosixError.3
+ ln AddErrInfo.3 Tcl_PosixError.3
+fi
+if test -r Preserve.3; then
+ rm -f Tcl_Preserve.3
+ ln Preserve.3 Tcl_Preserve.3
+fi
+if test -r PrintDbl.3; then
+ rm -f Tcl_PrintDouble.3
+ ln PrintDbl.3 Tcl_PrintDouble.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_QueueEvent.3
+ ln Notifier.3 Tcl_QueueEvent.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_Read.3
+ ln OpenFileChnl.3 Tcl_Read.3
+fi
+if test -r Alloc.3; then
+ rm -f Tcl_Realloc.3
+ ln Alloc.3 Tcl_Realloc.3
+fi
+if test -r DetachPids.3; then
+ rm -f Tcl_ReapDetachedProcs.3
+ ln DetachPids.3 Tcl_ReapDetachedProcs.3
+fi
+if test -r RecordEval.3; then
+ rm -f Tcl_RecordAndEval.3
+ ln RecordEval.3 Tcl_RecordAndEval.3
+fi
+if test -r RecEvalObj.3; then
+ rm -f Tcl_RecordAndEvalObj.3
+ ln RecEvalObj.3 Tcl_RecordAndEvalObj.3
+fi
+if test -r RegExp.3; then
+ rm -f Tcl_RegExpCompile.3
+ ln RegExp.3 Tcl_RegExpCompile.3
+fi
+if test -r RegExp.3; then
+ rm -f Tcl_RegExpExec.3
+ ln RegExp.3 Tcl_RegExpExec.3
+fi
+if test -r RegExp.3; then
+ rm -f Tcl_RegExpMatch.3
+ ln RegExp.3 Tcl_RegExpMatch.3
+fi
+if test -r RegExp.3; then
+ rm -f Tcl_RegExpRange.3
+ ln RegExp.3 Tcl_RegExpRange.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_RegisterChannel.3
+ ln OpenFileChnl.3 Tcl_RegisterChannel.3
+fi
+if test -r ObjectType.3; then
+ rm -f Tcl_RegisterObjType.3
+ ln ObjectType.3 Tcl_RegisterObjType.3
+fi
+if test -r Preserve.3; then
+ rm -f Tcl_Release.3
+ ln Preserve.3 Tcl_Release.3
+fi
+if test -r SetResult.3; then
+ rm -f Tcl_ResetResult.3
+ ln SetResult.3 Tcl_ResetResult.3
+fi
+if test -r SplitList.3; then
+ rm -f Tcl_ScanElement.3
+ ln SplitList.3 Tcl_ScanElement.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_Seek.3
+ ln OpenFileChnl.3 Tcl_Seek.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_ServiceAll.3
+ ln Notifier.3 Tcl_ServiceAll.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_ServiceEvent.3
+ ln Notifier.3 Tcl_ServiceEvent.3
+fi
+if test -r AssocData.3; then
+ rm -f Tcl_SetAssocData.3
+ ln AssocData.3 Tcl_SetAssocData.3
+fi
+if test -r BoolObj.3; then
+ rm -f Tcl_SetBooleanObj.3
+ ln BoolObj.3 Tcl_SetBooleanObj.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_SetChannelBufferSize.3
+ ln CrtChannel.3 Tcl_SetChannelBufferSize.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_SetChannelOption.3
+ ln OpenFileChnl.3 Tcl_SetChannelOption.3
+fi
+if test -r CrtObjCmd.3; then
+ rm -f Tcl_SetCommandInfo.3
+ ln CrtObjCmd.3 Tcl_SetCommandInfo.3
+fi
+if test -r CrtChannel.3; then
+ rm -f Tcl_SetDefaultTranslation.3
+ ln CrtChannel.3 Tcl_SetDefaultTranslation.3
+fi
+if test -r DoubleObj.3; then
+ rm -f Tcl_SetDoubleObj.3
+ ln DoubleObj.3 Tcl_SetDoubleObj.3
+fi
+if test -r SetErrno.3; then
+ rm -f Tcl_SetErrno.3
+ ln SetErrno.3 Tcl_SetErrno.3
+fi
+if test -r AddErrInfo.3; then
+ rm -f Tcl_SetErrorCode.3
+ ln AddErrInfo.3 Tcl_SetErrorCode.3
+fi
+if test -r Hash.3; then
+ rm -f Tcl_SetHashValue.3
+ ln Hash.3 Tcl_SetHashValue.3
+fi
+if test -r IntObj.3; then
+ rm -f Tcl_SetIntObj.3
+ ln IntObj.3 Tcl_SetIntObj.3
+fi
+if test -r ListObj.3; then
+ rm -f Tcl_SetListObj.3
+ ln ListObj.3 Tcl_SetListObj.3
+fi
+if test -r IntObj.3; then
+ rm -f Tcl_SetLongObj.3
+ ln IntObj.3 Tcl_SetLongObj.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_SetMaxBlockTime.3
+ ln Notifier.3 Tcl_SetMaxBlockTime.3
+fi
+if test -r StringObj.3; then
+ rm -f Tcl_SetObjLength.3
+ ln StringObj.3 Tcl_SetObjLength.3
+fi
+if test -r SetResult.3; then
+ rm -f Tcl_SetObjResult.3
+ ln SetResult.3 Tcl_SetObjResult.3
+fi
+if test -r SetRecLmt.3; then
+ rm -f Tcl_SetRecursionLimit.3
+ ln SetRecLmt.3 Tcl_SetRecursionLimit.3
+fi
+if test -r SetResult.3; then
+ rm -f Tcl_SetResult.3
+ ln SetResult.3 Tcl_SetResult.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_SetServiceMode.3
+ ln Notifier.3 Tcl_SetServiceMode.3
+fi
+if test -r GetStdChan.3; then
+ rm -f Tcl_SetStdChannel.3
+ ln GetStdChan.3 Tcl_SetStdChannel.3
+fi
+if test -r StringObj.3; then
+ rm -f Tcl_SetStringObj.3
+ ln StringObj.3 Tcl_SetStringObj.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_SetTimer.3
+ ln Notifier.3 Tcl_SetTimer.3
+fi
+if test -r SetVar.3; then
+ rm -f Tcl_SetVar.3
+ ln SetVar.3 Tcl_SetVar.3
+fi
+if test -r SetVar.3; then
+ rm -f Tcl_SetVar2.3
+ ln SetVar.3 Tcl_SetVar2.3
+fi
+if test -r Sleep.3; then
+ rm -f Tcl_Sleep.3
+ ln Sleep.3 Tcl_Sleep.3
+fi
+if test -r SplitList.3; then
+ rm -f Tcl_SplitList.3
+ ln SplitList.3 Tcl_SplitList.3
+fi
+if test -r SplitPath.3; then
+ rm -f Tcl_SplitPath.3
+ ln SplitPath.3 Tcl_SplitPath.3
+fi
+if test -r StaticPkg.3; then
+ rm -f Tcl_StaticPackage.3
+ ln StaticPkg.3 Tcl_StaticPackage.3
+fi
+if test -r StrMatch.3; then
+ rm -f Tcl_StringMatch.3
+ ln StrMatch.3 Tcl_StringMatch.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_Tell.3
+ ln OpenFileChnl.3 Tcl_Tell.3
+fi
+if test -r TraceVar.3; then
+ rm -f Tcl_TraceVar.3
+ ln TraceVar.3 Tcl_TraceVar.3
+fi
+if test -r TraceVar.3; then
+ rm -f Tcl_TraceVar2.3
+ ln TraceVar.3 Tcl_TraceVar2.3
+fi
+if test -r Translate.3; then
+ rm -f Tcl_TranslateFileName.3
+ ln Translate.3 Tcl_TranslateFileName.3
+fi
+if test -r LinkVar.3; then
+ rm -f Tcl_UnlinkVar.3
+ ln LinkVar.3 Tcl_UnlinkVar.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_UnregisterChannel.3
+ ln OpenFileChnl.3 Tcl_UnregisterChannel.3
+fi
+if test -r SetVar.3; then
+ rm -f Tcl_UnsetVar.3
+ ln SetVar.3 Tcl_UnsetVar.3
+fi
+if test -r SetVar.3; then
+ rm -f Tcl_UnsetVar2.3
+ ln SetVar.3 Tcl_UnsetVar2.3
+fi
+if test -r TraceVar.3; then
+ rm -f Tcl_UntraceVar.3
+ ln TraceVar.3 Tcl_UntraceVar.3
+fi
+if test -r TraceVar.3; then
+ rm -f Tcl_UntraceVar2.3
+ ln TraceVar.3 Tcl_UntraceVar2.3
+fi
+if test -r UpVar.3; then
+ rm -f Tcl_UpVar.3
+ ln UpVar.3 Tcl_UpVar.3
+fi
+if test -r UpVar.3; then
+ rm -f Tcl_UpVar2.3
+ ln UpVar.3 Tcl_UpVar2.3
+fi
+if test -r LinkVar.3; then
+ rm -f Tcl_UpdateLinkedVar.3
+ ln LinkVar.3 Tcl_UpdateLinkedVar.3
+fi
+if test -r Eval.3; then
+ rm -f Tcl_VarEval.3
+ ln Eval.3 Tcl_VarEval.3
+fi
+if test -r TraceVar.3; then
+ rm -f Tcl_VarTraceInfo.3
+ ln TraceVar.3 Tcl_VarTraceInfo.3
+fi
+if test -r TraceVar.3; then
+ rm -f Tcl_VarTraceInfo2.3
+ ln TraceVar.3 Tcl_VarTraceInfo2.3
+fi
+if test -r Notifier.3; then
+ rm -f Tcl_WaitForEvent.3
+ ln Notifier.3 Tcl_WaitForEvent.3
+fi
+if test -r OpenFileChnl.3; then
+ rm -f Tcl_Write.3
+ ln OpenFileChnl.3 Tcl_Write.3
+fi
+if test -r WrongNumArgs.3; then
+ rm -f Tcl_WrongNumArgs.3
+ ln WrongNumArgs.3 Tcl_WrongNumArgs.3
+fi
+if test -r pkgMkIndex.n; then
+ rm -f pkg_mkIndex.n
+ ln pkgMkIndex.n pkg_mkIndex.n
+fi
+exit 0
diff --git a/unix/porting.notes b/unix/porting.notes
new file mode 100644
index 0000000..2d0a403
--- /dev/null
+++ b/unix/porting.notes
@@ -0,0 +1,412 @@
+This file contains a collection of notes that various people have
+provided about porting Tcl to various machines and operating systems.
+I don't have personal access to any of these machines, so I make
+no guarantees that the notes are correct, complete, or up-to-date.
+If you see the word "I" in any explanations, it refers to the person
+who contributed the information, not to me; this means that I
+probably can't answer any questions about any of this stuff. In
+some cases, a person has volunteered to act as a contact point for
+questions about porting Tcl to a particular machine; in these
+cases the person's name and e-mail address are listed. I'm
+interested in getting new porting information to add to the file;
+please mail updates to "john.ousterhout@eng.sun.com".
+
+This file reflects information provided for Tcl 7.4 and later releases (8.x).
+If there is no information for your configuration in this file, check
+the file "porting.old" too; it contains information that was
+submitted for Tcl 7.3 and earlier releases, and some of that information
+may still be valid.
+
+A new porting database has recently become available on the Web at
+the following URL:
+ http://www.sunlabs.com/cgi-bin/tcl/info.8.0
+This page provides information about the platforms on which Tcl and
+and Tk 8.0 have been compiled and what changes were needed to get Tcl
+and Tk to compile. You can also add new entries to that database
+when you install Tcl and Tk on a new platform. The Web database is
+likely to be more up-to-date than this file.
+
+sccsid = SCCS: @(#) porting.notes 1.20 97/11/03 09:43:40
+
+--------------------------------------------
+Solaris, various versions
+--------------------------------------------
+
+1. If typing "make test" results in an error message saying that
+there are no "*.test" files, or you get lots of globbing errors,
+it's probably because your system doesn't have cc installed and
+you used gcc. In order for this to work, you have to set your
+CC environment variable to gcc and your CPP environment variable
+to "gcc -E" before running the configure script.
+
+2. Make sure that /usr/ucb is not in your PATH or LD_LIBRARY_PATH
+environment variables; this will cause confusion between the new
+Solaris libraries and older UCB versions (Tcl will expect one version
+and get another).
+
+3. There have been several reports of problems with the "glob" command.
+So far these reports have all been for older versions of Tcl, but
+if you run into problems, edit the Makefile after "configure" is
+run and add "-DNO_DIRENT_H=1" to the definitions of DEFS. Do this
+before compiling.
+
+--------------------------------------------
+SunOS 4 and potentially other OSes
+--------------------------------------------
+
+On systems where both getcwd(3) and getwd(3) exist, check the man
+page and if getcwd, like on SunOS 4, uses popen to pwd(1)
+add -DUSEGETWD to the flags CFLAGS so getwd will be used instead.
+
+That is, change the CFLAGS = -O line so it reads
+CFLAGS = -O -DUSEGETWD
+
+--------------------------------------------
+Linux, ELF, various versions/distributions
+--------------------------------------------
+
+If ./configure --enable-shared complains it can not do a shared
+library you might have to make the following symbolic link:
+ln -s /lib/libdl.so.1 /lib/libdl.so
+then remove config.cache and re run configure.
+
+--------------------------------------------
+Pyramid DC/OSx SVr4, DC/OSx version 94c079
+--------------------------------------------
+
+Tcl seems to dump core in cmdinfo.test when compiled with the
+optimiser turned on in TclEval which calls 'free'. To get around
+this, turn the optimiser off.
+
+--------------------------------------------
+SGI machines, IRIX 5.2, 5.3, IRIX64 6.0.1
+--------------------------------------------
+
+1. If you compile with gcc-2.6.3 under some versions of IRIX (e.g.
+ 4.0.5), DBL_MAX is defined too large for gcc and Tcl complains
+ about all floating-point values being too large to represent.
+ If this happens, redefining DBL_MAX to 9.99e299.
+
+2. Add "-D_BSD_TIME" to CFLAGS in Makefile. This avoids type conflicts
+in the prototype for the gettimeofday procedure.
+
+2. If you're running under Irix 6.x and tclsh dumps core, try
+removing -O from the CFLAGS in Makefile and recompiling; compiler
+optimizations seem to cause problems on some machines.
+
+--------------------------------------------
+IBM RTs, AOS
+--------------------------------------------
+
+1. Steal fmod from 4.4BSD
+2. Add a #define to tclExpr such that:
+extern double fmod();
+is defined conditionally on ibm032
+
+--------------------------------------------
+QNX 4.22
+--------------------------------------------
+
+tclPort.h
+ - commented out 2 lines containing #include <sys/param.h>
+
+tcl.h
+ - changed #define VARARGS ()
+ - to #ifndef __QNX__
+ #define VARARGS ()
+ #else
+ #define VARARGS (void *, ...)
+ #endif
+
+--------------------------------------------
+Interactive UNIX
+--------------------------------------------
+
+Add the switch -Xp to LIBS in Makefile; otherwise strftime will not
+be found when linking.
+
+--------------------------------------------
+Motorola SVR4 V4.2 (m88k)
+--------------------------------------------
+
+For Motorola Unix R40V4.2 (m88k architechure), use /usr/ucb/cc instead of
+/usr/bin/cc. Otherwise, the compile will fail because of conflicts over
+the gettimeofday() call.
+
+Also, -DNO_DIRENT_H=1 is required for the "glob" command to work.
+
+--------------------------------------------
+NeXTSTEP 3.x
+--------------------------------------------
+
+Here's the set of changes I made to make 7.5b3 compile cleanly on
+NeXTSTEP3.x.
+
+Here are a couple lines from unix/Makefile:
+
+# Added utsname.o, which implements a uname() emulation for NeXTSTEP.
+COMPAT_OBJS = getcwd.o strtod.o tmpnam.o utsname.o
+
+TCL_NAMES=\
+ -Dstrtod=tcl_strtod -Dtmpnam=tcl_tmpnam -Dgetcwd=tcl_getcwd \
+ -Dpanic=tcl_panic -Dmatherr=tcl_matherr \
+ -Duname=tcl_uname -Dutsname=tcl_utsname
+
+# Added mode_t, pid_t, and O_NONBLOCK definitions.
+AC_FLAGS = -DNO_DIRENT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_TIME_H=1
+-DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1
+-DSTDC_HEADERS=1 -Dmode_t=int -Dpid_t=int -DO_NONBLOCK=O_NDELAY ${TCL_NAMES}
+
+
+Here are diffs for other files. utsname.[hc] are a couple files I added
+to compat/ I'm not clear whether that's where they legitimately belong
+- I considered stashing them in tclLoadNext.c instead. The tclIO.c
+change was a bug, I believe, which I reported on comp.lang.tcl and
+has apparently been noted and fixed. The objc_loadModules() change
+allows "load" to load object code containing Objective-C code in
+addition to plain C code.
+
+---
+scott hess <shess@winternet.com> (WWW to "http://www.winternet.com/~shess/")
+Work: 12550 Portland Avenue South #121, Burnsville, MN 55337 (612)895-1208
+
+
+diff -rc tcl7.5b3.orig/compat/utsname.c tcl7.5b3/compat/utsname.c
+*** tcl7.5b3.orig/compat/utsname.c Tue Apr 2 13:57:23 1996
+--- tcl7.5b3/compat/utsname.c Mon Mar 18 11:05:54 1996
+***************
+*** 0 ****
+--- 1,27 ----
++ /*
++ * utsname.c --
++ *
++ * This file is an emulation of the POSIX uname() function
++ * under NeXTSTEP 3.x.
++ *
++ */
++
+
++ #include "utsname.h"
++ #include <mach-o/arch.h>
++ #include <stdio.h>
++
+
++ int uname( struct utsname *name)
++ {
++ const NXArchInfo *arch;
++ if( gethostname( name->nodename, sizeof( name->nodename))==-1) {
++ return -1;
++ }
++ if( (arch=NXGetLocalArchInfo())==NULL) {
++ return -1;
++ }
++ strncpy( name->machine, arch->description, sizeof( name->machine));
++ strcpy( name->sysname, "NEXTSTEP");
++ strcpy( name->release, "0");
++ strcpy( name->version, "3");
++ return 0;
++ }
+diff -rc tcl7.5b3.orig/compat/utsname.h tcl7.5b3/compat/utsname.h
+*** tcl7.5b3.orig/compat/utsname.h Tue Apr 2 13:57:26 1996
+--- tcl7.5b3/compat/utsname.h Mon Mar 18 10:34:05 1996
+***************
+*** 0 ****
+--- 1,22 ----
++ /*
++ * utsname.h --
++ *
++ * This file is an emulation of the POSIX uname() function
++ * under NeXTSTEP.
++ *
++ */
++
+
++ #ifndef _UTSNAME
++ #define _UTSNAME
++
+
++ struct utsname {
++ char sysname[ 32];
++ char nodename[ 32];
++ char release[ 32];
++ char version[ 32];
++ char machine[ 32];
++ };
++
+
++ extern int uname( struct utsname *name);
++
+
++ #endif /* _UTSNAME */
+diff -rc tcl7.5b3.orig/generic/tclIO.c tcl7.5b3/generic/tclIO.c
+*** tcl7.5b3.orig/generic/tclIO.c Fri Mar 8 12:59:53 1996
+--- tcl7.5b3/generic/tclIO.c Mon Mar 18 11:38:57 1996
+***************
+*** 2542,2548 ****
+ }
+ result = GetInput(chanPtr);
+ if (result != 0) {
+! if (result == EWOULDBLOCK) {
+ chanPtr->flags |= CHANNEL_BLOCKED;
+ return copied;
+ }
+--- 2542,2548 ----
+ }
+ result = GetInput(chanPtr);
+ if (result != 0) {
+! if (result == EAGAIN) {
+ chanPtr->flags |= CHANNEL_BLOCKED;
+ return copied;
+ }
+diff -rc tcl7.5b3.orig/unix/tclLoadNext.c tcl7.5b3/unix/tclLoadNext.c
+*** tcl7.5b3.orig/unix/tclLoadNext.c Sat Feb 17 16:16:42 1996
+--- tcl7.5b3/unix/tclLoadNext.c Mon Mar 18 10:02:36 1996
+***************
+*** 55,61 ****
+ char *files[]={fileName,NULL};
+ NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE);
+
+
+! if(!rld_load(errorStream,&header,files,NULL)) {
+ NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
+ Tcl_AppendResult(interp,"couldn't load file \"",fileName,"\": ",data,NULL);
+ NXCloseMemory(errorStream,NX_FREEBUFFER);
+--- 55,61 ----
+ char *files[]={fileName,NULL};
+ NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE);
+
+
+! if(objc_loadModules(files,errorStream,NULL,&header,NULL)) {
+ NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
+ Tcl_AppendResult(interp,"couldn't load file \"",fileName,"\": ",data,NULL);
+ NXCloseMemory(errorStream,NX_FREEBUFFER);
+diff -rc tcl7.5b3.orig/unix/tclUnixFile.c tcl7.5b3/unix/tclUnixFile.c
+*** tcl7.5b3.orig/unix/tclUnixFile.c Thu Mar 7 18:16:34 1996
+--- tcl7.5b3/unix/tclUnixFile.c Mon Mar 18 11:10:03 1996
+***************
+*** 31,37 ****
+--- 31,41 ----
+
+
+ static int executableNameExitHandlerSet = 0;
+
+
++ #if NeXT
++ #define waitpid( p, s, o) wait4( p, s, o, NULL)
++ #else
+ extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
++ #endif
+
+
+ /*
+ * Static routines for this file:
+diff -rc tcl7.5b3.orig/unix/tclUnixInit.c tcl7.5b3/unix/tclUnixInit.c
+*** tcl7.5b3.orig/unix/tclUnixInit.c Sat Feb 17 16:16:39 1996
+--- tcl7.5b3/unix/tclUnixInit.c Mon Mar 18 11:50:28 1996
+***************
+*** 14,20 ****
+ #include "tclInt.h"
+ #include "tclPort.h"
+ #ifndef NO_UNAME
+! # include <sys/utsname.h>
+ #endif
+ #if defined(__FreeBSD__)
+ #include <floatingpoint.h>
+--- 14,24 ----
+ #include "tclInt.h"
+ #include "tclPort.h"
+ #ifndef NO_UNAME
+! # if NeXT
+! # include "../compat/utsname.h"
+! # else
+! # include <sys/utsname.h>
+! # endif
+ #endif
+ #if defined(__FreeBSD__)
+ #include <floatingpoint.h>
+diff -rc tcl7.5b3.orig/unix/tclUnixPort.h tcl7.5b3/unix/tclUnixPort.h
+*** tcl7.5b3.orig/unix/tclUnixPort.h Thu Mar 7 18:16:31 1996
+--- tcl7.5b3/unix/tclUnixPort.h Mon Mar 18 11:53:14 1996
+***************
+*** 76,82 ****
+ */
+
+
+ #include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
+! #include <sys/utsname.h> /* uname system call. */
+ #include <netinet/in.h> /* struct in_addr, struct sockaddr_in */
+ #include <arpa/inet.h> /* inet_ntoa() */
+ #include <netdb.h> /* gethostbyname() */
+--- 76,88 ----
+ */
+
+
+ #include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
+! #ifndef NO_UNAME
+! # if NeXT
+! # include "../compat/utsname.h"
+! # else
+! # include <sys/utsname.h> /* uname system call. */
+! # endif
+! #endif
+ #include <netinet/in.h> /* struct in_addr, struct sockaddr_in */
+ #include <arpa/inet.h> /* inet_ntoa() */
+ #include <netdb.h> /* gethostbyname() */
+
+--------------------------------------------
+SCO Unix 3.2.4 (ODT 3.0)
+--------------------------------------------
+
+The macro va_start in /usr/include/stdarg.h is incorrectly terminated by
+a semi-colon. This causes compile of generic/tclBasic.c to fail. The
+best solution is to edit the definition of va_start to remove the `;'.
+This will fix this file for anything you want to compile. If you don't have
+permission to edit /usr/include/stdarg.h in place, copy it to the tcl unix
+directory and change it there.
+
+Contact me directly if you have problems on SCO systems.
+Mark Diekhans <markd@grizzly.com>
+
+--------------------------------------------
+SCO Unix 3.2.5 (ODT 5.0)
+--------------------------------------------
+
+Expect failures from socket tests 2.9 and 3.1.
+
+Contact me directly if you have problems on SCO systems.
+Mark Diekhans <markd@grizzly.com>
+
+--------------------------------------------
+Linux 1.2.13 (gcc 2.7.0, libc.so.5.0.9)
+--------------------------------------------
+
+Symptoms:
+
+* Some extensions could not be loaded dynamically, most
+ prominently Blt 2.0
+
+ The given error message essentially said:
+ Could not resolve symbol '__eprintf'.
+
+ (This procedure is used by the macro 'assert')
+
+Cause
+
+* '__eprintf' is defined in 'libgcc.a', not 'libc.so.x.y'.
+ It is therefore impossible to load it dynamically.
+
+* Neither tcl nor tk make use of 'assert', thereby
+ preventing a static linkage.
+
+Workaround
+
+* I included <assert.h> in 'tclAppInit.c' / 'tkAppInit.c'
+ and then executed 'assert (argc)' just before the call
+ to Tcl_Main / Tk_Main.
+
+ This forced the static linkage of '__eprintf' and
+ everything went fine from then on.
+
+ (Something like 'assert (1)', 'assert (a==a)' is not
+ sufficient, it will be optimized away).
+
diff --git a/unix/porting.old b/unix/porting.old
new file mode 100644
index 0000000..e312de0
--- /dev/null
+++ b/unix/porting.old
@@ -0,0 +1,384 @@
+This is an old version of the file "porting.notes". It contains
+porting information that people submitted for Tcl releases numbered
+7.3 and earlier. You may find information in this file useful if
+there is no information available for your machine in the current
+version of "porting.notes".
+
+I don't have personal access to any of these machines, so I make
+no guarantees that the notes are correct, complete, or up-to-date.
+If you see the word "I" in any explanations, it refers to the person
+who contributed the information, not to me; this means that I
+probably can't answer any questions about any of this stuff. In
+some cases, a person has volunteered to act as a contact point for
+questions about porting Tcl to a particular machine; in these
+cases the person's name and e-mail address are listed.
+
+sccsid = SCCS: @(#) porting.old 1.3 96/02/16 08:56:07
+
+---------------------------------------------
+Cray machines running UNICOS:
+Contact: John Freeman (jlf@cray.com)
+---------------------------------------------
+
+1. There is an error in the strstr function in UNICOS such that if the
+string to be searched is empty (""), the search will continue past the
+end of the string. Because of this, the history substitution loop
+will sometimes run past the end of its target string and trash
+malloc's free list, resulting in a core dump some time later. (As you
+can probably guess, this took a while to diagnose.) I've submitted a
+problem report to the C library maintainers, but in the meantime here
+is a workaround.
+
+-----------------------------------------------------------------
+diff -c1 -r1.1 tclHistory.c
+*** 1.1 1991/11/12 16:01:58
+--- tclHistory.c 1991/11/12 16:14:22
+***************
+*** 23,24 ****
+--- 23,29 ----
+ #include "tclInt.h"
++
++ #ifdef _CRAY
++ /* There is a bug in strstr in UNICOS; this works around it. */
++ #define strstr(s1,s2) ((s1)?(*(s1)?strstr((s1),(s2)):0):0)
++ #endif _CRAY
+
+---------------------------------------------
+MIPS systems runing EP/IX:
+---------------------------------------------
+
+1. Need to add a line "#include <bsd/sys/time.h>" in tclUnix.h.
+
+2. Need to add "-lbsd" into the line that makes tclTest:
+
+ ${CC} ${CFLAGS} tclTest.o libtcl.a -lbsd -o tclTest
+
+---------------------------------------------
+IBM RS/6000 systems running AIX:
+---------------------------------------------
+
+1. The system version of strtoul is buggy, at least under some
+versions of AIX. If the expression tests fail, try forcing Tcl
+to use its own version of strtoul instead of the system version.
+To do this, first copy strtoul.c from the compat subdirectory up
+to the main Tcl directory. Then modify the Makefile so that
+the definition for COMPAT_OBJS includes "strtoul.o". Note: the
+"config" script should now detect the buggy strtoul and substitute
+Tcl's version automatically.
+
+2. You may have to comment out the declaration of open in tclUnix.h.
+
+3. You may need to add "-D_BSD -lbsd" to the CFLAGS definition. This
+causes the system include files to look like BSD include files and
+causes C library routines to act like bsd library routines. Without
+this, the system may choke on "struct wait".
+
+---------------------------------------------
+AT&T 4.03 OS:
+---------------------------------------------
+
+Machine: i386/33Mhz i387 32k Cache 16MByte
+OS: AT&T SYSV Release 4 Version 3
+X: X11R5 fixlevel 9
+Xserver: X386 1.2
+
+1. Change the Tk Makefile as follows:
+XLIB = -lX11
+ should be changed to:
+XLIB = -lX11 -lsocket -lnsl
+
+-------------------------------------------------------
+Silicon Graphics systems:
+-------------------------------------------------------
+
+1. Change the CC variable in the Makefile to:
+
+CC = cc -xansi -D__STDC__ -signed
+
+2. In Irix releases 4.0.1 or earlier the C compiler has a buggy optimizer.
+ If Tcl fails its test suite or generates inexplicable errors,
+ compile tclVar.c with -O0 instead of -O.
+
+3. For IRIX 5.1 or later, comments 1 and 2 are no longer relevant,
+but you must add -D_BSD_SIGNALS to CFLAGS to get the proper signal
+routines.
+
+4. Add a "-lsun" switch in the targets for tclsh and tcltest,
+just before ${MATH_LIBS}.
+
+5. Rumor has it that you also need to add the "-lmalloc" library switch
+in the targets for tclsh and tcltest.
+
+6. In IRIX 5.2 you'll have to modify Makefile to fix the following problems:
+ - The "-c" option is illegal with this version of install, but
+ the "-F" switch is needed instead. Change this in the "INSTALL ="
+ definition line.
+ - The order of file and directory have to be changed in all the
+ invocations of INSTALL_DATA or INSTALL_PROGRAM.
+
+---------------------------------------------
+NeXT machines running NeXTStep 3.1:
+---------------------------------------------
+
+1. Run configure with predefined CPP:
+ CPP='cc -E' ./configure
+ (If your shell is [t]csh, do a "setenv CPP 'cc -E' ")
+
+2. Edit Makefile:
+ -add tmpnam.o to COMPAT_OBJS:
+ COMPAT_OBJS = getcwd.o waitpid.o strtod.o tmpnam.o
+ -add the following to AC_FLAGS:
+ -Dstrtod=tcl_strtod
+
+3. Edit compat/tmpnam.c and replace "/usr/tmp" with "/tmp"
+
+After this, tcl7.0 will be build fine on NeXT (ignore linker warning)
+and run all the tests. There are some formatting problems in printf() or
+scanf() which come from NeXT's lacking POSIX conformance. Ignore those
+errors, they don't matter much.
+
+4. Additional information that may apply to NeXTStep 3.2 only:
+
+ The problem on NEXTSTEP 3.2 is that the configure script makes some
+ bad assumptions about the uid_t and gid_t types. Actually, the may
+ have been valid for NEXTSTEP 3.0, or it may be NEXTSTEP's rudimentary
+ attempt at POSIX support under 3.2, but no matter what the reason, the
+ configure script sets up the Makefile with CFLAGS '-Duid_t=int' and
+ '-Dgid_t=int', which are, unfortunately, incorrect, since they shoudl
+ actually be (I think) unsigned shorts. This causes problems when the
+ 'stat' structure is included, since it throws off the field offsets
+ from what the 'fstat' function thinks they should be.
+
+ Anyway, the quick fix is to run configure and then edit the Makefile
+ to remove the uid_t and gid_t defines. This will allow tcl and Tk to
+ compile and run. There are some other problems on NEXTSTEP,
+ specifically with %g in the printf family of functions, but making the
+ uid_t and gid_t change will get it up and running.
+
+---------------------------------------------
+NeXT machines running NeXTStep 3.2:
+---------------------------------------------
+
+1. Run configure with predefined CPP:
+ CPP='cc -E' ./configure
+ (If your shell is [t]csh, do a "setenv CPP 'cc -E' ")
+
+2. Edit Makefile:
+ -add tmpnam.o to COMPAT_OBJS:
+ COMPAT_OBJS = getcwd.o waitpid.o strtod.o tmpnam.o
+ -add the following to AC_FLAGS:
+ -Dstrtod=tcl_strtod
+ -add '-m' to MATH_LIBS:
+ MATH_LIBS = -m -lm
+ -add '-O2 -arch m68k -arch i386' to CFLAGS:
+ CFLAGS = -O2 -arch m68k -arch i386
+
+-------------------------------------------------
+ISC 2.2 UNIX (using standard ATT SYSV compiler):
+-------------------------------------------------
+
+In Makefile, change
+
+CFLAGS = -g -I. -DTCL_LIBRARY=\"${TCL_LIBRARY}\"
+
+to
+
+CFLAGS = -g -I. -DPOSIX_JC -DTCL_LIBRARY=\"${TCL_LIBRARY}\"
+
+This brings in the typedef for pid_t, which is needed for
+/usr/include/sys/wait.h in tclUnix.h.
+
+---------------------------------------------
+DEC Alphas:
+---------------------------------------------
+
+1. There appears to be a compiler/library bug that causes core-dumps
+unless you compile tclVar.c without optimization (remove the -O compiler
+switch). The problem appears to have been fixed in the 1.3-4 version
+of the compiler.
+
+---------------------------------------------
+CDC 4680MP, EP/IX 1.4.3:
+---------------------------------------------
+
+The installation was done in the System V environment (-systype sysv)
+with the BSD extensions available (-I/usr/include/bsd and -lbsd). It was
+built with the 2.20 level C compiler. The 2.11 level should not be used
+because it has a problem with detecting NaN values in lines like:
+ if (x != x) ...
+which appear in the TCL code.
+
+To make the configure script find the BSD extensions, I set environment
+variable DEFS to "-I/usr/include/bsd" and LIBS to "-lbsd" before
+running it. I would have also set CC to "cc2.20", but that compiler
+driver has a bug that loader errors (e.g. not finding a library routine,
+which the script uses to tell what is available) do not cause an error
+status to be returned to the shell (but see the comments about "-non_shared"
+below in the 2.1.1 notes).
+
+There is a bug in the <sys/wait.h> include file that mis-defines the
+structure fields and causes WIFEXITED and WIFSIGNALED to return incorrect
+values. My solution was to create a subdirectory "sys" of the main TCL
+source directory and put a corrected wait.h in it. The "-I." already on
+all the compile lines causes it to be used instead of the system version.
+To fix this, compare the structure definition in /usr/include/bsd/sys/wait.h
+with /bsd43/include/sys/wait.h (or mail to John Jackson, jrj@cc.purdue.edu,
+and he'll send you a context diff).
+
+After running configure, I made the following changes to Makefile:
+
+ 1) In AC_FLAGS, change:
+ -DNO_WAIT3=1
+ to
+ -DNO_WAIT3=0 -Dwait3=wait2
+ EP/IX (in the System V environment) provides a wait2() system
+ call with what TCL needs (the WNOHANG flag). The extra parameter
+ TCL passes to what it thinks is wait3() (the resources used by
+ the child process) is always zero and will be safely ignored.
+
+ 2) Change:
+ CC=cc
+ to
+ CC=cc2.20
+ because of the NaN problem mentioned earlier. Skip this if the
+ default compiler is already 2.20 (or later).
+
+ 3) Add "-lbsd" to the commands that create tclsh and tcltest
+ (look for "-o").
+
+---------------------------------------------
+CDC 4680MP, EP/IX 2.1.1:
+---------------------------------------------
+
+The installation was done in the System V environment (-systype sysv)
+with the BSD extensions available (-I/usr/include/bsd and -lbsd). It was
+built with the 3.11 level C compiler. The 2.11 level should not be used
+because it has a problem with detecting NaN values in lines like:
+ if (x != x) ...
+which appear in the TCL code. The 2.20 compiler does not have this
+problem.
+
+To make the configure script find the BSD extensions, I set environment
+variable DEFS to:
+
+ "-I/usr/include/bsd -D__STDC__=0 -non_shared"
+
+and LIBS to:
+
+ "-lbsd"
+
+before running it. The "-non_shared" is needed because with shared
+libraries, the compiler (actually, the loader) does not report an
+error for "missing" routines. The configuration script depends on this
+error to know what routines are available. This is the real problem
+I reported above for EP/IX 1.4.3 that I incorrectly attributed to a
+compiler driver bug. I don't have 1.4.3 available any more, but it's
+possible using "-non_shared" on it would have solved the problem.
+
+The same <sys/wait.h> bug exists at 2.1.1 (yes, I have reported it to
+CDC), and the same fix as described in the 1.4.3 porting notes works.
+
+In addition to the three Makefile changes described in the 1.4.3 notes,
+you can remove the "-non_shared" flag from AC_FLAGS. It is only needed
+for the configuration step, not the build.
+
+You will get duplicate definition compilation warnings of:
+
+ DBL_MIN
+ DBL_MAX
+ FLT_MIN
+ FLT_MAX
+
+during tclExpr.c. These can be ignored.
+
+During expr.test, you will get a failure for one of the "fmod" tests
+unless you have CDC patch CC40038311 installed.
+
+---------------------------------------------
+Convex systems, OS 10.1 and 10.2:
+Contact: Lennart Sorth (ls@dmi.min.dk)
+---------------------------------------------
+
+1. tcl7.0b2 compiles on Convex systems (OS 10.1 and 10.2) by just running
+ configure, typing make, except tclUnixUtil.c needs to be compiled
+ with option "-pcc" (portable cc, =!ANSI) due to:
+ cc: Error on line 1111 of tclUnixUtil.c: 'waitpid' redeclared:
+ incompatible types.
+
+-------------------------------------------------
+Pyramid, OSx 5.1a (UCB universe, GCC installed):
+-------------------------------------------------
+
+1. The procedures memcpy, strchr, fmod, and strrchr are all missing,
+so you'll need to provide substitutes for them. After you do that
+everything should compile fine. There will be one error in a scan
+test, but it's an obscure one because of a non-ANSI implementation
+of sscanf on the machine; you can ignore it.
+
+2. You may also have to add "tmpnam.o" to COMPAT_OBJS in Makefile:
+the system version appears to be bad.
+
+-------------------------------------------------
+Encore 91, UMAX V 3.0.9.3:
+-------------------------------------------------
+
+1. Modify the CFLAGS assignment in file Makefile.in to include the
+-DENCORE flag in Makefile:
+
+ CFLAGS = -O -DENCORE
+
+2. "mkdir" does not by default create the parent directories. The mkdir
+directives should be modified to "midir -p".
+
+-------------------------------------------------
+Sequent machines running Dynix:
+Contact: Andrew Swan (aswan@soda.berkeley.edu)
+-------------------------------------------------
+
+1. Use gcc instead of the cc distributed by Sequent
+
+2. The distributed math library does not include the fmod
+ function. Source for fmod can be retrieved from a BSD
+ source archive (such as ftp.uu.net) and included in the
+ compat directory. Add fmod.o to the COMPAT_OBJS variable
+ in the Makefile. You may need to comment out references
+ to 'isnan' and 'finite' in fmod.c
+
+3. If the linker complains that there are two copies of the
+ 'tanh' function, use the ar command to extract the objects
+ from the math library and build a new one without tanh.o
+
+4. The *scanf functions in the Sequent libraries are apparently
+ broken, which will cause the scanning tests to fail. The
+ cases that fail are fairly obscure. Using GNU libc apparently
+ solves this problem.
+
+-------------------------------------------------
+Systems running Interactive 4.0:
+-------------------------------------------------
+
+1. Add "-posix -D_SYSV3" to CFLAGS in Makefile (or Makefile.in).
+
+-------------------------------------------------
+Systems running FreeBSD 1.1.5.1:
+-------------------------------------------------
+
+The following changes comprise the entire porting effort of tcl7.3 to
+FreeBSD (i.e. these were the changes to tclTest.c) and should probably
+be made part of the tcl distribution. The changes only effect the way that
+floating point exceptions are reported. I've choosen to move the changes
+out of tclTest.c and into tclBasic.c.
+
+in tclBasic.c at top-of-file:
+
+#ifdef BSD_NET2
+#include <floatingpoint.h>
+#endif
+
+in tclBasic.c in Tcl_Init():
+
+#ifdef BSD_NET2
+ fpsetround(FP_RN);
+ fpsetmask(0L);
+#endif
+
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
new file mode 100644
index 0000000..fafa31e
--- /dev/null
+++ b/unix/tclAppInit.c
@@ -0,0 +1,136 @@
+/*
+ * tclAppInit.c --
+ *
+ * Provides a default version of the main program and Tcl_AppInit
+ * procedure for Tcl applications (without Tk).
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-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.
+ *
+ * SCCS: @(#) tclAppInit.c 1.20 97/03/24 14:29:43
+ */
+
+#ifdef TCL_XT_TEST
+#include <X11/Intrinsic.h>
+#endif
+
+#include "tcl.h"
+
+/*
+ * The following variable is a special hack that is needed in order for
+ * Sun shared libraries to be used for Tcl.
+ */
+
+extern int matherr();
+int *tclDummyMathPtr = (int *) matherr;
+
+
+#ifdef TCL_TEST
+EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+#ifdef TCL_XT_TEST
+EXTERN int Tclxttest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tcl_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+#ifdef TCL_XT_TEST
+ XtToolkitInitialize();
+#endif
+ Tcl_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppInit --
+ *
+ * This procedure performs application-specific initialization.
+ * Most applications, especially those that incorporate additional
+ * packages, will have their own version of this procedure.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error
+ * message in interp->result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+#ifdef TCL_TEST
+#ifdef TCL_XT_TEST
+ if (Tclxttest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#endif
+ if (Tcltest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
+ (Tcl_PackageInitProc *) NULL);
+ if (TclObjTest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#endif /* TCL_TEST */
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
new file mode 100644
index 0000000..905aa84
--- /dev/null
+++ b/unix/tclConfig.sh.in
@@ -0,0 +1,116 @@
+# 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.
+#
+# SCCS: @(#) tclConfig.sh.in 1.20 97/07/01 11:40:19
+
+# Tcl's version number.
+TCL_VERSION='@TCL_VERSION@'
+TCL_MAJOR_VERSION='@TCL_MAJOR_VERSION@'
+TCL_MINOR_VERSION='@TCL_MINOR_VERSION@'
+TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@'
+
+# C compiler to use for compilation.
+TCL_CC='@CC@'
+
+# -D flags for use with the C compiler.
+TCL_DEFS='@DEFS@'
+
+# Flag, 1: we built a shared lib, 0 we didn't
+TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
+
+# The name of the Tcl library (may be either a .a file or a shared library):
+TCL_LIB_FILE=@TCL_LIB_FILE@
+
+# Additional libraries to use when linking Tcl.
+TCL_LIBS='@DL_LIBS@ @LIBS@ @MATH_LIBS@'
+
+# Top-level directory in which Tcl's platform-independent files are
+# installed.
+TCL_PREFIX='@prefix@'
+
+# Top-level directory in which Tcl's platform-specific files (e.g.
+# executables) are installed.
+TCL_EXEC_PREFIX='@exec_prefix@'
+
+# Flags to pass to cc when compiling the components of a shared library:
+TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@'
+
+# Base command to use for combining object files into a shared library:
+TCL_SHLIB_LD='@SHLIB_LD@'
+
+# 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='@SHLIB_LD_LIBS@'
+
+# Suffix to use for the name of a shared library.
+TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'
+
+# Library file(s) to include in tclsh and other base applications
+# in order to provide facilities needed by DLOBJ above.
+TCL_DL_LIBS='@DL_LIBS@'
+
+# Flags to pass to the compiler when linking object files into
+# an executable tclsh or tcltest binary.
+TCL_LD_FLAGS='@LD_FLAGS@'
+
+# 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_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
+
+# Additional object files linked with Tcl to provide compatibility
+# with standard facilities from ANSI C or POSIX.
+TCL_COMPAT_OBJS='@LIBOBJS@'
+
+# Name of the ranlib program to use.
+TCL_RANLIB='@RANLIB@'
+
+# String to pass to linker to pick up the Tcl library from its
+# build directory.
+TCL_BUILD_LIB_SPEC='@TCL_BUILD_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tcl library from its
+# installed directory.
+TCL_LIB_SPEC='@TCL_LIB_SPEC@'
+
+# 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='@TCL_LIB_VERSIONS_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='@TCL_SHARED_LIB_SUFFIX@'
+
+# 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='@TCL_UNSHARED_LIB_SUFFIX@'
+
+# 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='@TCL_SRC_DIR@'
+
+# 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='@TCL_PACKAGE_PATH@'
diff --git a/unix/tclLoadAix.c b/unix/tclLoadAix.c
new file mode 100644
index 0000000..edf33d6
--- /dev/null
+++ b/unix/tclLoadAix.c
@@ -0,0 +1,549 @@
+/*
+ * tclLoadAix.c --
+ *
+ * This file implements the dlopen and dlsym APIs under the
+ * AIX operating system, to enable the Tcl "load" command to
+ * work. This code was provided by Jens-Uwe Mager.
+ *
+ * This file is subject to the following copyright notice, which is
+ * different from the notice used elsewhere in Tcl. The file has
+ * been modified to incorporate the file dlfcn.h in-line.
+ *
+ * Copyright (c) 1992,1993,1995,1996, Jens-Uwe Mager, Helios Software GmbH
+ * Not derived from licensed software.
+
+ * Permission is granted to freely use, copy, modify, and redistribute
+ * this software, provided that the author is not construed to be liable
+ * for any results of using the software, alterations are clearly marked
+ * as such, and this notice is not modified.
+ *
+ * SCCS: @(#) tclLoadAix.c 1.11 96/10/07 10:41:24
+ *
+ * Note: this file has been altered from the original in a few
+ * ways in order to work properly with Tcl.
+ */
+
+/*
+ * @(#)dlfcn.c 1.7 revision of 95/08/14 19:08:38
+ * This is an unpublished work copyright (c) 1992 HELIOS Software GmbH
+ * 30159 Hannover, Germany
+ */
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/ldr.h>
+#include <a.out.h>
+#include <ldfcn.h>
+#include "../compat/dlfcn.h"
+
+/*
+ * We simulate dlopen() et al. through a call to load. Because AIX has
+ * no call to find an exported symbol we read the loader section of the
+ * loaded module and build a list of exported symbols and their virtual
+ * address.
+ */
+
+typedef struct {
+ char *name; /* the symbols's name */
+ void *addr; /* its relocated virtual address */
+} Export, *ExportPtr;
+
+/*
+ * xlC uses the following structure to list its constructors and
+ * destructors. This is gleaned from the output of munch.
+ */
+typedef struct {
+ void (*init)(void); /* call static constructors */
+ void (*term)(void); /* call static destructors */
+} Cdtor, *CdtorPtr;
+
+/*
+ * The void * handle returned from dlopen is actually a ModulePtr.
+ */
+typedef struct Module {
+ struct Module *next;
+ char *name; /* module name for refcounting */
+ int refCnt; /* the number of references */
+ void *entry; /* entry point from load */
+ struct dl_info *info; /* optional init/terminate functions */
+ CdtorPtr cdtors; /* optional C++ constructors */
+ int nExports; /* the number of exports found */
+ ExportPtr exports; /* the array of exports */
+} Module, *ModulePtr;
+
+/*
+ * We keep a list of all loaded modules to be able to call the fini
+ * handlers and destructors at atexit() time.
+ */
+static ModulePtr modList;
+
+/*
+ * The last error from one of the dl* routines is kept in static
+ * variables here. Each error is returned only once to the caller.
+ */
+static char errbuf[BUFSIZ];
+static int errvalid;
+
+static void caterr(char *);
+static int readExports(ModulePtr);
+static void terminate(void);
+static void *findMain(void);
+
+VOID *dlopen(const char *path, int mode)
+{
+ register ModulePtr mp;
+ static void *mainModule;
+
+ /*
+ * Upon the first call register a terminate handler that will
+ * close all libraries. Also get a reference to the main module
+ * for use with loadbind.
+ */
+ if (!mainModule) {
+ if ((mainModule = findMain()) == NULL)
+ return NULL;
+ atexit(terminate);
+ }
+ /*
+ * Scan the list of modules if we have the module already loaded.
+ */
+ for (mp = modList; mp; mp = mp->next)
+ if (strcmp(mp->name, path) == 0) {
+ mp->refCnt++;
+ return (VOID *) mp;
+ }
+ if ((mp = (ModulePtr)calloc(1, sizeof(*mp))) == NULL) {
+ errvalid++;
+ strcpy(errbuf, "calloc: ");
+ strcat(errbuf, strerror(errno));
+ return (VOID *) NULL;
+ }
+ mp->name = malloc((unsigned) (strlen(path) + 1));
+ strcpy(mp->name, path);
+ /*
+ * load should be declared load(const char *...). Thus we
+ * cast the path to a normal char *. Ugly.
+ */
+ if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) {
+ free(mp->name);
+ free(mp);
+ errvalid++;
+ strcpy(errbuf, "dlopen: ");
+ strcat(errbuf, path);
+ strcat(errbuf, ": ");
+ /*
+ * If AIX says the file is not executable, the error
+ * can be further described by querying the loader about
+ * the last error.
+ */
+ if (errno == ENOEXEC) {
+ char *tmp[BUFSIZ/sizeof(char *)];
+ if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
+ strcpy(errbuf, strerror(errno));
+ else {
+ char **p;
+ for (p = tmp; *p; p++)
+ caterr(*p);
+ }
+ } else
+ strcat(errbuf, strerror(errno));
+ return (VOID *) NULL;
+ }
+ mp->refCnt = 1;
+ mp->next = modList;
+ modList = mp;
+ if (loadbind(0, mainModule, mp->entry) == -1) {
+ dlclose(mp);
+ errvalid++;
+ strcpy(errbuf, "loadbind: ");
+ strcat(errbuf, strerror(errno));
+ return (VOID *) NULL;
+ }
+ /*
+ * If the user wants global binding, loadbind against all other
+ * loaded modules.
+ */
+ if (mode & RTLD_GLOBAL) {
+ register ModulePtr mp1;
+ for (mp1 = mp->next; mp1; mp1 = mp1->next)
+ if (loadbind(0, mp1->entry, mp->entry) == -1) {
+ dlclose(mp);
+ errvalid++;
+ strcpy(errbuf, "loadbind: ");
+ strcat(errbuf, strerror(errno));
+ return (VOID *) NULL;
+ }
+ }
+ if (readExports(mp) == -1) {
+ dlclose(mp);
+ return (VOID *) NULL;
+ }
+ /*
+ * If there is a dl_info structure, call the init function.
+ */
+ if (mp->info = (struct dl_info *)dlsym(mp, "dl_info")) {
+ if (mp->info->init)
+ (*mp->info->init)();
+ } else
+ errvalid = 0;
+ /*
+ * If the shared object was compiled using xlC we will need
+ * to call static constructors (and later on dlclose destructors).
+ */
+ if (mp->cdtors = (CdtorPtr)dlsym(mp, "__cdtors")) {
+ while (mp->cdtors->init) {
+ (*mp->cdtors->init)();
+ mp->cdtors++;
+ }
+ } else
+ errvalid = 0;
+ return (VOID *) mp;
+}
+
+/*
+ * Attempt to decipher an AIX loader error message and append it
+ * to our static error message buffer.
+ */
+static void caterr(char *s)
+{
+ register char *p = s;
+
+ while (*p >= '0' && *p <= '9')
+ p++;
+ switch(atoi(s)) {
+ case L_ERROR_TOOMANY:
+ strcat(errbuf, "to many errors");
+ break;
+ case L_ERROR_NOLIB:
+ strcat(errbuf, "can't load library");
+ strcat(errbuf, p);
+ break;
+ case L_ERROR_UNDEF:
+ strcat(errbuf, "can't find symbol");
+ strcat(errbuf, p);
+ break;
+ case L_ERROR_RLDBAD:
+ strcat(errbuf, "bad RLD");
+ strcat(errbuf, p);
+ break;
+ case L_ERROR_FORMAT:
+ strcat(errbuf, "bad exec format in");
+ strcat(errbuf, p);
+ break;
+ case L_ERROR_ERRNO:
+ strcat(errbuf, strerror(atoi(++p)));
+ break;
+ default:
+ strcat(errbuf, s);
+ break;
+ }
+}
+
+VOID *dlsym(void *handle, const char *symbol)
+{
+ register ModulePtr mp = (ModulePtr)handle;
+ register ExportPtr ep;
+ register int i;
+
+ /*
+ * Could speed up the search, but I assume that one assigns
+ * the result to function pointers anyways.
+ */
+ for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
+ if (strcmp(ep->name, symbol) == 0)
+ return ep->addr;
+ errvalid++;
+ strcpy(errbuf, "dlsym: undefined symbol ");
+ strcat(errbuf, symbol);
+ return NULL;
+}
+
+char *dlerror(void)
+{
+ if (errvalid) {
+ errvalid = 0;
+ return errbuf;
+ }
+ return NULL;
+}
+
+int dlclose(void *handle)
+{
+ register ModulePtr mp = (ModulePtr)handle;
+ int result;
+ register ModulePtr mp1;
+
+ if (--mp->refCnt > 0)
+ return 0;
+ if (mp->info && mp->info->fini)
+ (*mp->info->fini)();
+ if (mp->cdtors)
+ while (mp->cdtors->term) {
+ (*mp->cdtors->term)();
+ mp->cdtors++;
+ }
+ result = unload(mp->entry);
+ if (result == -1) {
+ errvalid++;
+ strcpy(errbuf, strerror(errno));
+ }
+ if (mp->exports) {
+ register ExportPtr ep;
+ register int i;
+ for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
+ if (ep->name)
+ free(ep->name);
+ free(mp->exports);
+ }
+ if (mp == modList)
+ modList = mp->next;
+ else {
+ for (mp1 = modList; mp1; mp1 = mp1->next)
+ if (mp1->next == mp) {
+ mp1->next = mp->next;
+ break;
+ }
+ }
+ free(mp->name);
+ free(mp);
+ return result;
+}
+
+static void terminate(void)
+{
+ while (modList)
+ dlclose(modList);
+}
+
+/*
+ * Build the export table from the XCOFF .loader section.
+ */
+static int readExports(ModulePtr mp)
+{
+ LDFILE *ldp = NULL;
+ SCNHDR sh, shdata;
+ LDHDR *lhp;
+ char *ldbuf;
+ LDSYM *ls;
+ int i;
+ ExportPtr ep;
+
+ if ((ldp = ldopen(mp->name, ldp)) == NULL) {
+ struct ld_info *lp;
+ char *buf;
+ int size = 4*1024;
+ if (errno != ENOENT) {
+ errvalid++;
+ strcpy(errbuf, "readExports: ");
+ strcat(errbuf, strerror(errno));
+ return -1;
+ }
+ /*
+ * The module might be loaded due to the LIBPATH
+ * environment variable. Search for the loaded
+ * module using L_GETINFO.
+ */
+ if ((buf = malloc(size)) == NULL) {
+ errvalid++;
+ strcpy(errbuf, "readExports: ");
+ strcat(errbuf, strerror(errno));
+ return -1;
+ }
+ while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
+ free(buf);
+ size += 4*1024;
+ if ((buf = malloc(size)) == NULL) {
+ errvalid++;
+ strcpy(errbuf, "readExports: ");
+ strcat(errbuf, strerror(errno));
+ return -1;
+ }
+ }
+ if (i == -1) {
+ errvalid++;
+ strcpy(errbuf, "readExports: ");
+ strcat(errbuf, strerror(errno));
+ free(buf);
+ return -1;
+ }
+ /*
+ * Traverse the list of loaded modules. The entry point
+ * returned by load() does actually point to the data
+ * segment origin.
+ */
+ lp = (struct ld_info *)buf;
+ while (lp) {
+ if (lp->ldinfo_dataorg == mp->entry) {
+ ldp = ldopen(lp->ldinfo_filename, ldp);
+ break;
+ }
+ if (lp->ldinfo_next == 0)
+ lp = NULL;
+ else
+ lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
+ }
+ free(buf);
+ if (!ldp) {
+ errvalid++;
+ strcpy(errbuf, "readExports: ");
+ strcat(errbuf, strerror(errno));
+ return -1;
+ }
+ }
+ if (TYPE(ldp) != U802TOCMAGIC) {
+ errvalid++;
+ strcpy(errbuf, "readExports: bad magic");
+ while(ldclose(ldp) == FAILURE)
+ ;
+ return -1;
+ }
+ /*
+ * Get the padding for the data section. This is needed for
+ * AIX 4.1 compilers. This is used when building the final
+ * function pointer to the exported symbol.
+ */
+ if (ldnshread(ldp, _DATA, &shdata) != SUCCESS) {
+ errvalid++;
+ strcpy(errbuf, "readExports: cannot read data section header");
+ while(ldclose(ldp) == FAILURE)
+ ;
+ return -1;
+ }
+ if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
+ errvalid++;
+ strcpy(errbuf, "readExports: cannot read loader section header");
+ while(ldclose(ldp) == FAILURE)
+ ;
+ return -1;
+ }
+ /*
+ * We read the complete loader section in one chunk, this makes
+ * finding long symbol names residing in the string table easier.
+ */
+ if ((ldbuf = (char *)malloc(sh.s_size)) == NULL) {
+ errvalid++;
+ strcpy(errbuf, "readExports: ");
+ strcat(errbuf, strerror(errno));
+ while(ldclose(ldp) == FAILURE)
+ ;
+ return -1;
+ }
+ if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
+ errvalid++;
+ strcpy(errbuf, "readExports: cannot seek to loader section");
+ free(ldbuf);
+ while(ldclose(ldp) == FAILURE)
+ ;
+ return -1;
+ }
+ if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
+ errvalid++;
+ strcpy(errbuf, "readExports: cannot read loader section");
+ free(ldbuf);
+ while(ldclose(ldp) == FAILURE)
+ ;
+ return -1;
+ }
+ lhp = (LDHDR *)ldbuf;
+ ls = (LDSYM *)(ldbuf+LDHDRSZ);
+ /*
+ * Count the number of exports to include in our export table.
+ */
+ for (i = lhp->l_nsyms; i; i--, ls++) {
+ if (!LDR_EXPORT(*ls))
+ continue;
+ mp->nExports++;
+ }
+ if ((mp->exports = (ExportPtr)calloc(mp->nExports, sizeof(*mp->exports))) == NULL) {
+ errvalid++;
+ strcpy(errbuf, "readExports: ");
+ strcat(errbuf, strerror(errno));
+ free(ldbuf);
+ while(ldclose(ldp) == FAILURE)
+ ;
+ return -1;
+ }
+ /*
+ * Fill in the export table. All entries are relative to
+ * the entry point we got from load.
+ */
+ ep = mp->exports;
+ ls = (LDSYM *)(ldbuf+LDHDRSZ);
+ for (i = lhp->l_nsyms; i; i--, ls++) {
+ char *symname;
+ char tmpsym[SYMNMLEN+1];
+ if (!LDR_EXPORT(*ls))
+ continue;
+ if (ls->l_zeroes == 0)
+ symname = ls->l_offset+lhp->l_stoff+ldbuf;
+ else {
+ /*
+ * The l_name member is not zero terminated, we
+ * must copy the first SYMNMLEN chars and make
+ * sure we have a zero byte at the end.
+ */
+ strncpy(tmpsym, ls->l_name, SYMNMLEN);
+ tmpsym[SYMNMLEN] = '\0';
+ symname = tmpsym;
+ }
+ ep->name = malloc((unsigned) (strlen(symname) + 1));
+ strcpy(ep->name, symname);
+ ep->addr = (void *)((unsigned long)mp->entry +
+ ls->l_value - shdata.s_vaddr);
+ ep++;
+ }
+ free(ldbuf);
+ while(ldclose(ldp) == FAILURE)
+ ;
+ return 0;
+}
+
+/*
+ * Find the main modules entry point. This is used as export pointer
+ * for loadbind() to be able to resolve references to the main part.
+ */
+static void * findMain(void)
+{
+ struct ld_info *lp;
+ char *buf;
+ int size = 4*1024;
+ int i;
+ void *ret;
+
+ if ((buf = malloc(size)) == NULL) {
+ errvalid++;
+ strcpy(errbuf, "findMain: ");
+ strcat(errbuf, strerror(errno));
+ return NULL;
+ }
+ while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
+ free(buf);
+ size += 4*1024;
+ if ((buf = malloc(size)) == NULL) {
+ errvalid++;
+ strcpy(errbuf, "findMain: ");
+ strcat(errbuf, strerror(errno));
+ return NULL;
+ }
+ }
+ if (i == -1) {
+ errvalid++;
+ strcpy(errbuf, "findMain: ");
+ strcat(errbuf, strerror(errno));
+ free(buf);
+ return NULL;
+ }
+ /*
+ * The first entry is the main module. The entry point
+ * returned by load() does actually point to the data
+ * segment origin.
+ */
+ lp = (struct ld_info *)buf;
+ ret = lp->ldinfo_dataorg;
+ free(buf);
+ return ret;
+}
+
diff --git a/unix/tclLoadAout.c b/unix/tclLoadAout.c
new file mode 100644
index 0000000..ade7161
--- /dev/null
+++ b/unix/tclLoadAout.c
@@ -0,0 +1,470 @@
+/*
+ * tclLoadAout.c --
+ *
+ * This procedure provides a version of the TclLoadFile that
+ * provides pseudo-static linking using version-7 compatible
+ * a.out files described in either sys/exec.h or sys/a.out.h.
+ *
+ * Copyright (c) 1995, by General Electric Company. All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * This work was supported in part by the ARPA Manufacturing Automation
+ * and Design Engineering (MADE) Initiative through ARPA contract
+ * F33615-94-C-4400.
+ *
+ * SCCS: @(#) tclLoadAout.c 1.9 97/02/22 14:05:01
+ */
+
+#include "tclInt.h"
+#include <fcntl.h>
+#ifdef HAVE_EXEC_AOUT_H
+# include <sys/exec_aout.h>
+#endif
+
+/*
+ * Some systems describe the a.out header in sys/exec.h, and some in
+ * a.out.h.
+ */
+
+#ifdef USE_SYS_EXEC_H
+#include <sys/exec.h>
+#endif
+#ifdef USE_A_OUT_H
+#include <a.out.h>
+#endif
+#ifdef USE_SYS_EXEC_AOUT_H
+#include <sys/exec_aout.h>
+#define a_magic a_midmag
+#endif
+
+/*
+ * TCL_LOADSHIM is the amount by which to shim the break when loading
+ */
+
+#ifndef TCL_LOADSHIM
+#define TCL_LOADSHIM 0x4000L
+#endif
+
+/*
+ * TCL_LOADALIGN must be a power of 2, and is the alignment to which
+ * to force the origin of load modules
+ */
+
+#ifndef TCL_LOADALIGN
+#define TCL_LOADALIGN 0x4000L
+#endif
+
+/*
+ * TCL_LOADMAX is the maximum size of a load module, and is used as
+ * a sanity check when loading
+ */
+
+#ifndef TCL_LOADMAX
+#define TCL_LOADMAX 2000000L
+#endif
+
+/*
+ * Kernel calls that appear to be missing from the system .h files:
+ */
+
+extern char * brk _ANSI_ARGS_((char *));
+extern char * sbrk _ANSI_ARGS_((size_t));
+
+/*
+ * The static variable SymbolTableFile contains the file name where the
+ * result of the last link was stored. The file is kept because doing so
+ * allows one load module to use the symbols defined in another.
+ */
+
+static char * SymbolTableFile = NULL;
+
+/*
+ * Type of the dictionary function that begins each load module.
+ */
+
+typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_ ((char * symbol));
+
+/*
+ * Prototypes for procedures referenced only in this file:
+ */
+
+static int FindLibraries _ANSI_ARGS_((Tcl_Interp * interp, char * fileName,
+ Tcl_DString * buf));
+static void UnlinkSymbolTable _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ * Dynamically loads a binary code file into memory and returns
+ * the addresses of two procedures within that file, if they
+ * are defined.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error
+ * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * are filled in with the addresses of the symbols given by
+ * *sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *
+ * Bugs:
+ * This function does not attempt to handle the case where the
+ * BSS segment is not executable. It will therefore fail on
+ * Encore Multimax, Pyramid 90x, and similar machines. The
+ * reason is that the mprotect() kernel call, which would
+ * otherwise be employed to mark the newly-loaded text segment
+ * executable, results in a system crash on BSD/386.
+ *
+ * In an effort to make it fast, this function eschews the
+ * technique of linking the load module once, reading its header
+ * to determine its size, allocating memory for it, and linking
+ * it again. Instead, it `shims out' memory allocation by
+ * placing the module TCL_LOADSHIM bytes beyond the break,
+ * and assuming that any malloc() calls required to run the
+ * linker will not advance the break beyond that point. If
+ * the break is advanced beyonnd that point, the load will
+ * fail with an `inconsistent memory allocation' error.
+ * It perhaps ought to retry the link, but the failure has
+ * not been observed in two years of daily use of this function.
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+{
+ char * inputSymbolTable; /* Name of the file containing the
+ * symbol table from the last link. */
+ Tcl_DString linkCommandBuf; /* Command to do the run-time relocation
+ * of the module.*/
+ char * linkCommand;
+ char relocatedFileName [L_tmpnam];
+ /* Name of the file holding the relocated */
+ /* text of the module */
+ int relocatedFd; /* File descriptor of the file holding
+ * relocated text */
+ struct exec relocatedHead; /* Header of the relocated text */
+ unsigned long relocatedSize; /* Size of the relocated text */
+ char * startAddress; /* Starting address of the module */
+ DictFn dictionary; /* Dictionary function in the load module */
+ int status; /* Status return from Tcl_ calls */
+ char * p;
+
+ /* Find the file that contains the symbols for the run-time link. */
+
+ if (SymbolTableFile != NULL) {
+ inputSymbolTable = SymbolTableFile;
+ } else if (tclExecutableName == NULL) {
+ Tcl_SetResult (interp, "can't find the tclsh executable", TCL_STATIC);
+ return TCL_ERROR;
+ } else {
+ inputSymbolTable = tclExecutableName;
+ }
+
+ /* Construct the `ld' command that builds the relocated module */
+
+ tmpnam (relocatedFileName);
+ Tcl_DStringInit (&linkCommandBuf);
+ Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1);
+ Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1);
+#if defined(__mips) || defined(mips)
+ Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);
+#endif
+ Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);
+ TclGuessPackageName(fileName, &linkCommandBuf);
+ Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);
+ Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);
+ Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);
+ Tcl_DStringAppend (&linkCommandBuf, fileName, -1);
+ Tcl_DStringAppend (&linkCommandBuf, " ", -1);
+ if (FindLibraries (interp, fileName, &linkCommandBuf) != TCL_OK) {
+ Tcl_DStringFree (&linkCommandBuf);
+ return TCL_ERROR;
+ }
+ linkCommand = Tcl_DStringValue (&linkCommandBuf);
+
+ /* Determine the starting address, and plug it into the command */
+
+ startAddress = (char *) (((unsigned long) sbrk (0)
+ + TCL_LOADSHIM + TCL_LOADALIGN - 1)
+ & (- TCL_LOADALIGN));
+ p = strstr (linkCommand, "-T") + 3;
+ sprintf (p, "%08lx", (long) startAddress);
+ p [8] = ' ';
+
+ /* Run the linker */
+
+ status = Tcl_Eval (interp, linkCommand);
+ Tcl_DStringFree (&linkCommandBuf);
+ if (status != 0) {
+ return TCL_ERROR;
+ }
+
+ /* Open the linker's result file and read the header */
+
+ relocatedFd = open (relocatedFileName, O_RDONLY);
+ if (relocatedFd < 0) {
+ goto ioError;
+ }
+ status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead);
+ if (status < sizeof relocatedHead) {
+ goto ioError;
+ }
+
+ /* Check the magic number */
+
+ if (relocatedHead.a_magic != OMAGIC) {
+ Tcl_AppendResult (interp, "bad magic number in intermediate file \"",
+ relocatedFileName, "\"", (char *) NULL);
+ goto failure;
+ }
+
+ /* Make sure that memory allocation is still consistent */
+
+ if ((unsigned long) sbrk (0) > (unsigned long) startAddress) {
+ Tcl_SetResult (interp, "can't load, memory allocation is inconsistent.",
+ TCL_STATIC);
+ goto failure;
+ }
+
+ /* Make sure that the relocated module's size is reasonable */
+
+ relocatedSize = relocatedHead.a_text + relocatedHead.a_data
+ + relocatedHead.a_bss;
+ if (relocatedSize > TCL_LOADMAX) {
+ Tcl_SetResult (interp, "module too big to load", TCL_STATIC);
+ goto failure;
+ }
+
+ /* Advance the break to protect the loaded module */
+
+ (void) brk (startAddress + relocatedSize);
+
+ /* Seek to the start of the module's text */
+
+#if defined(__mips) || defined(mips)
+ status = lseek (relocatedFd,
+ N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
+ SEEK_SET);
+#else
+ status = lseek (relocatedFd, N_TXTOFF (relocatedHead), SEEK_SET);
+#endif
+ if (status < 0) {
+ goto ioError;
+ }
+
+ /* Read in the module's text and data */
+
+ relocatedSize = relocatedHead.a_text + relocatedHead.a_data;
+ if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) {
+ brk (startAddress);
+ ioError:
+ Tcl_AppendResult (interp, "error on intermediate file \"",
+ relocatedFileName, "\": ", Tcl_PosixError (interp),
+ (char *) NULL);
+ failure:
+ (void) unlink (relocatedFileName);
+ return TCL_ERROR;
+ }
+
+ /* Close the intermediate file. */
+
+ (void) close (relocatedFd);
+
+ /* Arrange things so that intermediate symbol tables eventually get
+ * deleted. */
+
+ if (SymbolTableFile != NULL) {
+ UnlinkSymbolTable ();
+ } else {
+ atexit (UnlinkSymbolTable);
+ }
+ SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1);
+ strcpy (SymbolTableFile, relocatedFileName);
+
+ /* Look up the entry points in the load module's dictionary. */
+
+ dictionary = (DictFn) startAddress;
+ *proc1Ptr = dictionary (sym1);
+ *proc2Ptr = dictionary (sym2);
+
+ return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * FindLibraries --
+ *
+ * Find the libraries needed to link a load module at run time.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs,
+ * an error message is left in interp->result. The -l and -L flags
+ * are concatenated onto the dynamic string `buf'.
+ *
+ *------------------------------------------------------------------------
+ */
+
+static int
+FindLibraries (interp, fileName, buf)
+ Tcl_Interp * interp; /* Used for error reporting */
+ char * fileName; /* Name of the load module */
+ Tcl_DString * buf; /* Buffer where the -l an -L flags */
+{
+ FILE * f; /* The load module */
+ int c; /* Byte from the load module */
+ char * p;
+
+ /* Open the load module */
+
+ if ((f = fopen (fileName, "rb")) == NULL) {
+ Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ",
+ Tcl_PosixError (interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Search for the library list in the load module */
+
+ p = "@LIBS: ";
+ while (*p != '\0' && (c = getc (f)) != EOF) {
+ if (c == *p) {
+ ++p;
+ }
+ else {
+ p = "@LIBS: ";
+ if (c == *p) {
+ ++p;
+ }
+ }
+ }
+
+ /* No library list -- this must be an ill-formed module */
+
+ if (c == EOF) {
+ Tcl_AppendResult (interp, "File \"", fileName,
+ "\" is not a Tcl load module.", (char *) NULL);
+ (void) fclose (f);
+ return TCL_ERROR;
+ }
+
+ /* Accumulate the library list */
+
+ while ((c = getc (f)) != '\0' && c != EOF) {
+ char cc = c;
+ Tcl_DStringAppend (buf, &cc, 1);
+ }
+ (void) fclose (f);
+
+ if (c == EOF) {
+ Tcl_AppendResult (interp, "Library directory in \"", fileName,
+ "\" ends prematurely.", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * UnlinkSymbolTable --
+ *
+ * Remove the symbol table file from the last dynamic link.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The symbol table file from the last dynamic link is removed.
+ * This function is called when (a) a new symbol table is present
+ * because another dynamic link is complete, or (b) the process
+ * is exiting.
+ *------------------------------------------------------------------------
+ */
+
+static void
+UnlinkSymbolTable ()
+{
+ (void) unlink (SymbolTableFile);
+ ckfree (SymbolTableFile);
+ SymbolTableFile = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(fileName, bufPtr)
+ 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. */
+{
+ char *p, *q, *r;
+
+ if (q = strrchr(fileName,'/')) {
+ q++;
+ } else {
+ q = fileName;
+ }
+ if (!strncmp(q,"lib",3)) {
+ q+=3;
+ }
+ p = q;
+ while ((*p) && (*p != '.') && ((*p<'0') || (*p>'9'))) {
+ p++;
+ }
+ if ((p>q+2) && !strncmp(p-2,"_G0.",4)) {
+ p-=2;
+ }
+ if (p<q) {
+ return 0;
+ }
+
+ Tcl_DStringAppend(bufPtr,q, p-q);
+
+ r = Tcl_DStringValue(bufPtr);
+ r += strlen(r) - (p-q);
+
+ if (islower(UCHAR(*r))) {
+ *r = (char) toupper(UCHAR(*r));
+ }
+ while (*(++r)) {
+ if (isupper(UCHAR(*r))) {
+ *r = (char) tolower(UCHAR(*r));
+ }
+ }
+
+ return 1;
+}
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
new file mode 100644
index 0000000..2619bfd
--- /dev/null
+++ b/unix/tclLoadDl.c
@@ -0,0 +1,135 @@
+/*
+ * 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 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclLoadDl.c 1.8 96/12/03 16:57:00
+ */
+
+#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_GLOBAL
+ * flag is needed on some systems (e.g. SCO and UnixWare) but doesn't
+ * exist on others; if it doesn't exist, set it to 0 so it has no effect.
+ */
+
+#ifndef RTLD_NOW
+# define RTLD_NOW 1
+#endif
+
+#ifndef RTLD_GLOBAL
+# define RTLD_GLOBAL 0
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ * Dynamically loads a binary code file into memory and returns
+ * the addresses of two procedures within that file, if they
+ * are defined.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error
+ * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * are filled in with the addresses of the symbols given by
+ * *sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+{
+ VOID *handle;
+ Tcl_DString newName;
+
+ handle = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);
+ if (handle == NULL) {
+ Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+ "\": ", dlerror(), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * 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.
+ */
+
+ *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym1);
+ if (*proc1Ptr == NULL) {
+ Tcl_DStringInit(&newName);
+ Tcl_DStringAppend(&newName, "_", 1);
+ Tcl_DStringAppend(&newName, sym1, -1);
+ *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle,
+ Tcl_DStringValue(&newName));
+ Tcl_DStringFree(&newName);
+ }
+ *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym2);
+ if (*proc2Ptr == NULL) {
+ Tcl_DStringInit(&newName);
+ Tcl_DStringAppend(&newName, "_", 1);
+ Tcl_DStringAppend(&newName, sym2, -1);
+ *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle,
+ Tcl_DStringValue(&newName));
+ Tcl_DStringFree(&newName);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(fileName, bufPtr)
+ 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;
+}
diff --git a/unix/tclLoadDld.c b/unix/tclLoadDld.c
new file mode 100644
index 0000000..0ef994a
--- /dev/null
+++ b/unix/tclLoadDld.c
@@ -0,0 +1,125 @@
+/*
+ * tclLoadDld.c --
+ *
+ * This procedure provides a version of the TclLoadFile that
+ * works with the "dld_link" and "dld_get_func" library procedures
+ * for dynamic loading. It has been tested on Linux 1.1.95 and
+ * dld-3.2.7. This file probably isn't needed anymore, since it
+ * makes more sense to use "dl_open" etc.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclLoadDld.c 1.5 97/05/14 13:24:22
+ */
+
+#include "tclInt.h"
+#include "dld.h"
+
+/*
+ * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
+ * and this argument to dlopen must always be 1.
+ */
+
+#ifndef RTLD_NOW
+# define RTLD_NOW 1
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ * Dynamically loads a binary code file into memory and returns
+ * the addresses of two procedures within that file, if they
+ * are defined.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error
+ * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * are filled in with the addresses of the symbols given by
+ * *sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+{
+ static int firstTime = 1;
+ int returnCode;
+
+ /*
+ * The dld package needs to know the pathname to the tcl binary.
+ * If that's not know, return an error.
+ */
+
+ if (firstTime) {
+ if (tclExecutableName == NULL) {
+ Tcl_SetResult(interp,
+ "don't know name of application binary file, so can't initialize dynamic loader",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ returnCode = dld_init(tclExecutableName);
+ if (returnCode != 0) {
+ Tcl_AppendResult(interp,
+ "initialization failed for dynamic loader: ",
+ dld_strerror(returnCode), (char *) NULL);
+ return TCL_ERROR;
+ }
+ firstTime = 0;
+ }
+
+ if ((returnCode = dld_link(fileName)) != 0) {
+ Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+ "\": ", dld_strerror(returnCode), (char *) NULL);
+ return TCL_ERROR;
+ }
+ *proc1Ptr = (Tcl_PackageInitProc *) dld_get_func(sym1);
+ *proc2Ptr = (Tcl_PackageInitProc *) dld_get_func(sym2);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(fileName, bufPtr)
+ 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;
+}
diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c
new file mode 100644
index 0000000..ed4b823
--- /dev/null
+++ b/unix/tclLoadNext.c
@@ -0,0 +1,111 @@
+/*
+ * tclLoadNext.c --
+ *
+ * This procedure provides a version of the TclLoadFile that
+ * works with NeXTs rld_* dynamic loading. This file provided
+ * by Pedja Bogdanovich.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclLoadNext.c 1.4 96/02/15 11:58:55
+ */
+
+#include "tclInt.h"
+#include <mach-o/rld.h>
+#include <streams/streams.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ * Dynamically loads a binary code file into memory and returns
+ * the addresses of two procedures within that file, if they
+ * are defined.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error
+ * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * are filled in with the addresses of the symbols given by
+ * *sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+{
+ struct mach_header *header;
+ char *data;
+ int len, maxlen;
+ char *files[]={fileName,NULL};
+ NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE);
+
+ if(!rld_load(errorStream,&header,files,NULL)) {
+ NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
+ Tcl_AppendResult(interp,"couldn't load file \"",fileName,"\": ",data,NULL);
+ NXCloseMemory(errorStream,NX_FREEBUFFER);
+ return TCL_ERROR;
+ }
+ NXCloseMemory(errorStream,NX_FREEBUFFER);
+
+ *proc1Ptr=NULL;
+ if(sym1) {
+ char sym[strlen(sym1)+2];
+ sym[0]='_'; sym[1]=0; strcat(sym,sym1);
+ rld_lookup(NULL,sym,(unsigned long *)proc1Ptr);
+ }
+
+ *proc2Ptr=NULL;
+ if(sym2) {
+ char sym[strlen(sym2)+2];
+ sym[0]='_'; sym[1]=0; strcat(sym,sym2);
+ rld_lookup(NULL,sym,(unsigned long *)proc2Ptr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(fileName, bufPtr)
+ 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;
+}
diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c
new file mode 100644
index 0000000..ca8c8fc
--- /dev/null
+++ b/unix/tclLoadOSF.c
@@ -0,0 +1,128 @@
+/*
+ * tclLoadOSF.c --
+ *
+ * This procedure provides a version of the TclLoadFile that works
+ * under OSF/1 1.0/1.1/1.2 and related systems, utilizing the old OSF/1
+ * /sbin/loader and /usr/include/loader.h. OSF/1 versions from 1.3 and
+ * on use ELF, rtld, and dlopen()[/usr/include/ldfcn.h].
+ *
+ * This is useful for:
+ * OSF/1 1.0, 1.1, 1.2 (from OSF)
+ * includes: MK4 and AD1 (from OSF RI)
+ * OSF/1 1.3 (from OSF) using ROSE
+ * HP OSF/1 1.0 ("Acorn") using COFF
+ *
+ * This is likely to be useful for:
+ * Paragon OSF/1 (from Intel)
+ * HI-OSF/1 (from Hitachi)
+ *
+ * This is NOT to be used on:
+ * Digitial Alpha OSF/1 systems
+ * OSF/1 1.3 or later (from OSF) using ELF
+ * includes: MK6, MK7, AD2, AD3 (from OSF RI)
+ *
+ * This approach to things was utter @&^#; thankfully,
+ * OSF/1 eventually supported dlopen().
+ *
+ * John Robert LoVerso <loverso@freebsd.osf.org>
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclLoadOSF.c 1.2 96/02/15 11:58:40
+ */
+
+#include "tclInt.h"
+#include <sys/types.h>
+#include <loader.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ * Dynamically loads a binary code file into memory and returns
+ * the addresses of two procedures within that file, if they
+ * are defined.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error
+ * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * are filled in with the addresses of the symbols given by
+ * *sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+{
+ ldr_module_t lm;
+ char *pkg;
+
+ lm = (Tcl_PackageInitProc *) load(fileName, LDR_NOFLAGS);
+ if (lm == LDR_NULL_MODULE) {
+ Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+ "\": ", Tcl_PosixError (interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * My convention is to use a [OSF loader] package name the same as shlib,
+ * since the idiots never implemented ldr_lookup() and it is otherwise
+ * impossible to get a package name given a module.
+ *
+ * I build loadable modules with a makefile rule like
+ * ld ... -export $@: -o $@ $(OBJS)
+ */
+ if ((pkg = strrchr(fileName, '/')) == NULL)
+ pkg = fileName;
+ else
+ pkg++;
+ *proc1Ptr = ldr_lookup_package(pkg, sym1);
+ *proc2Ptr = ldr_lookup_package(pkg, sym2);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(fileName, bufPtr)
+ 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;
+}
diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c
new file mode 100644
index 0000000..2f290ab
--- /dev/null
+++ b/unix/tclLoadShl.c
@@ -0,0 +1,129 @@
+/*
+ * tclLoadShl.c --
+ *
+ * This procedure provides a version of the TclLoadFile that works
+ * with the "shl_load" and "shl_findsym" library procedures for
+ * dynamic loading (e.g. for HP machines).
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclLoadShl.c 1.5 96/03/15 15:01:44
+ */
+
+#include <dl.h>
+
+/*
+ * On some HP machines, dl.h defines EXTERN; remove that definition.
+ */
+
+#ifdef EXTERN
+# undef EXTERN
+#endif
+
+#include "tcl.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ * Dynamically loads a binary code file into memory and returns
+ * the addresses of two procedures within that file, if they
+ * are defined.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error
+ * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * are filled in with the addresses of the symbols given by
+ * *sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+{
+ shl_t handle;
+ Tcl_DString newName;
+
+ handle = shl_load(fileName, BIND_IMMEDIATE, 0L);
+ if (handle == NULL) {
+ Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Some versions of the HP system software still use "_" at the
+ * beginning of exported symbols while others don't; try both
+ * forms of each name.
+ */
+
+ if (shl_findsym(&handle, sym1, (short) TYPE_PROCEDURE, (void *) proc1Ptr)
+ != 0) {
+ Tcl_DStringInit(&newName);
+ Tcl_DStringAppend(&newName, "_", 1);
+ Tcl_DStringAppend(&newName, sym1, -1);
+ if (shl_findsym(&handle, Tcl_DStringValue(&newName),
+ (short) TYPE_PROCEDURE, (void *) proc1Ptr) != 0) {
+ *proc1Ptr = NULL;
+ }
+ Tcl_DStringFree(&newName);
+ }
+ if (shl_findsym(&handle, sym2, (short) TYPE_PROCEDURE, (void *) proc2Ptr)
+ != 0) {
+ Tcl_DStringInit(&newName);
+ Tcl_DStringAppend(&newName, "_", 1);
+ Tcl_DStringAppend(&newName, sym2, -1);
+ if (shl_findsym(&handle, Tcl_DStringValue(&newName),
+ (short) TYPE_PROCEDURE, (void *) proc2Ptr) != 0) {
+ *proc2Ptr = NULL;
+ }
+ Tcl_DStringFree(&newName);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(fileName, bufPtr)
+ 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;
+}
diff --git a/unix/tclMtherr.c b/unix/tclMtherr.c
new file mode 100644
index 0000000..24b815d
--- /dev/null
+++ b/unix/tclMtherr.c
@@ -0,0 +1,86 @@
+/*
+ * tclMatherr.c --
+ *
+ * This function provides a default implementation of the
+ * "matherr" function, for SYS-V systems where it's needed.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMtherr.c 1.12 96/06/22 16:36:57
+ */
+
+#include "tclInt.h"
+#include <math.h>
+
+#ifndef TCL_GENERIC_ONLY
+#include "tclPort.h"
+#else
+#define NO_ERRNO_H
+#endif
+
+#ifdef NO_ERRNO_H
+extern int errno; /* Use errno from tclExecute.c. */
+#define EDOM 33
+#define ERANGE 34
+#endif
+
+/*
+ * The following variable is secretly shared with Tcl so we can
+ * tell if expression evaluation is in progress. If not, matherr
+ * just emulates the default behavior, which includes printing
+ * a message.
+ */
+
+extern int tcl_MathInProgress;
+
+/*
+ * The following definitions allow matherr to compile on systems
+ * that don't really support it. The compiled procedure is bogus,
+ * but it will never be executed on these systems anyway.
+ */
+
+#ifndef NEED_MATHERR
+struct exception {
+ int type;
+};
+#define DOMAIN 0
+#define SING 0
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * matherr --
+ *
+ * This procedure is invoked on Sys-V systems when certain
+ * errors occur in mathematical functions. Type "man matherr"
+ * for more information on how this function works.
+ *
+ * Results:
+ * Returns 1 to indicate that we've handled the error
+ * locally.
+ *
+ * Side effects:
+ * Sets errno based on what's in xPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+matherr(xPtr)
+ struct exception *xPtr; /* Describes error that occurred. */
+{
+ if (!tcl_MathInProgress) {
+ return 0;
+ }
+ if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
+ errno = EDOM;
+ } else {
+ errno = ERANGE;
+ }
+ return 1;
+}
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
new file mode 100644
index 0000000..2c0e996
--- /dev/null
+++ b/unix/tclUnixChan.c
@@ -0,0 +1,2565 @@
+/*
+ * tclUnixChan.c
+ *
+ * Common channel driver for Unix channels based on files, command
+ * pipes and TCP sockets.
+ *
+ * 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.
+ *
+ * SCCS: @(#) tclUnixChan.c 1.207 97/11/04 14:45:29
+ */
+
+#include "tclInt.h" /* Internal definitions for Tcl. */
+#include "tclPort.h" /* Portability features for Tcl. */
+
+/*
+ * sys/ioctl.h has already been included by tclPort.h. Including termios.h
+ * or termio.h causes a bunch of warning messages because some duplicate
+ * (but not contradictory) #defines exist in termios.h and/or termio.h
+ */
+#undef NL0
+#undef NL1
+#undef CR0
+#undef CR1
+#undef CR2
+#undef CR3
+#undef TAB0
+#undef TAB1
+#undef TAB2
+#undef XTABS
+#undef BS0
+#undef BS1
+#undef FF0
+#undef FF1
+#undef ECHO
+#undef NOFLSH
+#undef TOSTOP
+#undef FLUSHO
+#undef PENDIN
+
+#ifdef USE_TERMIOS
+# include <termios.h>
+#else /* !USE_TERMIOS */
+#ifdef USE_TERMIO
+# include <termio.h>
+#else /* !USE_TERMIO */
+#ifdef USE_SGTTY
+# include <sgtty.h>
+#endif /* USE_SGTTY */
+#endif /* !USE_TERMIO */
+#endif /* !USE_TERMIOS */
+
+/*
+ * 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;
+
+/*
+ * 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. */
+ struct FileState *nextPtr; /* Pointer to next file in list of all
+ * file channels. */
+} FileState;
+
+/*
+ * List of all file channels currently open.
+ */
+
+static FileState *firstFilePtr = NULL;
+
+/*
+ * This structure describes per-instance state of a tcp based channel.
+ */
+
+typedef struct TcpState {
+ Tcl_Channel channel; /* Channel associated with this file. */
+ int fd; /* The socket itself. */
+ int flags; /* ORed combination of the bitfields
+ * defined below. */
+ Tcl_TcpAcceptProc *acceptProc;
+ /* Proc to call on accept. */
+ ClientData acceptProcData; /* The data for the accept proc. */
+} TcpState;
+
+/*
+ * These bits may be ORed together into the "flags" field of a TcpState
+ * structure.
+ */
+
+#define TCP_ASYNC_SOCKET (1<<0) /* Asynchronous socket. */
+#define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */
+
+/*
+ * The following defines the maximum length of the listen queue. This is
+ * the number of outstanding yet-to-be-serviced requests for a connection
+ * on a server socket, more than this number of outstanding requests and
+ * the connection request will fail.
+ */
+
+#ifndef SOMAXCONN
+#define SOMAXCONN 100
+#endif
+
+#if (SOMAXCONN < 100)
+#undef SOMAXCONN
+#define SOMAXCONN 100
+#endif
+
+/*
+ * The following defines how much buffer space the kernel should maintain
+ * for a socket.
+ */
+
+#define SOCKET_BUFSIZE 4096
+
+/*
+ * Static routines for this file:
+ */
+
+static TcpState * CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
+ int port, char *host, int server,
+ char *myaddr, int myport, int async));
+static int CreateSocketAddress _ANSI_ARGS_(
+ (struct sockaddr_in *sockaddrPtr,
+ char *host, int port));
+static int FileBlockModeProc _ANSI_ARGS_((
+ ClientData instanceData, int mode));
+static int FileCloseProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static int FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int FileOutputProc _ANSI_ARGS_((
+ ClientData instanceData, char *buf, int toWrite,
+ int *errorCode));
+static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
+ long offset, int mode, int *errorCode));
+static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static void TcpAccept _ANSI_ARGS_((ClientData data, int mask));
+static int TcpBlockModeProc _ANSI_ARGS_((ClientData data,
+ int mode));
+static int TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static int TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+static int TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ Tcl_DString *dsPtr));
+static int TcpInputProc _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toWrite, int *errorCode));
+static void TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static int TtyParseMode _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *mode, int *speedPtr, int *parityPtr,
+ int *dataPtr, int *stopPtr));
+static void TtyGetAttributes _ANSI_ARGS_((int fd,
+ TtyAttrs *ttyPtr));
+static int TtyGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ Tcl_DString *dsPtr));
+static void TtyInit _ANSI_ARGS_((int fd));
+static void TtySetAttributes _ANSI_ARGS_((int fd,
+ TtyAttrs *ttyPtr));
+static int TtySetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ char *value));
+static int WaitForConnect _ANSI_ARGS_((TcpState *statePtr,
+ int *errorCodePtr));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType fileChannelType = {
+ "file", /* Type name. */
+ FileBlockModeProc, /* Set blocking/nonblocking mode.*/
+ 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. */
+};
+
+/*
+ * This structure describes the channel type structure for serial IO.
+ * Note that this type is a subclass of the "file" type.
+ */
+
+static Tcl_ChannelType ttyChannelType = {
+ "tty", /* Type name. */
+ FileBlockModeProc, /* Set blocking/nonblocking mode.*/
+ 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. */
+};
+
+/*
+ * This structure describes the channel type structure for TCP socket
+ * based IO:
+ */
+
+static Tcl_ChannelType tcpChannelType = {
+ "tcp", /* Type name. */
+ TcpBlockModeProc, /* Set blocking/nonblocking mode.*/
+ TcpCloseProc, /* Close proc. */
+ TcpInputProc, /* Input proc. */
+ TcpOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ TcpGetOptionProc, /* Get option proc. */
+ TcpWatchProc, /* Initialize notifier. */
+ TcpGetHandleProc, /* Get OS handles out of channel. */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileBlockModeProc --
+ *
+ * Helper procedure 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(instanceData, mode)
+ ClientData instanceData; /* File state. */
+ int mode; /* The mode to set. Can be one of
+ * TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ FileState *fsPtr = (FileState *) instanceData;
+ int curStatus;
+
+#ifndef USE_FIONBIO
+ curStatus = fcntl(fsPtr->fd, F_GETFL);
+ if (mode == TCL_MODE_BLOCKING) {
+ curStatus &= (~(O_NONBLOCK));
+ } else {
+ curStatus |= O_NONBLOCK;
+ }
+ if (fcntl(fsPtr->fd, F_SETFL, curStatus) < 0) {
+ return errno;
+ }
+ curStatus = fcntl(fsPtr->fd, F_GETFL);
+#else
+ if (mode == TCL_MODE_BLOCKING) {
+ curStatus = 0;
+ } else {
+ curStatus = 1;
+ }
+ if (ioctl(fsPtr->fd, (int) FIONBIO, &curStatus) < 0) {
+ return errno;
+ }
+#endif
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileInputProc --
+ *
+ * This procedure 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(instanceData, buf, toRead, errorCodePtr)
+ 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 = (FileState *) 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 procedure 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(instanceData, buf, toWrite, errorCodePtr)
+ ClientData instanceData; /* File state. */
+ char *buf; /* The data buffer. */
+ int toWrite; /* How many bytes to write? */
+ int *errorCodePtr; /* Where to store error code. */
+{
+ FileState *fsPtr = (FileState *) instanceData;
+ int written;
+
+ *errorCodePtr = 0;
+ written = write(fsPtr->fd, buf, (size_t) toWrite);
+ if (written > -1) {
+ return written;
+ }
+ *errorCodePtr = errno;
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileCloseProc --
+ *
+ * This procedure 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(instanceData, interp)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - unused. */
+{
+ FileState *fsPtr = (FileState *) instanceData;
+ FileState **nextPtrPtr;
+ int errorCode = 0;
+
+ Tcl_DeleteFileHandler(fsPtr->fd);
+ if (!TclInExit()
+ || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
+ if (close(fsPtr->fd) < 0) {
+ errorCode = errno;
+ }
+ }
+ for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
+ nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
+ if ((*nextPtrPtr) == fsPtr) {
+ (*nextPtrPtr) = fsPtr->nextPtr;
+ break;
+ }
+ }
+ ckfree((char *) fsPtr);
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileSeekProc --
+ *
+ * This procedure 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(instanceData, offset, mode, errorCodePtr)
+ 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 = (FileState *) instanceData;
+ int newLoc;
+
+ newLoc = lseek(fsPtr->fd, 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(instanceData, mask)
+ ClientData instanceData; /* The file state. */
+ int mask; /* Events of interest; an OR-ed
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+ FileState *fsPtr = (FileState *) 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,
+ (ClientData) fsPtr->channel);
+ } else {
+ Tcl_DeleteFileHandler(fsPtr->fd);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileGetHandleProc --
+ *
+ * Called from Tcl_GetChannelFile 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(instanceData, direction, handlePtr)
+ ClientData instanceData; /* The file state. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr; /* Where to store the handle. */
+{
+ FileState *fsPtr = (FileState *) instanceData;
+
+ if (direction & fsPtr->validMask) {
+ *handlePtr = (ClientData) fsPtr->fd;
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtySetOptionProc --
+ *
+ * Sets an option on a channel.
+ *
+ * Results:
+ * A standard Tcl result. Also sets interp->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(instanceData, interp, optionName, value)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Which option to set? */
+ char *value; /* New value for option. */
+{
+ FileState *fsPtr = (FileState *) instanceData;
+ unsigned int len;
+ TtyAttrs tty;
+
+ len = strlen(optionName);
+ if ((len > 1) && (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;
+ } else {
+ return Tcl_BadChannelOption(interp, optionName, "mode");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(instanceData, interp, optionName, dsPtr)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Option to get. */
+ Tcl_DString *dsPtr; /* Where to store value(s). */
+{
+ FileState *fsPtr = (FileState *) instanceData;
+ unsigned int len;
+ char buf[32];
+ TtyAttrs tty;
+
+ if (optionName == NULL) {
+ Tcl_DStringAppendElement(dsPtr, "-mode");
+ len = 0;
+ } else {
+ len = strlen(optionName);
+ }
+ if ((len == 0) ||
+ ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
+ TtyGetAttributes(fsPtr->fd, &tty);
+ sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ return TCL_OK;
+ } else {
+ return Tcl_BadChannelOption(interp, optionName, "mode");
+ }
+}
+
+#undef DIRECT_BAUD
+#ifdef B4800
+# if (B4800 == 4800)
+# define DIRECT_BAUD
+# endif
+#endif
+
+#ifdef DIRECT_BAUD
+# define TtyGetSpeed(baud) ((unsigned) (baud))
+# define TtyGetBaud(speed) ((int) (speed))
+#else
+
+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(baud)
+ 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(speed)
+ 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 */
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Serial device initialized.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TtyInit(fd)
+ int fd; /* Open file descriptor for serial port to
+ * be initialized. */
+{
+#ifdef USE_TERMIOS
+ struct termios termios;
+
+ tcgetattr(fd, &termios);
+ termios.c_iflag = IGNBRK;
+ termios.c_oflag = 0;
+ termios.c_lflag = 0;
+ termios.c_cflag |= CREAD;
+ termios.c_cc[VMIN] = 60;
+ termios.c_cc[VTIME] = 2;
+ tcsetattr(fd, TCSANOW, &termios);
+#else /* !USE_TERMIOS */
+#ifdef USE_TERMIO
+ struct termio termio;
+
+ ioctl(fd, TCGETA, &termio);
+ termio.c_iflag = IGNBRK;
+ termio.c_oflag = 0;
+ termio.c_lflag = 0;
+ termio.c_cflag |= CREAD;
+ termio.c_cc[VMIN] = 60;
+ termio.c_cc[VTIME] = 2;
+ ioctl(fd, TCSETAW, &termio);
+#else /* !USE_TERMIO */
+#ifdef USE_SGTTY
+ struct sgttyb sgttyb;
+
+ ioctl(fd, TIOCGETP, &sgttyb);
+ sgttyb.sg_flags &= (EVENP | ODDP);
+ sgttyb.sg_flags |= RAW;
+ ioctl(fd, TIOCSETP, &sgttyb);
+#endif /* USE_SGTTY */
+#endif /* !USE_TERMIO */
+#endif /* !USE_TERMIOS */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyGetAttributes --
+ *
+ * Get the current attributes of the specified serial device.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TtyGetAttributes(fd, ttyPtr)
+ int fd; /* Open file descriptor for serial port to
+ * be queried. */
+ TtyAttrs *ttyPtr; /* Buffer filled with serial port
+ * attributes. */
+{
+#ifdef USE_TERMIOS
+ int parity, data;
+ struct termios termios;
+
+ tcgetattr(fd, &termios);
+ ttyPtr->baud = TtyGetBaud(cfgetospeed(&termios));
+
+ parity = 'n';
+#ifdef PAREXT
+ switch ((int) (termios.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) (termios.c_cflag & (PARENB | PARODD))) {
+ case PARENB : parity = 'e'; break;
+ case PARENB | PARODD : parity = 'o'; break;
+ }
+#endif /* !PAREXT */
+ ttyPtr->parity = parity;
+
+ data = termios.c_cflag & CSIZE;
+ ttyPtr->data = (data == CS5) ? 5 : (data == CS6) ? 6 :
+ (data == CS7) ? 7 : 8;
+
+ ttyPtr->stop = (termios.c_cflag & CSTOPB) ? 2 : 1;
+#else /* !USE_TERMIOS */
+#ifdef USE_TERMIO
+ int parity, data;
+ struct termio termio;
+
+ ioctl(fd, TCGETA, &termio);
+ ttyPtr->baud = TtyGetBaud(termio.c_cflag & CBAUD);
+ parity = 'n';
+ switch (termio.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;
+ }
+ ttyPtr->parity = parity;
+
+ data = termio.c_cflag & CSIZE;
+ ttyPtr->data = (data == CS5) ? 5 : (data == CS6) ? 6 :
+ (data == CS7) ? 7 : 8;
+
+ ttyPtr->stop = (termio.c_cflag & CSTOPB) ? 2 : 1;
+#else /* !USE_TERMIO */
+#ifdef USE_SGTTY
+ int parity;
+ struct sgttyb sgttyb;
+
+ ioctl(fd, TIOCGETP, &sgttyb);
+ ttyPtr->baud = TtyGetBaud(sgttyb.sg_ospeed);
+ parity = 'n';
+ if (sgttyb.sg_flags & EVENP) {
+ parity = 'e';
+ } else if (sgttyb.sg_flags & ODDP) {
+ parity = 'o';
+ }
+ ttyPtr->parity = parity;
+ ttyPtr->data = (sgttyb.sg_flags & (EVENP | ODDP)) ? 7 : 8;
+ ttyPtr->stop = 1;
+#else /* !USE_SGTTY */
+ ttyPtr->baud = 0;
+ ttyPtr->parity = 'n';
+ ttyPtr->data = 0;
+ ttyPtr->stop = 0;
+#endif /* !USE_SGTTY */
+#endif /* !USE_TERMIO */
+#endif /* !USE_TERMIOS */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TtySetAttributes --
+ *
+ * Set the current attributes of the specified serial device.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TtySetAttributes(fd, ttyPtr)
+ int fd; /* Open file descriptor for serial port to
+ * be modified. */
+ TtyAttrs *ttyPtr; /* Buffer containing new attributes for
+ * serial port. */
+{
+#ifdef USE_TERMIOS
+ int parity, data, flag;
+ struct termios termios;
+
+ tcgetattr(fd, &termios);
+ cfsetospeed(&termios, TtyGetSpeed(ttyPtr->baud));
+ cfsetispeed(&termios, TtyGetSpeed(ttyPtr->baud));
+
+ flag = 0;
+ parity = ttyPtr->parity;
+ if (parity != 'n') {
+ flag |= PARENB;
+#ifdef PAREXT
+ termios.c_cflag &= ~PAREXT;
+ if ((parity == 'm') || (parity == 's')) {
+ flag |= PAREXT;
+ }
+#endif
+ if ((parity == 'm') || (parity == 'o')) {
+ flag |= PARODD;
+ }
+ }
+ data = ttyPtr->data;
+ flag |= (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8;
+ if (ttyPtr->stop == 2) {
+ flag |= CSTOPB;
+ }
+
+ termios.c_cflag &= ~(PARENB | PARODD | CSIZE | CSTOPB);
+ termios.c_cflag |= flag;
+ tcsetattr(fd, TCSANOW, &termios);
+
+#else /* !USE_TERMIOS */
+#ifdef USE_TERMIO
+ int parity, data, flag;
+ struct termio termio;
+
+ ioctl(fd, TCGETA, &termio);
+ termio.c_cflag &= ~CBAUD;
+ termio.c_cflag |= TtyGetSpeed(ttyPtr->baud);
+
+ flag = 0;
+ parity = ttyPtr->parity;
+ if (parity != 'n') {
+ flag |= PARENB;
+ if ((parity == 'm') || (parity == 's')) {
+ flag |= PAREXT;
+ }
+ if ((parity == 'm') || (parity == 'o')) {
+ flag |= PARODD;
+ }
+ }
+ data = ttyPtr->data;
+ flag |= (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8;
+ if (ttyPtr->stop == 2) {
+ flag |= CSTOPB;
+ }
+
+ termio.c_cflag &= ~(PARENB | PARODD | PAREXT | CSIZE | CSTOPB);
+ termio.c_cflag |= flag;
+ ioctl(fd, TCSETAW, &termio);
+
+#else /* !USE_TERMIO */
+#ifdef USE_SGTTY
+ int parity;
+ struct sgttyb sgttyb;
+
+ ioctl(fd, TIOCGETP, &sgttyb);
+ sgttyb.sg_ospeed = TtyGetSpeed(ttyPtr->baud);
+ sgttyb.sg_ispeed = TtyGetSpeed(ttyPtr->baud);
+
+ parity = ttyPtr->parity;
+ if (parity == 'e') {
+ sgttyb.sg_flags &= ~ODDP;
+ sgttyb.sg_flags |= EVENP;
+ } else if (parity == 'o') {
+ sgttyb.sg_flags &= ~EVENP;
+ sgttyb.sg_flags |= ODDP;
+ }
+ ioctl(fd, TIOCSETP, &sgttyb);
+#endif /* USE_SGTTY */
+#endif /* !USE_TERMIO */
+#endif /* !USE_TERMIOS */
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 interp->result (if interp is non-NULL).
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
+ 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 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;
+ }
+ if (strchr("noems", parity) == NULL) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, bad,
+ " parity: should be n, o, e, m, or s", 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenFileChannel --
+ *
+ * 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 interp->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
+Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
+ Tcl_Interp *interp; /* Interpreter for error reporting;
+ * can be NULL. */
+ char *fileName; /* Name of file to open. */
+ char *modeString; /* A list of POSIX open modes or
+ * a string such as "rw". */
+ int permissions; /* If the open involves creating a
+ * file, with what modes to create
+ * it? */
+{
+ int fd, seekFlag, mode, channelPermissions;
+ FileState *fsPtr;
+ char *nativeName, channelName[20];
+ Tcl_DString buffer;
+ Tcl_ChannelType *channelTypePtr;
+
+ mode = TclGetOpenMode(interp, modeString, &seekFlag);
+ if (mode == -1) {
+ return NULL;
+ }
+ 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.
+ */
+ panic("Tcl_OpenFileChannel: invalid mode value");
+ return NULL;
+ }
+
+ nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+ if (nativeName == NULL) {
+ return NULL;
+ }
+ fd = open(nativeName, mode, permissions);
+
+ /*
+ * If nativeName is not NULL, the buffer is valid and we must free
+ * the storage.
+ */
+
+ Tcl_DStringFree(&buffer);
+
+ if (fd < 0) {
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) 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);
+
+ fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
+ fsPtr->nextPtr = firstFilePtr;
+ firstFilePtr = fsPtr;
+ fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
+ fsPtr->fd = fd;
+
+ if (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.
+ */
+
+ TtyInit(fd);
+ channelTypePtr = &ttyChannelType;
+ } else {
+ channelTypePtr = &fileChannelType;
+ }
+
+ fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
+ (ClientData) fsPtr, channelPermissions);
+
+ if (seekFlag) {
+ if (Tcl_Seek(fsPtr->channel, 0, SEEK_END) < 0) {
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "couldn't seek to end of file on \"",
+ channelName, "\": ", Tcl_PosixError(interp), NULL);
+ }
+ Tcl_Close(NULL, fsPtr->channel);
+ return NULL;
+ }
+ }
+
+ if (channelTypePtr == &ttyChannelType) {
+ /*
+ * 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",
+ "auto crlf") != 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(handle, mode)
+ ClientData handle; /* OS level handle. */
+ int mode; /* ORed combination of TCL_READABLE and
+ * TCL_WRITABLE to indicate file mode. */
+{
+ FileState *fsPtr;
+ char channelName[20];
+ int fd = (int) handle;
+
+ if (mode == 0) {
+ return NULL;
+ }
+
+ sprintf(channelName, "file%d", fd);
+
+ /*
+ * Look to see if a channel with this fd and the same mode already exists.
+ * If the fd is used, but the mode doesn't match, return NULL.
+ */
+
+ for (fsPtr = firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) {
+ if (fsPtr->fd == fd) {
+ return (mode == fsPtr->validMask) ? fsPtr->channel : NULL;
+ }
+ }
+
+ fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
+ fsPtr->nextPtr = firstFilePtr;
+ firstFilePtr = fsPtr;
+ fsPtr->fd = fd;
+ fsPtr->validMask = mode | TCL_EXCEPTION;
+ fsPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
+ (ClientData) fsPtr, mode);
+
+ return fsPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpBlockModeProc --
+ *
+ * This procedure is invoked by the generic IO level to set blocking
+ * and nonblocking mode on a TCP socket based channel.
+ *
+ * Results:
+ * 0 if successful, errno when failed.
+ *
+ * Side effects:
+ * Sets the device into blocking or nonblocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TcpBlockModeProc(instanceData, mode)
+ ClientData instanceData; /* Socket state. */
+ int mode; /* The mode to set. Can be one of
+ * TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ TcpState *statePtr = (TcpState *) instanceData;
+ int setting;
+
+#ifndef USE_FIONBIO
+ setting = fcntl(statePtr->fd, F_GETFL);
+ if (mode == TCL_MODE_BLOCKING) {
+ statePtr->flags &= (~(TCP_ASYNC_SOCKET));
+ setting &= (~(O_NONBLOCK));
+ } else {
+ statePtr->flags |= TCP_ASYNC_SOCKET;
+ setting |= O_NONBLOCK;
+ }
+ if (fcntl(statePtr->fd, F_SETFL, setting) < 0) {
+ return errno;
+ }
+#endif
+
+#ifdef USE_FIONBIO
+ if (mode == TCL_MODE_BLOCKING) {
+ statePtr->flags &= (~(TCP_ASYNC_SOCKET));
+ setting = 0;
+ if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
+ return errno;
+ }
+ } else {
+ statePtr->flags |= TCP_ASYNC_SOCKET;
+ setting = 1;
+ if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
+ return errno;
+ }
+ }
+#endif
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForConnect --
+ *
+ * Waits for a connection on an asynchronously opened socket to
+ * be completed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The socket is connected after this function returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForConnect(statePtr, errorCodePtr)
+ TcpState *statePtr; /* State of the socket. */
+ int *errorCodePtr; /* Where to store errors? */
+{
+ int timeOut; /* How long to wait. */
+ int state; /* Of calling TclWaitForFile. */
+ int flags; /* fcntl flags for the socket. */
+
+ /*
+ * If an asynchronous connect is in progress, attempt to wait for it
+ * to complete before reading.
+ */
+
+ if (statePtr->flags & TCP_ASYNC_CONNECT) {
+ if (statePtr->flags & TCP_ASYNC_SOCKET) {
+ timeOut = 0;
+ } else {
+ timeOut = -1;
+ }
+ errno = 0;
+ state = TclUnixWaitForFile(statePtr->fd,
+ TCL_WRITABLE | TCL_EXCEPTION, timeOut);
+ if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
+#ifndef USE_FIONBIO
+ flags = fcntl(statePtr->fd, F_GETFL);
+ flags &= (~(O_NONBLOCK));
+ (void) fcntl(statePtr->fd, F_SETFL, flags);
+#endif
+
+#ifdef USE_FIONBIO
+ flags = 0;
+ (void) ioctl(statePtr->fd, FIONBIO, &flags);
+#endif
+ }
+ if (state & TCL_EXCEPTION) {
+ return -1;
+ }
+ if (state & TCL_WRITABLE) {
+ statePtr->flags &= (~(TCP_ASYNC_CONNECT));
+ } else if (timeOut == 0) {
+ *errorCodePtr = errno = EWOULDBLOCK;
+ return -1;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpInputProc --
+ *
+ * This procedure is invoked by the generic IO level to read input
+ * from a TCP socket based channel.
+ *
+ * NOTE: We cannot share code with FilePipeInputProc because here
+ * we must use recv to obtain the input from the channel, not read.
+ *
+ * Results:
+ * The number of bytes read is returned or -1 on error. An output
+ * argument contains the POSIX error code on error, or zero if no
+ * error occurred.
+ *
+ * Side effects:
+ * Reads input from the input device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TcpInputProc(instanceData, buf, bufSize, errorCodePtr)
+ ClientData instanceData; /* Socket state. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCodePtr; /* Where to store error code. */
+{
+ TcpState *statePtr = (TcpState *) instanceData;
+ int bytesRead, state;
+
+ *errorCodePtr = 0;
+ state = WaitForConnect(statePtr, errorCodePtr);
+ if (state != 0) {
+ return -1;
+ }
+ bytesRead = recv(statePtr->fd, buf, bufSize, 0);
+ if (bytesRead > -1) {
+ return bytesRead;
+ }
+ if (errno == ECONNRESET) {
+
+ /*
+ * Turn ECONNRESET into a soft EOF condition.
+ */
+
+ return 0;
+ }
+ *errorCodePtr = errno;
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpOutputProc --
+ *
+ * This procedure is invoked by the generic IO level to write output
+ * to a TCP socket based channel.
+ *
+ * NOTE: We cannot share code with FilePipeOutputProc because here
+ * we must use send, not write, to get reliable error reporting.
+ *
+ * Results:
+ * The number of bytes written is returned. An output argument is
+ * set to a POSIX error code if an error occurred, or zero.
+ *
+ * Side effects:
+ * Writes output on the output device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
+ ClientData instanceData; /* Socket state. */
+ char *buf; /* The data buffer. */
+ int toWrite; /* How many bytes to write? */
+ int *errorCodePtr; /* Where to store error code. */
+{
+ TcpState *statePtr = (TcpState *) instanceData;
+ int written;
+ int state; /* Of waiting for connection. */
+
+ *errorCodePtr = 0;
+ state = WaitForConnect(statePtr, errorCodePtr);
+ if (state != 0) {
+ return -1;
+ }
+ written = send(statePtr->fd, buf, toWrite, 0);
+ if (written > -1) {
+ return written;
+ }
+ *errorCodePtr = errno;
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpCloseProc --
+ *
+ * This procedure is invoked by the generic IO level to perform
+ * channel-type-specific cleanup when a TCP socket based channel
+ * is closed.
+ *
+ * Results:
+ * 0 if successful, the value of errno if failed.
+ *
+ * Side effects:
+ * Closes the socket of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TcpCloseProc(instanceData, interp)
+ ClientData instanceData; /* The socket to close. */
+ Tcl_Interp *interp; /* For error reporting - unused. */
+{
+ TcpState *statePtr = (TcpState *) instanceData;
+ int errorCode = 0;
+
+ /*
+ * Delete a file handler that may be active for this socket if this
+ * is a server socket - the file handler was created automatically
+ * by Tcl as part of the mechanism to accept new client connections.
+ * Channel handlers are already deleted in the generic IO channel
+ * closing code that called this function, so we do not have to
+ * delete them here.
+ */
+
+ Tcl_DeleteFileHandler(statePtr->fd);
+
+ if (close(statePtr->fd) < 0) {
+ errorCode = errno;
+ }
+ ckfree((char *) statePtr);
+
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpGetOptionProc --
+ *
+ * Computes an option value for a TCP socket based channel, or a
+ * list of all options and their values.
+ *
+ * Note: This code is based on code contributed by John Haxby.
+ *
+ * Results:
+ * A standard Tcl result. The value of the specified option or a
+ * list of all options and their values is returned in the
+ * supplied DString. Sets Error message if needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
+ ClientData instanceData; /* Socket state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Name of the option to
+ * retrieve the value for, or
+ * NULL to get all options and
+ * their values. */
+ Tcl_DString *dsPtr; /* Where to store the computed
+ * value; initialized by caller. */
+{
+ TcpState *statePtr = (TcpState *) instanceData;
+ struct sockaddr_in sockname;
+ struct sockaddr_in peername;
+ struct hostent *hostEntPtr;
+ int size = sizeof(struct sockaddr_in);
+ size_t len = 0;
+ char buf[128];
+
+ if (optionName != (char *) NULL) {
+ len = strlen(optionName);
+ }
+
+ if ((len == 0) ||
+ ((len > 1) && (optionName[1] == 'p') &&
+ (strncmp(optionName, "-peername", len) == 0))) {
+ if (getpeername(statePtr->fd, (struct sockaddr *) &peername, &size)
+ >= 0) {
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-peername");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+ hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
+ sizeof(peername.sin_addr), AF_INET);
+ if (hostEntPtr != (struct hostent *) NULL) {
+ Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+ } else {
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+ }
+ sprintf(buf, "%d", ntohs(peername.sin_port));
+ Tcl_DStringAppendElement(dsPtr, buf);
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ /*
+ * getpeername failed - but if we were asked for all the options
+ * (len==0), don't flag an error at that point because it could
+ * be an fconfigure request on a server socket. (which have
+ * no peer). same must be done on win&mac.
+ */
+
+ if (len) {
+ if (interp) {
+ Tcl_AppendResult(interp, "can't get peername: ",
+ Tcl_PosixError(interp),
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ if ((len == 0) ||
+ ((len > 1) && (optionName[1] == 's') &&
+ (strncmp(optionName, "-sockname", len) == 0))) {
+ if (getsockname(statePtr->fd, (struct sockaddr *) &sockname, &size)
+ >= 0) {
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-sockname");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
+ sizeof(sockname.sin_addr), AF_INET);
+ if (hostEntPtr != (struct hostent *) NULL) {
+ Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+ } else {
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ }
+ sprintf(buf, "%d", ntohs(sockname.sin_port));
+ Tcl_DStringAppendElement(dsPtr, buf);
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp, "can't get sockname: ",
+ Tcl_PosixError(interp),
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+
+ if (len > 0) {
+ return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpWatchProc --
+ *
+ * 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
+TcpWatchProc(instanceData, mask)
+ ClientData instanceData; /* The socket state. */
+ int mask; /* Events of interest; an OR-ed
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+ TcpState *statePtr = (TcpState *) instanceData;
+
+ if (mask) {
+ Tcl_CreateFileHandler(statePtr->fd, mask,
+ (Tcl_FileProc *) Tcl_NotifyChannel,
+ (ClientData) statePtr->channel);
+ } else {
+ Tcl_DeleteFileHandler(statePtr->fd);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpGetHandleProc --
+ *
+ * Called from Tcl_GetChannelFile to retrieve OS handles from inside
+ * a TCP socket 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TcpGetHandleProc(instanceData, direction, handlePtr)
+ ClientData instanceData; /* The socket state. */
+ int direction; /* Not used. */
+ ClientData *handlePtr; /* Where to store the handle. */
+{
+ TcpState *statePtr = (TcpState *) instanceData;
+
+ *handlePtr = (ClientData)statePtr->fd;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSocket --
+ *
+ * This function opens a new socket in client or server mode
+ * and initializes the TcpState structure.
+ *
+ * Results:
+ * Returns a new TcpState, or NULL with an error in interp->result,
+ * if interp is not NULL.
+ *
+ * Side effects:
+ * Opens a socket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TcpState *
+CreateSocket(interp, port, host, server, myaddr, myport, async)
+ Tcl_Interp *interp; /* For error reporting; can be NULL. */
+ int port; /* Port number to open. */
+ char *host; /* Name of host on which to open port.
+ * NULL implies INADDR_ANY */
+ int server; /* 1 if socket should be a server socket,
+ * else 0 for a client socket. */
+ char *myaddr; /* Optional client-side address */
+ int myport; /* Optional client-side port */
+ int async; /* If nonzero and creating a client socket,
+ * attempt to do an async connect. Otherwise
+ * do a synchronous connect or bind. */
+{
+ int status, sock, asyncConnect, curState, origState;
+ struct sockaddr_in sockaddr; /* socket address */
+ struct sockaddr_in mysockaddr; /* Socket address for client */
+ TcpState *statePtr;
+
+ sock = -1;
+ origState = 0;
+ if (! CreateSocketAddress(&sockaddr, host, port)) {
+ goto addressError;
+ }
+ if ((myaddr != NULL || myport != 0) &&
+ ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
+ goto addressError;
+ }
+
+ sock = socket(AF_INET, SOCK_STREAM, 0);
+ if (sock < 0) {
+ goto addressError;
+ }
+
+ /*
+ * Set the close-on-exec flag so that the socket will not get
+ * inherited by child processes.
+ */
+
+ fcntl(sock, F_SETFD, FD_CLOEXEC);
+
+ /*
+ * Set kernel space buffering
+ */
+
+ TclSockMinimumBuffers(sock, SOCKET_BUFSIZE);
+
+ asyncConnect = 0;
+ status = 0;
+ if (server) {
+
+ /*
+ * Set up to reuse server addresses automatically and bind to the
+ * specified port.
+ */
+
+ status = 1;
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
+ sizeof(status));
+ status = bind(sock, (struct sockaddr *) &sockaddr,
+ sizeof(struct sockaddr));
+ if (status != -1) {
+ status = listen(sock, SOMAXCONN);
+ }
+ } else {
+ if (myaddr != NULL || myport != 0) {
+ curState = 1;
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
+ (char *) &curState, sizeof(curState));
+ status = bind(sock, (struct sockaddr *) &mysockaddr,
+ sizeof(struct sockaddr));
+ if (status < 0) {
+ goto bindError;
+ }
+ }
+
+ /*
+ * Attempt to connect. The connect may fail at present with an
+ * EINPROGRESS but at a later time it will complete. The caller
+ * will set up a file handler on the socket if she is interested in
+ * being informed when the connect completes.
+ */
+
+ if (async) {
+#ifndef USE_FIONBIO
+ origState = fcntl(sock, F_GETFL);
+ curState = origState | O_NONBLOCK;
+ status = fcntl(sock, F_SETFL, curState);
+#endif
+
+#ifdef USE_FIONBIO
+ curState = 1;
+ status = ioctl(sock, FIONBIO, &curState);
+#endif
+ } else {
+ status = 0;
+ }
+ if (status > -1) {
+ status = connect(sock, (struct sockaddr *) &sockaddr,
+ sizeof(sockaddr));
+ if (status < 0) {
+ if (errno == EINPROGRESS) {
+ asyncConnect = 1;
+ status = 0;
+ }
+ }
+ }
+ }
+
+bindError:
+ if (status < 0) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't open socket: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ if (sock != -1) {
+ close(sock);
+ }
+ return NULL;
+ }
+
+ /*
+ * Allocate a new TcpState for this socket.
+ */
+
+ statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
+ statePtr->flags = 0;
+ if (asyncConnect) {
+ statePtr->flags = TCP_ASYNC_CONNECT;
+ }
+ statePtr->fd = sock;
+
+ return statePtr;
+
+addressError:
+ if (sock != -1) {
+ close(sock);
+ }
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't open socket: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSocketAddress --
+ *
+ * This function initializes a sockaddr structure for a host and port.
+ *
+ * Results:
+ * 1 if the host was valid, 0 if the host could not be converted to
+ * an IP address.
+ *
+ * Side effects:
+ * Fills in the *sockaddrPtr structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateSocketAddress(sockaddrPtr, host, port)
+ struct sockaddr_in *sockaddrPtr; /* Socket address */
+ char *host; /* Host. NULL implies INADDR_ANY */
+ int port; /* Port number */
+{
+ struct hostent *hostent; /* Host database entry */
+ struct in_addr addr; /* For 64/32 bit madness */
+
+ (void) memset((VOID *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
+ sockaddrPtr->sin_family = AF_INET;
+ sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
+ if (host == NULL) {
+ addr.s_addr = INADDR_ANY;
+ } else {
+ addr.s_addr = inet_addr(host);
+ if (addr.s_addr == -1) {
+ hostent = gethostbyname(host);
+ if (hostent != NULL) {
+ memcpy((VOID *) &addr,
+ (VOID *) hostent->h_addr_list[0],
+ (size_t) hostent->h_length);
+ } else {
+#ifdef EHOSTUNREACH
+ errno = EHOSTUNREACH;
+#else
+#ifdef ENXIO
+ errno = ENXIO;
+#endif
+#endif
+ return 0; /* error */
+ }
+ }
+ }
+
+ /*
+ * NOTE: On 64 bit machines the assignment below is rumored to not
+ * do the right thing. Please report errors related to this if you
+ * observe incorrect behavior on 64 bit machines such as DEC Alphas.
+ * Should we modify this code to do an explicit memcpy?
+ */
+
+ sockaddrPtr->sin_addr.s_addr = addr.s_addr;
+ return 1; /* Success. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpClient --
+ *
+ * Opens a TCP client socket and creates a channel around it.
+ *
+ * Results:
+ * The channel or NULL if failed. An error message is returned
+ * in the interpreter on failure.
+ *
+ * Side effects:
+ * Opens a client socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
+ Tcl_Interp *interp; /* For error reporting; can be NULL. */
+ int port; /* Port number to open. */
+ char *host; /* Host on which to open port. */
+ char *myaddr; /* Client-side address */
+ int myport; /* Client-side port */
+ int async; /* If nonzero, attempt to do an
+ * asynchronous connect. Otherwise
+ * we do a blocking connect. */
+{
+ TcpState *statePtr;
+ char channelName[20];
+
+ /*
+ * Create a new client socket and wrap it in a channel.
+ */
+
+ statePtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
+ if (statePtr == NULL) {
+ return NULL;
+ }
+
+ statePtr->acceptProc = NULL;
+ statePtr->acceptProcData = (ClientData) NULL;
+
+ sprintf(channelName, "sock%d", statePtr->fd);
+
+ statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+ (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
+ if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
+ "auto crlf") == TCL_ERROR) {
+ Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
+ return NULL;
+ }
+ return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeTcpClientChannel --
+ *
+ * Creates a Tcl_Channel from an existing client TCP socket.
+ *
+ * Results:
+ * The Tcl_Channel wrapped around the preexisting TCP socket.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeTcpClientChannel(sock)
+ ClientData sock; /* The socket to wrap up into a channel. */
+{
+ TcpState *statePtr;
+ char channelName[20];
+
+ statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
+ statePtr->fd = (int) sock;
+ statePtr->acceptProc = NULL;
+ statePtr->acceptProcData = (ClientData) NULL;
+
+ sprintf(channelName, "sock%d", statePtr->fd);
+
+ statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+ (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
+ if (Tcl_SetChannelOption((Tcl_Interp *) NULL, statePtr->channel,
+ "-translation", "auto crlf") == TCL_ERROR) {
+ Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
+ return NULL;
+ }
+ return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpServer --
+ *
+ * Opens a TCP server socket and creates a channel around it.
+ *
+ * Results:
+ * The channel or NULL if failed. If an error occurred, an
+ * error message is left in interp->result if interp is
+ * not NULL.
+ *
+ * Side effects:
+ * Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
+ Tcl_Interp *interp; /* For error reporting - may be
+ * NULL. */
+ int port; /* Port number to open. */
+ char *myHost; /* Name of local host. */
+ Tcl_TcpAcceptProc *acceptProc; /* Callback for accepting connections
+ * from new clients. */
+ ClientData acceptProcData; /* Data for the callback. */
+{
+ TcpState *statePtr;
+ char channelName[20];
+
+ /*
+ * Create a new client socket and wrap it in a channel.
+ */
+
+ statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
+ if (statePtr == NULL) {
+ return NULL;
+ }
+
+ statePtr->acceptProc = acceptProc;
+ statePtr->acceptProcData = acceptProcData;
+
+ /*
+ * Set up the callback mechanism for accepting connections
+ * from new clients.
+ */
+
+ Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
+ (ClientData) statePtr);
+ sprintf(channelName, "sock%d", statePtr->fd);
+ statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+ (ClientData) statePtr, 0);
+ return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TcpAccept --
+ * Accept a TCP socket connection. This is called by the event loop.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new connection socket. Calls the registered callback
+ * for the connection acceptance mechanism.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+TcpAccept(data, mask)
+ ClientData data; /* Callback token. */
+ int mask; /* Not used. */
+{
+ TcpState *sockState; /* Client data of server socket. */
+ int newsock; /* The new client socket */
+ TcpState *newSockState; /* State for new socket. */
+ struct sockaddr_in addr; /* The remote address */
+ int len; /* For accept interface */
+ char channelName[20];
+
+ sockState = (TcpState *) data;
+
+ len = sizeof(struct sockaddr_in);
+ newsock = accept(sockState->fd, (struct sockaddr *)&addr, &len);
+ if (newsock < 0) {
+ return;
+ }
+
+ /*
+ * Set close-on-exec flag to prevent the newly accepted socket from
+ * being inherited by child processes.
+ */
+
+ (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);
+
+ newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
+
+ newSockState->flags = 0;
+ newSockState->fd = newsock;
+ newSockState->acceptProc = (Tcl_TcpAcceptProc *) NULL;
+ newSockState->acceptProcData = (ClientData) NULL;
+
+ sprintf(channelName, "sock%d", newsock);
+ newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+ (ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));
+
+ Tcl_SetChannelOption((Tcl_Interp *) NULL, newSockState->channel,
+ "-translation", "auto crlf");
+
+ if (sockState->acceptProc != (Tcl_TcpAcceptProc *) NULL) {
+ (sockState->acceptProc) (sockState->acceptProcData,
+ newSockState->channel, inet_ntoa(addr.sin_addr),
+ ntohs(addr.sin_port));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetDefaultStdChannel --
+ *
+ * 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
+TclGetDefaultStdChannel(type)
+ 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). */
+ char *bufMode = NULL;
+
+ switch (type) {
+ case TCL_STDIN:
+ if ((lseek(0, (off_t) 0, SEEK_CUR) == -1) &&
+ (errno == EBADF)) {
+ return (Tcl_Channel) NULL;
+ }
+ fd = 0;
+ mode = TCL_READABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDOUT:
+ if ((lseek(1, (off_t) 0, SEEK_CUR) == -1) &&
+ (errno == EBADF)) {
+ return (Tcl_Channel) NULL;
+ }
+ fd = 1;
+ mode = TCL_WRITABLE;
+ bufMode = "line";
+ break;
+ case TCL_STDERR:
+ if ((lseek(2, (off_t) 0, SEEK_CUR) == -1) &&
+ (errno == EBADF)) {
+ return (Tcl_Channel) NULL;
+ }
+ fd = 2;
+ mode = TCL_WRITABLE;
+ bufMode = "none";
+ break;
+ default:
+ panic("TclGetDefaultStdChannel: Unexpected channel type");
+ break;
+ }
+
+ channel = Tcl_MakeFileChannel((ClientData) fd, mode);
+
+ /*
+ * Set up the normal channel options for stdio handles.
+ */
+
+ Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
+ 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 interp->result.
+ *
+ * Side effects:
+ * May invoke fdopen to create the FILE * for the requested file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
+ Tcl_Interp *interp; /* Interpreter in which to find file. */
+ char *string; /* 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;
+ Tcl_ChannelType *chanTypePtr;
+ ClientData data;
+ int fd;
+ FILE *f;
+
+ chan = Tcl_GetChannel(interp, string, &chanMode);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+ if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
+ Tcl_AppendResult(interp,
+ "\"", string, "\" wasn't opened for writing", (char *) NULL);
+ return TCL_ERROR;
+ } else if ((!(forWriting)) && ((chanMode & TCL_READABLE) == 0)) {
+ Tcl_AppendResult(interp,
+ "\"", string, "\" wasn't opened for reading", (char *) 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) || (chanTypePtr == &tcpChannelType)
+ || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
+ if (Tcl_GetChannelHandle(chan,
+ (forWriting ? TCL_WRITABLE : TCL_READABLE),
+ (ClientData*) &data) == TCL_OK) {
+ fd = (int) 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 \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ *filePtr = (ClientData) f;
+ return TCL_OK;
+ }
+ }
+
+ Tcl_AppendResult(interp, "\"", string,
+ "\" cannot be used to get a FILE *", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUnixWaitForFile --
+ *
+ * This procedure 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
+ * procedure 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 procedure.
+ *
+ * Side effects:
+ * Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUnixWaitForFile(fd, mask, timeout)
+ 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, now;
+ struct timeval blockTime, *timeoutPtr;
+ int index, bit, numFound, result = 0;
+ static fd_mask readyMasks[3*MASK_SIZE];
+ /* This array reflects the readable/writable
+ * conditions that were found to exist by the
+ * last call to select. */
+
+ /*
+ * If there is a non-zero finite timeout, compute the time when
+ * we give up.
+ */
+
+ if (timeout > 0) {
+ TclpGetTime(&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 ready masks and compute the mask offsets.
+ */
+
+ if (fd >= FD_SETSIZE) {
+ panic("TclWaitForFile can't handle file id %d", fd);
+ }
+ memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+
+ /*
+ * 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;
+ }
+ }
+
+ /*
+ * Set the appropriate bit in the ready masks for the fd.
+ */
+
+ if (mask & TCL_READABLE) {
+ readyMasks[index] |= bit;
+ }
+ if (mask & TCL_WRITABLE) {
+ (readyMasks+MASK_SIZE)[index] |= bit;
+ }
+ if (mask & TCL_EXCEPTION) {
+ (readyMasks+2*(MASK_SIZE))[index] |= bit;
+ }
+
+ /*
+ * Wait for the event or a timeout.
+ */
+
+ numFound = select(fd+1, (SELECT_MASK *) &readyMasks[0],
+ (SELECT_MASK *) &readyMasks[MASK_SIZE],
+ (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
+ if (numFound == 1) {
+ if (readyMasks[index] & bit) {
+ result |= TCL_READABLE;
+ }
+ if ((readyMasks+MASK_SIZE)[index] & bit) {
+ result |= TCL_WRITABLE;
+ }
+ if ((readyMasks+2*(MASK_SIZE))[index] & bit) {
+ result |= TCL_EXCEPTION;
+ }
+ result &= mask;
+ if (result) {
+ break;
+ }
+ }
+ if (timeout == 0) {
+ break;
+ }
+
+ /*
+ * The select returned early, so we need to recompute the timeout.
+ */
+
+ TclpGetTime(&now);
+ if ((abortTime.sec < now.sec)
+ || ((abortTime.sec == now.sec)
+ && (abortTime.usec <= now.usec))) {
+ break;
+ }
+ }
+ return result;
+}
diff --git a/unix/tclUnixEvent.c b/unix/tclUnixEvent.c
new file mode 100644
index 0000000..24841ca
--- /dev/null
+++ b/unix/tclUnixEvent.c
@@ -0,0 +1,76 @@
+/*
+ * 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.
+ *
+ * SCCS: @(#) tclUnixEvent.c 1.1 97/03/04 14:19:34
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Sleep --
+ *
+ * Delay execution for the specified number of milliseconds.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Sleep(ms)
+ int ms; /* Number of milliseconds to sleep. */
+{
+ static struct timeval delay;
+ Tcl_Time before, after;
+
+ /*
+ * 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.
+ */
+
+ TclpGetTime(&before);
+ after = before;
+ after.sec += ms/1000;
+ after.usec += (ms%1000)*1000;
+ if (after.usec > 1000000) {
+ after.usec -= 1000000;
+ after.sec += 1;
+ }
+ while (1) {
+ delay.tv_sec = after.sec - before.sec;
+ delay.tv_usec = after.usec - before.usec;
+ if (delay.tv_usec < 0) {
+ delay.tv_usec += 1000000;
+ delay.tv_sec -= 1;
+ }
+
+ /*
+ * 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);
+ TclpGetTime(&before);
+ }
+}
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
new file mode 100644
index 0000000..3ec1a69
--- /dev/null
+++ b/unix/tclUnixFCmd.c
@@ -0,0 +1,1224 @@
+/*
+ * 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-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.
+ *
+ * SCCS: @(#) tclUnixFCmd.c 1.31 97/10/13 16:51:14
+ *
+ * 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. All advertising materials mentioning features or use of this software
+ * must display the following acknowledgement:
+ * This product includes software developed by the University of
+ * California, Berkeley and its contributors.
+ * 4. 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 "tclPort.h"
+#include <utime.h>
+#include <grp.h>
+
+/*
+ * 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 _ANSI_ARGS_((Tcl_Interp *interp,
+ int objIndex, char *fileName,
+ Tcl_Obj **attributePtrPtr));
+static int GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+ int objIndex, char *fileName,
+ Tcl_Obj **attributePtrPtr));
+static int GetPermissionsAttribute _ANSI_ARGS_((
+ Tcl_Interp *interp, int objIndex, char *fileName,
+ Tcl_Obj **attributePtrPtr));
+static int SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+ int objIndex, char *fileName,
+ Tcl_Obj *attributePtr));
+static int SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+ int objIndex, char *fileName,
+ Tcl_Obj *attributePtr));
+static int SetPermissionsAttribute _ANSI_ARGS_((
+ Tcl_Interp *interp, int objIndex, char *fileName,
+ Tcl_Obj *attributePtr));
+
+/*
+ * Prototype for the TraverseUnixTree callback function.
+ */
+
+typedef int (TraversalProc) _ANSI_ARGS_((char *src, char *dst,
+ struct stat *sb, int type, Tcl_DString *errorPtr));
+
+/*
+ * Constants and variables necessary for file attributes subcommand.
+ */
+
+enum {
+ UNIX_GROUP_ATTRIBUTE,
+ UNIX_OWNER_ATTRIBUTE,
+ UNIX_PERMISSIONS_ATTRIBUTE
+};
+
+char *tclpFileAttrStrings[] = {"-group", "-owner", "-permissions",
+ (char *) NULL};
+CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+ {GetGroupAttribute, SetGroupAttribute},
+ {GetOwnerAttribute, SetOwnerAttribute},
+ {GetPermissionsAttribute, SetPermissionsAttribute}};
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static int CopyFile _ANSI_ARGS_((char *src, char *dst,
+ struct stat *srcStatBufPtr));
+static int CopyFileAtts _ANSI_ARGS_((char *src, char *dst,
+ struct stat *srcStatBufPtr));
+static int TraversalCopy _ANSI_ARGS_((char *src, char *dst,
+ struct stat *sbPtr, int type,
+ Tcl_DString *errorPtr));
+static int TraversalDelete _ANSI_ARGS_((char *src, char *dst,
+ struct stat *sbPtr, int type,
+ Tcl_DString *errorPtr));
+static int TraverseUnixTree _ANSI_ARGS_((
+ TraversalProc *traversalProc,
+ Tcl_DString *sourcePath, Tcl_DString *destPath,
+ Tcl_DString *errorPtr));
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpRenameFile --
+ *
+ * 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
+TclpRenameFile(src, dst)
+ char *src; /* Pathname of file or dir to be renamed. */
+ char *dst; /* New pathname of file or directory. */
+{
+ if (rename(src, dst) == 0) {
+ return TCL_OK;
+ }
+ if (errno == ENOTEMPTY) {
+ errno = EEXIST;
+ }
+
+#ifdef sparc
+ /*
+ * 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() is only defined on SunOS.
+ */
+
+ if (errno == EINVAL) {
+ char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
+ DIR *dirPtr;
+ struct dirent *dirEntPtr;
+
+ if ((realpath(src, srcPath) != NULL)
+ && (realpath(dst, dstPath) != NULL)
+ && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
+ dirPtr = opendir(dst);
+ if (dirPtr != NULL) {
+ while ((dirEntPtr = readdir(dirPtr)) != NULL) {
+ if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
+ (strcmp(dirEntPtr->d_name, "..") != 0)) {
+ errno = EEXIST;
+ closedir(dirPtr);
+ return TCL_ERROR;
+ }
+ }
+ closedir(dirPtr);
+ }
+ }
+ errno = EINVAL;
+ }
+#endif /* sparc */
+
+ 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;
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCopyFile --
+ *
+ * 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
+TclpCopyFile(src, dst)
+ char *src; /* Pathname of file to be copied. */
+ char *dst; /* Pathname of file to copy to. */
+{
+ struct stat srcStatBuf, dstStatBuf;
+ char link[MAXPATHLEN];
+ int length;
+
+ /*
+ * Have to do a stat() to determine the filetype.
+ */
+
+ if (lstat(src, &srcStatBuf) != 0) {
+ return TCL_ERROR;
+ }
+ if (S_ISDIR(srcStatBuf.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 (lstat(dst, &dstStatBuf) == 0) {
+ if (S_ISDIR(dstStatBuf.st_mode)) {
+ errno = EISDIR;
+ return TCL_ERROR;
+ }
+ }
+ if (unlink(dst) != 0) {
+ if (errno != ENOENT) {
+ return TCL_ERROR;
+ }
+ }
+
+ switch ((int) (srcStatBuf.st_mode & S_IFMT)) {
+ case S_IFLNK:
+ length = readlink(src, link, sizeof(link));
+ if (length == -1) {
+ return TCL_ERROR;
+ }
+ link[length] = '\0';
+ if (symlink(link, dst) < 0) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case S_IFBLK:
+ case S_IFCHR:
+ if (mknod(dst, srcStatBuf.st_mode, srcStatBuf.st_rdev) < 0) {
+ return TCL_ERROR;
+ }
+ return CopyFileAtts(src, dst, &srcStatBuf);
+
+ case S_IFIFO:
+ if (mkfifo(dst, srcStatBuf.st_mode) < 0) {
+ return TCL_ERROR;
+ }
+ return CopyFileAtts(src, dst, &srcStatBuf);
+
+ default:
+ return CopyFile(src, dst, &srcStatBuf);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyFile -
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CopyFile(src, dst, srcStatBufPtr)
+ char *src; /* Pathname of file to copy. */
+ char *dst; /* Pathname of file to create/overwrite. */
+ struct stat *srcStatBufPtr; /* Used to determine mode and blocksize */
+{
+ int srcFd;
+ int dstFd;
+ u_int blockSize; /* Optimal I/O blocksize for filesystem */
+ char *buffer; /* Data buffer for copy */
+ size_t nread;
+
+ if ((srcFd = open(src, O_RDONLY, 0)) < 0) {
+ return TCL_ERROR;
+ }
+
+ dstFd = open(dst, O_CREAT | O_TRUNC | O_WRONLY, srcStatBufPtr->st_mode);
+ if (dstFd < 0) {
+ close(srcFd);
+ return TCL_ERROR;
+ }
+
+#if HAVE_ST_BLKSIZE
+ blockSize = srcStatBufPtr->st_blksize;
+#else
+ blockSize = 4096;
+#endif
+
+ buffer = ckalloc(blockSize);
+ while (1) {
+ nread = read(srcFd, buffer, blockSize);
+ if ((nread == -1) || (nread == 0)) {
+ break;
+ }
+ if (write(dstFd, buffer, nread) != nread) {
+ nread = (size_t) -1;
+ break;
+ }
+ }
+
+ ckfree(buffer);
+ close(srcFd);
+ if ((close(dstFd) != 0) || (nread == -1)) {
+ unlink(dst);
+ return TCL_ERROR;
+ }
+ if (CopyFileAtts(src, dst, srcStatBufPtr) == 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);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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
+TclpDeleteFile(path)
+ char *path; /* Pathname of file to be removed. */
+{
+ if (unlink(path) != 0) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCreateDirectory --
+ *
+ * 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
+TclpCreateDirectory(path)
+ char *path; /* Pathname of directory to create. */
+{
+ mode_t mode;
+
+ mode = umask(0);
+ umask(mode);
+
+ /*
+ * umask return value is actually the inverse of the permissions.
+ */
+
+ mode = (0777 & ~mode);
+
+ if (mkdir(path, mode | S_IRUSR | S_IWUSR | S_IXUSR) != 0) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCopyDirectory --
+ *
+ * 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 TclpCreateDirectory and TclpCopyFile
+ * 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
+TclpCopyDirectory(src, dst, errorPtr)
+ char *src; /* Pathname of directory to be copied. */
+ char *dst; /* Pathname of target directory. */
+ Tcl_DString *errorPtr; /* If non-NULL, initialized DString for
+ * error reporting. */
+{
+ int result;
+ Tcl_DString srcBuffer;
+ Tcl_DString dstBuffer;
+
+ Tcl_DStringInit(&srcBuffer);
+ Tcl_DStringInit(&dstBuffer);
+ Tcl_DStringAppend(&srcBuffer, src, -1);
+ Tcl_DStringAppend(&dstBuffer, dst, -1);
+ result = TraverseUnixTree(TraversalCopy, &srcBuffer, &dstBuffer,
+ errorPtr);
+ Tcl_DStringFree(&srcBuffer);
+ Tcl_DStringFree(&dstBuffer);
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpRemoveDirectory --
+ *
+ * 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
+TclpRemoveDirectory(path, recursive, errorPtr)
+ char *path; /* Pathname of directory to be removed. */
+ int recursive; /* If non-zero, removes directories that
+ * are nonempty. Otherwise, will only remove
+ * empty directories. */
+ Tcl_DString *errorPtr; /* If non-NULL, initialized DString for
+ * error reporting. */
+{
+ int result;
+ Tcl_DString buffer;
+
+ if (rmdir(path) == 0) {
+ return TCL_OK;
+ }
+ if (errno == ENOTEMPTY) {
+ errno = EEXIST;
+ }
+ if ((errno != EEXIST) || (recursive == 0)) {
+ if (errorPtr != NULL) {
+ Tcl_DStringAppend(errorPtr, path, -1);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * The directory is nonempty, but the recursive flag has been
+ * specified, so we recursively remove all the files in the directory.
+ */
+
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, path, -1);
+ result = TraverseUnixTree(TraversalDelete, &buffer, NULL, errorPtr);
+ Tcl_DStringFree(&buffer);
+ 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(traverseProc, sourcePtr, targetPtr, errorPtr)
+ TraversalProc *traverseProc;/* Function to call for every file and
+ * directory in source hierarchy. */
+ Tcl_DString *sourcePtr; /* Pathname of source directory to be
+ * traversed. */
+ Tcl_DString *targetPtr; /* Pathname of directory to traverse in
+ * parallel with source directory. */
+ Tcl_DString *errorPtr; /* If non-NULL, an initialized DString for
+ * error reporting. */
+{
+ struct stat statbuf;
+ char *source, *target, *errfile;
+ int result, sourceLen;
+ int targetLen = 0; /* Initialization needed only to prevent
+ * warning in gcc. */
+ struct dirent *dirp;
+ DIR *dp;
+
+ result = TCL_OK;
+ source = Tcl_DStringValue(sourcePtr);
+ if (targetPtr != NULL) {
+ target = Tcl_DStringValue(targetPtr);
+ } else {
+ target = NULL;
+ }
+
+ errfile = NULL;
+ if (lstat(source, &statbuf) != 0) {
+ errfile = source;
+ goto end;
+ }
+ if (!S_ISDIR(statbuf.st_mode)) {
+ /*
+ * Process the regular file
+ */
+
+ return (*traverseProc)(source, target, &statbuf, DOTREE_F, errorPtr);
+ }
+
+ dp = opendir(source);
+ if (dp == NULL) {
+ /*
+ * Can't read directory
+ */
+
+ errfile = source;
+ goto end;
+ }
+ result = (*traverseProc)(source, target, &statbuf, DOTREE_PRED, errorPtr);
+ if (result != TCL_OK) {
+ closedir(dp);
+ return result;
+ }
+
+ Tcl_DStringAppend(sourcePtr, "/", 1);
+ source = Tcl_DStringValue(sourcePtr);
+ sourceLen = Tcl_DStringLength(sourcePtr);
+
+ if (targetPtr != NULL) {
+ Tcl_DStringAppend(targetPtr, "/", 1);
+ target = Tcl_DStringValue(targetPtr);
+ targetLen = Tcl_DStringLength(targetPtr);
+ }
+
+ while ((dirp = readdir(dp)) != NULL) {
+ if ((strcmp(dirp->d_name, ".") == 0)
+ || (strcmp(dirp->d_name, "..") == 0)) {
+ continue;
+ }
+
+ /*
+ * Append name after slash, and recurse on the file.
+ */
+
+ Tcl_DStringAppend(sourcePtr, dirp->d_name, -1);
+ if (targetPtr != NULL) {
+ Tcl_DStringAppend(targetPtr, dirp->d_name, -1);
+ }
+ result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
+ errorPtr);
+ if (result != TCL_OK) {
+ break;
+ }
+
+ /*
+ * Remove name after slash.
+ */
+
+ Tcl_DStringSetLength(sourcePtr, sourceLen);
+ if (targetPtr != NULL) {
+ Tcl_DStringSetLength(targetPtr, targetLen);
+ }
+ }
+ closedir(dp);
+
+ /*
+ * Strip off the trailing slash we added
+ */
+
+ Tcl_DStringSetLength(sourcePtr, sourceLen - 1);
+ source = Tcl_DStringValue(sourcePtr);
+ if (targetPtr != NULL) {
+ Tcl_DStringSetLength(targetPtr, targetLen - 1);
+ target = Tcl_DStringValue(targetPtr);
+ }
+
+ if (result == TCL_OK) {
+ /*
+ * Call traverseProc() on a directory after visiting all the
+ * files in that directory.
+ */
+
+ result = (*traverseProc)(source, target, &statbuf, DOTREE_POSTD,
+ errorPtr);
+ }
+ end:
+ if (errfile != NULL) {
+ if (errorPtr != NULL) {
+ Tcl_DStringAppend(errorPtr, errfile, -1);
+ }
+ result = TCL_ERROR;
+ }
+
+ 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(src, dst, sbPtr, type, errorPtr)
+ char *src; /* Source pathname to copy. */
+ char *dst; /* Destination pathname of copy. */
+ struct stat *sbPtr; /* Stat info for file specified by src. */
+ int type; /* Reason for call - see TraverseUnixTree(). */
+ Tcl_DString *errorPtr; /* If non-NULL, initialized DString for
+ * error return. */
+{
+ switch (type) {
+ case DOTREE_F:
+ if (TclpCopyFile(src, dst) == TCL_OK) {
+ return TCL_OK;
+ }
+ break;
+
+ case DOTREE_PRED:
+ if (TclpCreateDirectory(dst) == TCL_OK) {
+ return TCL_OK;
+ }
+ break;
+
+ case DOTREE_POSTD:
+ if (CopyFileAtts(src, dst, sbPtr) == 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_DStringAppend(errorPtr, dst, -1);
+ }
+ 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(src, ignore, sbPtr, type, errorPtr)
+ char *src; /* Source pathname. */
+ char *ignore; /* Destination pathname (not used). */
+ struct stat *sbPtr; /* Stat info for file specified by src. */
+ int type; /* Reason for call - see TraverseUnixTree(). */
+ Tcl_DString *errorPtr; /* If non-NULL, initialized DString for
+ * error return. */
+{
+ switch (type) {
+ case DOTREE_F:
+ if (unlink(src) == 0) {
+ return TCL_OK;
+ }
+ break;
+
+ case DOTREE_PRED:
+ return TCL_OK;
+
+ case DOTREE_POSTD:
+ if (rmdir(src) == 0) {
+ return TCL_OK;
+ }
+ break;
+
+ }
+
+ if (errorPtr != NULL) {
+ Tcl_DStringAppend(errorPtr, src, -1);
+ }
+ 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(src, dst, statBufPtr)
+ char *src; /* Path name of source file */
+ char *dst; /* Path name of target file */
+ struct stat *statBufPtr; /* ptr to 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)) {
+ newMode &= ~(S_ISUID | S_ISGID);
+ if (chmod(dst, newMode)) {
+ return TCL_ERROR;
+ }
+ }
+
+ tval.actime = statBufPtr->st_atime;
+ tval.modtime = statBufPtr->st_mtime;
+
+ if (utime(dst, &tval)) {
+ return TCL_ERROR;
+ }
+ 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(interp, objIndex, fileName, attributePtrPtr)
+ Tcl_Interp *interp; /* The interp we are using for errors. */
+ int objIndex; /* The index of the attribute. */
+ char *fileName; /* The name of the file. */
+ Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
+{
+ struct stat statBuf;
+ struct group *groupPtr;
+
+ if (stat(fileName, &statBuf) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not stat file \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ groupPtr = getgrgid(statBuf.st_gid);
+ if (groupPtr == NULL) {
+ *attributePtrPtr = Tcl_NewIntObj(statBuf.st_gid);
+ } else {
+ *attributePtrPtr = Tcl_NewStringObj(groupPtr->gr_name, -1);
+ }
+ endgrent();
+ 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(interp, objIndex, fileName, attributePtrPtr)
+ Tcl_Interp *interp; /* The interp we are using for errors. */
+ int objIndex; /* The index of the attribute. */
+ char *fileName; /* The name of the file. */
+ Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
+{
+ struct stat statBuf;
+ struct passwd *pwPtr;
+
+ if (stat(fileName, &statBuf) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not stat file \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ pwPtr = getpwuid(statBuf.st_uid);
+ if (pwPtr == NULL) {
+ *attributePtrPtr = Tcl_NewIntObj(statBuf.st_uid);
+ } else {
+ *attributePtrPtr = Tcl_NewStringObj(pwPtr->pw_name, -1);
+ }
+ endpwent();
+ 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(interp, objIndex, fileName, attributePtrPtr)
+ Tcl_Interp *interp; /* The interp we are using for errors. */
+ int objIndex; /* The index of the attribute. */
+ char *fileName; /* The name of the file. */
+ Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
+{
+ struct stat statBuf;
+ char returnString[6];
+
+ if (stat(fileName, &statBuf) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not stat file \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ sprintf(returnString, "%0#5lo", (statBuf.st_mode & 0x00007FFF));
+
+ *attributePtrPtr = Tcl_NewStringObj(returnString, -1);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetGroupAttribute
+ *
+ * Sets the file to the given group.
+ *
+ * Results:
+ * Standard TCL result.
+ *
+ * Side effects:
+ * The group of the file is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetGroupAttribute(interp, objIndex, fileName, attributePtr)
+ Tcl_Interp *interp; /* The interp we are using for errors. */
+ int objIndex; /* The index of the attribute. */
+ char *fileName; /* The name of the file. */
+ Tcl_Obj *attributePtr; /* The attribute to set. */
+{
+ gid_t groupNumber;
+ long placeHolder;
+
+ if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
+ struct group *groupPtr;
+ char *groupString = Tcl_GetStringFromObj(attributePtr, NULL);
+
+ Tcl_ResetResult(interp);
+ groupPtr = getgrnam(groupString);
+ if (groupPtr == NULL) {
+ endgrent();
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not set group for file \"", fileName,
+ "\": group \"", groupString, "\" does not exist",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ groupNumber = groupPtr->gr_gid;
+ } else {
+ groupNumber = (gid_t) placeHolder;
+ }
+
+ if (chown(fileName, -1, groupNumber) != 0) {
+ endgrent();
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not set group for file \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ endgrent();
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetOwnerAttribute
+ *
+ * Sets the file to the given owner.
+ *
+ * Results:
+ * Standard TCL result.
+ *
+ * Side effects:
+ * The group of the file is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetOwnerAttribute(interp, objIndex, fileName, attributePtr)
+ Tcl_Interp *interp; /* The interp we are using for errors. */
+ int objIndex; /* The index of the attribute. */
+ char *fileName; /* The name of the file. */
+ Tcl_Obj *attributePtr; /* The attribute to set. */
+{
+ uid_t userNumber;
+ long placeHolder;
+
+ if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
+ struct passwd *pwPtr;
+ char *ownerString = Tcl_GetStringFromObj(attributePtr, NULL);
+
+ Tcl_ResetResult(interp);
+ pwPtr = getpwnam(ownerString);
+ if (pwPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not set owner for file \"", fileName,
+ "\": user \"", ownerString, "\" does not exist",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ userNumber = pwPtr->pw_uid;
+ } else {
+ userNumber = (uid_t) placeHolder;
+ }
+
+ if (chown(fileName, userNumber, -1) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not set owner for file \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetPermissionsAttribute
+ *
+ * Sets the file to the given group.
+ *
+ * Results:
+ * Standard TCL result.
+ *
+ * Side effects:
+ * The group of the file is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
+ Tcl_Interp *interp; /* The interp we are using for errors. */
+ int objIndex; /* The index of the attribute. */
+ char *fileName; /* The name of the file. */
+ Tcl_Obj *attributePtr; /* The attribute to set. */
+{
+ long modeInt;
+ mode_t newMode;
+
+ /*
+ * mode_t is a long under SPARC; an int under SunOS. Since we do not
+ * know how big it really is, we get the long and then cast it
+ * down to a mode_t.
+ */
+
+ if (Tcl_GetLongFromObj(interp, attributePtr, &modeInt)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ newMode = (mode_t) modeInt;
+
+ if (chmod(fileName, newMode) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not set permissions for file \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpListVolumes --
+ *
+ * Lists the currently mounted volumes, which on UNIX is just /.
+ *
+ * Results:
+ * A standard Tcl result. Will always be TCL_OK, since there is no way
+ * that this command can fail. Also, the interpreter's result is set to
+ * the list of volumes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpListVolumes(interp)
+ Tcl_Interp *interp; /* Interpreter to which to pass
+ * the volume list. */
+{
+ Tcl_Obj *resultPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_SetStringObj(resultPtr, "/", 1);
+ return TCL_OK;
+}
+
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
new file mode 100644
index 0000000..eb11006
--- /dev/null
+++ b/unix/tclUnixFile.c
@@ -0,0 +1,528 @@
+/*
+ * tclUnixFile.c --
+ *
+ * This file contains wrappers around UNIX file handling functions.
+ * These wrappers mask differences between Windows and UNIX.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixFile.c 1.48 97/07/07 16:38:11
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The variable below caches the name of the current working directory
+ * in order to avoid repeated calls to getcwd. The string is malloc-ed.
+ * NULL means the cache needs to be refreshed.
+ */
+
+static char *currentDir = NULL;
+static int currentDirExitHandlerSet = 0;
+
+/*
+ * The variable below is set if the exit routine for deleting the string
+ * containing the executable name has been registered.
+ */
+
+static int executableNameExitHandlerSet = 0;
+
+extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
+
+/*
+ * Static routines for this file:
+ */
+
+static void FreeCurrentDir _ANSI_ARGS_((ClientData clientData));
+static void FreeExecutableName _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeCurrentDir --
+ *
+ * Frees the string stored in the currentDir variable. This routine
+ * is registered as an exit handler and will be called during shutdown.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the memory occuppied by the currentDir value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+FreeCurrentDir(clientData)
+ ClientData clientData; /* Not used. */
+{
+ if (currentDir != (char *) NULL) {
+ ckfree(currentDir);
+ currentDir = (char *) NULL;
+ currentDirExitHandlerSet = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeExecutableName --
+ *
+ * Frees the string stored in the tclExecutableName variable. This
+ * routine is registered as an exit handler and will be called
+ * during shutdown.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the memory occuppied by the tclExecutableName value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+FreeExecutableName(clientData)
+ ClientData clientData; /* Not used. */
+{
+ if (tclExecutableName != (char *) NULL) {
+ ckfree(tclExecutableName);
+ tclExecutableName = (char *) NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChdir --
+ *
+ * Change the current working directory.
+ *
+ * Results:
+ * The result is a standard Tcl result. If an error occurs and
+ * interp isn't NULL, an error message is left in interp->result.
+ *
+ * Side effects:
+ * The working directory for this application is changed. Also
+ * the cache maintained used by TclGetCwd is deallocated and
+ * set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChdir(interp, dirName)
+ Tcl_Interp *interp; /* If non NULL, used for error reporting. */
+ char *dirName; /* Path to new working directory. */
+{
+ if (currentDir != NULL) {
+ ckfree(currentDir);
+ currentDir = NULL;
+ }
+ if (chdir(dirName) != 0) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't change working directory to \"",
+ dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCwd --
+ *
+ * Return the path name of the current working directory.
+ *
+ * Results:
+ * The result is the full path name of the current working
+ * directory, or NULL if an error occurred while figuring it out.
+ * The returned string is owned by the TclGetCwd routine and must
+ * not be freed by the caller. If an error occurs and interp
+ * isn't NULL, an error message is left in interp->result.
+ *
+ * Side effects:
+ * The path name is cached to avoid having to recompute it
+ * on future calls; if it is already cached, the cached
+ * value is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetCwd(interp)
+ Tcl_Interp *interp; /* If non NULL, used for error reporting. */
+{
+ char buffer[MAXPATHLEN+1];
+
+ if (currentDir == NULL) {
+ if (!currentDirExitHandlerSet) {
+ currentDirExitHandlerSet = 1;
+ Tcl_CreateExitHandler(FreeCurrentDir, (ClientData) NULL);
+ }
+#ifdef USEGETWD
+ if ((int)getwd(buffer) == (int)NULL) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ buffer, (char *)NULL);
+ }
+ return NULL;
+ }
+#else
+ if (getcwd(buffer, MAXPATHLEN+1) == NULL) {
+ if (interp != NULL) {
+ if (errno == ERANGE) {
+ Tcl_SetResult(interp,
+ "working directory name is too long",
+ TCL_STATIC);
+ } else {
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ }
+ return NULL;
+ }
+#endif
+ currentDir = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
+ strcpy(currentDir, buffer);
+ }
+ return currentDir;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindExecutable --
+ *
+ * This procedure computes the absolute path name of the current
+ * application, given its argv[0] value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The variable tclExecutableName gets filled in with the file
+ * name for the application, if we figured it out. If we couldn't
+ * figure it out, Tcl_FindExecutable is set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FindExecutable(argv0)
+ char *argv0; /* The value of the application's argv[0]. */
+{
+ char *name, *p, *cwd;
+ Tcl_DString buffer;
+ int length;
+ struct stat statBuf;
+
+ Tcl_DStringInit(&buffer);
+ if (tclExecutableName != NULL) {
+ ckfree(tclExecutableName);
+ tclExecutableName = NULL;
+ }
+
+ name = argv0;
+ for (p = name; *p != 0; p++) {
+ if (*p == '/') {
+ /*
+ * The name contains a slash, so use the name directly
+ * without doing a path search.
+ */
+
+ goto gotName;
+ }
+ }
+
+ p = getenv("PATH");
+ if (p == NULL) {
+ /*
+ * There's no PATH environment variable; use the default that
+ * is used by sh.
+ */
+
+ p = ":/bin:/usr/bin";
+ }
+
+ /*
+ * Search through all the directories named in the PATH variable
+ * to see if argv[0] is in one of them. If so, use that file
+ * name.
+ */
+
+ while (*p != 0) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ name = p;
+ while ((*p != ':') && (*p != 0)) {
+ p++;
+ }
+ Tcl_DStringSetLength(&buffer, 0);
+ if (p != name) {
+ Tcl_DStringAppend(&buffer, name, p-name);
+ if (p[-1] != '/') {
+ Tcl_DStringAppend(&buffer, "/", 1);
+ }
+ }
+ Tcl_DStringAppend(&buffer, argv0, -1);
+ if ((access(Tcl_DStringValue(&buffer), X_OK) == 0)
+ && (stat(Tcl_DStringValue(&buffer), &statBuf) == 0)
+ && S_ISREG(statBuf.st_mode)) {
+ name = Tcl_DStringValue(&buffer);
+ goto gotName;
+ }
+ if (*p == 0) {
+ break;
+ }
+ p++;
+ }
+ goto done;
+
+ /*
+ * If the name starts with "/" then just copy it to tclExecutableName.
+ */
+
+ gotName:
+ if (name[0] == '/') {
+ tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1));
+ strcpy(tclExecutableName, name);
+ goto done;
+ }
+
+ /*
+ * The name is relative to the current working directory. First
+ * strip off a leading "./", if any, then add the full path name of
+ * the current working directory.
+ */
+
+ if ((name[0] == '.') && (name[1] == '/')) {
+ name += 2;
+ }
+ cwd = TclGetCwd((Tcl_Interp *) NULL);
+ if (cwd == NULL) {
+ tclExecutableName = NULL;
+ goto done;
+ }
+ length = strlen(cwd);
+ tclExecutableName = (char *) ckalloc((unsigned)
+ (length + strlen(name) + 2));
+ strcpy(tclExecutableName, cwd);
+ tclExecutableName[length] = '/';
+ strcpy(tclExecutableName + length + 1, name);
+
+ done:
+ Tcl_DStringFree(&buffer);
+
+ if (!executableNameExitHandlerSet) {
+ executableNameExitHandlerSet = 1;
+ Tcl_CreateExitHandler(FreeExecutableName, (ClientData) NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetUserHome --
+ *
+ * This function takes the passed in user name and finds the
+ * corresponding home directory specified in the password file.
+ *
+ * Results:
+ * The result is a pointer to a static string containing
+ * the new name. If there was an error in processing the
+ * user name then the return value is NULL. Otherwise the
+ * result is stored in bufferPtr, and the caller must call
+ * Tcl_DStringFree(bufferPtr) to free the result.
+ *
+ * Side effects:
+ * Information may be left in bufferPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetUserHome(name, bufferPtr)
+ char *name; /* User name to use to find home directory. */
+ Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold
+ * anything at the time of the call, and need
+ * not even be initialized. */
+{
+ struct passwd *pwPtr;
+
+ pwPtr = getpwnam(name);
+ if (pwPtr == NULL) {
+ endpwent();
+ return NULL;
+ }
+ Tcl_DStringInit(bufferPtr);
+ Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);
+ endpwent();
+ return bufferPtr->string;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMatchFiles --
+ *
+ * This routine is used by the globbing code to search a
+ * directory for all files which match a given pattern.
+ *
+ * Results:
+ * If the tail argument is NULL, then the matching files are
+ * added to the interp->result. Otherwise, TclDoGlob is called
+ * recursively for each matching subdirectory. The return value
+ * is a standard Tcl result indicating whether an error occurred
+ * in globbing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMatchFiles(interp, separators, dirPtr, pattern, tail)
+ Tcl_Interp *interp; /* Interpreter to receive results. */
+ char *separators; /* Path separators to pass to TclDoGlob. */
+ Tcl_DString *dirPtr; /* Contains path to directory to search. */
+ char *pattern; /* Pattern to match against. */
+ char *tail; /* Pointer to end of pattern. */
+{
+ char *dirName, *patternEnd = tail;
+ char savedChar = 0; /* Initialization needed only to prevent
+ * compiler warning from gcc. */
+ DIR *d;
+ struct stat statBuf;
+ struct dirent *entryPtr;
+ int matchHidden;
+ int result = TCL_OK;
+ int baseLength = Tcl_DStringLength(dirPtr);
+
+ /*
+ * Make sure that the directory part of the name really is a
+ * directory. If the directory name is "", use the name "."
+ * instead, because some UNIX systems don't treat "" like "."
+ * automatically. Keep the "" for use in generating file names,
+ * otherwise "glob foo.c" would return "./foo.c".
+ */
+
+ if (dirPtr->string[0] == '\0') {
+ dirName = ".";
+ } else {
+ dirName = dirPtr->string;
+ }
+ if ((stat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
+ return TCL_OK;
+ }
+
+ /*
+ * Check to see if the pattern needs to compare with hidden files.
+ */
+
+ if ((pattern[0] == '.')
+ || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
+ matchHidden = 1;
+ } else {
+ matchHidden = 0;
+ }
+
+ /*
+ * Now open the directory for reading and iterate over the contents.
+ */
+
+ d = opendir(dirName);
+ if (d == NULL) {
+ Tcl_ResetResult(interp);
+
+ /*
+ * Strip off a trailing '/' if necessary, before reporting the error.
+ */
+
+ if (baseLength > 0) {
+ savedChar = dirPtr->string[baseLength-1];
+ if (savedChar == '/') {
+ dirPtr->string[baseLength-1] = '\0';
+ }
+ }
+ Tcl_AppendResult(interp, "couldn't read directory \"",
+ dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ if (baseLength > 0) {
+ dirPtr->string[baseLength-1] = savedChar;
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Clean up the end of the pattern and the tail pointer. Leave
+ * the tail pointing to the first character after the path separator
+ * following the pattern, or NULL. Also, ensure that the pattern
+ * is null-terminated.
+ */
+
+ if (*tail == '\\') {
+ tail++;
+ }
+ if (*tail == '\0') {
+ tail = NULL;
+ } else {
+ tail++;
+ }
+ savedChar = *patternEnd;
+ *patternEnd = '\0';
+
+ while (1) {
+ entryPtr = readdir(d);
+ if (entryPtr == NULL) {
+ break;
+ }
+
+ /*
+ * Don't match names starting with "." unless the "." is
+ * present in the pattern.
+ */
+
+ if (!matchHidden && (*entryPtr->d_name == '.')) {
+ continue;
+ }
+
+ /*
+ * Now check to see if the file matches. If there are more
+ * characters to be processed, then ensure matching files are
+ * directories before calling TclDoGlob. Otherwise, just add
+ * the file to the result.
+ */
+
+ if (Tcl_StringMatch(entryPtr->d_name, pattern)) {
+ Tcl_DStringSetLength(dirPtr, baseLength);
+ Tcl_DStringAppend(dirPtr, entryPtr->d_name, -1);
+ if (tail == NULL) {
+ Tcl_AppendElement(interp, dirPtr->string);
+ } else if ((stat(dirPtr->string, &statBuf) == 0)
+ && S_ISDIR(statBuf.st_mode)) {
+ Tcl_DStringAppend(dirPtr, "/", 1);
+ result = TclDoGlob(interp, separators, dirPtr, tail);
+ if (result != TCL_OK) {
+ break;
+ }
+ }
+ }
+ }
+ *patternEnd = savedChar;
+
+ closedir(d);
+ return result;
+}
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
new file mode 100644
index 0000000..91d866f
--- /dev/null
+++ b/unix/tclUnixInit.c
@@ -0,0 +1,317 @@
+/*
+ * tclUnixInit.c --
+ *
+ * Contains the Unix-specific interpreter initialization functions.
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixInit.c 1.26 97/08/05 20:09:25
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#if defined(__FreeBSD__)
+# include <floatingpoint.h>
+#endif
+#if defined(__bsdi__)
+# include <sys/param.h>
+# if _BSDI_VERSION > 199501
+# include <dlfcn.h>
+# endif
+#endif
+
+/*
+ * Default directory in which to look for Tcl library scripts. The
+ * symbol is defined by Makefile.
+ */
+
+static char defaultLibraryDir[200] = TCL_LIBRARY;
+
+/*
+ * Directory in which to look for packages (each package is typically
+ * installed as a subdirectory of this directory). The symbol is
+ * defined by Makefile.
+ */
+
+static char pkgPath[200] = TCL_PACKAGE_PATH;
+
+/*
+ * Is this module initialized?
+ */
+
+static int initialized = 0;
+
+/*
+ * The following string is the startup script executed in new
+ * interpreters. It looks on disk in several different directories
+ * for a script "init.tcl" that is compatible with this version
+ * of Tcl. The init.tcl script does all of the real work of
+ * initialization.
+ */
+
+static char initScript[] =
+"proc tclInit {} {\n\
+ global tcl_library tcl_version tcl_patchLevel env errorInfo\n\
+ global tcl_pkgPath\n\
+ rename tclInit {}\n\
+ set errors {}\n\
+ set dirs {}\n\
+ if [info exists env(TCL_LIBRARY)] {\n\
+ lappend dirs $env(TCL_LIBRARY)\n\
+ }\n\
+ lappend dirs [info library]\n\
+ set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
+ lappend dirs $parentDir/lib/tcl$tcl_version\n\
+ if [string match {*[ab]*} $tcl_patchLevel] {\n\
+ set lib tcl$tcl_patchLevel\n\
+ } else {\n\
+ set lib tcl$tcl_version\n\
+ }\n\
+ lappend dirs [file dirname $parentDir]/$lib/library\n\
+ lappend dirs $parentDir/library\n\
+ foreach i $dirs {\n\
+ set tcl_library $i\n\
+ set tclfile [file join $i init.tcl]\n\
+ if {[file exists $tclfile]} {\n\
+ lappend tcl_pkgPath [file dirname $i]\n\
+ if ![catch {uplevel #0 [list source $tclfile]} msg] {\n\
+ return\n\
+ } else {\n\
+ append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
+ }\n\
+ }\n\
+ }\n\
+ set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
+ append msg \" $dirs\n\n\"\n\
+ append msg \"$errors\n\n\"\n\
+ append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
+ error $msg\n\
+}\n\
+tclInit";
+
+/*
+ * Static routines in this file:
+ */
+
+static void PlatformInitExitHandler _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformInitExitHandler --
+ *
+ * Uninitializes all values on unload, so that this module can
+ * be later reinitialized.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Returns the module to uninitialized state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PlatformInitExitHandler(clientData)
+ ClientData clientData; /* Unused. */
+{
+ strcpy(defaultLibraryDir, TCL_LIBRARY);
+ strcpy(pkgPath, TCL_PACKAGE_PATH);
+ initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPlatformInit --
+ *
+ * Performs Unix-specific interpreter initialization related to the
+ * tcl_library and tcl_platform variables, and other platform-
+ * specific things.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets "tcl_library" and "tcl_platform" Tcl variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPlatformInit(interp)
+ Tcl_Interp *interp;
+{
+#ifndef NO_UNAME
+ struct utsname name;
+#endif
+ int unameOK;
+
+ tclPlatform = TCL_PLATFORM_UNIX;
+ Tcl_SetVar(interp, "tcl_library", defaultLibraryDir, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
+ unameOK = 0;
+#ifndef NO_UNAME
+ if (uname(&name) >= 0) {
+ unameOK = 1;
+ Tcl_SetVar2(interp, "tcl_platform", "os", name.sysname,
+ TCL_GLOBAL_ONLY);
+ /*
+ * The following code is a special hack to handle differences in
+ * the way version information is returned by uname. On most
+ * systems the full version number is available in name.release.
+ * However, under AIX the major version number is in
+ * name.version and the minor version number is in name.release.
+ */
+
+ if ((strchr(name.release, '.') != NULL) || !isdigit(name.version[0])) {
+ Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
+ TCL_GLOBAL_ONLY);
+ } else {
+ Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
+ Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
+ }
+ Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
+ TCL_GLOBAL_ONLY);
+ }
+#endif
+ if (!unameOK) {
+ Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
+ }
+
+ if (!initialized) {
+
+ /*
+ * Create an exit handler so that uninitialization will be done
+ * on unload.
+ */
+
+ Tcl_CreateExitHandler(PlatformInitExitHandler, NULL);
+
+ /*
+ * The code below causes SIGPIPE (broken pipe) errors to
+ * be ignored. This is needed so that Tcl processes don't
+ * die if they create child processes (e.g. using "exec" or
+ * "open") that terminate prematurely. The signal handler
+ * is only set up when the first interpreter is created;
+ * after this the application can override the handler with
+ * a different one of its own, if it wants.
+ */
+
+#ifdef SIGPIPE
+ (void) signal(SIGPIPE, SIG_IGN);
+#endif /* SIGPIPE */
+
+#ifdef __FreeBSD__
+ fpsetround(FP_RN);
+ fpsetmask(0L);
+#endif
+
+#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
+ /*
+ * Find local symbols. Don't report an error if we fail.
+ */
+ (void) dlopen (NULL, RTLD_NOW);
+#endif
+ initialized = 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Init --
+ *
+ * This procedure is typically invoked by Tcl_AppInit procedures
+ * to perform additional initialization for a Tcl interpreter,
+ * such as sourcing the "init.tcl" script.
+ *
+ * Results:
+ * Returns a standard Tcl completion code and sets interp->result
+ * if there is an error.
+ *
+ * Side effects:
+ * Depends on what's in the init.tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Init(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ return Tcl_Eval(interp, initScript);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SourceRCFile --
+ *
+ * This procedure is typically invoked by Tcl_Main of Tk_Main
+ * procedure to source an application specific rc file into the
+ * interpreter at startup time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what's in the rc script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SourceRCFile(interp)
+ Tcl_Interp *interp; /* Interpreter to source rc file into. */
+{
+ Tcl_DString temp;
+ char *fileName;
+ Tcl_Channel errChannel;
+
+ fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
+
+ if (fileName != NULL) {
+ Tcl_Channel c;
+ char *fullName;
+
+ Tcl_DStringInit(&temp);
+ fullName = Tcl_TranslateFileName(interp, fileName, &temp);
+ if (fullName == NULL) {
+ /*
+ * Couldn't translate the file name (e.g. it referred to a
+ * bogus user or there was no HOME environment variable).
+ * Just do nothing.
+ */
+ } else {
+
+ /*
+ * Test for the existence of the rc file before trying to read it.
+ */
+
+ c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
+ if (c != (Tcl_Channel) NULL) {
+ Tcl_Close(NULL, c);
+ if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
+ errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ if (errChannel) {
+ Tcl_Write(errChannel, interp->result, -1);
+ Tcl_Write(errChannel, "\n", 1);
+ }
+ }
+ }
+ }
+ Tcl_DStringFree(&temp);
+ }
+}
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
new file mode 100644
index 0000000..1a86680
--- /dev/null
+++ b/unix/tclUnixNotfy.c
@@ -0,0 +1,518 @@
+/*
+ * tclUnixNotify.c --
+ *
+ * This file contains the implementation of the select-based
+ * Unix-specific notifier, which is the lowest-level part of the
+ * Tcl event loop. This file works together with
+ * ../generic/tclNotify.c.
+ *
+ * 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.
+ *
+ * SCCS: @(#) tclUnixNotfy.c 1.44 97/11/05 13:02:20
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include <signal.h>
+
+/*
+ * This structure is used to keep track of the notifier info for a
+ * a registered file.
+ */
+
+typedef struct FileHandler {
+ int fd;
+ int mask; /* Mask of desired events: TCL_READABLE,
+ * etc. */
+ int readyMask; /* Mask of events that have been seen since the
+ * last time file handlers were invoked for
+ * this file. */
+ Tcl_FileProc *proc; /* Procedure to call, in the style of
+ * Tcl_CreateFileHandler. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct FileHandler *nextPtr;/* Next in list of all files we care about. */
+} FileHandler;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file handlers are ready to fire.
+ */
+
+typedef struct FileHandlerEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ int fd; /* File descriptor that is ready. Used
+ * to find the FileHandler structure for
+ * the file (can't point directly to the
+ * FileHandler structure because it could
+ * go away while the event is queued). */
+} FileHandlerEvent;
+
+/*
+ * The following static structure contains the state information for the
+ * select based implementation of the Tcl notifier.
+ */
+
+static struct {
+ FileHandler *firstFileHandlerPtr;
+ /* Pointer to head of file handler list. */
+ fd_mask checkMasks[3*MASK_SIZE];
+ /* This array is used to build up the masks
+ * to be used in the next call to select.
+ * Bits are set in response to calls to
+ * Tcl_CreateFileHandler. */
+ fd_mask readyMasks[3*MASK_SIZE];
+ /* This array reflects the readable/writable
+ * conditions that were found to exist by the
+ * last call to select. */
+ int numFdBits; /* Number of valid bits in checkMasks
+ * (one more than highest fd for which
+ * Tcl_WatchFile has been called). */
+} notifier;
+
+/*
+ * The following static indicates whether this module has been initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * Static routines defined in this file.
+ */
+
+static void InitNotifier _ANSI_ARGS_((void));
+static void NotifierExitHandler _ANSI_ARGS_((
+ ClientData clientData));
+static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitNotifier --
+ *
+ * Initializes the notifier state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new exit handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitNotifier()
+{
+ initialized = 1;
+ memset(&notifier, 0, sizeof(notifier));
+ Tcl_CreateExitHandler(NotifierExitHandler, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierExitHandler --
+ *
+ * This function is called to cleanup the notifier state before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys the notifier window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NotifierExitHandler(clientData)
+ ClientData clientData; /* Not used. */
+{
+ initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimer --
+ *
+ * This procedure sets the current notifier timer value. This
+ * interface is not implemented in this notifier because we are
+ * always running inside of Tcl_DoOneEvent.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetTimer(timePtr)
+ Tcl_Time *timePtr; /* Timeout value, may be NULL. */
+{
+ /*
+ * The interval timer doesn't do anything in this implementation,
+ * because the only event loop is via Tcl_DoOneEvent, which passes
+ * timeout values to Tcl_WaitForEvent.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateFileHandler --
+ *
+ * This procedure registers a file handler with the Xt notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new file handler structure and registers one or more
+ * input procedures with Xt.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateFileHandler(fd, mask, proc, clientData)
+ int fd; /* Handle of stream to watch. */
+ int mask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION:
+ * indicates conditions under which
+ * proc should be called. */
+ Tcl_FileProc *proc; /* Procedure to call for each
+ * selected event. */
+ ClientData clientData; /* Arbitrary data to pass to proc. */
+{
+ FileHandler *filePtr;
+ int index, bit;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+ if (filePtr == NULL) {
+ filePtr = (FileHandler*) ckalloc(sizeof(FileHandler)); /* MLK */
+ filePtr->fd = fd;
+ filePtr->readyMask = 0;
+ filePtr->nextPtr = notifier.firstFileHandlerPtr;
+ notifier.firstFileHandlerPtr = filePtr;
+ }
+ filePtr->proc = proc;
+ filePtr->clientData = clientData;
+ filePtr->mask = mask;
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+ if (mask & TCL_READABLE) {
+ notifier.checkMasks[index] |= bit;
+ } else {
+ notifier.checkMasks[index] &= ~bit;
+ }
+ if (mask & TCL_WRITABLE) {
+ (notifier.checkMasks+MASK_SIZE)[index] |= bit;
+ } else {
+ (notifier.checkMasks+MASK_SIZE)[index] &= ~bit;
+ }
+ if (mask & TCL_EXCEPTION) {
+ (notifier.checkMasks+2*(MASK_SIZE))[index] |= bit;
+ } else {
+ (notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit;
+ }
+ if (notifier.numFdBits <= fd) {
+ notifier.numFdBits = fd+1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteFileHandler --
+ *
+ * Cancel a previously-arranged callback arrangement for
+ * a file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a callback was previously registered on file, remove it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteFileHandler(fd)
+ int fd; /* Stream id for which to remove callback procedure. */
+{
+ FileHandler *filePtr, *prevPtr;
+ int index, bit, i;
+ unsigned long flags;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ /*
+ * Find the entry for the given file (and return if there
+ * isn't one).
+ */
+
+ for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ if (filePtr == NULL) {
+ return;
+ }
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ index = fd/(NBBY*sizeof(fd_mask));
+ bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
+
+ if (filePtr->mask & TCL_READABLE) {
+ notifier.checkMasks[index] &= ~bit;
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ (notifier.checkMasks+MASK_SIZE)[index] &= ~bit;
+ }
+ if (filePtr->mask & TCL_EXCEPTION) {
+ (notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit;
+ }
+
+ /*
+ * Find current max fd.
+ */
+
+ if (fd+1 == notifier.numFdBits) {
+ for (notifier.numFdBits = 0; index >= 0; index--) {
+ flags = notifier.checkMasks[index]
+ | (notifier.checkMasks+MASK_SIZE)[index]
+ | (notifier.checkMasks+2*(MASK_SIZE))[index];
+ if (flags) {
+ for (i = (NBBY*sizeof(fd_mask)); i > 0; i--) {
+ if (flags & (((unsigned long)1) << (i-1))) {
+ break;
+ }
+ }
+ notifier.numFdBits = index * (NBBY*sizeof(fd_mask)) + i;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Clean up information in the callback record.
+ */
+
+ if (prevPtr == NULL) {
+ notifier.firstFileHandlerPtr = filePtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = filePtr->nextPtr;
+ }
+ ckfree((char *) filePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileHandlerEventProc --
+ *
+ * This procedure is called by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure is
+ * responsible for actually handling the event by invoking the
+ * callback for the file handler.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the file handler's callback procedure does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileHandlerEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event to service. */
+ int flags; /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+{
+ FileHandler *filePtr;
+ FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
+ int mask;
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /*
+ * Search through the file handlers to find the one whose handle matches
+ * the event. We do this rather than keeping a pointer to the file
+ * handler directly in the event, so that the handler can be deleted
+ * while the event is queued without leaving a dangling pointer.
+ */
+
+ for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd != fileEvPtr->fd) {
+ continue;
+ }
+
+ /*
+ * The code is tricky for two reasons:
+ * 1. The file handler's desired events could have changed
+ * since the time when the event was queued, so AND the
+ * ready mask with the desired mask.
+ * 2. The file could have been closed and re-opened since
+ * the time when the event was queued. This is why the
+ * ready mask is stored in the file handler rather than
+ * the queued event: it will be zeroed when a new
+ * file handler is created for the newly opened file.
+ */
+
+ mask = filePtr->readyMask & filePtr->mask;
+ filePtr->readyMask = 0;
+ if (mask != 0) {
+ (*filePtr->proc)(filePtr->clientData, mask);
+ }
+ break;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ * This function is called by Tcl_DoOneEvent to wait for new
+ * events on the message queue. If the block time is 0, then
+ * Tcl_WaitForEvent just polls without blocking.
+ *
+ * Results:
+ * Returns -1 if the select would block forever, otherwise
+ * returns 0.
+ *
+ * Side effects:
+ * Queues file events that are detected by the select.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(timePtr)
+ Tcl_Time *timePtr; /* Maximum block time, or NULL. */
+{
+ FileHandler *filePtr;
+ FileHandlerEvent *fileEvPtr;
+ struct timeval timeout, *timeoutPtr;
+ int bit, index, mask, numFound;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ /*
+ * Set up the timeout structure. Note that if there are no events to
+ * check for, we return with a negative result rather than blocking
+ * forever.
+ */
+
+ if (timePtr) {
+ timeout.tv_sec = timePtr->sec;
+ timeout.tv_usec = timePtr->usec;
+ timeoutPtr = &timeout;
+ } else if (notifier.numFdBits == 0) {
+ return -1;
+ } else {
+ timeoutPtr = NULL;
+ }
+
+ memcpy((VOID *) notifier.readyMasks, (VOID *) notifier.checkMasks,
+ 3*MASK_SIZE*sizeof(fd_mask));
+ numFound = select(notifier.numFdBits,
+ (SELECT_MASK *) &notifier.readyMasks[0],
+ (SELECT_MASK *) &notifier.readyMasks[MASK_SIZE],
+ (SELECT_MASK *) &notifier.readyMasks[2*MASK_SIZE], timeoutPtr);
+
+ /*
+ * Some systems don't clear the masks after an error, so
+ * we have to do it here.
+ */
+
+ if (numFound == -1) {
+ memset((VOID *) notifier.readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+ }
+
+ /*
+ * Queue all detected file events before returning.
+ */
+
+ for (filePtr = notifier.firstFileHandlerPtr;
+ (filePtr != NULL) && (numFound > 0);
+ filePtr = filePtr->nextPtr) {
+ index = filePtr->fd / (NBBY*sizeof(fd_mask));
+ bit = 1 << (filePtr->fd % (NBBY*sizeof(fd_mask)));
+ mask = 0;
+
+ if (notifier.readyMasks[index] & bit) {
+ mask |= TCL_READABLE;
+ }
+ if ((notifier.readyMasks+MASK_SIZE)[index] & bit) {
+ mask |= TCL_WRITABLE;
+ }
+ if ((notifier.readyMasks+2*(MASK_SIZE))[index] & bit) {
+ mask |= TCL_EXCEPTION;
+ }
+
+ if (!mask) {
+ continue;
+ } else {
+ numFound--;
+ }
+
+ /*
+ * Don't bother to queue an event if the mask was previously
+ * non-zero since an event must still be on the queue.
+ */
+
+ if (filePtr->readyMask == 0) {
+ fileEvPtr = (FileHandlerEvent *) ckalloc(
+ sizeof(FileHandlerEvent));
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ }
+ filePtr->readyMask = mask;
+ }
+ return 0;
+}
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
new file mode 100644
index 0000000..83aa4e8
--- /dev/null
+++ b/unix/tclUnixPipe.c
@@ -0,0 +1,1149 @@
+/*
+ * tclUnixPipe.c --
+ *
+ * This file implements the UNIX-specific exec pipeline functions,
+ * the "pipe" channel driver, and the "pid" Tcl command.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-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.
+ *
+ * SCCS: @(#) tclUnixPipe.c 1.37 97/10/31 17:23:37
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The following macros convert between TclFile's and fd's. The conversion
+ * simple involves shifting fd's up by one to ensure that no valid fd is ever
+ * the same as NULL.
+ */
+
+#define MakeFile(fd) ((TclFile)(((int)fd)+1))
+#define GetFd(file) (((int)file)-1)
+
+/*
+ * This structure describes per-instance state of a pipe based channel.
+ */
+
+typedef struct PipeState {
+ Tcl_Channel channel;/* Channel associated with this file. */
+ TclFile inFile; /* Output from pipe. */
+ TclFile outFile; /* Input to pipe. */
+ TclFile errorFile; /* Error output from pipe. */
+ int numPids; /* How many processes are attached to this pipe? */
+ Tcl_Pid *pidPtr; /* The process IDs themselves. Allocated by
+ * the creator of the pipe. */
+ int isNonBlocking; /* Nonzero when the pipe is in nonblocking mode.
+ * Used to decide whether to wait for the children
+ * at close time. */
+} PipeState;
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static int PipeBlockModeProc _ANSI_ARGS_((ClientData instanceData,
+ int mode));
+static int PipeCloseProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static int PipeGetHandleProc _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+static int PipeInputProc _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int PipeOutputProc _ANSI_ARGS_((
+ ClientData instanceData, char *buf, int toWrite,
+ int *errorCode));
+static void PipeWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
+static void RestoreSignals _ANSI_ARGS_((void));
+static int SetupStdFile _ANSI_ARGS_((TclFile file, int type));
+
+/*
+ * This structure describes the channel type structure for command pipe
+ * based IO:
+ */
+
+static Tcl_ChannelType pipeChannelType = {
+ "pipe", /* Type name. */
+ PipeBlockModeProc, /* Set blocking/nonblocking mode.*/
+ PipeCloseProc, /* Close proc. */
+ PipeInputProc, /* Input proc. */
+ PipeOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ PipeWatchProc, /* Initialize notifier. */
+ PipeGetHandleProc, /* Get OS handles out of channel. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMakeFile --
+ *
+ * Make a TclFile from a channel.
+ *
+ * Results:
+ * Returns a new TclFile or NULL on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclFile
+TclpMakeFile(channel, direction)
+ Tcl_Channel channel; /* Channel to get file from. */
+ int direction; /* Either TCL_READABLE or TCL_WRITABLE. */
+{
+ ClientData data;
+
+ if (Tcl_GetChannelHandle(channel, direction, (ClientData *) &data)
+ == TCL_OK) {
+ return MakeFile((int)data);
+ } else {
+ return (TclFile) NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenFile --
+ *
+ * Open a file for use in a pipeline.
+ *
+ * Results:
+ * Returns a new TclFile handle or NULL on failure.
+ *
+ * Side effects:
+ * May cause a file to be created on the file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclFile
+TclpOpenFile(fname, mode)
+ char *fname; /* The name of the file to open. */
+ int mode; /* In what mode to open the file? */
+{
+ int fd;
+
+ fd = open(fname, mode, 0666);
+ if (fd != -1) {
+ fcntl(fd, F_SETFD, FD_CLOEXEC);
+
+ /*
+ * If the file is being opened for writing, seek to the end
+ * so we can append to any data already in the file.
+ */
+
+ if (mode & O_WRONLY) {
+ lseek(fd, 0, SEEK_END);
+ }
+
+ /*
+ * Increment the fd so it can't be 0, which would conflict with
+ * the NULL return for errors.
+ */
+
+ return MakeFile(fd);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateTempFile --
+ *
+ * This function creates a temporary file initialized with an
+ * optional string, and returns a file handle with the file pointer
+ * at the beginning of the file.
+ *
+ * Results:
+ * A handle to a file.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclFile
+TclpCreateTempFile(contents, namePtr)
+ char *contents; /* String to write into temp file, or NULL. */
+ Tcl_DString *namePtr; /* If non-NULL, pointer to initialized
+ * DString that is filled with the name of
+ * the temp file that was created. */
+{
+ char fileName[L_tmpnam];
+ TclFile file;
+ size_t length = (contents == NULL) ? 0 : strlen(contents);
+
+ tmpnam(fileName);
+ file = TclpOpenFile(fileName, O_RDWR|O_CREAT|O_TRUNC);
+ unlink(fileName);
+
+ if ((file != NULL) && (length > 0)) {
+ int fd = GetFd(file);
+ while (1) {
+ if (write(fd, contents, length) != -1) {
+ break;
+ } else if (errno != EINTR) {
+ close(fd);
+ return NULL;
+ }
+ }
+ lseek(fd, 0, SEEK_SET);
+ }
+ if (namePtr != NULL) {
+ Tcl_DStringAppend(namePtr, fileName, -1);
+ }
+ return file;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreatePipe --
+ *
+ * Creates a pipe - simply calls the pipe() function.
+ *
+ * Results:
+ * Returns 1 on success, 0 on failure.
+ *
+ * Side effects:
+ * Creates a pipe.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpCreatePipe(readPipe, writePipe)
+ TclFile *readPipe; /* Location to store file handle for
+ * read side of pipe. */
+ TclFile *writePipe; /* Location to store file handle for
+ * write side of pipe. */
+{
+ int pipeIds[2];
+
+ if (pipe(pipeIds) != 0) {
+ return 0;
+ }
+
+ fcntl(pipeIds[0], F_SETFD, FD_CLOEXEC);
+ fcntl(pipeIds[1], F_SETFD, FD_CLOEXEC);
+
+ *readPipe = MakeFile(pipeIds[0]);
+ *writePipe = MakeFile(pipeIds[1]);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCloseFile --
+ *
+ * Implements a mechanism to close a UNIX file.
+ *
+ * Results:
+ * Returns 0 on success, or -1 on error, setting errno.
+ *
+ * Side effects:
+ * The file is closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpCloseFile(file)
+ TclFile file; /* The file to close. */
+{
+ int fd = GetFd(file);
+
+ /*
+ * Refuse to close the fds for stdin, stdout and stderr.
+ */
+
+ if ((fd == 0) || (fd == 1) || (fd == 2)) {
+ return 0;
+ }
+
+ Tcl_DeleteFileHandler(fd);
+ return close(fd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateProcess --
+ *
+ * Create a child process that has the specified files as its
+ * standard input, output, and error. The child process runs
+ * asynchronously and runs with the same environment variables
+ * as the creating process.
+ *
+ * The path is searched to find the specified executable.
+ *
+ * Results:
+ * The return value is TCL_ERROR and an error message is left in
+ * interp->result if there was a problem creating the child
+ * process. Otherwise, the return value is TCL_OK and *pidPtr is
+ * filled with the process id of the child process.
+ *
+ * Side effects:
+ * A process is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
+ pidPtr)
+ Tcl_Interp *interp; /* Interpreter in which to leave errors that
+ * occurred when creating the child process.
+ * Error messages from the child process
+ * itself are sent to errorFile. */
+ int argc; /* Number of arguments in following array. */
+ char **argv; /* Array of argument strings. argv[0]
+ * contains the name of the executable
+ * converted to native format (using the
+ * Tcl_TranslateFileName call). Additional
+ * arguments have not been converted. */
+ TclFile inputFile; /* If non-NULL, gives the file to use as
+ * input for the child process. If inputFile
+ * file is not readable or is NULL, the child
+ * will receive no standard input. */
+ TclFile outputFile; /* If non-NULL, gives the file that
+ * receives output from the child process. If
+ * outputFile file is not writeable or is
+ * NULL, output from the child will be
+ * discarded. */
+ TclFile errorFile; /* If non-NULL, gives the file that
+ * receives errors from the child process. If
+ * errorFile file is not writeable or is NULL,
+ * errors from the child will be discarded.
+ * errorFile may be the same as outputFile. */
+ Tcl_Pid *pidPtr; /* If this procedure is successful, pidPtr
+ * is filled with the process id of the child
+ * process. */
+{
+ TclFile errPipeIn, errPipeOut;
+ int joinThisError, count, status, fd;
+ char errSpace[200];
+ int pid;
+
+ errPipeIn = NULL;
+ errPipeOut = NULL;
+ pid = -1;
+
+ /*
+ * Create a pipe that the child can use to return error
+ * information if anything goes wrong.
+ */
+
+ if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 0) {
+ Tcl_AppendResult(interp, "couldn't create pipe: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ goto error;
+ }
+
+ joinThisError = (errorFile == outputFile);
+ pid = vfork();
+ if (pid == 0) {
+ fd = GetFd(errPipeOut);
+
+ /*
+ * Set up stdio file handles for the child process.
+ */
+
+ if (!SetupStdFile(inputFile, TCL_STDIN)
+ || !SetupStdFile(outputFile, TCL_STDOUT)
+ || (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
+ || (joinThisError &&
+ ((dup2(1,2) == -1) ||
+ (fcntl(2, F_SETFD, 0) != 0)))) {
+ sprintf(errSpace,
+ "%dforked process couldn't set up input/output: ",
+ errno);
+ write(fd, errSpace, (size_t) strlen(errSpace));
+ _exit(1);
+ }
+
+ /*
+ * Close the input side of the error pipe.
+ */
+
+ RestoreSignals();
+ execvp(argv[0], &argv[0]);
+ sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno,
+ argv[0]);
+ write(fd, errSpace, (size_t) strlen(errSpace));
+ _exit(1);
+ }
+ if (pid == -1) {
+ Tcl_AppendResult(interp, "couldn't fork child process: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ goto error;
+ }
+
+ /*
+ * Read back from the error pipe to see if the child started
+ * up OK. The info in the pipe (if any) consists of a decimal
+ * errno value followed by an error message.
+ */
+
+ TclpCloseFile(errPipeOut);
+ errPipeOut = NULL;
+
+ fd = GetFd(errPipeIn);
+ count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1));
+ if (count > 0) {
+ char *end;
+ errSpace[count] = 0;
+ errno = strtol(errSpace, &end, 10);
+ Tcl_AppendResult(interp, end, Tcl_PosixError(interp),
+ (char *) NULL);
+ goto error;
+ }
+
+ TclpCloseFile(errPipeIn);
+ *pidPtr = (Tcl_Pid) pid;
+ return TCL_OK;
+
+ error:
+ if (pid != -1) {
+ /*
+ * Reap the child process now if an error occurred during its
+ * startup.
+ */
+
+ Tcl_WaitPid((Tcl_Pid) pid, &status, WNOHANG);
+ }
+
+ if (errPipeIn) {
+ TclpCloseFile(errPipeIn);
+ }
+ if (errPipeOut) {
+ TclpCloseFile(errPipeOut);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RestoreSignals --
+ *
+ * This procedure is invoked in a forked child process just before
+ * exec-ing a new program to restore all signals to their default
+ * settings.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Signal settings get changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RestoreSignals()
+{
+#ifdef SIGABRT
+ signal(SIGABRT, SIG_DFL);
+#endif
+#ifdef SIGALRM
+ signal(SIGALRM, SIG_DFL);
+#endif
+#ifdef SIGFPE
+ signal(SIGFPE, SIG_DFL);
+#endif
+#ifdef SIGHUP
+ signal(SIGHUP, SIG_DFL);
+#endif
+#ifdef SIGILL
+ signal(SIGILL, SIG_DFL);
+#endif
+#ifdef SIGINT
+ signal(SIGINT, SIG_DFL);
+#endif
+#ifdef SIGPIPE
+ signal(SIGPIPE, SIG_DFL);
+#endif
+#ifdef SIGQUIT
+ signal(SIGQUIT, SIG_DFL);
+#endif
+#ifdef SIGSEGV
+ signal(SIGSEGV, SIG_DFL);
+#endif
+#ifdef SIGTERM
+ signal(SIGTERM, SIG_DFL);
+#endif
+#ifdef SIGUSR1
+ signal(SIGUSR1, SIG_DFL);
+#endif
+#ifdef SIGUSR2
+ signal(SIGUSR2, SIG_DFL);
+#endif
+#ifdef SIGCHLD
+ signal(SIGCHLD, SIG_DFL);
+#endif
+#ifdef SIGCONT
+ signal(SIGCONT, SIG_DFL);
+#endif
+#ifdef SIGTSTP
+ signal(SIGTSTP, SIG_DFL);
+#endif
+#ifdef SIGTTIN
+ signal(SIGTTIN, SIG_DFL);
+#endif
+#ifdef SIGTTOU
+ signal(SIGTTOU, SIG_DFL);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetupStdFile --
+ *
+ * Set up stdio file handles for the child process, using the
+ * current standard channels if no other files are specified.
+ * If no standard channel is defined, or if no file is associated
+ * with the channel, then the corresponding standard fd is closed.
+ *
+ * Results:
+ * Returns 1 on success, or 0 on failure.
+ *
+ * Side effects:
+ * Replaces stdio fds.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetupStdFile(file, type)
+ TclFile file; /* File to dup, or NULL. */
+ int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR */
+{
+ Tcl_Channel channel;
+ int fd;
+ int targetFd = 0; /* Initializations here needed only to */
+ int direction = 0; /* prevent warnings about using uninitialized
+ * variables. */
+
+ switch (type) {
+ case TCL_STDIN:
+ targetFd = 0;
+ direction = TCL_READABLE;
+ break;
+ case TCL_STDOUT:
+ targetFd = 1;
+ direction = TCL_WRITABLE;
+ break;
+ case TCL_STDERR:
+ targetFd = 2;
+ direction = TCL_WRITABLE;
+ break;
+ }
+
+ if (!file) {
+ channel = Tcl_GetStdChannel(type);
+ if (channel) {
+ file = TclpMakeFile(channel, direction);
+ }
+ }
+ if (file) {
+ fd = GetFd(file);
+ if (fd != targetFd) {
+ if (dup2(fd, targetFd) == -1) {
+ return 0;
+ }
+
+ /*
+ * Must clear the close-on-exec flag for the target FD, since
+ * some systems (e.g. Ultrix) do not clear the CLOEXEC flag on
+ * the target FD.
+ */
+
+ fcntl(targetFd, F_SETFD, 0);
+ } else {
+ int result;
+
+ /*
+ * Since we aren't dup'ing the file, we need to explicitly clear
+ * the close-on-exec flag.
+ */
+
+ result = fcntl(fd, F_SETFD, 0);
+ }
+ } else {
+ close(targetFd);
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateCommandChannel --
+ *
+ * This function is called by the generic IO level to perform
+ * the platform specific channel initialization for a command
+ * channel.
+ *
+ * Results:
+ * Returns a new channel or NULL on failure.
+ *
+ * Side effects:
+ * Allocates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
+ TclFile readFile; /* If non-null, gives the file for reading. */
+ TclFile writeFile; /* If non-null, gives the file for writing. */
+ TclFile errorFile; /* If non-null, gives the file where errors
+ * can be read. */
+ int numPids; /* The number of pids in the pid array. */
+ Tcl_Pid *pidPtr; /* An array of process identifiers.
+ * Allocated by the caller, freed when
+ * the channel is closed or the processes
+ * are detached (in a background exec). */
+{
+ char channelName[20];
+ int channelId;
+ PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
+ int mode;
+
+ statePtr->inFile = readFile;
+ statePtr->outFile = writeFile;
+ statePtr->errorFile = errorFile;
+ statePtr->numPids = numPids;
+ statePtr->pidPtr = pidPtr;
+ statePtr->isNonBlocking = 0;
+
+ mode = 0;
+ if (readFile) {
+ mode |= TCL_READABLE;
+ }
+ if (writeFile) {
+ mode |= TCL_WRITABLE;
+ }
+
+ /*
+ * Use one of the fds associated with the channel as the
+ * channel id.
+ */
+
+ if (readFile) {
+ channelId = GetFd(readFile);
+ } else if (writeFile) {
+ channelId = GetFd(writeFile);
+ } else if (errorFile) {
+ channelId = GetFd(errorFile);
+ } else {
+ channelId = 0;
+ }
+
+ /*
+ * For backward compatibility with previous versions of Tcl, we
+ * use "file%d" as the base name for pipes even though it would
+ * be more natural to use "pipe%d".
+ */
+
+ sprintf(channelName, "file%d", channelId);
+ statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
+ (ClientData) statePtr, mode);
+ return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetAndDetachPids --
+ *
+ * This procedure is invoked in the generic implementation of a
+ * background "exec" (An exec when invoked with a terminating "&")
+ * to store a list of the PIDs for processes in a command pipeline
+ * in interp->result and to detach the processes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Modifies interp->result. Detaches processes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclGetAndDetachPids(interp, chan)
+ Tcl_Interp *interp;
+ Tcl_Channel chan;
+{
+ PipeState *pipePtr;
+ Tcl_ChannelType *chanTypePtr;
+ int i;
+ char buf[20];
+
+ /*
+ * Punt if the channel is not a command channel.
+ */
+
+ chanTypePtr = Tcl_GetChannelType(chan);
+ if (chanTypePtr != &pipeChannelType) {
+ return;
+ }
+
+ pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
+ for (i = 0; i < pipePtr->numPids; i++) {
+ sprintf(buf, "%ld", TclpGetPid(pipePtr->pidPtr[i]));
+ Tcl_AppendElement(interp, buf);
+ Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
+ }
+ if (pipePtr->numPids > 0) {
+ ckfree((char *) pipePtr->pidPtr);
+ pipePtr->numPids = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeBlockModeProc --
+ *
+ * Helper procedure to set blocking and nonblocking modes on a
+ * pipe 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
+PipeBlockModeProc(instanceData, mode)
+ ClientData instanceData; /* Pipe state. */
+ int mode; /* The mode to set. Can be one of
+ * TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ PipeState *psPtr = (PipeState *) instanceData;
+ int curStatus;
+ int fd;
+
+#ifndef USE_FIONBIO
+ if (psPtr->inFile) {
+ fd = GetFd(psPtr->inFile);
+ curStatus = fcntl(fd, F_GETFL);
+ if (mode == TCL_MODE_BLOCKING) {
+ curStatus &= (~(O_NONBLOCK));
+ } else {
+ curStatus |= O_NONBLOCK;
+ }
+ if (fcntl(fd, F_SETFL, curStatus) < 0) {
+ return errno;
+ }
+ curStatus = fcntl(fd, F_GETFL);
+ }
+ if (psPtr->outFile) {
+ fd = GetFd(psPtr->outFile);
+ curStatus = fcntl(fd, F_GETFL);
+ if (mode == TCL_MODE_BLOCKING) {
+ curStatus &= (~(O_NONBLOCK));
+ } else {
+ curStatus |= O_NONBLOCK;
+ }
+ if (fcntl(fd, F_SETFL, curStatus) < 0) {
+ return errno;
+ }
+ }
+#endif /* !FIONBIO */
+
+#ifdef USE_FIONBIO
+ if (psPtr->inFile) {
+ fd = GetFd(psPtr->inFile);
+ if (mode == TCL_MODE_BLOCKING) {
+ curStatus = 0;
+ } else {
+ curStatus = 1;
+ }
+ if (ioctl(fd, (int) FIONBIO, &curStatus) < 0) {
+ return errno;
+ }
+ }
+ if (psPtr->outFile != NULL) {
+ fd = GetFd(psPtr->outFile);
+ if (mode == TCL_MODE_BLOCKING) {
+ curStatus = 0;
+ } else {
+ curStatus = 1;
+ }
+ if (ioctl(fd, (int) FIONBIO, &curStatus) < 0) {
+ return errno;
+ }
+ }
+#endif /* USE_FIONBIO */
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeCloseProc --
+ *
+ * This procedure is invoked by the generic IO level to perform
+ * channel-type-specific cleanup when a command pipeline channel
+ * is closed.
+ *
+ * Results:
+ * 0 on success, errno otherwise.
+ *
+ * Side effects:
+ * Closes the command pipeline channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+PipeCloseProc(instanceData, interp)
+ ClientData instanceData; /* The pipe to close. */
+ Tcl_Interp *interp; /* For error reporting. */
+{
+ PipeState *pipePtr;
+ Tcl_Channel errChan;
+ int errorCode, result;
+
+ errorCode = 0;
+ result = 0;
+ pipePtr = (PipeState *) instanceData;
+ if (pipePtr->inFile) {
+ if (TclpCloseFile(pipePtr->inFile) < 0) {
+ errorCode = errno;
+ }
+ }
+ if (pipePtr->outFile) {
+ if ((TclpCloseFile(pipePtr->outFile) < 0) && (errorCode == 0)) {
+ errorCode = errno;
+ }
+ }
+
+ if (pipePtr->isNonBlocking || TclInExit()) {
+
+ /*
+ * If the channel is non-blocking or Tcl is being cleaned up, just
+ * detach the children PIDs, reap them (important if we are in a
+ * dynamic load module), and discard the errorFile.
+ */
+
+ Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
+ Tcl_ReapDetachedProcs();
+
+ if (pipePtr->errorFile) {
+ TclpCloseFile(pipePtr->errorFile);
+ }
+ } else {
+
+ /*
+ * Wrap the error file into a channel and give it to the cleanup
+ * routine.
+ */
+
+ if (pipePtr->errorFile) {
+ errChan = Tcl_MakeFileChannel(
+ (ClientData) GetFd(pipePtr->errorFile), TCL_READABLE);
+ } else {
+ errChan = NULL;
+ }
+ result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
+ errChan);
+ }
+
+ if (pipePtr->numPids != 0) {
+ ckfree((char *) pipePtr->pidPtr);
+ }
+ ckfree((char *) pipePtr);
+ if (errorCode == 0) {
+ return result;
+ }
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeInputProc --
+ *
+ * This procedure is invoked from the generic IO level to read
+ * input from a command pipeline 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
+PipeInputProc(instanceData, buf, toRead, errorCodePtr)
+ ClientData instanceData; /* Pipe 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. */
+{
+ PipeState *psPtr = (PipeState *) 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(GetFd(psPtr->inFile), buf, (size_t) toRead);
+ if (bytesRead > -1) {
+ return bytesRead;
+ }
+ *errorCodePtr = errno;
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeOutputProc--
+ *
+ * This procedure is invoked from the generic IO level to write
+ * output to a command pipeline based 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
+PipeOutputProc(instanceData, buf, toWrite, errorCodePtr)
+ ClientData instanceData; /* Pipe state. */
+ char *buf; /* The data buffer. */
+ int toWrite; /* How many bytes to write? */
+ int *errorCodePtr; /* Where to store error code. */
+{
+ PipeState *psPtr = (PipeState *) instanceData;
+ int written;
+
+ *errorCodePtr = 0;
+ written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite);
+ if (written > -1) {
+ return written;
+ }
+ *errorCodePtr = errno;
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeWatchProc --
+ *
+ * Initialize the notifier to watch the fds 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
+PipeWatchProc(instanceData, mask)
+ ClientData instanceData; /* The pipe state. */
+ int mask; /* Events of interest; an OR-ed
+ * combination of TCL_READABLE,
+ * TCL_WRITABEL and TCL_EXCEPTION. */
+{
+ PipeState *psPtr = (PipeState *) instanceData;
+ int newmask;
+
+ if (psPtr->inFile) {
+ newmask = mask & (TCL_READABLE | TCL_EXCEPTION);
+ if (newmask) {
+ Tcl_CreateFileHandler(GetFd(psPtr->inFile), mask,
+ (Tcl_FileProc *) Tcl_NotifyChannel,
+ (ClientData) psPtr->channel);
+ } else {
+ Tcl_DeleteFileHandler(GetFd(psPtr->inFile));
+ }
+ }
+ if (psPtr->outFile) {
+ newmask = mask & (TCL_WRITABLE | TCL_EXCEPTION);
+ if (newmask) {
+ Tcl_CreateFileHandler(GetFd(psPtr->outFile), mask,
+ (Tcl_FileProc *) Tcl_NotifyChannel,
+ (ClientData) psPtr->channel);
+ } else {
+ Tcl_DeleteFileHandler(GetFd(psPtr->outFile));
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeGetHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from
+ * inside a command pipeline 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
+PipeGetHandleProc(instanceData, direction, handlePtr)
+ ClientData instanceData; /* The pipe state. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr; /* Where to store the handle. */
+{
+ PipeState *psPtr = (PipeState *) instanceData;
+
+ if (direction == TCL_READABLE && psPtr->inFile) {
+ *handlePtr = (ClientData) GetFd(psPtr->inFile);
+ return TCL_OK;
+ }
+ if (direction == TCL_WRITABLE && psPtr->outFile) {
+ *handlePtr = (ClientData) GetFd(psPtr->outFile);
+ return TCL_OK;
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitPid --
+ *
+ * Implements the waitpid system call on Unix systems.
+ *
+ * Results:
+ * Result of calling waitpid.
+ *
+ * Side effects:
+ * Waits for a process to terminate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Pid
+Tcl_WaitPid(pid, statPtr, options)
+ Tcl_Pid pid;
+ int *statPtr;
+ int options;
+{
+ int result;
+ pid_t real_pid;
+
+ real_pid = (pid_t) pid;
+ while (1) {
+ result = (int) waitpid(real_pid, statPtr, options);
+ if ((result != -1) || (errno != EINTR)) {
+ return (Tcl_Pid) result;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PidObjCmd --
+ *
+ * This procedure is invoked to process the "pid" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_PidObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST *objv; /* Argument strings. */
+{
+ Tcl_Channel chan;
+ Tcl_ChannelType *chanTypePtr;
+ PipeState *pipePtr;
+ int i;
+ Tcl_Obj *resultPtr, *longObjPtr;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
+ return TCL_ERROR;
+ }
+ if (objc == 1) {
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) getpid());
+ } else {
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+ NULL);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+ chanTypePtr = Tcl_GetChannelType(chan);
+ if (chanTypePtr != &pipeChannelType) {
+ return TCL_OK;
+ }
+ pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
+ resultPtr = Tcl_GetObjResult(interp);
+ for (i = 0; i < pipePtr->numPids; i++) {
+ longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i]));
+ Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr);
+ }
+ }
+ return TCL_OK;
+}
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
new file mode 100644
index 0000000..186de21
--- /dev/null
+++ b/unix/tclUnixPort.h
@@ -0,0 +1,480 @@
+/*
+ * tclUnixPort.h --
+ *
+ * This header file handles porting issues that occur because
+ * of differences between systems. It reads in UNIX-related
+ * header files and sets up UNIX-related macros for Tcl's UNIX
+ * core. It should be the only file that contains #ifdefs to
+ * handle different flavors of UNIX. This file sets up the
+ * union of all UNIX-related things needed by any of the Tcl
+ * core files. This file depends on configuration #defines such
+ * as NO_DIRENT_H that are set up by the "configure" script.
+ *
+ * Much of the material in this file was originally contributed
+ * by Karl Lehenbauer, Mark Diekhans and Peter da Silva.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixPort.h 1.49 97/07/30 14:11:59
+ */
+
+#ifndef _TCLUNIXPORT
+#define _TCLUNIXPORT
+
+#ifndef _TCLINT
+# include "tclInt.h"
+#endif
+#include <errno.h>
+#include <fcntl.h>
+#ifdef HAVE_NET_ERRNO_H
+# include <net/errno.h>
+#endif
+#include <pwd.h>
+#include <signal.h>
+#include <sys/param.h>
+#include <sys/types.h>
+#ifdef USE_DIRENT2_H
+# include "../compat/dirent2.h"
+#else
+# ifdef NO_DIRENT_H
+# include "../compat/dirent.h"
+# else
+# include <dirent.h>
+# endif
+#endif
+#include <sys/file.h>
+#ifdef HAVE_SYS_SELECT_H
+# include <sys/select.h>
+#endif
+#include <sys/stat.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+#ifndef NO_SYS_WAIT_H
+# include <sys/wait.h>
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#else
+# include "../compat/unistd.h"
+#endif
+#ifdef USE_FIONBIO
+
+ /*
+ * Not using the Posix fcntl(...,O_NONBLOCK,...) interface, instead
+ * we are using ioctl(..,FIONBIO,..).
+ */
+
+# ifdef HAVE_SYS_FILIO_H
+# include <sys/filio.h> /* For FIONBIO. */
+# endif
+
+# ifdef HAVE_SYS_IOCTL_H
+# include <sys/ioctl.h> /* For FIONBIO. */
+# endif
+#endif /* USE_FIONBIO */
+
+/*
+ * Socket support stuff: This likely needs more work to parameterize for
+ * each system.
+ */
+
+#include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
+#ifndef NO_UNAME
+# include <sys/utsname.h> /* uname system call. */
+#endif
+#include <netinet/in.h> /* struct in_addr, struct sockaddr_in */
+#include <arpa/inet.h> /* inet_ntoa() */
+#include <netdb.h> /* gethostbyname() */
+
+/*
+ * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we
+ * look for an alternative definition. If no other alternative is available
+ * we use a reasonable guess.
+ */
+
+#ifndef NO_FLOAT_H
+#include <float.h>
+#else
+# ifndef NO_VALUES_H
+# include <values.h>
+# endif
+#endif
+
+#ifndef FLT_MAX
+# ifdef MAXFLOAT
+# define FLT_MAX MAXFLOAT
+# else
+# define FLT_MAX 3.402823466E+38F
+# endif
+#endif
+#ifndef FLT_MIN
+# ifdef MINFLOAT
+# define FLT_MIN MINFLOAT
+# else
+# define FLT_MIN 1.175494351E-38F
+# endif
+#endif
+
+/*
+ * NeXT doesn't define O_NONBLOCK, so #define it here if necessary.
+ */
+
+#ifndef O_NONBLOCK
+# define O_NONBLOCK 0x80
+#endif
+
+/*
+ * HPUX needs the flag O_NONBLOCK to get the right non-blocking I/O
+ * semantics, while most other systems need O_NDELAY. Define the
+ * constant NBIO_FLAG to be one of these
+ */
+
+#ifdef HPUX
+# define NBIO_FLAG O_NONBLOCK
+#else
+# define NBIO_FLAG O_NDELAY
+#endif
+
+/*
+ * The following defines denote malloc and free as the system calls
+ * used to allocate new memory. These defines are only used in the
+ * file tclCkalloc.c.
+ */
+
+#define TclpAlloc(size) malloc(size)
+#define TclpFree(ptr) free(ptr)
+#define TclpRealloc(ptr, size) realloc(ptr, size)
+
+/*
+ * The default platform eol translation on Unix is TCL_TRANSLATE_LF:
+ */
+
+#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_LF
+
+/*
+ * Not all systems declare the errno variable in errno.h. so this
+ * file does it explicitly. The list of system error messages also
+ * isn't generally declared in a header file anywhere.
+ */
+
+extern int errno;
+
+/*
+ * The type of the status returned by wait varies from UNIX system
+ * to UNIX system. The macro below defines it:
+ */
+
+#ifdef _AIX
+# define WAIT_STATUS_TYPE pid_t
+#else
+#ifndef NO_UNION_WAIT
+# define WAIT_STATUS_TYPE union wait
+#else
+# define WAIT_STATUS_TYPE int
+#endif
+#endif
+
+/*
+ * Supply definitions for macros to query wait status, if not already
+ * defined in header files above.
+ */
+
+#ifndef WIFEXITED
+# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0)
+#endif
+
+#ifndef WEXITSTATUS
+# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
+#endif
+
+#ifndef WIFSIGNALED
+# define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
+#endif
+
+#ifndef WTERMSIG
+# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f)
+#endif
+
+#ifndef WIFSTOPPED
+# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177)
+#endif
+
+#ifndef WSTOPSIG
+# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff)
+#endif
+
+/*
+ * Define constants for waitpid() system call if they aren't defined
+ * by a system header file.
+ */
+
+#ifndef WNOHANG
+# define WNOHANG 1
+#endif
+#ifndef WUNTRACED
+# define WUNTRACED 2
+#endif
+
+/*
+ * Supply macros for seek offsets, if they're not already provided by
+ * an include file.
+ */
+
+#ifndef SEEK_SET
+# define SEEK_SET 0
+#endif
+
+#ifndef SEEK_CUR
+# define SEEK_CUR 1
+#endif
+
+#ifndef SEEK_END
+# define SEEK_END 2
+#endif
+
+/*
+ * The stuff below is needed by the "time" command. If this
+ * system has no gettimeofday call, then must use times and the
+ * CLK_TCK #define (from sys/param.h) to compute elapsed time.
+ * Unfortunately, some systems only have HZ and no CLK_TCK, and
+ * some might not even have HZ.
+ */
+
+#ifdef NO_GETTOD
+# include <sys/times.h>
+# include <sys/param.h>
+# ifndef CLK_TCK
+# ifdef HZ
+# define CLK_TCK HZ
+# else
+# define CLK_TCK 60
+# endif
+# endif
+#else
+# ifdef HAVE_BSDGETTIMEOFDAY
+# define gettimeofday BSDgettimeofday
+# endif
+#endif
+
+#ifdef GETTOD_NOT_DECLARED
+EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
+ struct timezone *tzp));
+#endif
+
+/*
+ * Define access mode constants if they aren't already defined.
+ */
+
+#ifndef F_OK
+# define F_OK 00
+#endif
+#ifndef X_OK
+# define X_OK 01
+#endif
+#ifndef W_OK
+# define W_OK 02
+#endif
+#ifndef R_OK
+# define R_OK 04
+#endif
+
+/*
+ * Define FD_CLOEEXEC (the close-on-exec flag bit) if it isn't
+ * already defined.
+ */
+
+#ifndef FD_CLOEXEC
+# define FD_CLOEXEC 1
+#endif
+
+/*
+ * On systems without symbolic links (i.e. S_IFLNK isn't defined)
+ * define "lstat" to use "stat" instead.
+ */
+
+#ifndef S_IFLNK
+# define lstat stat
+#endif
+
+/*
+ * Define macros to query file type bits, if they're not already
+ * defined.
+ */
+
+#ifndef S_ISREG
+# ifdef S_IFREG
+# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
+# else
+# define S_ISREG(m) 0
+# endif
+# endif
+#ifndef S_ISDIR
+# ifdef S_IFDIR
+# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
+# else
+# define S_ISDIR(m) 0
+# endif
+# endif
+#ifndef S_ISCHR
+# ifdef S_IFCHR
+# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
+# else
+# define S_ISCHR(m) 0
+# endif
+# endif
+#ifndef S_ISBLK
+# ifdef S_IFBLK
+# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
+# else
+# define S_ISBLK(m) 0
+# endif
+# endif
+#ifndef S_ISFIFO
+# ifdef S_IFIFO
+# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
+# else
+# define S_ISFIFO(m) 0
+# endif
+# endif
+#ifndef S_ISLNK
+# ifdef S_IFLNK
+# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
+# else
+# define S_ISLNK(m) 0
+# endif
+# endif
+#ifndef S_ISSOCK
+# ifdef S_IFSOCK
+# define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK)
+# else
+# define S_ISSOCK(m) 0
+# endif
+# endif
+
+/*
+ * Make sure that MAXPATHLEN is defined.
+ */
+
+#ifndef MAXPATHLEN
+# ifdef PATH_MAX
+# define MAXPATHLEN PATH_MAX
+# else
+# define MAXPATHLEN 2048
+# endif
+#endif
+
+/*
+ * Make sure that L_tmpnam is defined.
+ */
+
+#ifndef L_tmpnam
+# define L_tmpnam 100
+#endif
+
+/*
+ * The following macro defines the type of the mask arguments to
+ * select:
+ */
+
+#ifndef NO_FD_SET
+# define SELECT_MASK fd_set
+#else
+# ifndef _AIX
+ typedef long fd_mask;
+# endif
+# if defined(_IBMR2)
+# define SELECT_MASK void
+# else
+# define SELECT_MASK int
+# endif
+#endif
+
+/*
+ * Define "NBBY" (number of bits per byte) if it's not already defined.
+ */
+
+#ifndef NBBY
+# define NBBY 8
+#endif
+
+/*
+ * The following macro defines the number of fd_masks in an fd_set:
+ */
+
+#ifndef FD_SETSIZE
+# ifdef OPEN_MAX
+# define FD_SETSIZE OPEN_MAX
+# else
+# define FD_SETSIZE 256
+# endif
+#endif
+#if !defined(howmany)
+# define howmany(x, y) (((x)+((y)-1))/(y))
+#endif
+#ifndef NFDBITS
+# define NFDBITS NBBY*sizeof(fd_mask)
+#endif
+#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
+
+/*
+ * The following implements the Unix method for exiting the process.
+ */
+#define TclPlatformExit(status) exit(status)
+
+/*
+ * The following functions always succeeds under Unix.
+ */
+
+#define TclHasSockets(interp) (TCL_OK)
+#define TclHasPipes() (1)
+
+/*
+ * Variables provided by the C library:
+ */
+
+#if defined(_sgi) || defined(__sgi)
+#define environ _environ
+#endif
+extern char **environ;
+
+/*
+ * At present (12/91) not all stdlib.h implementations declare strtod.
+ * The declaration below is here to ensure that it's declared, so that
+ * the compiler won't take the default approach of assuming it returns
+ * an int. There's no ANSI prototype for it because there would end
+ * up being too many conflicts with slightly-different prototypes.
+ */
+
+extern double strtod();
+
+/*
+ * The following macros define time related functions in terms of
+ * standard Unix routines.
+ */
+
+#define TclpGetDate(t,u) ((u) ? gmtime((t)) : localtime((t)))
+#define TclStrftime(s,m,f,t) (strftime((s),(m),(f),(t)))
+#define TclpGetPid(pid) ((unsigned long) (pid))
+
+#define TclpReleaseFile(file)
+
+/*
+ * The following routine is only exported for testing purposes.
+ */
+
+EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
+ int timeout));
+
+#endif /* _TCLUNIXPORT */
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
new file mode 100644
index 0000000..c532993
--- /dev/null
+++ b/unix/tclUnixSock.c
@@ -0,0 +1,100 @@
+/*
+ * tclUnixSock.c --
+ *
+ * This file contains Unix-specific socket related code.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixSock.c 1.9 97/10/09 18:24:49
+ */
+
+#include "tcl.h"
+#include "tclPort.h"
+
+/*
+ * There is no portable macro for the maximum length
+ * of host names returned by gethostbyname(). We should only
+ * trust SYS_NMLN if it is at least 255 + 1 bytes to comply with DNS
+ * host name limits.
+ *
+ * Note: SYS_NMLN is a restriction on "uname" not on gethostbyname!
+ *
+ * For example HP-UX 10.20 has SYS_NMLN == 9, while gethostbyname()
+ * can return a fully qualified name from DNS of up to 255 bytes.
+ *
+ * Fix suggested by Viktor Dukhovni (viktor@esm.com)
+ */
+
+#if defined(SYS_NMLN) && SYS_NMLEN >= 256
+#define TCL_HOSTNAME_LEN SYS_NMLEN
+#else
+#define TCL_HOSTNAME_LEN 256
+#endif
+
+
+/*
+ * The following variable holds the network name of this host.
+ */
+
+static char hostname[TCL_HOSTNAME_LEN + 1];
+static int hostnameInited = 0;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetHostName --
+ *
+ * Returns the name of the local host.
+ *
+ * Results:
+ * A string containing the network name for this machine, or
+ * an empty string if we can't figure out the name. The caller
+ * must not modify or free this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetHostName()
+{
+#ifndef NO_UNAME
+ struct utsname u;
+ struct hostent *hp;
+#endif
+
+ if (hostnameInited) {
+ return hostname;
+ }
+
+#ifndef NO_UNAME
+ (VOID *) memset((VOID *) &u, (int) 0, sizeof(struct utsname));
+ if (uname(&u) > -1) {
+ hp = gethostbyname(u.nodename);
+ if (hp != NULL) {
+ strcpy(hostname, hp->h_name);
+ } else {
+ strcpy(hostname, u.nodename);
+ }
+ hostnameInited = 1;
+ return hostname;
+ }
+#else
+ /*
+ * Uname doesn't exist; try gethostname instead.
+ */
+
+ if (gethostname(hostname, sizeof(hostname)) > -1) {
+ hostnameInited = 1;
+ return hostname;
+ }
+#endif
+
+ hostname[0] = 0;
+ return hostname;
+}
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
new file mode 100644
index 0000000..b1d1676
--- /dev/null
+++ b/unix/tclUnixTest.c
@@ -0,0 +1,431 @@
+/*
+ * tclUnixTest.c --
+ *
+ * Contains platform specific test commands for the Unix platform.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixTest.c 1.5 97/10/31 17:23:42
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The following macros convert between TclFile's and fd's. The conversion
+ * simple involves shifting fd's up by one to ensure that no valid fd is ever
+ * the same as NULL. Note that this code is duplicated from tclUnixPipe.c
+ */
+
+#define MakeFile(fd) ((TclFile)((fd)+1))
+#define GetFd(file) (((int)file)-1)
+
+/*
+ * The stuff below is used to keep track of file handlers created and
+ * exercised by the "testfilehandler" command.
+ */
+
+typedef struct Pipe {
+ TclFile readFile; /* File handle for reading from the
+ * pipe. NULL means pipe doesn't exist yet. */
+ TclFile writeFile; /* File handle for writing from the
+ * pipe. */
+ int readCount; /* Number of times the file handler for
+ * this file has triggered and the file
+ * was readable. */
+ int writeCount; /* Number of times the file handler for
+ * this file has triggered and the file
+ * was writable. */
+} Pipe;
+
+#define MAX_PIPES 10
+static Pipe testPipes[MAX_PIPES];
+
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+
+static void TestFileHandlerProc _ANSI_ARGS_((ClientData clientData,
+ int mask));
+static int TestfilehandlerCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestfilewaitCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclplatformtestInit --
+ *
+ * Defines commands that test platform specific functionality for
+ * Unix platforms.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Defines new commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclplatformtestInit(interp)
+ Tcl_Interp *interp; /* Interpreter to add commands to. */
+{
+ Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestfilehandlerCmd --
+ *
+ * This procedure implements the "testfilehandler" command. It is
+ * used to test Tcl_CreateFileHandler, Tcl_DeleteFileHandler, and
+ * TclWaitForFile.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestfilehandlerCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Pipe *pipePtr;
+ int i, mask, timeout;
+ static int initialized = 0;
+ char buffer[4000];
+ TclFile file;
+
+ /*
+ * NOTE: When we make this code work on Windows also, the following
+ * variable needs to be made Unix-only.
+ */
+
+ if (!initialized) {
+ for (i = 0; i < MAX_PIPES; i++) {
+ testPipes[i].readFile = NULL;
+ }
+ initialized = 1;
+ }
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " option ... \"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ pipePtr = NULL;
+ if (argc >= 3) {
+ if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i >= MAX_PIPES) {
+ Tcl_AppendResult(interp, "bad index ", argv[2], (char *) NULL);
+ return TCL_ERROR;
+ }
+ pipePtr = &testPipes[i];
+ }
+
+ if (strcmp(argv[1], "close") == 0) {
+ for (i = 0; i < MAX_PIPES; i++) {
+ if (testPipes[i].readFile != NULL) {
+ TclpCloseFile(testPipes[i].readFile);
+ testPipes[i].readFile = NULL;
+ TclpCloseFile(testPipes[i].writeFile);
+ testPipes[i].writeFile = NULL;
+ }
+ }
+ } else if (strcmp(argv[1], "clear") == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " clear index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ pipePtr->readCount = pipePtr->writeCount = 0;
+ } else if (strcmp(argv[1], "counts") == 0) {
+ char buf[30];
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " counts index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ } else if (strcmp(argv[1], "create") == 0) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " create index readMode writeMode\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (pipePtr->readFile == NULL) {
+ if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
+ Tcl_AppendResult(interp, "couldn't open pipe: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+#ifdef O_NONBLOCK
+ fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
+ fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
+#else
+ Tcl_SetResult(interp, "can't make pipes non-blocking",
+ TCL_STATIC);
+ return TCL_ERROR;
+#endif
+ }
+ pipePtr->readCount = 0;
+ pipePtr->writeCount = 0;
+
+ if (strcmp(argv[3], "readable") == 0) {
+ Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
+ TestFileHandlerProc, (ClientData) pipePtr);
+ } else if (strcmp(argv[3], "off") == 0) {
+ Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
+ } else if (strcmp(argv[3], "disabled") == 0) {
+ Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
+ TestFileHandlerProc, (ClientData) pipePtr);
+ } else {
+ Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[4], "writable") == 0) {
+ Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
+ TestFileHandlerProc, (ClientData) pipePtr);
+ } else if (strcmp(argv[4], "off") == 0) {
+ Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
+ } else if (strcmp(argv[4], "disabled") == 0) {
+ Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
+ TestFileHandlerProc, (ClientData) pipePtr);
+ } else {
+ Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[1], "empty") == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " empty index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
+ /* Empty loop body. */
+ }
+ } else if (strcmp(argv[1], "fill") == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " empty index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ memset((VOID *) buffer, 'a', 4000);
+ while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
+ /* Empty loop body. */
+ }
+ } else if (strcmp(argv[1], "fillpartial") == 0) {
+ char buf[30];
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " empty index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ memset((VOID *) buffer, 'b', 10);
+ sprintf(buf, "%d", write(GetFd(pipePtr->writeFile), buffer, 10));
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ } else if (strcmp(argv[1], "oneevent") == 0) {
+ Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
+ } else if (strcmp(argv[1], "wait") == 0) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " wait index readable/writable timeout\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (pipePtr->readFile == NULL) {
+ Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[3], "readable") == 0) {
+ mask = TCL_READABLE;
+ file = pipePtr->readFile;
+ } else {
+ mask = TCL_WRITABLE;
+ file = pipePtr->writeFile;
+ }
+ if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i = TclUnixWaitForFile(GetFd(file), mask, timeout);
+ if (i & TCL_READABLE) {
+ Tcl_AppendElement(interp, "readable");
+ }
+ if (i & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, "writable");
+ }
+ } else if (strcmp(argv[1], "windowevent") == 0) {
+ Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be close, clear, counts, create, empty, fill, ",
+ "fillpartial, oneevent, wait, or windowevent",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+static void TestFileHandlerProc(clientData, mask)
+ ClientData clientData; /* Points to a Pipe structure. */
+ int mask; /* Indicates which events happened:
+ * TCL_READABLE or TCL_WRITABLE. */
+{
+ Pipe *pipePtr = (Pipe *) clientData;
+
+ if (mask & TCL_READABLE) {
+ pipePtr->readCount++;
+ }
+ if (mask & TCL_WRITABLE) {
+ pipePtr->writeCount++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestfilewaitCmd --
+ *
+ * This procedure implements the "testfilewait" command. It is
+ * used to test TclUnixWaitForFile.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestfilewaitCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int mask, result, timeout;
+ Tcl_Channel channel;
+ int fd;
+ ClientData data;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " file readable|writable|both timeout\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ channel = Tcl_GetChannel(interp, argv[1], NULL);
+ if (channel == NULL) {
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[2], "readable") == 0) {
+ mask = TCL_READABLE;
+ } else if (strcmp(argv[2], "writable") == 0){
+ mask = TCL_WRITABLE;
+ } else if (strcmp(argv[2], "both") == 0){
+ mask = TCL_WRITABLE|TCL_READABLE;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[2],
+ "\": must be readable, writable, or both", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetChannelHandle(channel,
+ (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
+ (ClientData*) &data) != TCL_OK) {
+ Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ fd = (int) data;
+ if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ result = TclUnixWaitForFile(fd, mask, timeout);
+ if (result & TCL_READABLE) {
+ Tcl_AppendElement(interp, "readable");
+ }
+ if (result & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, "writable");
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestgetopenfileCmd --
+ *
+ * This procedure implements the "testgetopenfile" command. It is
+ * used to get a FILE * value from a registered channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetopenfileCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ClientData filePtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp,
+ "wrong # args: should be \"", argv[0],
+ " channelName forWriting\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
+ == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (filePtr == (ClientData) NULL) {
+ Tcl_AppendResult(interp,
+ "Tcl_GetOpenFile succeeded but FILE * NULL!", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
new file mode 100644
index 0000000..ba8d984
--- /dev/null
+++ b/unix/tclUnixTime.c
@@ -0,0 +1,236 @@
+/*
+ * tclUnixTime.c --
+ *
+ * Contains Unix specific versions of Tcl functions that
+ * obtain time values from the operating system.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixTime.c 1.13 97/10/31 15:04:58
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclpGetSeconds --
+ *
+ * This procedure returns the number of seconds from the epoch. On
+ * most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
+ *
+ * Results:
+ * Number of seconds from the epoch.
+ *
+ * Side effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetSeconds()
+{
+ return time((time_t *) NULL);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * TclpGetClicks --
+ *
+ * This procedure returns a value that represents the highest resolution
+ * clock available on the system. There are no garantees on what the
+ * resolution will be. In Tcl we will call this value a "click". The
+ * start time is also system dependant.
+ *
+ * Results:
+ * Number of clicks from some start time.
+ *
+ * Side effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+unsigned long
+TclpGetClicks()
+{
+ unsigned long now;
+#ifdef NO_GETTOD
+ struct tms dummy;
+#else
+ struct timeval date;
+ struct timezone tz;
+#endif
+
+#ifdef NO_GETTOD
+ now = (unsigned long) times(&dummy);
+#else
+ gettimeofday(&date, &tz);
+ now = date.tv_sec*1000000 + date.tv_usec;
+#endif
+
+ return now;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTimeZone --
+ *
+ * Determines the current timezone. The method varies wildly
+ * between different platform implementations, so its hidden in
+ * this function.
+ *
+ * Results:
+ * The return value is the local time zone, measured in
+ * minutes away from GMT (-ve for east, +ve for west).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpGetTimeZone (currentTime)
+ unsigned long currentTime;
+{
+ /*
+ * Determine how a timezone is obtained from "struct tm". If there is no
+ * time zone in this struct (very lame) then use the timezone variable.
+ * This is done in a way to make the timezone variable the method of last
+ * resort, as some systems have it in addition to a field in "struct tm".
+ * The gettimeofday system call can also be used to determine the time
+ * zone.
+ */
+
+#if defined(HAVE_TM_TZADJ)
+# define TCL_GOT_TIMEZONE
+ time_t curTime = (time_t) currentTime;
+ struct tm *timeDataPtr = localtime(&curTime);
+ int timeZone;
+
+ timeZone = timeDataPtr->tm_tzadj / 60;
+ if (timeDataPtr->tm_isdst) {
+ timeZone += 60;
+ }
+
+ return timeZone;
+#endif
+
+#if defined(HAVE_TM_GMTOFF) && !defined (TCL_GOT_TIMEZONE)
+# define TCL_GOT_TIMEZONE
+ time_t curTime = (time_t) currentTime;
+ struct tm *timeDataPtr = localtime(&curTime);
+ int timeZone;
+
+ timeZone = -(timeDataPtr->tm_gmtoff / 60);
+ if (timeDataPtr->tm_isdst) {
+ timeZone += 60;
+ }
+
+ return timeZone;
+#endif
+
+#if defined(USE_DELTA_FOR_TZ)
+#define TCL_GOT_TIMEZONE 1
+ /*
+ * This hack replaces using global var timezone or gettimeofday
+ * in situations where they are buggy such as on AIX when libbsd.a
+ * is linked in.
+ */
+
+ int timeZone;
+ time_t tt;
+ struct tm *stm;
+ tt = 849268800L; /* 1996-11-29 12:00:00 GMT */
+ stm = localtime(&tt); /* eg 1996-11-29 6:00:00 CST6CDT */
+ /* The calculation below assumes a max of +12 or -12 hours from GMT */
+ timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min);
+ return timeZone; /* eg +360 for CST6CDT */
+#endif
+
+ /*
+ * Must prefer timezone variable over gettimeofday, as gettimeofday does
+ * not return timezone information on many systems that have moved this
+ * information outside of the kernel.
+ */
+
+#if defined(HAVE_TIMEZONE_VAR) && !defined (TCL_GOT_TIMEZONE)
+# define TCL_GOT_TIMEZONE
+ static int setTZ = 0;
+ int timeZone;
+
+ if (!setTZ) {
+ tzset();
+ setTZ = 1;
+ }
+
+ /*
+ * Note: this is not a typo in "timezone" below! See tzset
+ * documentation for details.
+ */
+
+ timeZone = timezone / 60;
+
+ return timeZone;
+#endif
+
+#if !defined(NO_GETTOD) && !defined (TCL_GOT_TIMEZONE)
+# define TCL_GOT_TIMEZONE
+ struct timeval tv;
+ struct timezone tz;
+ int timeZone;
+
+ gettimeofday(&tv, &tz);
+ timeZone = tz.tz_minuteswest;
+ if (tz.tz_dsttime) {
+ timeZone += 60;
+ }
+
+ return timeZone;
+#endif
+
+#ifndef TCL_GOT_TIMEZONE
+ /*
+ * Cause compile error, we don't know how to get timezone.
+ */
+ error: autoconf did not figure out how to determine the timezone.
+#endif
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTime --
+ *
+ * Gets the current system time in seconds and microseconds
+ * since the beginning of the epoch: 00:00 UCT, January 1, 1970.
+ *
+ * Results:
+ * Returns the current time in timePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpGetTime(timePtr)
+ Tcl_Time *timePtr; /* Location to store time information. */
+{
+ struct timeval tv;
+ struct timezone tz;
+
+ (void) gettimeofday(&tv, &tz);
+ timePtr->sec = tv.tv_sec;
+ timePtr->usec = tv.tv_usec;
+}
diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c
new file mode 100644
index 0000000..1479412
--- /dev/null
+++ b/unix/tclXtTest.c
@@ -0,0 +1,113 @@
+/*
+ * tclXtTest.c --
+ *
+ * Contains commands for Xt notifier specific tests on Unix.
+ *
+ * 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.
+ *
+ * SCCS: @(#) tclXtTest.c 1.2 97/09/15 15:26:52
+ */
+
+#include <X11/Intrinsic.h>
+#include "tcl.h"
+
+static int TesteventloopCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tclxttest_Init --
+ *
+ * This procedure performs application-specific initialization.
+ * Most applications, especially those that incorporate additional
+ * packages, will have their own version of this procedure.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error
+ * message in interp->result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tclxttest_Init(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TesteventloopCmd --
+ *
+ * This procedure implements the "testeventloop" command. It is
+ * used to test the Tcl notifier from an "external" event loop
+ * (i.e. not Tcl_DoOneEvent()).
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TesteventloopCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ static int *framePtr = NULL; /* Pointer to integer on stack frame of
+ * innermost invocation of the "wait"
+ * subcommand. */
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " option ... \"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[1], "done") == 0) {
+ *framePtr = 1;
+ } else if (strcmp(argv[1], "wait") == 0) {
+ int *oldFramePtr;
+ int done;
+ int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+
+ /*
+ * Save the old stack frame pointer and set up the current frame.
+ */
+
+ oldFramePtr = framePtr;
+ framePtr = &done;
+
+ /*
+ * Enter an Xt event loop until the flag changes.
+ * Note that we do not explicitly call Tcl_ServiceEvent().
+ */
+
+ done = 0;
+ while (!done) {
+ XtAppProcessEvent(TclSetAppContext(NULL), XtIMAll);
+ }
+ (void) Tcl_SetServiceMode(oldMode);
+ framePtr = oldFramePtr;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be done or wait", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}