Attachment "tcl8.5.2-VxWorks-DKM.patch" to
ticket [1955146fff]
added by
fpilhofer
2008-05-01 04:56:47.
diff -r -u -N tcl8.5.2.orig/generic/regguts.h tcl8.5.2/generic/regguts.h
--- tcl8.5.2.orig/generic/regguts.h 2007-12-18 05:53:16.000000000 -0500
+++ tcl8.5.2/generic/regguts.h 2008-03-31 15:01:27.914744600 -0400
@@ -108,6 +108,15 @@
#define _POSIX2_RE_DUP_MAX 255 /* normally from <limits.h> */
#endif
+#if defined(_WRS_KERNEL)
+#if defined(EOS)
+#undef EOS
+#endif
+#if defined(LOCAL)
+#undef LOCAL
+#endif
+#endif
+
/*
* misc
*/
diff -r -u -N tcl8.5.2.orig/generic/tclBasic.c tcl8.5.2/generic/tclBasic.c
--- tcl8.5.2.orig/generic/tclBasic.c 2008-03-14 15:53:10.000000000 -0400
+++ tcl8.5.2/generic/tclBasic.c 2008-03-31 15:01:27.930369400 -0400
@@ -24,6 +24,14 @@
#include <math.h>
#include "tommath.h"
+#if defined (_WRS_KERNEL)
+double
+hypot (double x, double y)
+{
+ return sqrt (x*x + y*y);
+}
+#endif
+
/*
* Determine whether we're using IEEE floating point
*/
@@ -4339,7 +4347,7 @@
TclAdvanceLines(&line, parsePtr->commandStart, p);
Tcl_FreeParse(parsePtr);
gotParse = 0;
- } while (bytesLeft > 0);
+ } while (bytesLeft > 0 && !(iPtr->flags & DELETED));
iPtr->varFramePtr = savedVarFramePtr;
code = TCL_OK;
goto cleanup_return;
diff -r -u -N tcl8.5.2.orig/generic/tclCkalloc.c tcl8.5.2/generic/tclCkalloc.c
--- tcl8.5.2.orig/generic/tclCkalloc.c 2007-04-23 16:33:56.000000000 -0400
+++ tcl8.5.2/generic/tclCkalloc.c 2008-03-31 15:01:27.930369400 -0400
@@ -19,8 +19,10 @@
#include "tclInt.h"
+#if !defined(_WRS_KERNEL)
#define FALSE 0
#define TRUE 1
+#endif
#ifdef TCL_MEM_DEBUG
diff -r -u -N tcl8.5.2.orig/generic/tclClock.c tcl8.5.2/generic/tclClock.c
--- tcl8.5.2.orig/generic/tclClock.c 2008-02-26 21:08:27.000000000 -0500
+++ tcl8.5.2/generic/tclClock.c 2008-03-31 15:01:27.945994200 -0400
@@ -1977,6 +1977,7 @@
static void
TzsetIfNecessary(void)
{
+#if !defined(_WRS_KERNEL)
static char* tzWas = NULL; /* Previous value of TZ, protected by
* clockMutex. */
const char* tzIsNow; /* Current value of TZ */
@@ -1996,6 +1997,7 @@
tzWas = NULL;
}
Tcl_MutexUnlock(&clockMutex);
+#endif
}
/*
diff -r -u -N tcl8.5.2.orig/generic/tclCmdAH.c tcl8.5.2/generic/tclCmdAH.c
--- tcl8.5.2.orig/generic/tclCmdAH.c 2008-03-14 12:07:23.000000000 -0400
+++ tcl8.5.2/generic/tclCmdAH.c 2008-03-31 15:01:27.945994200 -0400
@@ -990,7 +990,7 @@
* we always return 1.
*/
-#if defined(__WIN32__)
+#if defined(__WIN32__) || defined(_WRS_KERNEL)
value = 1;
#else
value = (geteuid() == buf.st_uid);
diff -r -u -N tcl8.5.2.orig/generic/tclEnv.c tcl8.5.2/generic/tclEnv.c
--- tcl8.5.2.orig/generic/tclEnv.c 2007-12-13 10:23:16.000000000 -0500
+++ tcl8.5.2/generic/tclEnv.c 2008-03-31 15:01:27.945994200 -0400
@@ -17,6 +17,13 @@
#include "tclInt.h"
+#if defined (_WRS_KERNEL)
+#include <envLib.h>
+#undef environ
+#define USE_PUTENV 1
+#define USE_PUTENV_FOR_UNSET 1
+#endif
+
TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
static struct {
@@ -76,6 +83,9 @@
Tcl_Interp *interp) /* Interpreter whose "env" array is to be
* managed. */
{
+#if defined (_WRS_KERNEL)
+ char ** environ = envGet (0);
+#endif
Tcl_DString envString;
char *p1, *p2;
int i;
@@ -156,6 +166,9 @@
* (UTF-8). */
const char *value) /* New value for variable (UTF-8). */
{
+#if defined (_WRS_KERNEL)
+ char ** environ = envGet (0);
+#endif
Tcl_DString envString;
int index, length, nameLength;
char *p, *oldValue;
@@ -353,6 +366,9 @@
TclUnsetEnv(
const char *name) /* Name of variable to remove (UTF-8). */
{
+#if defined (_WRS_KERNEL)
+ char ** environ = envGet (0);
+#endif
char *oldValue;
int length;
int index;
@@ -469,6 +485,9 @@
* value of the environment variable is
* stored. */
{
+#if defined (_WRS_KERNEL)
+ char ** environ = envGet (0);
+#endif
int length, index;
const char *result;
diff -r -u -N tcl8.5.2.orig/generic/tclEvent.c tcl8.5.2/generic/tclEvent.c
--- tcl8.5.2.orig/generic/tclEvent.c 2008-03-10 13:54:47.000000000 -0400
+++ tcl8.5.2/generic/tclEvent.c 2008-03-31 15:01:27.961619000 -0400
@@ -208,7 +208,7 @@
Tcl_Preserve((ClientData) assocPtr);
Tcl_Preserve((ClientData) interp);
- while (assocPtr->firstBgPtr != NULL) {
+ while (assocPtr->firstBgPtr != NULL && !Tcl_InterpDeleted (interp)) {
int code, prefixObjc;
Tcl_Obj **prefixObjv, **tempObjv;
@@ -1244,7 +1244,7 @@
};
done = 0;
foundEvent = 1;
- while (!done && foundEvent) {
+ while (!done && foundEvent && !Tcl_InterpDeleted (interp)) {
foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
if (Tcl_LimitExceeded(interp)) {
break;
@@ -1260,6 +1260,9 @@
*/
Tcl_ResetResult(interp);
+ if (Tcl_InterpDeleted (interp)) {
+ return TCL_OK;
+ }
if (!foundEvent) {
Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
"\": would wait forever", NULL);
diff -r -u -N tcl8.5.2.orig/generic/tclExecute.c tcl8.5.2/generic/tclExecute.c
--- tcl8.5.2.orig/generic/tclExecute.c 2008-03-18 14:52:07.000000000 -0400
+++ tcl8.5.2/generic/tclExecute.c 2008-03-31 15:01:27.961619000 -0400
@@ -858,6 +858,10 @@
#define WALLOCALIGN \
(TCL_ALLOCALIGN/sizeof(Tcl_Obj *))
+#if defined (_WRS_KERNEL)
+#undef OFFSET
+#endif
+
static inline int
OFFSET(
void *ptr)
@@ -1877,6 +1881,12 @@
}
}
+ if (iPtr->flags & DELETED) {
+ Tcl_ResetResult (interp);
+ result = TCL_ERROR;
+ goto abnormalReturn;
+ }
+
TCL_DTRACE_INST_NEXT();
/*
diff -r -u -N tcl8.5.2.orig/generic/tclFileName.c tcl8.5.2/generic/tclFileName.c
--- tcl8.5.2.orig/generic/tclFileName.c 2007-12-13 10:23:17.000000000 -0500
+++ tcl8.5.2/generic/tclFileName.c 2008-03-31 15:01:27.977243800 -0400
@@ -415,6 +415,43 @@
}
}
#endif
+#if defined (_WRS_KERNEL)
+ /*
+ * Absolute names may start with a "<device>:" prefix. If
+ * the device is "host", and the host is running Windows,
+ * then it might even look like "host:<drive>:<path>"
+ */
+
+ if (isalpha(UCHAR(*path))) {
+ ++path;
+
+ while (isalnum(UCHAR(*path)) || *path == '_' ) {
+ ++path;
+ }
+ }
+
+ if (path[0] == ':') {
+ if (path[1] != '\0' && path[2] == ':') {
+ path += 2;
+ }
+ if (path[0] == '/') {
+ path++;
+ }
+ if (driveNameLengthPtr != NULL) {
+ *driveNameLengthPtr = 1 + path - origPath;
+ }
+ type = TCL_PATH_ABSOLUTE;
+ }
+ else if (path[0] == '/') {
+ type = TCL_PATH_ABSOLUTE;
+ if (driveNameLengthPtr != NULL) {
+ *driveNameLengthPtr = 1;
+ }
+ }
+ else {
+ type = TCL_PATH_RELATIVE;
+ }
+#else
if (path[0] == '/') {
if (driveNameLengthPtr != NULL) {
/*
@@ -426,6 +463,7 @@
} else {
type = TCL_PATH_RELATIVE;
}
+#endif
break;
}
case TCL_PLATFORM_WINDOWS: {
diff -r -u -N tcl8.5.2.orig/generic/tclIOSock.c tcl8.5.2/generic/tclIOSock.c
--- tcl8.5.2.orig/generic/tclIOSock.c 2007-02-20 18:24:04.000000000 -0500
+++ tcl8.5.2/generic/tclIOSock.c 2008-03-31 15:01:27.977243800 -0400
@@ -12,6 +12,8 @@
*/
#include "tclInt.h"
+#include <sockLib.h>
+
/*
*---------------------------------------------------------------------------
@@ -39,6 +41,7 @@
const char *proto, /* "tcp" or "udp", typically */
int *portPtr) /* Return port number */
{
+#if !defined (_WRS_KERNEL)
struct servent *sp; /* Protocol info for named services */
Tcl_DString ds;
const char *native;
@@ -56,6 +59,7 @@
return TCL_OK;
}
}
+#endif
if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
return TCL_ERROR;
}
diff -r -u -N tcl8.5.2.orig/generic/tclInt.h tcl8.5.2/generic/tclInt.h
--- tcl8.5.2.orig/generic/tclInt.h 2008-01-23 16:32:36.000000000 -0500
+++ tcl8.5.2/generic/tclInt.h 2008-03-31 15:01:27.977243800 -0400
@@ -66,6 +66,15 @@
typedef int ptrdiff_t;
#endif
+#if defined (_WRS_KERNEL)
+extern int strcasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2));
+#endif
+
+#if defined (_WRS_KERNEL) && defined (USE_THREAD_ALLOC)
+#undef USE_THREAD_ALLOC
+#endif
+
/*
* Ensure WORDS_BIGENDIAN is defined correcly:
* Needs to happen here in addition to configure to work with fat compiles on
diff -r -u -N tcl8.5.2.orig/unix/Makefile.in tcl8.5.2/unix/Makefile.in
--- tcl8.5.2.orig/unix/Makefile.in 2008-03-28 14:41:53.000000000 -0400
+++ tcl8.5.2/unix/Makefile.in 2008-03-31 15:01:27.992868600 -0400
@@ -167,7 +167,7 @@
STLIB_LD = @STLIB_LD@
SHLIB_LD = @SHLIB_LD@
-SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_CFLAGS = # @SHLIB_CFLAGS@
SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
TCL_SHLIB_LD_EXTRAS = @TCL_SHLIB_LD_EXTRAS@
@@ -318,7 +318,7 @@
UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
- tclUnixTime.o tclUnixInit.o tclUnixThrd.o \
+ tclUnixTime.o tclUnixInit.o tclVxWorksThrd.o \
tclUnixCompat.o
NOTIFY_OBJS = tclUnixNotfy.o
@@ -328,7 +328,7 @@
DTRACE_OBJ = tclDTrace.o
TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
- @DL_OBJS@ @PLAT_OBJS@
+ tclLoadVxWorks.o @PLAT_OBJS@
OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@
@@ -505,7 +505,8 @@
$(UNIX_DIR)/tclUnixThrd.c \
$(UNIX_DIR)/tclUnixTime.c \
$(UNIX_DIR)/tclUnixInit.c \
- $(UNIX_DIR)/tclUnixCompat.c
+ $(UNIX_DIR)/tclUnixCompat.c \
+ $(UNIX_DIR)/tclVxWorksThrd.c
NOTIFY_SRCS = \
$(UNIX_DIR)/tclUnixNotfy.c
@@ -518,7 +519,8 @@
$(UNIX_DIR)/tclLoadDyld.c \
$(GENERIC_DIR)/tclLoadNone.c \
$(UNIX_DIR)/tclLoadOSF.c \
- $(UNIX_DIR)/tclLoadShl.c
+ $(UNIX_DIR)/tclLoadShl.c \
+ $(UNIX_DIR)/tclLoadVxWorks.c
MAC_OSX_SRCS = \
$(MAC_OSX_DIR)/tclMacOSXBundle.c \
@@ -538,7 +540,7 @@
all: binaries libraries doc
-binaries: ${LIB_FILE} $(STUB_LIB_FILE) $(TCL_BUILD_EXP_FILE) tclsh
+binaries: ${LIB_FILE} $(STUB_LIB_FILE) $(TCL_BUILD_EXP_FILE) tclsh.out
libraries:
@@ -569,6 +571,10 @@
${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} @EXTRA_TCLSH_LIBS@ \
${CC_SEARCH_FLAGS} -o tclsh
+tclsh.out: tclVxWorksInit.o ${TCL_LIB_FILE}
+ ${CC} ${CFLAGS} ${LDFLAGS} tclVxWorksInit.o @TCL_BUILD_LIB_SPEC@ @EXTRA_TCLSH_LIBS@ \
+ ${CC_SEARCH_FLAGS} -o tclsh.out
+
# Resetting the LIB_RUNTIME_DIR below is required so that the generated
# tcltest executable gets the build directory burned into its ld search path.
# This keeps tcltest from picking up an already installed version of the Tcl
@@ -883,12 +889,13 @@
clean:
rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
- errors tclsh tcltest lib.exp Tcl
+ errors tclsh tcltest lib.exp Tcl tclsh.out
cd dltest ; $(MAKE) clean
distclean: clean
rm -rf Makefile config.status config.cache config.log tclConfig.sh \
$(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework
+ rm -rf Makefile.?
cd dltest ; $(MAKE) distclean
depend:
@@ -958,6 +965,9 @@
tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
$(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
+tclVxWorksInit.o: $(UNIX_DIR)/tclVxWorksInit.c
+ $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclVxWorksInit.c
+
# On Unix we want to use the normal malloc/free implementation, so we
# specifically set the USE_TCLALLOC flag.
@@ -1096,6 +1106,9 @@
tclLoadShl.o: $(UNIX_DIR)/tclLoadShl.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadShl.c
+tclLoadVxWorks.o: $(UNIX_DIR)/tclLoadVxWorks.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadVxWorks.c
+
tclMain.o: $(GENERIC_DIR)/tclMain.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclMain.c
@@ -1426,6 +1439,9 @@
tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c
+tclVxWorksThrd.o: $(UNIX_DIR)/tclVxWorksThrd.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclVxWorksThrd.c
+
tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c
diff -r -u -N tcl8.5.2.orig/unix/configure tcl8.5.2/unix/configure
--- tcl8.5.2.orig/unix/configure 2008-03-28 14:41:53.000000000 -0400
+++ tcl8.5.2/unix/configure 2008-03-31 15:01:28.008493400 -0400
@@ -4561,7 +4561,7 @@
if test "$tcl_ok" = "yes"; then
# The space is needed
- THREADS_LIBS=" -lpthread"
+ THREADS_LIBS=""
else
echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthreads" >&5
echo $ECHO_N "checking for pthread_mutex_init in -lpthreads... $ECHO_C" >&6
diff -r -u -N tcl8.5.2.orig/unix/tclLoadVxWorks.c tcl8.5.2/unix/tclLoadVxWorks.c
--- tcl8.5.2.orig/unix/tclLoadVxWorks.c 1969-12-31 19:00:00.000000000 -0500
+++ tcl8.5.2/unix/tclLoadVxWorks.c 2008-03-31 15:01:28.008493400 -0400
@@ -0,0 +1,253 @@
+/*
+ * tclLoadVxWorks.c --
+ *
+ * This procedure provides a version of the TclLoadFile that works with
+ * the VxWorks kernel module loader for dynamic loading.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#include <string.h>
+#include <ioLib.h>
+#include <loadLib.h>
+#include <unldLib.h>
+#include <symLib.h>
+#include <moduleLib.h>
+#include <sysSymTbl.h>
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpDlopen --
+ *
+ * Dynamically loads a binary code file into memory and returns a handle
+ * to the new code.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error message
+ * is left in the interp's result.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpDlopen(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
+ * code (UTF-8). */
+ Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr)
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for this
+ * file. */
+{
+ MODULE_ID handle;
+ CONST char * native;
+ int fd, origErrno;
+
+ /*
+ * First try the full path the user gave us. This is particularly
+ * important if the cwd is inside a vfs, and we are trying to load using a
+ * relative path.
+ */
+
+ native = Tcl_FSGetNativePath(pathPtr);
+ fd = open (native, O_RDONLY, 0400);
+
+ if (fd == ERROR) {
+ Tcl_AppendResult (interp, "couldn't load file \"",
+ Tcl_GetString (pathPtr), "\": ",
+ Tcl_PosixError (interp),
+ NULL);
+ return TCL_ERROR;
+ }
+
+ handle = loadModule (fd,
+ LOAD_GLOBAL_SYMBOLS |
+ LOAD_COMMON_MATCH_NONE |
+ LOAD_CPLUS_XTOR_AUTO);
+ origErrno = errno;
+ close (fd);
+
+ if (!handle) {
+ /*
+ * A null handle is also returned if there are unresolved symbols,
+ * but the module remains loaded. So we have to unload it. For
+ * that, we need the module id that loadModule() should have
+ * returned. What a lovely design. So look up the module using
+ * its module name, which is the file name.
+ */
+
+ CONST char * baseName;
+ char * dirName;
+
+ baseName = strrchr (native, '/');
+
+ if (baseName) {
+ int dirLen = baseName - native;
+ dirName = malloc (dirLen + 1);
+ memcpy (dirName, native, dirLen);
+ dirName[dirLen] = '\0';
+ baseName++;
+ }
+ else {
+ baseName = native;
+ dirName = malloc (1);
+ dirName[0] = '\0';
+ }
+
+ if ((handle = moduleFindByNameAndPath ((char *) baseName, dirName))) {
+ unldByModuleId (handle, 0);
+ }
+
+ errno = origErrno;
+ Tcl_AppendResult (interp, "couldn't load file \"",
+ Tcl_GetString (pathPtr), "\": ",
+ Tcl_PosixError (interp),
+ NULL);
+ return TCL_ERROR;
+ }
+
+ *unloadProcPtr = &TclpUnloadFile;
+ *loadHandle = (Tcl_LoadHandle) handle;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFindSymbol --
+ *
+ * Looks up a symbol, by name, through a handle associated with a
+ * previously loaded piece of code (shared library).
+ *
+ * Results:
+ * Returns a pointer to the function associated with 'symbol' if it is
+ * found. Otherwise returns NULL and may leave an error message in the
+ * interp's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef struct FindSymbolHelperData_ {
+ const char * symbol;
+ int moduleGroupNumber;
+} FindSymbolHelperData;
+
+static
+BOOL
+findSymbolHelper (char * name,
+ int val,
+ SYM_TYPE type,
+ int arg,
+ UINT16 group)
+{
+ FindSymbolHelperData * hd = (FindSymbolHelperData *) arg;
+
+ if (group == hd->moduleGroupNumber &&
+ strcmp (hd->symbol, name) == 0) {
+ return FALSE;
+ }
+
+ return TRUE;
+}
+
+Tcl_PackageInitProc *
+TclpFindSymbol(
+ Tcl_Interp *interp, /* Place to put error messages. */
+ Tcl_LoadHandle loadHandle, /* Value from TcpDlopen(). */
+ CONST char *symbol) /* Symbol to look up. */
+{
+ FindSymbolHelperData helperData;
+ MODULE_ID handle = (MODULE_ID) loadHandle;
+ MODULE_INFO moduleInfo;
+ Tcl_DString ds;
+ SYMBOL * sym;
+
+ if (moduleInfoGet (handle, &moduleInfo) != OK) {
+ return NULL;
+ }
+
+ helperData.symbol = Tcl_UtfToExternalDString (NULL, symbol, -1, &ds);
+ helperData.moduleGroupNumber = moduleInfo.group;
+
+ sym = symEach (sysSymTbl,
+ (FUNCPTR) findSymbolHelper,
+ (int) &helperData);
+
+ Tcl_DStringFree(&ds);
+ return (sym ? ((Tcl_PackageInitProc *) sym->value) : NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory. Code
+ * pointers in the formerly loaded file are no longer valid after calling
+ * this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Code removed from memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(
+ Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
+ * TclpDlopen(). The loadHandle is a token
+ * that represents the loaded file. */
+{
+ MODULE_ID handle = (MODULE_ID) loadHandle;
+ unldByModuleId (handle, UNLD_CPLUS_XTOR_AUTO);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ * If the "load" command is invoked without providing a package name,
+ * this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ * Always returns 0 to indicate that we couldn't figure out a package
+ * name; generic code will then try to guess the package from the file
+ * name. A return value of 1 would have meant that we figured out the
+ * package name and put it in bufPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(
+ CONST char *fileName, /* Name of file containing package (already
+ * translated to local form if needed). */
+ Tcl_DString *bufPtr) /* Initialized empty dstring. Append package
+ * name to this if possible. */
+{
+ return 0;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff -r -u -N tcl8.5.2.orig/unix/tclUnixChan.c tcl8.5.2/unix/tclUnixChan.c
--- tcl8.5.2.orig/unix/tclUnixChan.c 2008-03-03 09:54:43.000000000 -0500
+++ tcl8.5.2/unix/tclUnixChan.c 2008-03-31 15:45:43.490127800 -0400
@@ -16,6 +16,12 @@
#include "tclInt.h" /* Internal definitions for Tcl. */
#include "tclIO.h" /* To get Channel type declaration. */
+#if defined(_WRS_KERNEL)
+#include <sockLib.h>
+#include <hostLib.h>
+#include <selectLib.h>
+#endif
+
#define SUPPORTS_TTY
#undef DIRECT_BAUD
@@ -3173,6 +3179,7 @@
FileState *fsPtr = (FileState *) instanceData;
int result;
+#if !defined (_WRS_KERNEL)
#ifdef HAVE_TYPE_OFF64_T
/*
* We assume this goes with the type for now...
@@ -3182,6 +3189,9 @@
#else
result = ftruncate(fsPtr->fd, (off_t) length);
#endif
+#else
+ result = ioctl (fsPtr->fd, FIOTRUNC64, &length);
+#endif
if (result) {
return errno;
}
diff -r -u -N tcl8.5.2.orig/unix/tclUnixCompat.c tcl8.5.2/unix/tclUnixCompat.c
--- tcl8.5.2.orig/unix/tclUnixCompat.c 2008-02-28 15:14:12.000000000 -0500
+++ tcl8.5.2/unix/tclUnixCompat.c 2008-03-31 15:45:44.661987800 -0400
@@ -11,11 +11,18 @@
*/
#include "tclInt.h"
+#if !defined (_WRS_KERNEL)
#include <pwd.h>
#include <grp.h>
+#endif
#include <errno.h>
#include <string.h>
+#if defined (_WRS_KERNEL)
+#include <ioLib.h>
+#include <hostLib.h>
+#endif
+
/* See also: SC_BLOCKING_STYLE in unix/tcl.m4
*/
#ifdef USE_FIONBIO
@@ -84,11 +91,13 @@
#ifdef TCL_THREADS
typedef struct ThreadSpecificData {
+#if !defined (_WRS_KERNEL)
struct passwd pwd;
char pbuf[2048];
struct group grp;
char gbuf[2048];
+#endif
#if !defined(HAVE_MTSAFE_GETHOSTBYNAME) || !defined(HAVE_MTSAFE_GETHOSTBYADDR)
struct hostent hent;
@@ -153,6 +162,7 @@
TclpGetPwNam(
const char *name)
{
+#if !defined(_WRS_KERNEL)
#if !defined(TCL_THREADS)
return getpwnam(name);
#else
@@ -186,6 +196,9 @@
return NULL; /* Not reached. */
#endif /* TCL_THREADS */
+#else /* _WRS_KERNEL */
+ return NULL;
+#endif
}
/*
@@ -209,6 +222,7 @@
TclpGetPwUid(
uid_t uid)
{
+#if !defined(_WRS_KERNEL)
#if !defined(TCL_THREADS)
return getpwuid(uid);
#else
@@ -242,6 +256,9 @@
return NULL; /* Not reached. */
#endif /* TCL_THREADS */
+#else /* _WRS_KERNEL */
+ return NULL;
+#endif
}
/*
@@ -265,6 +282,7 @@
TclpGetGrNam(
const char *name)
{
+#if !defined(_WRS_KERNEL)
#if !defined(TCL_THREADS)
return getgrnam(name);
#else
@@ -298,6 +316,9 @@
return NULL; /* Not reached. */
#endif /* TCL_THREADS */
+#else /* _WRS_KERNEL */
+ return NULL;
+#endif
}
/*
@@ -321,6 +342,7 @@
TclpGetGrGid(
gid_t gid)
{
+#if !defined(_WRS_KERNEL)
#if !defined(TCL_THREADS)
return getgrgid(gid);
#else
@@ -354,6 +376,9 @@
return NULL; /* Not reached. */
#endif /* TCL_THREADS */
+#else /* _WRS_KERNEL */
+ return NULL;
+#endif
}
/*
diff -r -u -N tcl8.5.2.orig/unix/tclUnixEvent.c tcl8.5.2/unix/tclUnixEvent.c
--- tcl8.5.2.orig/unix/tclUnixEvent.c 2005-11-02 19:26:50.000000000 -0400
+++ tcl8.5.2/unix/tclUnixEvent.c 2008-03-31 15:01:28.039743000 -0400
@@ -12,6 +12,12 @@
*/
#include "tclInt.h"
+
+#if defined (_WRS_KERNEL)
+#include <sockLib.h>
+#include <selectLib.h>
+#endif
+
/*
*----------------------------------------------------------------------
diff -r -u -N tcl8.5.2.orig/unix/tclUnixFCmd.c tcl8.5.2/unix/tclUnixFCmd.c
--- tcl8.5.2.orig/unix/tclUnixFCmd.c 2007-12-13 10:28:42.000000000 -0500
+++ tcl8.5.2/unix/tclUnixFCmd.c 2008-03-31 15:01:28.039743000 -0400
@@ -48,7 +48,9 @@
#include "tclInt.h"
#include <utime.h>
+#if !defined(_WRS_KERNEL)
#include <grp.h>
+#endif
#ifndef HAVE_ST_BLKSIZE
#ifndef NO_FSTATFS
#include <sys/statfs.h>
@@ -58,6 +60,10 @@
#include <fts.h>
#endif
+#if defined(_WRS_KERNEL)
+#include <ioLib.h>
+#endif
+
/*
* The following constants specify the type of callback when
* TraverseUnixTree() calls the traverseProc()
@@ -453,6 +459,7 @@
}
switch ((int) (statBufPtr->st_mode & S_IFMT)) {
+#if !defined(_WRS_KERNEL)
#ifndef DJGPP
case S_IFLNK: {
char link[MAXPATHLEN];
@@ -484,6 +491,7 @@
return TCL_ERROR;
}
return CopyFileAtts(src, dst, statBufPtr);
+#endif
default:
return TclUnixCopyFile(src, dst, statBufPtr, 0);
}
@@ -676,6 +684,7 @@
DoCreateDirectory(
CONST char *path) /* Pathname of directory to create (native). */
{
+#if !defined(_WRS_KERNEL)
mode_t mode;
mode = umask(0);
@@ -691,6 +700,12 @@
return TCL_ERROR;
}
return TCL_OK;
+#else
+ if (mkdir(path) != 0) { /* INTL: Native. */
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+#endif
}
/*
@@ -1312,7 +1327,9 @@
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
Tcl_StatBuf statBuf;
+#if !defined(_WRS_KERNEL)
struct group *groupPtr;
+#endif
int result;
result = TclpObjStat(fileName, &statBuf);
@@ -1326,6 +1343,7 @@
return TCL_ERROR;
}
+#if !defined(_WRS_KERNEL)
groupPtr = TclpGetGrGid(statBuf.st_gid);
if (groupPtr == NULL) {
@@ -1339,6 +1357,9 @@
Tcl_DStringFree(&ds);
}
endgrent();
+#else
+ *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid);
+#endif
return TCL_OK;
}
@@ -1367,7 +1388,9 @@
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
Tcl_StatBuf statBuf;
+#if !defined(_WRS_KERNEL)
struct passwd *pwPtr;
+#endif
int result;
result = TclpObjStat(fileName, &statBuf);
@@ -1381,6 +1404,7 @@
return TCL_ERROR;
}
+#if !defined(_WRS_KERNEL)
pwPtr = TclpGetPwUid(statBuf.st_uid);
if (pwPtr == NULL) {
@@ -1394,6 +1418,9 @@
Tcl_DStringFree(&ds);
}
endpwent();
+#else
+ *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
+#endif
return TCL_OK;
}
@@ -1463,8 +1490,10 @@
Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr) /* New group for file. */
{
- long gid;
int result;
+
+#if !defined(_WRS_KERNEL)
+ long gid;
CONST char *native;
if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
@@ -1495,6 +1524,10 @@
result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */
endgrent();
+#else
+ result = -1;
+ errno = ENOTSUP;
+#endif
if (result != 0) {
if (interp != NULL) {
Tcl_AppendResult(interp, "could not set group for file \"",
@@ -1529,8 +1562,10 @@
Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr) /* New owner for file. */
{
- long uid;
int result;
+
+#if !defined(_WRS_KERNEL)
+ long uid;
CONST char *native;
if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
@@ -1558,6 +1593,10 @@
native = Tcl_FSGetNativePath(fileName);
result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */
+#else
+ result = -1;
+ errno = ENOTSUP;
+#endif
if (result != 0) {
if (interp != NULL) {
diff -r -u -N tcl8.5.2.orig/unix/tclUnixFile.c tcl8.5.2/unix/tclUnixFile.c
--- tcl8.5.2.orig/unix/tclUnixFile.c 2007-12-13 10:28:42.000000000 -0500
+++ tcl8.5.2/unix/tclUnixFile.c 2008-03-31 15:01:28.039743000 -0400
@@ -442,7 +442,11 @@
#endif
(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
((types->perm & TCL_GLOB_PERM_R) &&
+#if !defined (_WRS_KERNEL)
(access(nativeEntry, R_OK) != 0)) ||
+#else
+ (access(nativeEntry, F_OK) != 0)) ||
+#endif
((types->perm & TCL_GLOB_PERM_W) &&
(access(nativeEntry, W_OK) != 0)) ||
((types->perm & TCL_GLOB_PERM_X) &&
@@ -562,6 +566,7 @@
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
* name of user's home directory. */
{
+#if !defined(_WRS_KERNEL)
struct passwd *pwPtr;
Tcl_DString ds;
CONST char *native;
@@ -577,6 +582,9 @@
Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
endpwent();
return Tcl_DStringValue(bufferPtr);
+#else
+ return NULL;
+#endif
}
/*
@@ -601,6 +609,16 @@
int mode) /* Permission setting. */
{
CONST char *path = Tcl_FSGetNativePath(pathPtr);
+#if defined (_WRS_KERNEL)
+ /*
+ * access() refuses to check permissions beyond testing a file's
+ * existence for remote or host-based file systems. At least
+ * pretend that files are readable.
+ */
+ if (mode == R_OK) {
+ mode = F_OK;
+ }
+#endif
if (path == NULL) {
return -1;
} else {
@@ -780,7 +798,7 @@
Tcl_DString *linkPtr) /* Uninitialized or free DString filled with
* contents of link (UTF-8). */
{
-#ifndef DJGPP
+#if !defined(DJGPP) && !defined(_WRS_KERNEL)
char link[MAXPATHLEN];
int length;
CONST char *native;
@@ -838,6 +856,7 @@
Tcl_Obj *toPtr,
int linkAction)
{
+#if !defined(_WRS_KERNEL)
if (toPtr != NULL) {
CONST char *src = Tcl_FSGetNativePath(pathPtr);
CONST char *target = NULL;
@@ -972,6 +991,10 @@
}
return linkPtr;
}
+#else
+ errno = ENOTSUP;
+ return NULL;
+#endif
}
#endif /* S_IFLNK */
diff -r -u -N tcl8.5.2.orig/unix/tclUnixInit.c tcl8.5.2/unix/tclUnixInit.c
--- tcl8.5.2.orig/unix/tclUnixInit.c 2007-12-13 10:28:42.000000000 -0500
+++ tcl8.5.2/unix/tclUnixInit.c 2008-03-31 15:01:28.055367800 -0400
@@ -37,6 +37,13 @@
#include <CoreFoundation/CoreFoundation.h>
#endif
+#if defined (_WRS_KERNEL)
+#include <envLib.h>
+#include <vmLib.h>
+#define getpagesize vmPageSizeGet
+#undef environ
+#endif
+
/*
* Define TCL_NO_STACK_CHECK in the compiler options if you want to revert to
* the old behavior of never checking the stack.
@@ -68,6 +75,16 @@
#define TCL_RESERVED_STACK_PAGES 8
#endif
+#if defined (_WRS_KERNEL)
+/*
+ * The reported task stack size value can be trusted relatively well, and
+ * the default stack size on some platforms is a mere 20k.
+ */
+
+#undef TCL_RESERVED_STACK_PAGES
+#define TCL_RESERVED_STACK_PAGES 2
+#endif
+
/*
* Thread specific data for stack checking.
*/
@@ -382,13 +399,25 @@
*/
if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
- open("/dev/null", O_RDONLY);
+ open("/dev/null", O_RDONLY
+#if defined (_WRS_KERNEL)
+ , 0
+#endif
+ );
}
if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
- open("/dev/null", O_WRONLY);
+ open("/dev/null", O_WRONLY
+#if defined (_WRS_KERNEL)
+ , 0
+#endif
+ );
}
if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
- open("/dev/null", O_WRONLY);
+ open("/dev/null", O_WRONLY
+#if defined (_WRS_KERNEL)
+ , 0
+#endif
+ );
}
/*
@@ -400,9 +429,11 @@
* different one of its own, if it wants.
*/
+#if !defined (_WRS_KERNEL)
#ifdef SIGPIPE
(void) signal(SIGPIPE, SIG_IGN);
#endif /* SIGPIPE */
+#endif
#if defined(__FreeBSD__) && defined(__GNUC__)
/*
@@ -936,6 +967,7 @@
*/
{
+#if !defined (_WRS_KERNEL)
struct passwd *pwEnt = TclpGetPwUid(getuid());
const char *user;
@@ -945,6 +977,10 @@
} else {
user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds);
}
+#else
+ const char * user = "";
+ Tcl_DStringInit(&ds); /* ensure cleanliness */
+#endif
Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
@@ -980,6 +1016,9 @@
* entries in environ (for unsuccessful
* searches). */
{
+#if defined (_WRS_KERNEL)
+ char ** environ = envGet (0);
+#endif
int i, result = -1;
register CONST char *env, *p1, *p2;
Tcl_DString envString;
@@ -1142,7 +1181,9 @@
size_t *stackSizePtr)
{
size_t rawStackSize;
+#if !defined (_WRS_KERNEL)
struct rlimit rLimit; /* The result from getrlimit(). */
+#endif
#ifdef TCL_THREADS
rawStackSize = TclpThreadGetStackSize();
@@ -1164,6 +1205,7 @@
*/
#endif /* TCL_THREADS */
+#if !defined (_WRS_KERNEL)
if (getrlimit(RLIMIT_STACK, &rLimit) != 0) {
/*
* getrlimit() failed, just fail the whole thing.
@@ -1179,6 +1221,9 @@
return TCL_CONTINUE;
}
rawStackSize = rLimit.rlim_cur;
+#else
+ rawStackSize = -1;
+#endif
/*
* Final sanity check on the determined stack size. If we fail this,
@@ -1198,6 +1243,13 @@
* Calculate a stack size with a safety margin.
*/
+ if ((rawStackSize / TCL_MAGIC_STACK_DIVISOR) <
+ (getpagesize() * TCL_RESERVED_STACK_PAGES)) {
+ /* Don't want to return a negative value for the stack size. */
+ STACK_DEBUG(("skipping stack checks with success: stack looks smaller than safety margin\n"));
+ return TCL_CONTINUE;
+ }
+
*stackSizePtr = (rawStackSize / TCL_MAGIC_STACK_DIVISOR)
- (getpagesize() * TCL_RESERVED_STACK_PAGES);
diff -r -u -N tcl8.5.2.orig/unix/tclUnixNotfy.c tcl8.5.2/unix/tclUnixNotfy.c
--- tcl8.5.2.orig/unix/tclUnixNotfy.c 2008-03-11 18:23:50.000000000 -0400
+++ tcl8.5.2/unix/tclUnixNotfy.c 2008-03-31 15:38:03.464766200 -0400
@@ -18,6 +18,20 @@
* in tclMacOSXNotify.c */
#include <signal.h>
+#if defined (_WRS_KERNEL)
+#include <selectLib.h>
+#if defined (TCL_THREADS)
+/*
+ * We don't want the threaded notifier on VxWorks. Not yet. Our motivation
+ * for defining TCL_THREADS was just to enable proper locking between
+ * independent Tcl threads. Each thread can use its own non-threaded
+ * notifier for now. I'm not sure if this is intended to work, but it
+ * does so far.
+ */
+#undef TCL_THREADS
+#endif
+#endif
+
/*
* This code does deep stub magic to allow replacement of the notifier at
* runtime.
diff -r -u -N tcl8.5.2.orig/unix/tclUnixPipe.c tcl8.5.2/unix/tclUnixPipe.c
--- tcl8.5.2.orig/unix/tclUnixPipe.c 2008-03-14 12:32:52.000000000 -0400
+++ tcl8.5.2/unix/tclUnixPipe.c 2008-03-31 15:38:02.996022200 -0400
@@ -60,8 +60,10 @@
static int PipeOutputProc(ClientData instanceData,
const char *buf, int toWrite, int *errorCode);
static void PipeWatchProc(ClientData instanceData, int mask);
+#if !defined (_WRS_KERNEL)
static void RestoreSignals(void);
static int SetupStdFile(TclFile file, int type);
+#endif
/*
* This structure describes the channel type structure for command pipe based
@@ -191,6 +193,7 @@
TclpCreateTempFile(
const char *contents) /* String to write into temp file, or NULL. */
{
+#if !defined (_WRS_KERNEL)
char fileName[L_tmpnam + 9];
const char *native;
Tcl_DString dstring;
@@ -223,6 +226,10 @@
TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_SET);
}
return MakeFile(fd);
+#else
+ errno = ENOTSUP;
+ return NULL;
+#endif
}
/*
@@ -244,6 +251,7 @@
Tcl_Obj *
TclpTempFileName(void)
{
+#if !defined (_WRS_KERNEL)
char fileName[L_tmpnam + 9];
Tcl_Obj *result = NULL;
int fd;
@@ -267,6 +275,10 @@
result = TclpNativeToNormalized((ClientData) fileName);
close(fd);
return result;
+#else
+ errno = ENOTSUP;
+ return NULL;
+#endif
}
/*
@@ -292,6 +304,7 @@
TclFile *writePipe) /* Location to store file handle for write
* side of pipe. */
{
+#if !defined (_WRS_KERNEL)
int pipeIds[2];
if (pipe(pipeIds) != 0) {
@@ -304,6 +317,10 @@
*readPipe = MakeFile(pipeIds[0]);
*writePipe = MakeFile(pipeIds[1]);
return 1;
+#else
+ errno = ENOTSUP;
+ return 0;
+#endif
}
/*
@@ -326,6 +343,7 @@
TclpCloseFile(
TclFile file) /* The file to close. */
{
+#if !defined (_WRS_KERNEL)
int fd = GetFd(file);
/*
@@ -338,6 +356,10 @@
Tcl_DeleteFileHandler(fd);
return close(fd);
+#else
+ errno = ENOTSUP;
+ return -1;
+#endif
}
/*
@@ -394,6 +416,7 @@
* filled with the process id of the child
* process. */
{
+#if !defined (_WRS_KERNEL)
TclFile errPipeIn, errPipeOut;
int count, status, fd;
char errSpace[200 + TCL_INTEGER_SPACE];
@@ -536,6 +559,10 @@
TclpCloseFile(errPipeOut);
}
return TCL_ERROR;
+#else
+ Tcl_AppendResult(interp, "spawning processes is not supported", NULL);
+ return TCL_ERROR;
+#endif
}
/*
@@ -556,6 +583,7 @@
*----------------------------------------------------------------------
*/
+#if !defined (_WRS_KERNEL)
static void
RestoreSignals(void)
{
@@ -611,6 +639,7 @@
signal(SIGTTOU, SIG_DFL);
#endif
}
+#endif
/*
*----------------------------------------------------------------------
@@ -631,6 +660,7 @@
*----------------------------------------------------------------------
*/
+#if !defined (_WRS_KERNEL)
static int
SetupStdFile(
TclFile file, /* File to dup, or NULL. */
@@ -690,6 +720,7 @@
}
return 1;
}
+#endif
/*
*----------------------------------------------------------------------
@@ -841,6 +872,7 @@
* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
+#if !defined (_WRS_KERNEL)
PipeState *psPtr = instanceData;
if (psPtr->inFile) {
@@ -857,6 +889,9 @@
psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING);
return 0;
+#else
+ return ENOTSUP;
+#endif
}
/*
@@ -883,6 +918,7 @@
ClientData instanceData, /* The pipe to close. */
Tcl_Interp *interp) /* For error reporting. */
{
+#if !defined (_WRS_KERNEL)
PipeState *pipePtr;
Tcl_Channel errChan;
int errorCode, result;
@@ -938,6 +974,9 @@
return result;
}
return errorCode;
+#else
+ return ENOTSUP;
+#endif
}
/*
@@ -966,6 +1005,7 @@
* buffer? */
int *errorCodePtr) /* Where to store error code. */
{
+#if !defined (_WRS_KERNEL)
PipeState *psPtr = (PipeState *) instanceData;
int bytesRead; /* How many bytes were actually read from the
* input device? */
@@ -990,6 +1030,10 @@
} else {
return bytesRead;
}
+#else
+ *errorCodePtr = ENOTSUP;
+ return -1;
+#endif
}
/*
@@ -1017,6 +1061,7 @@
int toWrite, /* How many bytes to write? */
int *errorCodePtr) /* Where to store error code. */
{
+#if !defined (_WRS_KERNEL)
PipeState *psPtr = (PipeState *) instanceData;
int written;
@@ -1037,6 +1082,10 @@
} else {
return written;
}
+#else
+ *errorCodePtr = ENOTSUP;
+ return -1;
+#endif
}
/*
@@ -1147,6 +1196,7 @@
int *statPtr,
int options)
{
+#if !defined (_WRS_KERNEL)
int result;
pid_t real_pid;
@@ -1157,6 +1207,10 @@
return (Tcl_Pid) INT2PTR(result);
}
}
+#else
+ errno = ENOTSUP;
+ return (Tcl_Pid) INT2PTR(-1);
+#endif
}
/*
diff -r -u -N tcl8.5.2.orig/unix/tclUnixPort.h tcl8.5.2/unix/tclUnixPort.h
--- tcl8.5.2.orig/unix/tclUnixPort.h 2008-03-11 18:26:27.000000000 -0400
+++ tcl8.5.2/unix/tclUnixPort.h 2008-03-31 15:38:02.480403800 -0400
@@ -41,7 +41,9 @@
#ifdef HAVE_NET_ERRNO_H
# include <net/errno.h>
#endif
+#if !defined(_WRS_KERNEL)
#include <pwd.h>
+#endif
#include <signal.h>
#ifdef HAVE_SYS_PARAM_H
# include <sys/param.h>
@@ -83,7 +85,9 @@
# define TclOSlstat lstat
#endif
+#if !defined(_WRS_KERNEL)
#include <sys/file.h>
+#endif
#ifdef HAVE_SYS_SELECT_H
# include <sys/select.h>
#endif
@@ -242,6 +246,7 @@
* gettimeofday call, then must use times() instead.
*/
+#if !defined (_WRS_KERNEL)
#ifdef NO_GETTOD
# include <sys/times.h>
#else
@@ -249,11 +254,14 @@
# define gettimeofday BSDgettimeofday
# endif
#endif
+#endif
+#if !defined(_WRS_KERNEL)
#ifdef GETTOD_NOT_DECLARED
EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
struct timezone *tzp));
#endif
+#endif
/*
* Define access mode constants if they aren't already defined.
@@ -286,7 +294,7 @@
* define "lstat" to use "stat" instead.
*/
-#ifndef S_IFLNK
+#if !defined(S_IFLNK) || defined(_WRS_KERNEL)
# undef TclOSlstat
# define lstat stat
# define lstat64 stat64
@@ -598,6 +606,7 @@
EXTERN struct tm * TclpLocaltime(CONST time_t *);
EXTERN struct tm * TclpGmtime(CONST time_t *);
EXTERN char * TclpInetNtoa(struct in_addr);
+#if !defined (_WRS_KERNEL)
/* #define localtime(x) TclpLocaltime(x)
* #define gmtime(x) TclpGmtime(x) */
# undef inet_ntoa
@@ -620,6 +629,7 @@
# endif
# endif /* HAVE_PTHREAD_GETATTR_NP */
# endif /* HAVE_PTHREAD_ATTR_GET_NP */
+#endif /* _WRS_KERNEL */
#endif /* TCL_THREADS */
/*
@@ -630,8 +640,10 @@
* to the TSD data.
*/
+#if !defined (_WRS_KERNEL)
#include <pwd.h>
#include <grp.h>
+#endif
MODULE_SCOPE struct passwd* TclpGetPwNam(const char *name);
MODULE_SCOPE struct group* TclpGetGrNam(const char *name);
diff -r -u -N tcl8.5.2.orig/unix/tclUnixSock.c tcl8.5.2/unix/tclUnixSock.c
--- tcl8.5.2.orig/unix/tclUnixSock.c 2007-12-13 10:28:42.000000000 -0500
+++ tcl8.5.2/unix/tclUnixSock.c 2008-03-31 15:01:28.070992600 -0400
@@ -13,6 +13,10 @@
#include "tclInt.h"
+#if defined (_WRS_KERNEL)
+#include <hostLib.h>
+#endif
+
/*
* The following variable holds the network name of this host.
*/
diff -r -u -N tcl8.5.2.orig/unix/tclUnixTime.c tcl8.5.2/unix/tclUnixTime.c
--- tcl8.5.2.orig/unix/tclUnixTime.c 2007-12-13 10:28:42.000000000 -0500
+++ tcl8.5.2/unix/tclUnixTime.c 2008-03-31 15:01:28.086617400 -0400
@@ -21,6 +21,10 @@
#define TM_YEAR_BASE 1900
#define IsLeapYear(x) (((x)%4 == 0) && ((x)%100 != 0 || (x)%400 == 0))
+#if defined (_WRS_KERNEL)
+#include <tickLib.h>
+#endif
+
/*
* TclpGetDate is coded to return a pointer to a 'struct tm'. For thread
* safety, this structure must be in thread-specific data. The 'tmKey'
@@ -38,11 +42,13 @@
* this mutex to try to protect them.
*/
+#if !defined (_WRS_KERNEL)
TCL_DECLARE_MUTEX(tmMutex)
static char *lastTZ = NULL; /* Holds the last setting of the TZ
* environment variable, or an empty string if
* the variable was not set. */
+#endif
/*
* Static functions declared in this file.
@@ -110,6 +116,7 @@
{
unsigned long now;
+#if !defined (_WRS_KERNEL)
#ifdef NO_GETTOD
if (tclGetTimeProcPtr != NativeGetTime) {
Tcl_Time time;
@@ -130,6 +137,9 @@
(*tclGetTimeProcPtr) (&time, tclTimeClientData);
now = time.sec*1000000 + time.usec;
#endif
+#else
+ now = tickGet ();
+#endif
return now;
}
@@ -602,12 +612,19 @@
Tcl_Time *timePtr,
ClientData clientData)
{
+#if !defined (_WRS_KERNEL)
struct timeval tv;
struct timezone tz;
(void) gettimeofday(&tv, &tz);
timePtr->sec = tv.tv_sec;
timePtr->usec = tv.tv_usec;
+#else
+ struct timespec ts;
+ clock_gettime (CLOCK_REALTIME, &ts);
+ timePtr->sec = ts.tv_sec;
+ timePtr->usec = ts.tv_nsec / 1000;
+#endif
}
/*
*----------------------------------------------------------------------
@@ -631,6 +648,7 @@
static void
SetTZIfNecessary(void)
{
+#if !defined (_WRS_KERNEL)
CONST char *newTZ = getenv("TZ");
Tcl_MutexLock(&tmMutex);
@@ -648,6 +666,7 @@
strcpy(lastTZ, newTZ);
}
Tcl_MutexUnlock(&tmMutex);
+#endif
}
/*
@@ -667,12 +686,14 @@
*----------------------------------------------------------------------
*/
+#if !defined (_WRS_KERNEL)
static void
CleanupMemory(
ClientData ignored)
{
ckfree(lastTZ);
}
+#endif
/*
* Local Variables:
diff -r -u -N tcl8.5.2.orig/unix/tclVxWorksInit.c tcl8.5.2/unix/tclVxWorksInit.c
--- tcl8.5.2.orig/unix/tclVxWorksInit.c 1969-12-31 19:00:00.000000000 -0500
+++ tcl8.5.2/unix/tclVxWorksInit.c 2008-03-31 15:01:28.086617400 -0400
@@ -0,0 +1,847 @@
+/*
+ * tclVxWorksInit.c --
+ *
+ * Provides the "tcl" and "tclsh" entrypoints for VxWorks DKM.
+ *
+ * "tcl" registers the Tcl interpreter with the kernel, and
+ * switches to it. The "C" command can be used to return to
+ * the C kernel shell.
+ *
+ * "tclsh" takes a single null-terminated string parameter,
+ * which is parsed as a command line. The first argument on
+ * the command line is used as the name of a Tcl script that
+ * is run in a new interpreter. The remaining arguments are
+ * used to initialize argv.
+ */
+
+#include "tcl.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Shell Interpreter
+ *
+ *----------------------------------------------------------------------
+ */
+
+#include <tclInt.h>
+#include <vxWorks.h>
+#include <ptyDrv.h>
+#include <sysLib.h>
+#include <taskLib.h>
+#include <shellLib.h>
+#include <shellConfigLib.h>
+#include <shellDataLib.h>
+#include <shellInterpLib.h>
+#include <shellPromptLib.h>
+#include <private/shellLibP.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <assert.h>
+
+
+/*
+ * This symbol is exported. Users should set it to the path that contains
+ * init.tcl before running tclsh or entering the Tcl shell.
+ */
+
+typedef enum {
+ PROMPT_NONE, /* Print no prompt */
+ PROMPT_START, /* Print prompt for command start */
+ PROMPT_CONTINUE /* Print prompt for command continuation */
+} PromptType;
+
+typedef struct InteractiveState {
+ Tcl_Obj *commandPtr; /* Used to assemble lines of input into Tcl
+ * commands. */
+ PromptType lastPrompt; /* Last prompt that was printed */
+ PromptType prompt; /* Next prompt to print */
+ Tcl_Interp *interp; /* Interpreter that evaluates interactive
+ * commands. */
+} InteractiveState;
+
+static int vxTclShellConfigSet (ClientData, Tcl_Interp *, int objc, Tcl_Obj *CONST objv[]);
+static int vxTclShellEvaluate (ClientData, Tcl_Interp *, int objc, Tcl_Obj *CONST objv[]);
+static int vxTclShellExec (ClientData, Tcl_Interp *, int objc, Tcl_Obj *CONST objv[]);
+
+/*
+ * This is used to "exit" from the interactive Tcl session back to the
+ * "C" interpreter.
+ */
+
+static
+int
+vxTclExit (ClientData clientData,
+ Tcl_Interp * interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
+{
+ InteractiveState * isPtr =
+ (InteractiveState *) clientData;
+
+ /*
+ * Delete the current interpreter and return to the C shell.
+ */
+
+ Tcl_DeleteInterp (isPtr->interp);
+ isPtr->interp = NULL;
+ shellPromptFmtSet (CURRENT_SHELL_SESSION,
+ "Tcl",
+ "%% ");
+ shellConfigValueSet (CURRENT_SHELL_SESSION, SHELL_CFG_INTERP, "C");
+ return TCL_OK;
+}
+
+/*
+ * Initialize the state for the interactive Tcl session.
+ */
+
+static
+int
+vxTclInitState (InteractiveState * isPtr)
+{
+ isPtr->interp = Tcl_CreateInterp ();
+ Tcl_InitMemory (isPtr->interp);
+
+ if (Tcl_Init (isPtr->interp) == TCL_ERROR) {
+ Tcl_Channel errChannel = Tcl_GetStdChannel (TCL_STDERR);
+ if (errChannel != (Tcl_Channel) NULL) {
+ Tcl_WriteObj (errChannel, Tcl_GetObjResult (isPtr->interp));
+ Tcl_WriteChars (errChannel, "\n", 1);
+ }
+
+ return ERROR;
+ }
+
+ /*
+ * exit is evil and must be overruled.
+ */
+
+ Tcl_CreateObjCommand (isPtr->interp, "exit", vxTclExit,
+ (ClientData) isPtr, NULL);
+
+ /*
+ * Useful extensions.
+ */
+
+ Tcl_CreateObjCommand (isPtr->interp, "shellConfigSet",
+ vxTclShellConfigSet,
+ NULL, NULL);
+ Tcl_CreateObjCommand (isPtr->interp, "shellEvaluate",
+ vxTclShellEvaluate,
+ NULL, NULL);
+ Tcl_CreateObjCommand (isPtr->interp, "shellExec",
+ vxTclShellExec,
+ NULL, NULL);
+
+ isPtr->lastPrompt = PROMPT_NONE;
+ isPtr->prompt = PROMPT_START;
+ isPtr->commandPtr = Tcl_NewObj ();
+ Tcl_IncrRefCount (isPtr->commandPtr);
+ return OK;
+}
+
+static
+STATUS
+vxTclInitialize (SHELL_INTERP_CTX * pInterpCtx)
+{
+ InteractiveState * isPtr =
+ (InteractiveState *) malloc (sizeof (InteractiveState));
+
+ if (vxTclInitState (isPtr) != OK) {
+ /* Otherwise, we're hosed. */
+ shellConfigValueSet (CURRENT_SHELL_SESSION, SHELL_CFG_INTERP, "C");
+ free (isPtr);
+ return ERROR;
+ }
+
+ pInterpCtx->pInterpParam = (void *) isPtr;
+ return OK;
+}
+
+static
+STATUS
+vxTclFinalize (SHELL_INTERP_CTX * pInterpCtx)
+{
+ InteractiveState * isPtr =
+ (InteractiveState *) pInterpCtx->pInterpParam;
+
+ if (isPtr) {
+ if (isPtr->commandPtr) {
+ Tcl_DecrRefCount (isPtr->commandPtr);
+ }
+
+ if (isPtr->interp) {
+ Tcl_DeleteInterp (isPtr->interp);
+ }
+ }
+
+ free (isPtr);
+ return OK;
+}
+
+static
+STATUS
+vxTclParse (SHELL_INTERP_CTX * pInterpCtx,
+ const char * inputLine,
+ BOOL isInteractive)
+{
+ InteractiveState *isPtr =
+ (InteractiveState *) pInterpCtx->pInterpParam;
+ Tcl_Obj *commandPtr;
+ Tcl_Interp *interp;
+ int code, length;
+
+ if (!isPtr->interp) {
+ if (vxTclInitState (isPtr) != OK) {
+ printf ("error: failed to initialize Tcl interpreter.\n");
+ shellConfigValueSet (CURRENT_SHELL_SESSION, SHELL_CFG_INTERP, "C");
+ return ERROR;
+ }
+ }
+
+ interp = isPtr->interp;
+ commandPtr = isPtr->commandPtr;
+
+ Tcl_Preserve (interp);
+
+ if (Tcl_IsShared (commandPtr)) {
+ Tcl_DecrRefCount(commandPtr);
+ commandPtr = Tcl_DuplicateObj (commandPtr);
+ Tcl_IncrRefCount (commandPtr);
+ }
+
+ Tcl_AppendToObj (commandPtr, inputLine, strlen (inputLine));
+ Tcl_AppendToObj (commandPtr, "\n", 1);
+
+ if (!TclObjCommandComplete (commandPtr)) {
+ isPtr->prompt = PROMPT_CONTINUE;
+ goto prompt;
+ }
+
+ isPtr->prompt = PROMPT_START;
+ Tcl_GetStringFromObj (commandPtr, &length);
+ Tcl_SetObjLength (commandPtr, --length);
+
+ code = Tcl_RecordAndEvalObj (interp, commandPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount (commandPtr);
+ isPtr->commandPtr = commandPtr = Tcl_NewObj();
+ Tcl_IncrRefCount (commandPtr);
+
+ if (code != TCL_OK) {
+ Tcl_Channel errChannel = Tcl_GetStdChannel (TCL_STDERR);
+ if (errChannel != (Tcl_Channel) NULL) {
+ Tcl_WriteObj (errChannel, Tcl_GetObjResult (interp));
+ Tcl_WriteChars (errChannel, "\n", 1);
+ }
+ }
+ else {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult (interp);
+ Tcl_Channel outChannel = Tcl_GetStdChannel (TCL_STDOUT);
+ Tcl_IncrRefCount (resultPtr);
+ Tcl_GetStringFromObj (resultPtr, &length);
+
+ if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
+ Tcl_WriteObj (outChannel, resultPtr);
+ Tcl_WriteChars (outChannel, "\n", 1);
+ }
+
+ Tcl_DecrRefCount(resultPtr);
+ }
+
+ prompt:
+ if (isPtr->prompt != isPtr->lastPrompt && !Tcl_InterpDeleted (interp)) {
+ char * newPrompt;
+ Tcl_Obj * promptCmdPtr;
+ char * promptString;
+ int promptLength;
+
+ if (isPtr->prompt == PROMPT_NONE) {
+ promptString = "";
+ promptLength = 0;
+ }
+ else {
+ promptCmdPtr = Tcl_GetVar2Ex (interp,
+ ((isPtr->prompt == PROMPT_CONTINUE) ?
+ "tcl_prompt2" : "tcl_prompt1"),
+ NULL, TCL_GLOBAL_ONLY);
+
+ if (promptCmdPtr) {
+ promptString = Tcl_GetStringFromObj (promptCmdPtr, &promptLength);
+ }
+ else {
+ promptString = "%% ";
+ promptLength = 3;
+ }
+ }
+
+ newPrompt = malloc (promptLength + 1);
+ memcpy (newPrompt, promptString, promptLength);
+ newPrompt[promptLength] = '\0';
+
+ shellPromptFmtSet (CURRENT_SHELL_SESSION,
+ "Tcl",
+ newPrompt);
+
+ isPtr->lastPrompt = isPtr->prompt;
+ free (newPrompt);
+ }
+
+ Tcl_Release (interp);
+ return OK;
+}
+
+static
+void
+vxTclRestart (SHELL_INTERP_CTX * pInterpCtx)
+{
+ vxTclFinalize (pInterpCtx);
+ if (vxTclInitialize (pInterpCtx) != OK) {
+ /* Otherwise, we're hosed. */
+ shellConfigValueSet (CURRENT_SHELL_SESSION, SHELL_CFG_INTERP, "C");
+ }
+}
+
+STATUS
+vxTclInit (SHELL_INTERP * pInterp)
+{
+ /* This must happen somewhere */
+ Tcl_FindExecutable (NULL);
+
+ /* Initialize the interpreter functions */
+ pInterp->ctxInit = vxTclInitialize;
+ pInterp->ctxFinalize = vxTclFinalize;
+ pInterp->parser = vxTclParse;
+ pInterp->ctxRestart = vxTclRestart;
+ pInterp->evaluate = NULL; /* no evaluation */
+ pInterp->completion = NULL; /* no completion */
+
+ /* Initialize name and default prompt */
+ pInterp->name = "Tcl";
+ pInterp->prompt = "%% ";
+
+ return OK;
+}
+
+int
+tcl ()
+{
+ shellInterpRegister (vxTclInit);
+ shellConfigValueSet (CURRENT_SHELL_SESSION,
+ SHELL_CFG_INTERP,
+ "Tcl");
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Various useful extensions
+ *
+ *----------------------------------------------------------------------
+ */
+
+static
+int
+vxTclShellConfigSet (ClientData clientData,
+ Tcl_Interp * interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs (interp, 0, objv, "config");
+ return TCL_ERROR;
+ }
+
+ CONST char * config = Tcl_GetStringFromObj (objv[1], NULL);
+
+ shellConfigSet (CURRENT_SHELL_SESSION, config);
+ return TCL_OK;
+}
+
+static
+int
+vxTclShellEvaluate (ClientData clientData,
+ Tcl_Interp * interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
+{
+ CONST char *cmd, *interpreterName;
+ SHELL_EVAL_VALUE sev;
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs (interp, 0, objv, "cmd ?interpreter?");
+ return TCL_ERROR;
+ }
+
+ cmd = Tcl_GetStringFromObj (objv[1], NULL);
+
+ if (objc == 3) {
+ interpreterName = Tcl_GetStringFromObj (objv[2], NULL);
+ }
+ else {
+ /*
+ * The documentation says that we can use NULL for the default
+ * interpreter, but that didn't work for me. Let's use the "C"
+ * interpreter as the default.
+ */
+
+ interpreterName = "C";
+ }
+
+ if (shellInterpEvaluate ((char *) cmd, interpreterName, &sev) != OK) {
+ Tcl_AppendResult (interp, "error evaluating \"", cmd,
+ "\" in \"", interpreterName,
+ "\" interpreter: ",
+ Tcl_PosixError (interp),
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * I did not find any documentation for SHELL_TYPE_VAL. I've only
+ * ever seen the type set to SHELL_INT.
+ */
+
+ switch (sev.type) {
+ case SHELL_INT:
+ Tcl_SetObjResult (interp, Tcl_NewIntObj (sev.value.intVal));
+ break;
+
+ default:
+ Tcl_SetObjResult (interp, Tcl_ObjPrintf ("error: interpreter returned type %d", sev.type));
+ return TCL_ERROR;
+ break;
+ }
+
+ return TCL_OK;
+}
+
+TCL_DECLARE_MUTEX(vxTclShellExecSync);
+
+static
+int
+vxTclShellExec (ClientData clientData,
+ Tcl_Interp * interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
+{
+ char currentDirectory[MAX_FILENAME_LENGTH+1];
+ CONST char *cmd, *interpreterName;
+ int fdInM, fdInS, fdOutM, fdOutS;
+ int tid, ttw, nUnread;
+ char *shellTaskName;
+ char shellConfig[32];
+ char buffer[2048];
+ int cmdLen, result;
+ Tcl_Obj * output;
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs (interp, 0, objv, "cmd ?interpreter?");
+ return TCL_ERROR;
+ }
+
+ cmd = Tcl_GetStringFromObj (objv[1], &cmdLen);
+
+ if (objc == 3) {
+ interpreterName = Tcl_GetStringFromObj (objv[2], NULL);
+
+ if (strlen (interpreterName) > 19) {
+ Tcl_AppendResult (interp, "interpreter name \"",
+ interpreterName, "\" too long",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+ else {
+ interpreterName = "C";
+ }
+
+ strcpy (shellConfig, "INTERPRETER=");
+ strcat (shellConfig, interpreterName);
+
+ /*
+ * Based on "10.2.15 Executing Shell Commands Programmatically"
+ * in the VxWorks Kernel Programmer's Guide. Is this the best
+ * way to do this? No idea, but documentation in this area is
+ * scarce, and it works well enough for me.
+ */
+
+ if (cmdLen > 2047) {
+ Tcl_AppendResult (interp, "command to long", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * For some reason, this procedure resets the current working
+ * directory. So save it off and reset it afterwards.
+ */
+
+ ioDefPathGet (currentDirectory);
+
+ /*
+ * Using hard-coded pty dev names, this is a critical section.
+ */
+
+ Tcl_MutexLock (&vxTclShellExecSync);
+
+ if (ptyDevCreate ("tclExecIn", 2048, 2048) != OK) {
+ Tcl_AppendResult (interp, "failed to create \"in\" pty: ",
+ Tcl_PosixError (interp), NULL);
+ Tcl_MutexUnlock (&vxTclShellExecSync);
+ return TCL_ERROR;
+ }
+
+ if (ptyDevCreate ("tclExecOut", 2048, 2048) != OK) {
+ Tcl_AppendResult (interp, "failed to create \"out\" pty: ",
+ Tcl_PosixError (interp), NULL);
+ ptyDevRemove ("tclExecIn");
+ Tcl_MutexUnlock (&vxTclShellExecSync);
+ return TCL_ERROR;
+ }
+
+ result = TCL_OK;
+ output = Tcl_NewObj ();
+ Tcl_IncrRefCount (output);
+
+ fdInM = open ("tclExecInM", O_WRONLY, 0); /* us writing to the shell */
+ fdInS = open ("tclExecInS", O_RDONLY, 0); /* shell reading from us */
+ fdOutM = open ("tclExecOutM", O_RDONLY, 0); /* us reading from the shell */
+ fdOutS = open ("tclExecOutS", O_WRONLY, 0); /* shell writing to us */
+
+ if (fdInM < 0 || fdInS < 0 || fdOutM < 0 || fdOutS < 0) {
+ Tcl_AppendResult (interp, "failed to open fds: ",
+ Tcl_PosixError (interp), NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Start the interpreter.
+ */
+
+ /*
+ * Is the shellTaskName allocated, and do we have to free it? The
+ * documentation does not say.
+ */
+
+ if (shellGenericInit (shellConfig, 0,
+ NULL, &shellTaskName,
+ FALSE, FALSE,
+ fdInS, fdOutS, fdOutS) != OK) {
+ Tcl_AppendResult (interp, "failed to start shell: ",
+ Tcl_PosixError (interp), NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Given the buffer size, we expect that we can write the entire
+ * command at once.
+ */
+
+ if (write (fdInM, (char *) cmd, cmdLen) != cmdLen ||
+ write (fdInM, "\n", 1) != 1) {
+ Tcl_AppendResult (interp, "failed to write to shell: ",
+ Tcl_PosixError (interp), NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Signal EOF to the shell, so that it may terminate.
+ */
+
+ close (fdInM);
+ fdInM = -1;
+
+ /*
+ * We never get an EOF on fdOutM, because fdOutS remains open even
+ * when the shell terminates. The best we can do is to occasionally
+ * poll if there is data to read, and to see if the shell task is
+ * still alive. Use a polling period of 100ms.
+ */
+
+ tid = taskNameToId (shellTaskName);
+ ttw = (sysClkRateGet() >= 10) ? (sysClkRateGet()/10) : 1;
+
+ while (tid != ERROR) {
+ if (taskIdVerify (tid) == ERROR) {
+ break;
+ }
+
+ if (ioctl (fdOutM, FIONWRITE, (int) &nUnread) != OK) {
+ nUnread = 0;
+ }
+
+ assert (nUnread <= 2048);
+
+ if (nUnread) {
+ if (read (fdOutM, buffer, nUnread) != nUnread) {
+ Tcl_AppendResult (interp, "failed to read from shell: ",
+ Tcl_PosixError (interp), NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ Tcl_AppendToObj (output, buffer, nUnread);
+ continue;
+ }
+
+ /*
+ * Wait a while before polling again.
+ */
+
+ taskDelay (ttw);
+ }
+
+ /*
+ * The shell task has terminated. There may be leftover data.
+ */
+
+ if (ioctl (fdOutM, FIONWRITE, (int) &nUnread) != OK) {
+ nUnread = 0;
+ }
+
+ assert (nUnread <= 2048);
+
+ if (nUnread) {
+ if (read (fdOutM, buffer, nUnread) != nUnread) {
+ Tcl_AppendResult (interp, "failed to read from shell: ",
+ Tcl_PosixError (interp), NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ Tcl_AppendToObj (output, buffer, nUnread);
+ }
+
+ /*
+ * Looks good.
+ */
+
+ result = TCL_OK;
+ Tcl_SetObjResult (interp, output);
+
+ /*
+ * Clean up.
+ */
+
+ done:
+ Tcl_DecrRefCount (output);
+
+ if (fdInM >= 0) close (fdInM);
+ if (fdInS >= 0) close (fdInS);
+ if (fdOutM >= 0) close (fdOutM);
+ if (fdOutS >= 0) close (fdOutS);
+
+ ptyDevRemove ("tclExecOut");
+ ptyDevRemove ("tclExecIn");
+ ioDefPathSet (currentDirectory);
+
+ Tcl_MutexUnlock (&vxTclShellExecSync);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * tclsh
+ *
+ * Entrypoint for VxWorks. Executes a Tcl script in a new
+ * interpreter.
+ *
+ * Results:
+ * Returns OK or ERROR
+ *
+ *----------------------------------------------------------------------
+ */
+
+static
+int
+vxTclshExit (ClientData clientData,
+ Tcl_Interp * interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
+{
+ Tcl_DeleteInterp (interp);
+ return TCL_OK;
+}
+
+int
+tclsh (const char * cmd)
+{
+ const char *bptr, *pptr, *eptr;
+ int argc, argi, result, isquoted;
+ Tcl_DString appName;
+ Tcl_Interp * interp;
+ Tcl_Obj *argvPtr;
+ char *argv[32], *aptr;
+
+ if (!cmd) {
+ printf ("tclsh: error: command line is null\n");
+ return ERROR;
+ }
+
+ argc = 0;
+ pptr = cmd;
+
+ while (*pptr) {
+ while (isspace ((unsigned char) *pptr)) {
+ pptr++;
+ }
+
+ if (!*pptr) {
+ break;
+ }
+
+ /*
+ * At the beginning of a parameter.
+ */
+
+ if (*pptr == '"') {
+ bptr = ++pptr;
+ isquoted = 1;
+ }
+ else {
+ bptr = pptr;
+ isquoted = 0;
+ }
+
+ eptr = 0;
+ while (*pptr) {
+ /*
+ * In the middle of a parameter.
+ */
+
+ if (*pptr == '\\') {
+ if (*++pptr) {
+ pptr++;
+ }
+ }
+ else if (isquoted && *pptr == '"') {
+ eptr = pptr;
+ pptr++;
+ break;
+ }
+ else if (!isquoted && isspace ((unsigned char) *pptr)) {
+ eptr = pptr;
+ pptr++;
+ break;
+ }
+ else {
+ pptr++;
+ }
+ }
+
+ /*
+ * At the end of a parameter.
+ */
+
+ if (!eptr) {
+ /*
+ * At the end of the command line.
+ */
+
+ if (isquoted) {
+ printf ("tclsh: error parsing command line: unterminated quote\n");
+ return ERROR;
+ }
+
+ eptr = pptr;
+ }
+
+ if (argc >= 31) {
+ printf ("tclsh: too many command-line parameters\n");
+ return ERROR;
+ }
+
+ argv[argc] = malloc (eptr - bptr + 1);
+
+ for (aptr = argv[argc]; bptr < eptr; aptr++, bptr++) {
+ if (*bptr == '\\') {
+ bptr++;
+ }
+ *aptr = *bptr;
+ }
+
+ *aptr = '\0';
+ argc++;
+ }
+
+ argv[argc] = NULL;
+
+ Tcl_FindExecutable (argv[0]);
+ interp = Tcl_CreateInterp ();
+ Tcl_InitMemory (interp);
+ result = Tcl_Init (interp);
+
+ if (result != TCL_OK) {
+ Tcl_Obj * resultPtr = Tcl_GetObjResult (interp);
+ printf ("error initializing Tcl interpreter: %s\n",
+ Tcl_GetStringFromObj (resultPtr, NULL));
+ Tcl_DeleteInterp (interp);
+ return ERROR;
+ }
+
+ Tcl_ExternalToUtfDString (NULL, argv[0], -1, &appName);
+ Tcl_SetVar (interp, "argv0", Tcl_DStringValue (&appName), TCL_GLOBAL_ONLY);
+ Tcl_DStringFree (&appName);
+
+ argvPtr = Tcl_NewListObj (0, NULL);
+
+ for (argi=1; argi<argc; argi++) {
+ Tcl_DString ds;
+ Tcl_ExternalToUtfDString (NULL, argv[argi], -1, &ds);
+ Tcl_ListObjAppendElement (NULL, argvPtr,
+ Tcl_NewStringObj(Tcl_DStringValue (&ds),
+ Tcl_DStringLength(&ds)));
+ Tcl_DStringFree (&ds);
+ }
+
+ Tcl_SetVar2Ex (interp, "argc", NULL, Tcl_NewIntObj (argc-1), TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex (interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
+ Tcl_SetVar (interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
+
+ /*
+ * exit is evil and must be replaced.
+ */
+
+ Tcl_CreateObjCommand (interp, "exit", vxTclshExit, NULL, NULL);
+ Tcl_CreateObjCommand (interp, "shellConfigSet",
+ vxTclShellConfigSet,
+ NULL, NULL);
+ Tcl_CreateObjCommand (interp, "shellEvaluate",
+ vxTclShellEvaluate,
+ NULL, NULL);
+ Tcl_CreateObjCommand (interp, "shellExec",
+ vxTclShellExec,
+ NULL, NULL);
+
+ Tcl_Preserve (interp);
+ result = Tcl_EvalFile (interp, argv[0]);
+
+ if (result != TCL_OK) {
+ Tcl_Obj * resultPtr = Tcl_GetObjResult (interp);
+ printf ("error: %s\n", Tcl_GetStringFromObj (resultPtr, NULL));
+ }
+
+ Tcl_DeleteInterp (interp);
+ Tcl_Release (interp);
+
+ for (argi=0; argi<argc; argi++) {
+ free (argv[argi]);
+ }
+
+ return (result == TCL_OK) ? OK : ERROR;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff -r -u -N tcl8.5.2.orig/unix/tclVxWorksThrd.c tcl8.5.2/unix/tclVxWorksThrd.c
--- tcl8.5.2.orig/unix/tclVxWorksThrd.c 1969-12-31 19:00:00.000000000 -0500
+++ tcl8.5.2/unix/tclVxWorksThrd.c 2008-03-31 15:01:28.102242200 -0400
@@ -0,0 +1,650 @@
+/*
+ * tclVxWorksThrd.c --
+ *
+ * This file implements the VxWorks-specific thread support.
+ */
+
+#include "tclInt.h"
+
+#ifdef TCL_THREADS
+
+#include <semLib.h>
+#include <objLib.h>
+#include <sysLib.h>
+#include <taskLib.h>
+
+typedef struct ThreadSpecificData {
+ char nabuf[16];
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * masterLock is used to serialize creation of mutexes, condition variables,
+ * and thread local storage. This is the only place that can count on the
+ * ability to statically initialize the mutex.
+ */
+
+static VX_MUTEX_SEMAPHORE(masterLockStorage);
+static SEM_ID masterLock;
+
+/*
+ * initLock is used to serialize initialization and finalization of Tcl. It
+ * cannot use any dyamically allocated storage.
+ */
+
+static int locksAreInitialized = 0;
+static VX_BINARY_SEMAPHORE(initLockStorage);
+static SEM_ID initLock;
+
+/*
+ * allocLock is used by Tcl's version of malloc for synchronization. For
+ * obvious reasons, cannot use any dyamically allocated storage.
+ */
+
+static VX_MUTEX_SEMAPHORE(allocLockStorage);
+static SEM_ID allocLock;
+
+/*
+ * These are for the critical sections inside this file.
+ */
+
+#define MASTER_LOCK semTake(masterLock, WAIT_FOREVER)
+#define MASTER_UNLOCK semGive(masterLock)
+
+#endif /* TCL_THREADS */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadCreate --
+ *
+ * This procedure creates a new thread.
+ *
+ * Results:
+ * TCL_OK if the thread could be created. The thread ID is returned in a
+ * parameter.
+ *
+ * Side effects:
+ * A new thread is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpThreadCreate(
+ Tcl_ThreadId *idPtr, /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc proc, /* Main() function of the thread */
+ ClientData clientData, /* The one argument to Main() */
+ int stackSize, /* Size of stack for the new thread */
+ int flags) /* Flags controlling behaviour of the new
+ * thread. */
+{
+ errno = ENOTSUP;
+ return ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_JoinThread --
+ *
+ * This procedure waits upon the exit of the specified thread.
+ *
+ * Results:
+ * TCL_OK if the wait was successful, TCL_ERROR else.
+ *
+ * Side effects:
+ * The result area is set to the exit code of the thread we waited upon.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_JoinThread(
+ Tcl_ThreadId threadId, /* Id of the thread to wait upon. */
+ int *state) /* Reference to the storage the result of the
+ * thread we wait upon will be written into.
+ * May be NULL. */
+{
+ errno = ENOTSUP;
+ return TCL_ERROR;
+}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadExit --
+ *
+ * This procedure terminates the current thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This procedure terminates the current thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadExit(
+ int status)
+{
+}
+#endif /* TCL_THREADS */
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadGetStackSize --
+ *
+ * This procedure returns the size of the current thread's stack.
+ *
+ * Results:
+ * Stack size (in bytes?) or -1 for error or 0 for undeterminable.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+size_t
+TclpThreadGetStackSize(void)
+{
+ TASK_DESC td;
+
+ if (taskInfoGet (0, &td) != OK) {
+ return 0;
+ }
+
+ return td.td_stackSize;
+}
+#endif /* TCL_THREADS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCurrentThread --
+ *
+ * This procedure returns the ID of the currently running thread.
+ *
+ * Results:
+ * A thread ID.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ThreadId
+Tcl_GetCurrentThread(void)
+{
+#ifdef TCL_THREADS
+ return (Tcl_ThreadId) taskIdSelf ();
+#else
+ return (Tcl_ThreadId) 0;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitLock
+ *
+ * This procedure is used to grab a lock that serializes initialization
+ * and finalization of Tcl. On some platforms this may also initialize
+ * the mutex used to serialize creation of more mutexes and thread local
+ * storage keys.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitLock(void)
+{
+#ifdef TCL_THREADS
+ taskLock ();
+ if (!locksAreInitialized) {
+ initLock = semBInitialize (initLockStorage, 0, SEM_FULL);
+ masterLock = semMInitialize (masterLockStorage, 0);
+ allocLock = semMInitialize (allocLockStorage, 0);
+ locksAreInitialized = 1;
+ }
+ taskUnlock ();
+
+ semTake (initLock, WAIT_FOREVER);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeLock
+ *
+ * This procedure is used to destroy all private resources used in this
+ * file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys everything private. TclpInitLock must be held entering this
+ * function.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeLock(void)
+{
+#ifdef TCL_THREADS
+ taskLock ();
+ locksAreInitialized = 0;
+ semDelete (allocLock);
+ semDelete (masterLock);
+ semDelete (initLock);
+ taskUnlock ();
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitUnlock
+ *
+ * This procedure is used to release a lock that serializes
+ * initialization and finalization of Tcl.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitUnlock(void)
+{
+#ifdef TCL_THREADS
+ semGive (initLock);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterLock
+ *
+ * This procedure is used to grab a lock that serializes creation and
+ * finalization of serialization objects. This interface is only needed
+ * in finalization; it is hidden during creation of the objects.
+ *
+ * This lock must be different than the initLock because the initLock is
+ * held during creation of syncronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterLock(void)
+{
+#ifdef TCL_THREADS
+ semTake (masterLock, WAIT_FOREVER);
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterUnlock
+ *
+ * This procedure is used to release a lock that serializes creation and
+ * finalization of synchronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterUnlock(void)
+{
+#ifdef TCL_THREADS
+ semGive (masterLock);
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetAllocMutex
+ *
+ * This procedure returns a pointer to a statically initialized mutex for
+ * use by the memory allocator. The alloctor must use this lock, because
+ * all other locks are allocated...
+ *
+ * Results:
+ * A pointer to a mutex that is suitable for passing to Tcl_MutexLock and
+ * Tcl_MutexUnlock.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Mutex *
+Tcl_GetAllocMutex(void)
+{
+#ifdef TCL_THREADS
+ return (Tcl_Mutex *) &allocLock;
+#else
+ return NULL;
+#endif
+}
+
+#ifdef TCL_THREADS
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexLock --
+ *
+ * This procedure is invoked to lock a mutex. This procedure handles
+ * initializing the mutex, if necessary. The caller can rely on the fact
+ * that Tcl_Mutex is an opaque pointer. This routine will change that
+ * pointer from NULL after first use.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May block the current thread. The mutex is aquired when this returns.
+ * Will allocate memory for a pthread_mutex_t and initialize this the
+ * first time this Tcl_Mutex is used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexLock(
+ Tcl_Mutex *mutexPtr) /* Really (SEM_ID *) */
+{
+ SEM_ID mutex;
+
+ if (*mutexPtr == NULL) {
+ MASTER_LOCK;
+ if (*mutexPtr == NULL) {
+ mutex = semMCreate (0);
+ *mutexPtr = (Tcl_Mutex) mutex;
+ TclRememberMutex (mutexPtr);
+ }
+ MASTER_UNLOCK;
+ }
+
+ mutex = *((SEM_ID *) mutexPtr);
+ semTake (mutex, WAIT_FOREVER);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexUnlock --
+ *
+ * This procedure is invoked to unlock a mutex. The mutex must have been
+ * locked by Tcl_MutexLock.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex is released when this returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexUnlock(
+ Tcl_Mutex *mutexPtr) /* Really (SEM_ID *) */
+{
+ SEM_ID mutex = *((SEM_ID *) mutexPtr);
+ semGive (mutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeMutex --
+ *
+ * This procedure is invoked to clean up one mutex. This is only safe to
+ * call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex list is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeMutex(
+ Tcl_Mutex *mutexPtr)
+{
+ if (*mutexPtr) {
+ SEM_ID mutex = *((SEM_ID *) mutexPtr);
+ semDelete (mutex);
+ *mutexPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionWait --
+ *
+ * This procedure is invoked to wait on a condition variable. The mutex
+ * is automically released as part of the wait, and automatically grabbed
+ * when the condition is signaled.
+ *
+ * The mutex must be held when this procedure is called.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May block the current thread. The mutex is aquired when this returns.
+ * Will allocate memory for a pthread_mutex_t and initialize this the
+ * first time this Tcl_Mutex is used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionWait(
+ Tcl_Condition *condPtr, /* Really (SEM_ID *) */
+ Tcl_Mutex *mutexPtr, /* Really (SEM_ID *) */
+ Tcl_Time *timePtr) /* Timeout on waiting period */
+{
+ unsigned int ticks;
+ SEM_ID mutex;
+ SEM_ID cond;
+
+ if (*condPtr == NULL) {
+ MASTER_LOCK;
+
+ /*
+ * Double check inside mutex to avoid race, then initialize condition
+ * variable if necessary.
+ */
+
+ if (*condPtr == NULL) {
+ cond = semBCreate (0, SEM_EMPTY);
+ *condPtr = (Tcl_Condition) cond;
+ TclRememberCondition (condPtr);
+ }
+
+ MASTER_UNLOCK;
+ }
+
+ mutex = *((SEM_ID *) mutexPtr);
+ cond = *((SEM_ID *) cond);
+
+
+ if (timePtr == NULL) {
+ ticks = WAIT_FOREVER;
+ }
+ else {
+ unsigned int msecs = ((timePtr->sec * 1000) +
+ (timePtr->usec / 1000));
+ ticks = msecs * sysClkRateGet() / 1000;
+ }
+
+ semGive (mutex);
+ semTake (cond, ticks);
+ semTake (mutex, WAIT_FOREVER);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionNotify --
+ *
+ * This procedure is invoked to signal a condition variable.
+ *
+ * The mutex must be held during this call to avoid races, but this
+ * interface does not enforce that.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May unblock another thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionNotify(
+ Tcl_Condition *condPtr)
+{
+ if (*condPtr != NULL) {
+ SEM_ID cond = *((SEM_ID *) cond);
+ semGive (cond);
+ } else {
+ /*
+ * Noone has used the condition variable, so there are no waiters.
+ */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeCondition --
+ *
+ * This procedure is invoked to clean up a condition variable. This is
+ * only safe to call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The condition variable is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeCondition(
+ Tcl_Condition *condPtr)
+{
+ if (*condPtr != NULL) {
+ SEM_ID cond = *((SEM_ID *) cond);
+ semDelete (cond);
+ *condPtr = NULL;
+ }
+}
+#endif /* TCL_THREADS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpReaddir, TclpLocaltime, TclpGmtime, TclpInetNtoa --
+ *
+ * These procedures replace core C versions to be used in a threaded
+ * environment.
+ *
+ * Results:
+ * See documentation of C functions.
+ *
+ * Side effects:
+ * See documentation of C functions.
+ *
+ * Notes:
+ * TclpReaddir is no longer used by the core (see 1095909), but it
+ * appears in the internal stubs table (see #589526).
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DirEntry *
+TclpReaddir(
+ DIR * dir)
+{
+ return TclOSreaddir(dir);
+}
+
+char *
+TclpInetNtoa(
+ struct in_addr addr)
+{
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ unsigned char *b = (unsigned char*) &addr.s_addr;
+
+ sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]);
+ return tsdPtr->nabuf;
+#else
+ return inet_ntoa(addr);
+#endif
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
