diff -rc tcl8.0/README.vxworks tcl8.0-vxworks/README.vxworks *** tcl8.0/README.vxworks Fri Oct 24 11:23:53 1997 --- tcl8.0-vxworks/README.vxworks Fri Oct 24 11:52:54 1997 *************** *** 0 **** --- 1,19 ---- + The only known unresolved references are ... + + 1) hostname + + This is just the following code stuck in usrConfig.c + + char hostname[MAXHOSTNAMELEN]; + gethostname(hostname,MAXHOSTNAMELEN); + + 2) gettimeofday + + This is part of Bob Herlien's usrTime package. + + Plus, you may want the following: + + INCLUDE_STANDALONE_SYM_TBL or INCLUDE_NET_SYM_TBL + (for sysSymTbl - used by tclVxWorksLoad.c) + INCLUDE_STAT_SYM_TBL + (for statSymTbl - used by tclPosixStr.c,tclVxWorksLoad.c (strerror())) Common subdirectories: tcl8.0/compat and tcl8.0-vxworks/compat Common subdirectories: tcl8.0/doc and tcl8.0-vxworks/doc Common subdirectories: tcl8.0/generic and tcl8.0-vxworks/generic Common subdirectories: tcl8.0/library and tcl8.0-vxworks/library Common subdirectories: tcl8.0/mac and tcl8.0-vxworks/mac Common subdirectories: tcl8.0/tests and tcl8.0-vxworks/tests Common subdirectories: tcl8.0/unix and tcl8.0-vxworks/unix Common subdirectories: tcl8.0/vxworks and tcl8.0-vxworks/vxworks Common subdirectories: tcl8.0/win and tcl8.0-vxworks/win diff -rc tcl8.0/compat/strftime.c tcl8.0-vxworks/compat/strftime.c *** tcl8.0/compat/strftime.c Fri Aug 8 17:02:46 1997 --- tcl8.0-vxworks/compat/strftime.c Fri Oct 24 09:42:52 1997 *************** *** 97,104 **** --- 97,109 ---- static const _TimeLocale *_CurrentTimeLocale = &_DefaultTimeLocale; + #ifdef VxWorks + #define gsize (tclGlob->gsize) + #define pt (tclGlob->pt) + #else static size_t gsize; static char *pt; + #endif /* VxWorks */ static int _add _ANSI_ARGS_((const char* str)); static int _conv _ANSI_ARGS_((int n, int digits, int pad)); static int _secs _ANSI_ARGS_((const struct tm *t)); diff -rc tcl8.0/compat/strncasecmp.c tcl8.0-vxworks/compat/strncasecmp.c *** tcl8.0/compat/strncasecmp.c Fri Mar 21 08:16:06 1997 --- tcl8.0-vxworks/compat/strncasecmp.c Fri Oct 24 09:42:52 1997 *************** *** 64,69 **** --- 64,70 ---- int strcasecmp _ANSI_ARGS_((CONST char *s1, CONST char *s2)); + #ifndef HAVE_STRCASECMP /* *---------------------------------------------------------------------- *************** *** 99,104 **** --- 100,106 ---- } return charmap[u1] - charmap[u2]; } + #endif /* *---------------------------------------------------------------------- diff -rc tcl8.0/generic/regexp.c tcl8.0-vxworks/generic/regexp.c *** tcl8.0/generic/regexp.c Thu May 15 17:09:36 1997 --- tcl8.0-vxworks/generic/regexp.c Fri Oct 24 09:43:01 1997 *************** *** 57,63 **** --- 57,67 ---- * thread-safe. */ + #ifdef VxWorks + #define errMsg (tclGlob->errMsg) + #else static char *errMsg = NULL; + #endif /* !VxWorks */ /* * The "internal use only" fields in regexp.h are present to pass info from diff -rc tcl8.0/generic/tcl.h tcl8.0-vxworks/generic/tcl.h *** tcl8.0/generic/tcl.h Thu Aug 7 10:26:52 1997 --- tcl8.0-vxworks/generic/tcl.h Fri Oct 24 09:43:01 1997 *************** *** 93,98 **** --- 93,119 ---- # endif #endif + /* + * The following definitions set up the proper options for VxWorks + * compilers. We use this method because there is no autoconf equivalent. + */ + + #ifdef VxWorks + # ifndef USE_TCLALLOC + # define USE_TCLALLOC 1 + # endif + # ifndef USE_PUTENV + # define USE_PUTENV 1 + # endif + # ifndef HAVE_STRCASECMP + # define HAVE_STRCASECMP 1 + # endif + # ifndef HAVE_GETTIMEOFDAY + # define HAVE_GETTIMEOFDAY 1 + # endif + #define TCL_COMPILE_STATS + #endif + /* * A special definition used to allow this header file to be included * in resource files so that they can get obtain version information from diff -rc tcl8.0/generic/tclAlloc.c tcl8.0-vxworks/generic/tclAlloc.c *** tcl8.0/generic/tclAlloc.c Tue Aug 12 17:04:56 1997 --- tcl8.0-vxworks/generic/tclAlloc.c Fri Oct 24 10:29:52 1997 *************** *** 26,32 **** --- 26,34 ---- # define RCHECK #endif + #ifndef VxWorks typedef unsigned long caddr_t; + #endif /* VxWorks */ /* * The overhead on a block is at least 4 bytes. When free, this space *************** *** 39,44 **** --- 41,47 ---- * bits of ov_next, and ov_magic can not be a valid ov_next bit pattern. */ + #ifndef VxWorks union overhead { union overhead *ov_next; /* when free */ struct { *************** *** 57,62 **** --- 60,66 ---- #define ov_rmagic ovu.ovu_rmagic #define ov_size ovu.ovu_size }; + #endif /* VxWorks */ #define MAGIC 0xef /* magic # on accounting info */ *************** *** 78,84 **** --- 82,92 ---- #define NBUCKETS 13 #define MAXMALLOC (1<<(NBUCKETS+2)) + #ifdef VxWorks + #define nextf (tclGlob->nextf) + #else static union overhead *nextf[NBUCKETS]; + #endif /* VxWorks */ #ifdef MSTATS *************** *** 87,93 **** --- 95,105 ---- * for a given block size. */ + #ifdef VxWorks + #define nmalloc (tclGlob->nmalloc) + #else static unsigned int nmalloc[NBUCKETS+1]; + #endif /* VxWorks */ #include #endif diff -rc tcl8.0/generic/tclAsync.c tcl8.0-vxworks/generic/tclAsync.c *** tcl8.0/generic/tclAsync.c Wed Oct 23 09:01:34 1996 --- tcl8.0-vxworks/generic/tclAsync.c Fri Oct 24 09:43:01 1997 *************** *** 34,39 **** --- 34,45 ---- * is invoked. */ } AsyncHandler; + #ifdef VxWorks + #define firstHandler ((AsyncHandler *)(tclGlob->firstHandler)) + #define lastHandler ((AsyncHandler *)(tclGlob->lastHandler)) + #define asyncReady (tclGlob->asyncReady) + #define asyncActive (tclGlob->asyncActive) + #else /* * The variables below maintain a list of all existing handlers. */ *************** *** 58,63 **** --- 64,70 ---- */ static int asyncActive = 0; + #endif /* VxWorks */ /* *---------------------------------------------------------------------- diff -rc tcl8.0/generic/tclBasic.c tcl8.0-vxworks/generic/tclBasic.c *** tcl8.0/generic/tclBasic.c Wed Aug 13 17:47:10 1997 --- tcl8.0-vxworks/generic/tclBasic.c Fri Oct 24 09:43:01 1997 *************** *** 77,84 **** --- 77,86 ---- (CompileProc *) NULL, 1}, {"eval", (Tcl_CmdProc *) NULL, Tcl_EvalObjCmd, (CompileProc *) NULL, 1}, + #if !defined(VxWorks) {"exit", (Tcl_CmdProc *) NULL, Tcl_ExitObjCmd, (CompileProc *) NULL, 0}, + #endif /* !VxWorks */ {"expr", (Tcl_CmdProc *) NULL, Tcl_ExprObjCmd, TclCompileExprCmd, 1}, {"fcopy", (Tcl_CmdProc *) NULL, Tcl_FcopyObjCmd, *************** *** 189,196 **** --- 191,200 ---- (CompileProc *) NULL, 0}, {"open", Tcl_OpenCmd, (Tcl_ObjCmdProc *) NULL, (CompileProc *) NULL, 0}, + #ifndef VxWorks {"pid", (Tcl_CmdProc *) NULL, Tcl_PidObjCmd, (CompileProc *) NULL, 1}, + #endif /* VxWorks */ {"puts", (Tcl_CmdProc *) NULL, Tcl_PutsObjCmd, (CompileProc *) NULL, 1}, {"pwd", Tcl_PwdCmd, (Tcl_ObjCmdProc *) NULL, *************** *** 222,229 **** --- 226,235 ---- {"source", (Tcl_CmdProc *) NULL, Tcl_MacSourceObjCmd, (CompileProc *) NULL, 0}, #else + #ifndef VxWorks {"exec", Tcl_ExecCmd, (Tcl_ObjCmdProc *) NULL, (CompileProc *) NULL, 0}, + #endif /* VxWorks */ {"source", (Tcl_CmdProc *) NULL, Tcl_SourceObjCmd, (CompileProc *) NULL, 0}, #endif /* MAC_TCL */ *************** *** 523,529 **** --- 529,539 ---- ClientData clientData; /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; + #ifdef VxWorks + #define assocDataCounter (tclGlob->assocDataCtr) + #else static int assocDataCounter = 0; + #endif /* VxWorks */ int new; char buffer[128]; AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData)); *************** *** 3989,3992 **** iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS; } - --- 3999,4001 ---- diff -rc tcl8.0/generic/tclCkalloc.c tcl8.0-vxworks/generic/tclCkalloc.c *** tcl8.0/generic/tclCkalloc.c Thu May 15 17:09:46 1997 --- tcl8.0-vxworks/generic/tclCkalloc.c Fri Oct 24 09:43:01 1997 *************** *** 38,45 **** --- 38,49 ---- #define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3) + #ifdef VxWorks + #define curTagPtr ((MemTag *)(tclGlob->curTagPtr)) + #else static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers * (set by "memory tag" command). */ + #endif /* VxWorks */ /* * One of the following structures is allocated just before each *************** *** 65,71 **** --- 69,79 ---- * one. */ }; + #ifdef VxWorks + #define allocHead (tclGlob->allocHead) + #else static struct mem_header *allocHead = NULL; /* List of allocated structures */ + #endif /* VxWorks */ #define GUARD_VALUE 0141 *************** *** 85,90 **** --- 93,111 ---- #define BODY_OFFSET \ ((unsigned long) (&((struct mem_header *) 0)->body)) + #ifdef VxWorks + #define total_mallocs (tclGlob->total_mallocs) + #define total_frees (tclGlob->total_frees) + #define current_bytes_malloced (tclGlob->current_bytes_malloced) + #define maximum_bytes_malloced (tclGlob->maximum_bytes_malloced) + #define current_malloc_packets (tclGlob->current_malloc_packets) + #define maximum_malloc_packets (tclGlob->maximum_malloc_packets) + #define break_on_malloc (tclGlob->break_on_malloc) + #define trace_on_at_malloc (tclGlob->trace_on_at_malloc) + #define alloc_tracing (tclGlob->alloc_tracing) + #define init_malloced_bodies (tclGlob->init_malloced_bodies) + #define validate_memory (tclGlob->validate_memory) + #else static int total_mallocs = 0; static int total_frees = 0; static int current_bytes_malloced = 0; *************** *** 100,105 **** --- 121,127 ---- #else static int validate_memory = FALSE; #endif + #endif /* VxWorks */ /* * Prototypes for procedures defined in this file: diff -rc tcl8.0/generic/tclClock.c tcl8.0-vxworks/generic/tclClock.c *** tcl8.0/generic/tclClock.c Fri Aug 1 10:48:32 1997 --- tcl8.0-vxworks/generic/tclClock.c Fri Oct 24 09:43:01 1997 *************** *** 226,231 **** --- 226,234 ---- int savedTimeZone; char *savedTZEnv; #endif + #ifdef VxWorks + struct tm buf; + #endif /* VxWorks */ Tcl_Obj *resultPtr; resultPtr = Tcl_GetObjResult(interp); *************** *** 263,269 **** --- 266,278 ---- } #endif + #ifdef VxWorks + useGMT ? gmtime_r((time_t *) &clockVal,&buf) : + localtime_r((time_t *) &clockVal,&buf); + timeDataPtr = &buf; + #else timeDataPtr = TclpGetDate((time_t *) &clockVal, useGMT); + #endif /* VxWorks */ /* * Make a guess at the upper limit on the substituted string size diff -rc tcl8.0/generic/tclCmdAH.c tcl8.0-vxworks/generic/tclCmdAH.c *** tcl8.0/generic/tclCmdAH.c Wed Aug 13 08:12:20 1997 --- tcl8.0-vxworks/generic/tclCmdAH.c Fri Oct 24 09:43:01 1997 *************** *** 1067,1072 **** --- 1067,1073 ---- } statOp = 0; break; + #ifndef VxWorks case FILE_READLINK: { char linkValue[MAXPATHLEN + 1]; int linkLength; *************** *** 1101,1106 **** --- 1102,1108 ---- Tcl_SetStringObj(resultPtr, linkValue, linkLength); goto done; } + #endif /* VxWorks */ case FILE_SIZE: if (objc != 3) { errorString = "size name"; diff -rc tcl8.0/generic/tclCmdIL.c tcl8.0-vxworks/generic/tclCmdIL.c *** tcl8.0/generic/tclCmdIL.c Fri Aug 1 10:48:00 1997 --- tcl8.0-vxworks/generic/tclCmdIL.c Fri Oct 24 09:43:01 1997 *************** *** 26,32 **** --- 26,34 ---- * Tcl_FindExecutable. The storage space is dynamically allocated. */ + #ifndef VxWorks char *tclExecutableName = NULL; + #endif /* !VxWorks */ /* * During execution of the "lsort" command, structures of the following diff -rc tcl8.0/generic/tclCompExpr.c tcl8.0-vxworks/generic/tclCompExpr.c *** tcl8.0/generic/tclCompExpr.c Thu Aug 7 15:57:18 1997 --- tcl8.0-vxworks/generic/tclCompExpr.c Fri Oct 24 09:43:01 1997 *************** *** 37,43 **** --- 37,47 ---- */ #ifdef TCL_COMPILE_DEBUG + #ifdef VxWorks + #define traceCompileExpr (tclGlob->traceCompileExpr) + #else static int traceCompileExpr = 0; + #endif /* VxWorks */ #endif /* TCL_COMPILE_DEBUG */ /* diff -rc tcl8.0/generic/tclCompile.c tcl8.0-vxworks/generic/tclCompile.c *** tcl8.0/generic/tclCompile.c Tue Aug 12 17:04:50 1997 --- tcl8.0-vxworks/generic/tclCompile.c Fri Oct 24 09:43:01 1997 *************** *** 25,32 **** --- 25,37 ---- * This variable is linked to the Tcl variable "tcl_traceCompile". */ + #ifdef VxWorks + #define traceInitialized (tclGlob->traceInitialized) + #define tclCmdNameType (tclGlob->tclCmdNameType) + #else int tclTraceCompile = 0; static int traceInitialized = 0; + #endif /* VxWorks */ /* * Count of the number of compilations and various other compilation- *************** *** 34,39 **** --- 39,45 ---- */ #ifdef TCL_COMPILE_STATS + #ifndef VxWorks long tclNumCompilations = 0; double tclTotalSourceBytes = 0.0; double tclTotalCodeBytes = 0.0; *************** *** 49,54 **** --- 55,61 ---- int tclSourceCount[32]; int tclByteCodeCount[32]; + #endif /* !VxWorks */ #endif /* TCL_COMPILE_STATS */ /* diff -rc tcl8.0/generic/tclCompile.h tcl8.0-vxworks/generic/tclCompile.h *** tcl8.0/generic/tclCompile.h Fri Aug 8 17:02:28 1997 --- tcl8.0-vxworks/generic/tclCompile.h Fri Oct 24 09:43:01 1997 *************** *** 23,28 **** --- 23,29 ---- *------------------------------------------------------------------------ */ + #ifndef VxWorks /* * Variable that denotes the command name Tcl object type. Objects of this * type cache the Command pointer that results from looking up command names *************** *** 79,84 **** --- 80,86 ---- extern int tclSourceCount[32]; extern int tclByteCodeCount[32]; #endif /* TCL_COMPILE_STATS */ + #endif /* VxWorks */ /* *------------------------------------------------------------------------ diff -rc tcl8.0/generic/tclEnv.c tcl8.0-vxworks/generic/tclEnv.c *** tcl8.0/generic/tclEnv.c Tue Aug 12 17:04:44 1997 --- tcl8.0-vxworks/generic/tclEnv.c Fri Oct 24 09:43:02 1997 *************** *** 32,37 **** --- 32,42 ---- * or zero. */ } EnvInterp; + #ifdef VxWorks + #define firstInterpPtr ((EnvInterp *)(tclGlob->firstEnvInterpPtr)) + #define cacheSize (tclGlob->cacheSize) + #define environCache (tclGlob->environCache) + #else static EnvInterp *firstInterpPtr = NULL; /* First in list of all managed interpreters, * or NULL if none. */ *************** *** 48,53 **** --- 53,59 ---- * once). Zero means that the environment * array is in its original static state. */ #endif + #endif /* VxWorks */ /* * Declarations for local procedures defined in this file: *************** *** 509,514 **** --- 515,523 ---- panic("EnvTraceProc called with confusing arguments"); } eiPtr = firstInterpPtr; + #ifdef VxWorks + if (eiPtr == NULL) return NULL; + #endif /* VxWorks */ if (eiPtr->interp == interp) { firstInterpPtr = eiPtr->nextPtr; } else { diff -rc tcl8.0/generic/tclEvent.c tcl8.0-vxworks/generic/tclEvent.c *** tcl8.0/generic/tclEvent.c Tue Aug 12 17:04:42 1997 --- tcl8.0-vxworks/generic/tclEvent.c Fri Oct 24 09:43:02 1997 *************** *** 66,74 **** --- 66,78 ---- * this application, or NULL for end of list. */ } ExitHandler; + #ifdef VxWorks + #define firstExitPtr ((ExitHandler *)(tclGlob->firstExitPtr)) + #else static ExitHandler *firstExitPtr = NULL; /* First in list of all exit handlers for * application. */ + #endif /* VxWorks */ /* * The following variable is a "secret" indication to Tcl_Exit that *************** *** 77,83 **** --- 81,89 ---- * dump memory usage information. */ + #ifndef VxWorks char *tclMemDumpFileName = NULL; + #endif /* !VxWorks */ /* * This variable is set to 1 when Tcl_Exit is called, and at the end of *************** *** 86,92 **** --- 92,102 ---- * files and pipes. */ + #ifdef VxWorks + #define tclInExit (tclGlob->tclInExit) + #else static int tclInExit = 0; + #endif /* VxWorks */ /* * Prototypes for procedures referenced only in this file: diff -rc tcl8.0/generic/tclExecute.c tcl8.0-vxworks/generic/tclExecute.c *** tcl8.0/generic/tclExecute.c Tue Aug 12 17:06:50 1997 --- tcl8.0-vxworks/generic/tclExecute.c Fri Oct 24 09:43:02 1997 *************** *** 47,53 **** --- 47,57 ---- * initialized. */ + #ifdef VxWorks + #define execInitialized (tclGlob->execInitialized) + #else static int execInitialized = 0; + #endif /* VxWorks */ /* * Variable that controls whether execution tracing is enabled and, if so, *************** *** 59,65 **** --- 63,71 ---- * This variable is linked to the Tcl variable "tcl_traceExec". */ + #ifndef VxWorks int tclTraceExec = 0; + #endif /* !VxWorks */ /* * The following global variable is use to signal matherr that Tcl *************** *** 68,74 **** --- 74,82 ---- * progress; non-zero means Tcl is doing math. */ + #ifndef VxWorks int tcl_MathInProgress = 0; + #endif /* !VxWorks */ /* * The variable below serves no useful purpose except to generate *************** *** 87,93 **** --- 95,105 ---- * Array of instruction names. */ + #ifdef VxWorks + #define opName (tclGlob->opName) + #else static char *opName[256]; + #endif /* VxWorks */ /* * Mapping from expression instruction opcodes to strings; used for error *************** *** 119,126 **** --- 131,143 ---- */ #ifdef TCL_COMPILE_STATS + #ifdef VxWorks + #define instructionCount (tclGlob->instructionCount) + #define numExecutions (tclGlob->numExecutions) + #else static long numExecutions = 0; static int instructionCount[256]; + #endif /* VxWorks */ #endif /* TCL_COMPILE_STATS */ /* *************** *** 4868,4874 **** --- 4885,4895 ---- int result; /* The Tcl result code for which to * generate a string. */ { + #ifdef VxWorks + #define buf (tclGlob->SFRCbuf) + #else static char buf[20]; + #endif /* VxWorks */ if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) { return resultStrings[result]; diff -rc tcl8.0/generic/tclFCmd.c tcl8.0-vxworks/generic/tclFCmd.c *** tcl8.0/generic/tclFCmd.c Thu May 15 17:09:58 1997 --- tcl8.0-vxworks/generic/tclFCmd.c Fri Oct 24 09:43:02 1997 *************** *** 15,20 **** --- 15,27 ---- #include "tclInt.h" #include "tclPort.h" + #if defined(VxWorks) + #undef ENOENT + #define ENOENT S_nfsLib_NFSERR_NOENT + #undef EEXIST + #define EEXIST S_nfsLib_NFSERR_NOTEMPTY + #endif /* VxWorks */ + /* * Declarations for local procedures defined in this file: */ diff -rc tcl8.0/generic/tclFileName.c tcl8.0-vxworks/generic/tclFileName.c *** tcl8.0/generic/tclFileName.c Wed Aug 6 10:04:02 1997 --- tcl8.0-vxworks/generic/tclFileName.c Fri Oct 24 09:43:02 1997 *************** *** 21,27 **** --- 21,31 ---- * registered for this file yet. */ + #ifdef VxWorks + #define initialized (tclGlob->fileNameExitHandlerInitialized) + #else static int initialized = 0; + #endif /* VxWorks */ /* * The following regular expression matches the root portion of a Windows *************** *** 44,51 **** --- 48,60 ---- * for use in filename matching. */ + #ifdef VxWorks + #define winRootPatternPtr ((regexp *)(tclGlob->winRootPatternPtr)) + #define macRootPatternPtr ((regexp *)(tclGlob->macRootPatternPtr)) + #else static regexp *winRootPatternPtr = NULL; static regexp *macRootPatternPtr = NULL; + #endif /* VxWorks */ /* * The following variable is set in the TclPlatformInit call to one *************** *** 52,58 **** --- 61,69 ---- * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS. */ + #ifndef VxWorks TclPlatformType tclPlatform = TCL_PLATFORM_UNIX; + #endif /* !VxWorks */ /* * Prototypes for local procedures defined in this file: *************** *** 201,206 **** --- 212,218 ---- switch (tclPlatform) { case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_VXWORKS: /* * Paths that begin with / or ~ are absolute. */ *************** *** 312,317 **** --- 324,330 ---- p = NULL; /* Needed only to prevent gcc warnings. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_VXWORKS: p = SplitUnixPath(path, &buffer); break; *************** *** 697,702 **** --- 710,716 ---- switch (tclPlatform) { case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_VXWORKS: for (i = 0; i < argc; i++) { p = argv[i]; /* *************** *** 1004,1009 **** --- 1018,1024 ---- lastSep = NULL; /* Needed only to prevent gcc warnings. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_VXWORKS: lastSep = strrchr(name, '/'); break; *************** *** 1158,1163 **** --- 1173,1179 ---- for (i = firstArg; i < argc; i++) { switch (tclPlatform) { case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_VXWORKS: separators = "/"; break; case TCL_PLATFORM_WINDOWS: *************** *** 1418,1423 **** --- 1434,1440 ---- break; case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_VXWORKS: /* * Add a separator if this is the first absolute element, or * a later relative element. *************** *** 1592,1597 **** --- 1609,1615 ---- break; } case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_VXWORKS: if (Tcl_DStringLength(headPtr) == 0) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { Tcl_DStringAppend(headPtr, "/", 1); diff -rc tcl8.0/generic/tclIO.c tcl8.0-vxworks/generic/tclIO.c *** tcl8.0/generic/tclIO.c Fri Aug 1 10:48:28 1997 --- tcl8.0-vxworks/generic/tclIO.c Fri Oct 24 10:33:54 1997 *************** *** 258,268 **** typedef struct NextChannelHandler { ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in * this invocation. */ ! struct NextChannelHandler *nestedHandlerPtr; /* Next nested invocation of * ChannelHandlerEventProc. */ } NextChannelHandler; /* * This variable holds the list of nested ChannelHandlerEventProc invocations. */ --- 258,273 ---- typedef struct NextChannelHandler { ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in * this invocation. */ ! struct NextChannelHandler *NestedHandlerPtr; /* Next nested invocation of * ChannelHandlerEventProc. */ } NextChannelHandler; + #ifdef VxWorks + #define nestedHandlerPtr ((NextChannelHandler *)(tclGlob->nestedHandlerPtr)) + #define firstChanPtr ((Channel *)(tclGlob->firstChanPtr)) + #define channelExitHandlerCreated (tclGlob->channelExitHandlerCreated) + #else /* * This variable holds the list of nested ChannelHandlerEventProc invocations. */ *************** *** 280,285 **** --- 285,291 ---- */ static int channelExitHandlerCreated = 0; + #endif /* VxWorks */ /* * The following structure describes the event that is added to the Tcl *************** *** 296,301 **** --- 302,315 ---- * Static variables to hold channels for stdin, stdout and stderr. */ + #ifdef VxWorks + #define stdinChannel (tclGlob->stdinChannel) + #define stdinInitialized (tclGlob->stdinInitialized) + #define stdoutChannel (tclGlob->stdoutChannel) + #define stdoutInitialized (tclGlob->stdoutInitialized) + #define stderrChannel (tclGlob->stderrChannel) + #define stderrInitialized (tclGlob->stderrInitialized) + #else static Tcl_Channel stdinChannel = NULL; static int stdinInitialized = 0; static Tcl_Channel stdoutChannel = NULL; *************** *** 302,307 **** --- 316,322 ---- static int stdoutInitialized = 0; static Tcl_Channel stderrChannel = NULL; static int stderrInitialized = 0; + #endif /* VxWorks */ /* * Static functions in this file: *************** *** 1945,1951 **** for (nhPtr = nestedHandlerPtr; nhPtr != (NextChannelHandler *) NULL; ! nhPtr = nhPtr->nestedHandlerPtr) { if (nhPtr->nextHandlerPtr && (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) { nhPtr->nextHandlerPtr = NULL; --- 1960,1966 ---- for (nhPtr = nestedHandlerPtr; nhPtr != (NextChannelHandler *) NULL; ! nhPtr = nhPtr->NestedHandlerPtr) { if (nhPtr->nextHandlerPtr && (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) { nhPtr->nextHandlerPtr = NULL; *************** *** 4504,4510 **** */ nh.nextHandlerPtr = (ChannelHandler *) NULL; ! nh.nestedHandlerPtr = nestedHandlerPtr; nestedHandlerPtr = &nh; for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) { --- 4519,4525 ---- */ nh.nextHandlerPtr = (ChannelHandler *) NULL; ! nh.NestedHandlerPtr = nestedHandlerPtr; nestedHandlerPtr = &nh; for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) { *************** *** 4533,4539 **** } Tcl_Release((ClientData)chanPtr); ! nestedHandlerPtr = nh.nestedHandlerPtr; } /* --- 4548,4554 ---- } Tcl_Release((ClientData)chanPtr); ! nestedHandlerPtr = nh.NestedHandlerPtr; } /* *************** *** 4781,4787 **** for (nhPtr = nestedHandlerPtr; nhPtr != (NextChannelHandler *) NULL; ! nhPtr = nhPtr->nestedHandlerPtr) { if (nhPtr->nextHandlerPtr == chPtr) { nhPtr->nextHandlerPtr = chPtr->nextPtr; } --- 4796,4802 ---- for (nhPtr = nestedHandlerPtr; nhPtr != (NextChannelHandler *) NULL; ! nhPtr = nhPtr->NestedHandlerPtr) { if (nhPtr->nextHandlerPtr == chPtr) { nhPtr->nextHandlerPtr = chPtr->nextPtr; } diff -rc tcl8.0/generic/tclIOCmd.c tcl8.0-vxworks/generic/tclIOCmd.c *** tcl8.0/generic/tclIOCmd.c Fri Aug 1 10:48:30 1997 --- tcl8.0-vxworks/generic/tclIOCmd.c Fri Oct 24 09:43:02 1997 *************** *** 782,787 **** --- 782,792 ---- (char *)NULL); return TCL_ERROR; #else /* !MAC_TCL */ + #ifdef VxWorks + Tcl_AppendResult(interp, "exec not implemented under VxWorks", + (char *)NULL); + return TCL_ERROR; + #else /* !VxWorks */ int keepNewline, firstWord, background, length, result; Tcl_Channel chan; Tcl_DString ds; *************** *** 890,895 **** --- 895,901 ---- } return result; + #endif /* !VxWorks */ #endif /* !MAC_TCL */ } *************** *** 1010,1015 **** --- 1016,1027 ---- (char *)NULL); return TCL_ERROR; #else + #ifdef VxWorks + Tcl_AppendResult(interp, + "command pipelines not supported on VxWorks", + (char *)NULL); + return TCL_ERROR; + #else int mode, seekFlag, cmdArgc; char **cmdArgv; *************** *** 1039,1044 **** --- 1051,1057 ---- chan = Tcl_OpenCommandChannel(interp, cmdArgc, cmdArgv, flags); } ckfree((char *) cmdArgv); + #endif /* VxWorks */ #endif } if (chan == (Tcl_Channel) NULL) { diff -rc tcl8.0/generic/tclIOSock.c tcl8.0-vxworks/generic/tclIOSock.c *** tcl8.0/generic/tclIOSock.c Thu Jun 26 10:23:48 1997 --- tcl8.0-vxworks/generic/tclIOSock.c Fri Oct 24 09:43:02 1997 *************** *** 41,46 **** --- 41,47 ---- char *proto; /* "tcp" or "udp", typically */ int *portPtr; /* Return port number */ { + #ifndef VxWorks struct servent *sp; /* Protocol info for named services */ if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) { sp = getservbyname(string, proto); *************** *** 51,56 **** --- 52,58 ---- } return TCL_ERROR; } + #endif /* !VxWorks */ if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) { return TCL_ERROR; } diff -rc tcl8.0/generic/tclIOUtil.c tcl8.0-vxworks/generic/tclIOUtil.c *** tcl8.0/generic/tclIOUtil.c Thu May 15 17:11:10 1997 --- tcl8.0-vxworks/generic/tclIOUtil.c Fri Oct 24 09:43:02 1997 *************** *** 255,260 **** --- 255,267 ---- "\": ", Tcl_PosixError(interp), (char *) NULL); goto error; } + #ifdef VxWorks + if ((unsigned)statBuf.st_size > MAX_EVAL_FILE_SIZE) { + Tcl_AppendResult(interp, "file size is to large for Eval malloc \"", + nativeName, "\"", (char *) NULL); + goto error; + } + #endif /* VxWorks */ cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1); result = Tcl_Read(chan, cmdBuffer, statBuf.st_size); if (result < 0) { diff -rc tcl8.0/generic/tclInt.h tcl8.0-vxworks/generic/tclInt.h *** tcl8.0/generic/tclInt.h Tue Aug 12 17:07:02 1997 --- tcl8.0-vxworks/generic/tclInt.h Fri Oct 24 09:43:02 1997 *************** *** 26,31 **** --- 26,47 ---- * needed by stdlib.h in some configurations. */ + #if defined(VxWorks) + /* make sure the correct varargs stuff is used */ + #include + #include + #if defined(_DIAB_TOOL) + #undef _ARCH_va_start + #define _ARCH_va_start(list,parmN) \ + (\ + ((list[0]).__mem = __va_mem()),\ + ((list[0]).__reg = __va_reg()),\ + ((list[0]).__gpr = __va_gpr()),\ + ((list[0]).__fpr = __va_fpr())\ + ) + #endif /* _DIAB_TOOL */ + #endif /* VxWorks */ + #include #ifndef _TCL *************** *** 1121,1127 **** typedef enum { TCL_PLATFORM_UNIX, /* Any Unix-like OS. */ TCL_PLATFORM_MAC, /* MacOS. */ ! TCL_PLATFORM_WINDOWS /* Any Microsoft Windows OS. */ } TclPlatformType; /* --- 1137,1144 ---- typedef enum { TCL_PLATFORM_UNIX, /* Any Unix-like OS. */ TCL_PLATFORM_MAC, /* MacOS. */ ! TCL_PLATFORM_WINDOWS, /* Any Microsoft Windows OS. */ ! TCL_PLATFORM_VXWORKS /* Any WRS VxWorks OS. */ } TclPlatformType; /* *************** *** 1919,1923 **** --- 1936,1946 ---- Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame)); + #ifdef VxWorks + #ifndef _TCLPORT + #include "tclPort.h" + #endif + #endif /* VxWorks */ + #endif /* _TCLINT */ diff -rc tcl8.0/generic/tclInterp.c tcl8.0-vxworks/generic/tclInterp.c *** tcl8.0/generic/tclInterp.c Wed Aug 6 10:04:02 1997 --- tcl8.0-vxworks/generic/tclInterp.c Fri Oct 24 09:43:03 1997 *************** *** 20,26 **** --- 20,30 ---- * Counter for how many aliases were created (global) */ + #ifdef VxWorks + #define aliasCounter (tclGlob->aliasCounter) + #else static int aliasCounter = 0; + #endif /* VxWorks */ /* * *************** *** 640,646 **** --- 644,654 ---- char localSlaveName[200]; /* Local area for creating names. */ int i; /* Loop counter. */ int len; /* Length of option argument. */ + #ifdef VxWorks + #define interpCounter (tclGlob->interpCounter) + #else static int interpCounter = 0; /* Unique id for created names. */ + #endif /* VxWorks */ moreFlags = 1; slavePath = NULL; diff -rc tcl8.0/generic/tclLoad.c tcl8.0-vxworks/generic/tclLoad.c *** tcl8.0/generic/tclLoad.c Fri Aug 1 10:48:22 1997 --- tcl8.0-vxworks/generic/tclLoad.c Fri Oct 24 09:43:03 1997 *************** *** 48,56 **** --- 48,60 ---- * end of list. */ } LoadedPackage; + #ifdef VxWorks + #define firstPackagePtr ((LoadedPackage *)(tclGlob->firstPackagePtr)) + #else static LoadedPackage *firstPackagePtr = NULL; /* First in list of all packages loaded into * this process. */ + #endif /* VxWorks */ /* * The following structure represents a particular package that has diff -rc tcl8.0/generic/tclMain.c tcl8.0-vxworks/generic/tclMain.c *** tcl8.0/generic/tclMain.c Fri Aug 8 17:02:26 1997 --- tcl8.0-vxworks/generic/tclMain.c Fri Oct 24 10:35:32 1997 *************** *** 15,20 **** --- 15,36 ---- #include "tcl.h" #include "tclInt.h" + #ifdef VxWorks + #ifdef TCL_MEM_DEBUG + #define Tcl_Exit(x) {tclGlob->mainInterp = NULL; \ + Tcl_Finalize(); \ + if (tclMemDumpFileName != NULL) \ + Tcl_DumpActiveMemory(tclMemDumpFileName); \ + return; \ + } + #else + #define Tcl_Exit(x) {tclGlob->mainInterp = NULL; \ + Tcl_Finalize(); \ + return; \ + } + #endif + #endif /* VxWorks */ + /* * The following code ensures that tclLink.c is linked whenever * Tcl is linked. Without this code there's no reference to the *************** *** 37,42 **** --- 53,64 ---- extern int isatty _ANSI_ARGS_((int fd)); extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src)); + #ifdef VxWorks + #ifdef TCL_MEM_DEBUG + #define dumpFile (tclGlob->dumpFile) + #define quitFlag (tclGlob->quitFlag) + #endif + #else static Tcl_Interp *interp; /* Interpreter for application. */ #ifdef TCL_MEM_DEBUG *************** *** 46,51 **** --- 68,74 ---- * so the application should quit and dump * memory allocation information. */ #endif + #endif /* VxWorks */ /* * Forward references for procedures defined later in this file: *************** *** 75,80 **** --- 98,107 ---- *---------------------------------------------------------------------- */ + #ifdef VxWorks + #define interp (tclGlob->mainInterp) + #endif /* VxWorks */ + void Tcl_Main(argc, argv, appInitProc) int argc; /* Number of arguments. */ *************** *** 94,99 **** --- 121,129 ---- int exitCode = 0; Tcl_Channel inChannel, outChannel, errChannel; + #ifdef VxWorks + TclPlatformCreateTask(taskIdSelf()); + #endif /* VxWorks */ Tcl_FindExecutable(argv[0]); interp = Tcl_CreateInterp(); #ifdef TCL_MEM_DEBUG *************** *** 294,302 **** --- 324,340 ---- if (prompt2NamePtr != NULL) { Tcl_DecrRefCount(prompt2NamePtr); } + #ifdef VxWorks + Tcl_DeleteInterp(interp); + Tcl_Exit(0); + #else sprintf(buffer, "exit %d", exitCode); Tcl_Eval(interp, buffer); + #endif /* VxWorks */ } + #ifdef VxWorks + #undef interp + #endif /* VxWorks */ /* *---------------------------------------------------------------------- *************** *** 326,332 **** --- 364,372 ---- int argc; /* Number of arguments. */ char *argv[]; /* String values of arguments. */ { + #ifndef VxWorks extern char *tclMemDumpFileName; + #endif /* !VxWorks */ if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " fileName\"", (char *) NULL); diff -rc tcl8.0/generic/tclNamesp.c tcl8.0-vxworks/generic/tclNamesp.c *** tcl8.0/generic/tclNamesp.c Tue Aug 5 08:48:24 1997 --- tcl8.0-vxworks/generic/tclNamesp.c Fri Oct 24 09:43:03 1997 *************** *** 37,43 **** --- 37,47 ---- * unique id for each namespace. */ + #ifdef VxWorks + #define numNsCreated (tclGlob->numNsCreated) + #else static long numNsCreated = 0; + #endif /* VxWorks */ /* * Data structure used as the ClientData of imported commands: commands *************** *** 162,168 **** --- 166,176 ---- * type has been registered with the Tcl compiler. */ + #ifdef VxWorks + #define nsInitialized (tclGlob->nsInitialized) + #else static int nsInitialized = 0; + #endif /* VxWorks */ /* *---------------------------------------------------------------------- diff -rc tcl8.0/generic/tclNotify.c tcl8.0-vxworks/generic/tclNotify.c *** tcl8.0/generic/tclNotify.c Wed Jun 25 10:39:24 1997 --- tcl8.0-vxworks/generic/tclNotify.c Fri Oct 24 09:43:03 1997 *************** *** 22,28 **** --- 22,32 ---- * The following static indicates whether this module has been initialized. */ + #ifdef VxWorks + #define initialized (tclGlob->notifyInitialized) + #else static int initialized = 0; + #endif /* VxWorks */ /* * For each event source (created with Tcl_CreateEventSource) there diff -rc tcl8.0/generic/tclObj.c tcl8.0-vxworks/generic/tclObj.c *** tcl8.0/generic/tclObj.c Sat Jul 19 15:56:28 1997 --- tcl8.0-vxworks/generic/tclObj.c Fri Oct 24 09:43:03 1997 *************** *** 19,32 **** --- 19,39 ---- * Table of all object types. */ + #ifdef VxWorks + #define typeTable (tclGlob->typeTable) + #define typeTableInitialized (tclGlob->typeTableInitialized) + #else static Tcl_HashTable typeTable; static int typeTableInitialized = 0; /* 0 means not yet initialized. */ + #endif /* VxWorks */ /* * Head of the list of free Tcl_Objs we maintain. */ + #ifndef VxWorks Tcl_Obj *tclFreeObjList = NULL; + #endif /* !VxWorks */ /* * Pointer to a heap-allocated string of length zero that the Tcl core uses *************** *** 34,40 **** --- 41,49 ---- * is shared by all new objects allocated by Tcl_NewObj. */ + #ifndef VxWorks char *tclEmptyStringRep = NULL; + #endif /* !VxWorks */ /* * Count of the number of Tcl objects every allocated (by Tcl_NewObj) and *************** *** 42,49 **** --- 51,60 ---- */ #ifdef TCL_COMPILE_STATS + #ifndef VxWorks long tclObjsAlloced = 0; long tclObjsFreed = 0; + #endif /* !VxWorks */ #endif /* TCL_COMPILE_STATS */ /* diff -rc tcl8.0/generic/tclPort.h tcl8.0-vxworks/generic/tclPort.h *** tcl8.0/generic/tclPort.h Wed Oct 23 09:01:50 1996 --- tcl8.0-vxworks/generic/tclPort.h Fri Oct 24 09:43:03 1997 *************** *** 22,28 **** # if defined(MAC_TCL) # include "tclMacPort.h" # else ! # include "../unix/tclUnixPort.h" # endif #endif --- 22,32 ---- # if defined(MAC_TCL) # include "tclMacPort.h" # else ! # if defined(VxWorks) ! # include "tclVxWorksPort.h" ! # else ! # include "../unix/tclUnixPort.h" ! # endif # endif #endif diff -rc tcl8.0/generic/tclPosixStr.c tcl8.0-vxworks/generic/tclPosixStr.c *** tcl8.0/generic/tclPosixStr.c Wed Oct 23 09:02:04 1996 --- tcl8.0-vxworks/generic/tclPosixStr.c Fri Oct 24 10:36:41 1997 *************** *** 453,458 **** --- 453,463 ---- #ifdef EXFULL case EXFULL: return "EXFULL"; #endif + #ifdef VxWorks + case S_nfsLib_NFSERR_NOENT: return "ENOENT"; + case S_nfsLib_NFSERR_NOTEMPTY: return "EEXIST"; + case S_nfsLib_NFSERR_ISDIR: return "EISDIR"; + #endif /* VxWorks */ } return "unknown error"; } *************** *** 900,905 **** --- 905,915 ---- #ifdef EXFULL case EXFULL: return "message tables full"; #endif + #ifdef VxWorks + case S_nfsLib_NFSERR_NOENT: return "no such file or directory"; + case S_nfsLib_NFSERR_NOTEMPTY: return "file already exists"; + case S_nfsLib_NFSERR_ISDIR: return "illegal operation on a directory"; + #endif /* VxWorks */ default: #ifdef NO_STRERROR return "unknown POSIX error"; diff -rc tcl8.0/generic/tclPreserve.c tcl8.0-vxworks/generic/tclPreserve.c *** tcl8.0/generic/tclPreserve.c Wed Oct 23 09:02:04 1996 --- tcl8.0-vxworks/generic/tclPreserve.c Fri Oct 24 09:43:03 1997 *************** *** 34,44 **** --- 34,51 ---- Tcl_FreeProc *freeProc; /* Procedure to call to free. */ } Reference; + #ifdef VxWorks + #define refArray ((Reference *)(tclGlob->refArray)) + #define spaceAvl (tclGlob->spaceAvl) + #define inUse (tclGlob->inUse) + #else static Reference *refArray; /* First in array of references. */ static int spaceAvl = 0; /* Total number of structures available * at *firstRefPtr. */ static int inUse = 0; /* Count of structures currently in use * in refArray. */ + #endif /* VxWorks */ + #define INITIAL_SIZE 2 /* diff -rc tcl8.0/generic/tclTest.c tcl8.0-vxworks/generic/tclTest.c *** tcl8.0/generic/tclTest.c Wed Aug 13 17:47:14 1997 --- tcl8.0-vxworks/generic/tclTest.c Fri Oct 24 09:43:03 1997 *************** *** 33,40 **** --- 33,45 ---- * to collect the results of the various deletion callbacks. */ + #if defined(VxWorks) + #define delString (tclGlob->delString) + #define delInterp (tclGlob->delInterp) + #else static Tcl_DString delString; static Tcl_Interp *delInterp; + #endif /* VxWorks */ /* * One of the following structures exists for each asynchronous *************** *** 49,55 **** --- 54,64 ---- struct TestAsyncHandler *nextPtr; /* Next is list of handlers. */ } TestAsyncHandler; + #if defined(VxWorks) + #define firstHandler ((TestAsyncHandler *)(tclGlob->firstTestHandler)) + #else static TestAsyncHandler *firstHandler = NULL; + #endif /* VxWorks */ /* * The dynamic string below is used by the "testdstring" command *************** *** 56,62 **** --- 65,75 ---- * to test the dynamic string facilities. */ + #if defined(VxWorks) + #define dstring (tclGlob->testDstring) + #else static Tcl_DString dstring; + #endif /* VxWorks */ /* * One of the following structures exists for each command created *************** *** 332,338 **** --- 345,355 ---- { TestAsyncHandler *asyncPtr, *prevPtr; int id, code; + #if defined(VxWorks) + #define nextId (tclGlob->nextTestAsyncId) + #else static int nextId = 1; + #endif /* VxWorks */ char buf[30]; if (argc < 2) { *************** *** 1314,1320 **** --- 1331,1341 ---- int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { + #if defined(VxWorks) + static char *platformStrings[] = { "unix", "mac", "windows", "vxworks" }; + #else static char *platformStrings[] = { "unix", "mac", "windows" }; + #endif /* VxWorks */ TclPlatformType *platform; #ifdef __WIN32__ *************** *** 1407,1417 **** --- 1428,1446 ---- int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { + #if defined(VxWorks) + #define intVar (tclGlob->intVar) + #define boolVar (tclGlob->boolVar) + #define realVar (tclGlob->realVar) + #define stringVar (tclGlob->stringVar) + #define created (tclGlob->created) + #else static int intVar = 43; static int boolVar = 4; static double realVar = 1.23; static char *stringVar = NULL; static int created = 0; + #endif /* VxWorks */ char buffer[TCL_DOUBLE_SPACE]; int writable, flag; *************** *** 1783,1791 **** *platform = TCL_PLATFORM_MAC; } else if (strncmp(argv[1], "windows", length) == 0) { *platform = TCL_PLATFORM_WINDOWS; } else { Tcl_AppendResult(interp, "unsupported platform: should be one of ", ! "unix, mac, or windows", (char *) NULL); return TCL_ERROR; } return TCL_OK; --- 1812,1822 ---- *platform = TCL_PLATFORM_MAC; } else if (strncmp(argv[1], "windows", length) == 0) { *platform = TCL_PLATFORM_WINDOWS; + } else if (strncmp(argv[1], "vxworks", length) == 0) { + *platform = TCL_PLATFORM_VXWORKS; } else { Tcl_AppendResult(interp, "unsupported platform: should be one of ", ! "unix, mac, windows, or vxworks", (char *) NULL); return TCL_ERROR; } return TCL_OK; *************** *** 2041,2047 **** --- 2072,2082 ---- int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { + #if defined(VxWorks) + #define interp2 (tclGlob->interp2) + #else static Tcl_Interp *interp2 = NULL; + #endif /* VxWorks */ int code; Tcl_Channel chan; *************** *** 2153,2158 **** --- 2188,2194 ---- int argc; /* Number of arguments. */ char **argv; /* Argument strings. */ { + #if !defined(VxWorks) int i, mode; char *rest; *************** *** 2183,2188 **** --- 2219,2229 ---- Tcl_DStringFree(&buffer); } return TCL_OK; + #else + Tcl_AppendResult(interp, argv[0], + " not supported under VxWorks", (char *) NULL); + return TCL_ERROR; + #endif /* !VxWorks */ } static int diff -rc tcl8.0/generic/tclTestObj.c tcl8.0-vxworks/generic/tclTestObj.c *** tcl8.0/generic/tclTestObj.c Tue May 20 16:59:56 1997 --- tcl8.0-vxworks/generic/tclTestObj.c Fri Oct 24 09:43:04 1997 *************** *** 23,29 **** --- 23,33 ---- */ #define NUMBER_OF_OBJECT_VARS 20 + #ifdef VxWorks + #define varPtr (tclGlob->varPtr) + #else static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS]; + #endif /* VxWorks */ /* * Forward declarations for procedures defined later in this file: diff -rc tcl8.0/generic/tclTimer.c tcl8.0-vxworks/generic/tclTimer.c *** tcl8.0/generic/tclTimer.c Fri Aug 1 10:48:46 1997 --- tcl8.0-vxworks/generic/tclTimer.c Fri Oct 24 09:43:04 1997 *************** *** 19,25 **** --- 19,29 ---- * This flag indicates whether this module has been initialized. */ + #ifdef VxWorks + #define initialized (tclGlob->timerInitialized) + #else static int initialized = 0; + #endif /* VxWorks */ /* * For each timer callback that's pending there is one record of the following *************** *** 37,47 **** --- 41,57 ---- * end of queue. */ } TimerHandler; + #ifdef VxWorks + #define firstTimerHandlerPtr ((TimerHandler *)(tclGlob->FirstTimerHandlerPtr)) + #define lastTimerId (tclGlob->lastTimerId) + #define timerPending (tclGlob->timerPending) + #else static TimerHandler *firstTimerHandlerPtr = NULL; /* First event in queue. */ static int lastTimerId; /* Timer identifier of most recently * created timer. */ static int timerPending; /* 1 if a timer event is in the queue. */ + #endif /* VxWorks */ /* * The data structure below is used by the "after" command to remember *************** *** 96,101 **** --- 106,116 ---- struct IdleHandler *nextPtr;/* Next in list of active handlers. */ } IdleHandler; + #ifdef VxWorks + #define idleList ((IdleHandler *)(tclGlob->idleList)) + #define lastIdlePtr ((IdleHandler *)(tclGlob->lastIdlePtr)) + #define idleGeneration (tclGlob->idleGeneration) + #else static IdleHandler *idleList; /* First in list of all idle handlers. */ static IdleHandler *lastIdlePtr; *************** *** 106,111 **** --- 121,127 ---- * idle handlers, so that all old handlers * can be called without calling any of the * new ones created by old ones. */ + #endif /* VxWorks */ /* * Prototypes for procedures referenced only in this file: *************** *** 490,496 **** --- 506,516 ---- currentTimerId = lastTimerId; TclpGetTime(&time); while (1) { + #ifdef VxWorks + nextPtrPtr = (TimerHandler **)&(tclGlob->FirstTimerHandlerPtr); + #else nextPtrPtr = &firstTimerHandlerPtr; + #endif /* VxWorks */ timerHandlerPtr = firstTimerHandlerPtr; if (timerHandlerPtr == NULL) { break; *************** *** 726,732 **** --- 746,756 ---- * any old ids will still be around when wrap-around occurs. */ + #ifdef VxWorks + #define nextId (tclGlob->nextAfterID) + #else static int nextId = 1; + #endif /* VxWorks */ int ms; AfterInfo *afterPtr; AfterAssocData *assocPtr = (AfterAssocData *) clientData; diff -rc tcl8.0/generic/tclUtil.c tcl8.0-vxworks/generic/tclUtil.c *** tcl8.0/generic/tclUtil.c Tue Aug 12 17:07:18 1997 --- tcl8.0-vxworks/generic/tclUtil.c Fri Oct 24 09:43:04 1997 *************** *** 46,51 **** --- 46,55 ---- * NOTE: these variables are not thread-safe. */ + #ifdef VxWorks + #define precisionString (tclGlob->precisionString) + #define precisionFormat (tclGlob->precisionFormat) + #else static char precisionString[10] = "12"; /* The string value of all the tcl_precision * variables. */ *************** *** 52,57 **** --- 56,62 ---- static char precisionFormat[10] = "%.12g"; /* The format string actually used in calls * to sprintf. */ + #endif /* VxWorks */ /* Common subdirectories: tcl8.0/library/http1.0 and tcl8.0-vxworks/library/http1.0 Common subdirectories: tcl8.0/library/http2.0 and tcl8.0-vxworks/library/http2.0 Common subdirectories: tcl8.0/library/opt0.1 and tcl8.0-vxworks/library/opt0.1 Common subdirectories: tcl8.0/unix/dltest and tcl8.0-vxworks/unix/dltest diff -rc tcl8.0/unix/tclUnixNotfy.c tcl8.0-vxworks/unix/tclUnixNotfy.c *** tcl8.0/unix/tclUnixNotfy.c Sat Jul 19 15:57:40 1997 --- tcl8.0-vxworks/unix/tclUnixNotfy.c Fri Oct 24 09:43:15 1997 *************** *** 23,28 **** --- 23,34 ---- * a registered file. */ + #ifdef VxWorks + /* + see tclVxWorksPort.h - this structure is duplicated there because + it has to be (indirectly) embedded in tclGlob. + */ + #else typedef struct FileHandler { int fd; int mask; /* Mask of desired events: TCL_READABLE, *************** *** 35,40 **** --- 41,47 ---- ClientData clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; + #endif /* VxWorks */ /* * The following structure is what is added to the Tcl event queue when *************** *** 56,61 **** --- 63,77 ---- * select based implementation of the Tcl notifier. */ + #ifdef VxWorks + + /* + see tclVxWorksPort.h - this structure is duplicated there because + it has to be embedded in tclGlob. too bad it wasn't malloc'd instead. + */ + + #define notifier (tclGlob->notifier) + #else static struct { FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler list. */ *************** *** 72,83 **** --- 88,104 ---- * (one more than highest fd for which * Tcl_WatchFile has been called). */ } notifier; + #endif /* VxWorks */ /* * The following static indicates whether this module has been initialized. */ + #ifdef VxWorks + #define initialized (tclGlob->unixNotifyInitialized) + #else static int initialized = 0; + #endif /* VxWorks */ /* * Static routines defined in this file. diff -rc tcl8.0/vxworks/Makefile tcl8.0-vxworks/vxworks/Makefile *** tcl8.0/vxworks/Makefile Fri Oct 24 10:24:19 1997 --- tcl8.0-vxworks/vxworks/Makefile Fri Oct 24 11:46:49 1997 *************** *** 0 **** --- 1,99 ---- + # Makefile - makefile for Tcl 8.0 + + CPU = PPC860 + TOOL = gnu + BOARD = gamma + + TGT_DIR = /usr/wind/target + + include $(TGT_DIR)/h/make/defs.bsp + include $(TGT_DIR)/h/make/make.$(CPU)$(TOOL) + include $(TGT_DIR)/h/make/defs.$(WIND_HOST_TYPE) + + ## Only redefine make definitions below this point, or your definitions will + ## be overwritten by the makefile stubs above. + + CC = /usr/wind/host/sun4-solaris2/bin/ccppc + LD = /usr/wind/host/sun4-solaris2/bin/ldppc + + # location of source + vpath %.c ../unix:../generic:../unix/dltest:../compat + + # target object file + OBJNAME = tcl.o + + VXWORKSOBJS = tclVxWorksChan.o tclVxWorksAlloc.o \ + tclVxWorksFile.o tclVxWorksInit.o \ + tclVxWorksSock.o \ + tclVxWorksDate.o tclVxWorksLoad.o \ + tclVxWorksFCmd.o setenv.o + + UNIXOBJS = tclUnixTime.o tclUnixNotfy.o tclUnixEvent.o + + GENERICOBJS = tclIO.o regexp.o tclIOCmd.o tclIOUtil.o \ + tclAsync.o tclIOSock.o tclBasic.o tclBinary.o \ + tclCkalloc.o tclInterp.o tclClock.o tclLink.o \ + tclCmdAH.o tclLoad.o tclCmdIL.o \ + tclCmdMZ.o tclNotify.o tclFCmd.o \ + tclParse.o tclEvent.o tclPkg.o \ + tclPosixStr.o tclPreserve.o tclAlloc.o \ + tclFileName.o tclProc.o tclGet.o tclEnv.o \ + tclHash.o tclUtil.o tclHistory.o tclVar.o \ + tclCompExpr.o tclCompile.o tclExecute.o \ + tclIndexObj.o tclListObj.o tclObj.o tclStringObj.o \ + tclNamesp.o tclTimer.o \ + tclTest.o tclTestObj.o tclVxWorksTest.o \ + access.o geteuid.o hypot.o + + COMPATOBJS = strncasecmp.o strtod.o + + OBJS = ${GENERICOBJS} ${UNIXOBJS} ${VXWORKSOBJS} ${COMPATOBJS} + + # additional compiler flags + ADDED_CFLAGS = -g -fdollars-in-identifiers \ + -B/usr/wind/host/sun4-solaris2/lib/gcc-lib/ + + # additional linker flags + LD_PARTIAL_FLAGS += + + # link libraries + LIB_EXTRA = + + # extra includes + EXTRA_INCLUDE = -I../generic + + # extra defines + EXTRA_DEFINE = -DVxWorks + + default: $(OBJNAME) dltest.o + + $(OBJNAME): $(OBJS) + $(LD) -M $(LD_PARTIAL_FLAGS) -o $@ $(OBJS) + + dltest.o: pkga.o pkgb.o pkgc.o pkgd.o pkge.o pkgf.o + $(LD) $(LD_PARTIAL_FLAGS) -o $@ \ + pkga.o pkgb.o pkgc.o pkgd.o pkge.o pkgf.o + + MISCOBJS = tclMain.o \ + pkga.o pkgb.o pkgc.o pkgd.o pkge.o pkgf.o + + exe: + + install: + + clean: + $(RM) *.o *.a + $(RM) *.d + + ## Only redefine make definitions above this point, or the expansion of + ## makefile target dependencies may be incorrect. + + # generate dependencies + GCC = gcc -nostdinc + %.d: %.c + $(SHELL) -ec '$(GCC) -MM $(CC_INCLUDE) $(CC_DEFINES) $< | \ + sed '\''s?$*.o?& $@?'\'' > $@' + + include $(OBJS:.o=.d) + include $(MISCOBJS:.o=.d) + diff -rc tcl8.0/vxworks/access.c tcl8.0-vxworks/vxworks/access.c *** tcl8.0/vxworks/access.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/access.c Fri Oct 24 10:54:33 1997 *************** *** 0 **** --- 1,51 ---- + /* + * access - determine file accessability. + * + */ + + #include + #include + + #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 + + int access(char *fileName, int mode) + { + int cmdResult=0; + struct stat statBuf; + + if (stat(fileName, &statBuf) == 0) { + switch(mode) { + case R_OK: + /* 1 if *all* the read bits are on! */ + cmdResult = (statBuf.st_mode & (S_IRUSR|S_IRGRP|S_IROTH)) == + (S_IRUSR|S_IRGRP|S_IROTH); + break; + case W_OK: + /* 1 if *all* the write bits are on! */ + cmdResult = (statBuf.st_mode & (S_IWUSR|S_IWGRP|S_IWOTH)) == + (S_IWUSR|S_IWGRP|S_IWOTH); + break; + case X_OK: + /* 1 if *all* the execute bits are on! */ + cmdResult = (statBuf.st_mode & (S_IXUSR|S_IXGRP|S_IXOTH)) == + (S_IXUSR|S_IXGRP|S_IXOTH); + break; + case F_OK: + /* Didn't error out, so I guess it exists */ + cmdResult = 1; + break; + } + } + return (cmdResult == 0 ? -1 : 0); + } diff -rc tcl8.0/vxworks/geteuid.c tcl8.0-vxworks/vxworks/geteuid.c *** tcl8.0/vxworks/geteuid.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/geteuid.c Fri Oct 24 10:05:27 1997 *************** *** 0 **** --- 1,15 ---- + #include + #include + + int + geteuid(void) + { + char machineName[80]; + int uid; + int gid; + int nGids; + int gids[10]; + + nfsAuthUnixGet(machineName,&uid,&gid,&nGids,gids); + return uid; + } diff -rc tcl8.0/vxworks/hypot.c tcl8.0-vxworks/vxworks/hypot.c *** tcl8.0/vxworks/hypot.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/hypot.c Fri Oct 24 10:38:54 1997 *************** *** 0 **** --- 1,10 ---- + #include + + double + hypot(double x,double y) + { + double sum; + + sum = x*x + y*y; + return sqrt(sum); + } diff -rc tcl8.0/vxworks/setenv.c tcl8.0-vxworks/vxworks/setenv.c *** tcl8.0/vxworks/setenv.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/setenv.c Fri Oct 24 09:43:16 1997 *************** *** 0 **** --- 1,16 ---- + #include + #include + #include + + /* + * + * + */ + int + setenv(const char *name,const char *value) + { + char buffer[256]; + + sprintf(buffer,"%s=%s",name,(value == NULL) ? "" : value); + return putenv(buffer); + } diff -rc tcl8.0/vxworks/tclVxWorksAlloc.c tcl8.0-vxworks/vxworks/tclVxWorksAlloc.c *** tcl8.0/vxworks/tclVxWorksAlloc.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksAlloc.c Fri Oct 24 09:43:16 1997 *************** *** 0 **** --- 1,78 ---- + #include "tclPort.h" + #include + + #define systemMemory (tclGlob->systemMemory) + + typedef struct memnode { + NODE n; + void *memPtr; + } MEMNODE; + + void + cleanupSystemMemory() + { + MEMNODE *memoryRecord; + + while ((memoryRecord = (MEMNODE *)lstGet(&systemMemory)) != NULL) { + lstDelete(&systemMemory,(NODE *)memoryRecord); + free(memoryRecord->memPtr); free(memoryRecord); + } + } + + static void + addMemRecord(void *ptr) + { + MEMNODE *newMemoryRecord; + + newMemoryRecord = (MEMNODE *) calloc(sizeof(MEMNODE),1); + newMemoryRecord->memPtr = ptr; + lstAdd(&systemMemory,(NODE *)newMemoryRecord); + } + + static void + removeMemRecord(void *ptr) + { + MEMNODE *memoryRecord; + + memoryRecord = (MEMNODE *)lstFirst(&systemMemory); + while (memoryRecord != NULL) { + if (memoryRecord->memPtr == ptr) { + lstDelete(&systemMemory,(NODE *)memoryRecord); + free(memoryRecord); free(ptr); + return; + } + memoryRecord = (MEMNODE *)lstNext((NODE *)memoryRecord); + } + return; + } + + void * + TclpSysRealloc(void *oldPtr,unsigned int size) + { + void *newPtr = NULL; + + newPtr = realloc(oldPtr,size); + if (newPtr == NULL) return newPtr; + if (newPtr != oldPtr) { + removeMemRecord(oldPtr); + addMemRecord(newPtr); + } + return newPtr; + } + + void * + TclpSysAlloc(long size,int isBin) + { + void *newPtr = NULL; + + newPtr = malloc(size); + if (newPtr != NULL) addMemRecord(newPtr); + return newPtr; + } + + void + TclpSysFree(void *ptr) + { + /*free(ptr); removeMemRecord() does this for us */ + removeMemRecord(ptr); + } diff -rc tcl8.0/vxworks/tclVxWorksChan.c tcl8.0-vxworks/vxworks/tclVxWorksChan.c *** tcl8.0/vxworks/tclVxWorksChan.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksChan.c Fri Oct 24 10:07:38 1997 *************** *** 0 **** --- 1,2464 ---- + /* + * tclVxWorksChan.c + * + * Common channel driver for VxWorks channels based on files + * 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. + * + * based on: + * SCCS: @(#) tclUnixChan.c 1.203 97/06/20 13:03:18 + */ + + #include "tclInt.h" /* Internal definitions for Tcl. */ + #include "tclPort.h" /* Portability features for Tcl. */ + + /* + * 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; + + /* + * 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)); + #if defined(INCLUDE_TTYCHAN) + 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)); + #endif /* INCLUDE_TTYCHAN */ + static int WaitForConnect _ANSI_ARGS_((TcpState *statePtr, + int *errorCodePtr)); + + int TclVxWorksWaitForFile _ANSI_ARGS_((int fd,int mask,int timeout)); + + /* + * 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. */ + }; + + #if defined(INCLUDE_TTYCHAN) + /* + * 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. */ + }; + #endif /* INCLUDE_TTYCHAN */ + + /* + * 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; + + if (mode == TCL_MODE_BLOCKING) { + curStatus = 0; + } else { + curStatus = 1; + } + if (ioctl(fsPtr->fd, (int) FIONBIO, (int) &curStatus) < 0) { + return errno; + } + 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); + (void)ioctl(fsPtr->fd,FIOSYNC,0); + 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 ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2)) { + if (close(fsPtr->fd) < 0) { + errorCode = errno; + } + } + for (nextPtrPtr = (FileState **)&tclGlob->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; + } + } + #if defined(INCLUDE_TTYCHAN) + + /* + *---------------------------------------------------------------------- + * + * 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; + } + #endif /* INCLUDE_TTYCHAN */ + + /* + *---------------------------------------------------------------------- + * + * Tcl_OpenFileChannel -- + * + * Open an file based channel on VxWorks 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 = NULL; + + 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; + } + + sprintf(channelName, "file%d", fd); + + fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState)); + fsPtr->nextPtr = (FileState *)tclGlob->firstFilePtr; + (FileState *)tclGlob->firstFilePtr = fsPtr; + fsPtr->validMask = channelPermissions | TCL_EXCEPTION; + fsPtr->fd = fd; + + #if defined(INCLUDE_TTYCHAN) + 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; + } + #else + channelTypePtr = &fileChannelType; + #endif /* INCLUDE_TTYCHAN */ + + 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 defined(INCLUDE_TTYCHAN) + 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; + } + } + #endif /* INCLUDE_TTYCHAN */ + + 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 = (FileState *)tclGlob->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 = (FileState *)tclGlob->firstFilePtr; + (FileState *)tclGlob->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; + + if (mode == TCL_MODE_BLOCKING) { + statePtr->flags &= (~(TCP_ASYNC_SOCKET)); + setting = 0; + if (ioctl(statePtr->fd, (int) FIONBIO, (int) &setting) == -1) { + return errno; + } + } else { + statePtr->flags |= TCP_ASYNC_SOCKET; + setting = 1; + if (ioctl(statePtr->fd, (int) FIONBIO, (int) &setting) == -1) { + return errno; + } + } + + 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 = TclVxWorksWaitForFile(statePtr->fd, + TCL_WRITABLE | TCL_EXCEPTION, timeOut); + if (!(statePtr->flags & TCP_ASYNC_SOCKET)) { + flags = 0; + (void) ioctl(statePtr->fd, FIONBIO, (int) &flags); + } + 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; + 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)); + if (hostGetByAddr(peername.sin_addr.s_addr,buf) != -1) { + Tcl_DStringAppendElement(dsPtr, buf); + } 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)); + if (hostGetByAddr(peername.sin_addr.s_addr,buf) != -1) { + Tcl_DStringAppendElement(dsPtr, buf); + } else { + Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.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 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) { + curState = 1; + status = ioctl(sock, FIONBIO, (int) &curState); + } 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 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) { + int h_addr; + h_addr = hostGetByName(host); + if (h_addr != ERROR) { + memcpy((char *) &addr, (char *) &h_addr, sizeof(h_addr)); + } 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; + } + + 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; + 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 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)) { + if (Tcl_GetChannelHandle(chan, + (forWriting ? TCL_WRITABLE : TCL_READABLE), (ClientData*) &fd) + == TCL_OK) { + + /* + * 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; + } + + /* + *---------------------------------------------------------------------- + * + * TclVxWorksWaitForFile -- + * + * 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 + TclVxWorksWaitForFile(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; + #define readyMasks (tclGlob->readyMasks) + /* 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 -rc tcl8.0/vxworks/tclVxWorksDate.c tcl8.0-vxworks/vxworks/tclVxWorksDate.c *** tcl8.0/vxworks/tclVxWorksDate.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksDate.c Fri Oct 24 09:43:16 1997 *************** *** 0 **** --- 1,1653 ---- + /* + * tclVxWorksDate.c -- + * + * This file is generated from a yacc grammar defined in + * the file tclGetDate.y and modified heavily for VxWorks. + * Be sure to keep them in sync. + * + * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans. + * 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. + * + * based on: + * @(#) tclDate.c 1.32 97/02/03 14:54:37 + */ + + #include "tclInt.h" + #include "tclPort.h" + + #define EPOCH 1970 + #define START_OF_TIME 1902 + #define END_OF_TIME 2037 + + /* + * The offset of tm_year of struct tm returned by localtime, gmtime, etc. + * I don't know how universal this is; K&R II, the NetBSD manpages, and + * ../compat/strftime.c all agree that tm_year is the year-1900. However, + * some systems may have a different value. This #define should be the + * same as in ../compat/strftime.c. + */ + #define TM_YEAR_BASE 1900 + + #define HOUR(x) ((int) (60 * x)) + #define SECSPERDAY (24L * 60L * 60L) + + + #if 0 + /* these are defined in tclVxWorksPort.h */ + /* + * An entry in the lexical lookup table. + */ + typedef struct _TABLE { + char *name; + int type; + time_t value; + } TABLE; + + + /* + * Daylight-savings mode: on, off, or not yet known. + */ + typedef enum _DSTMODE { + DSTon, DSToff, DSTmaybe + } DSTMODE; + + /* + * Meridian: am, pm, or 24-hour style. + */ + typedef enum _MERIDIAN { + MERam, MERpm, MER24 + } MERIDIAN; + #endif + + + /* + * Global variables. We could get rid of most of these by using a good + * union as the yacc stack. (This routine was originally written before + * yacc had the %union construct.) Maybe someday; right now we only use + * the %union very rarely. + */ + #define TclDateInput (tclGlob->TclDateInput) + #define TclDateDSTmode (tclGlob->TclDateDSTmode) + #define TclDateDayOrdinal (tclGlob->TclDateDayOrdinal) + #define TclDateDayNumber (tclGlob->TclDateDayNumber) + #define TclDateHaveDate (tclGlob->TclDateHaveDate) + #define TclDateHaveDay (tclGlob->TclDateHaveDay) + #define TclDateHaveRel (tclGlob->TclDateHaveRel) + #define TclDateHaveTime (tclGlob->TclDateHaveTime) + #define TclDateHaveZone (tclGlob->TclDateHaveZone) + #define TclDateTimezone (tclGlob->TclDateTimezone) + #define TclDateDay (tclGlob->TclDateDay) + #define TclDateHour (tclGlob->TclDateHour) + #define TclDateMinutes (tclGlob->TclDateMinutes) + #define TclDateMonth (tclGlob->TclDateMonth) + #define TclDateSeconds (tclGlob->TclDateSeconds) + #define TclDateYear (tclGlob->TclDateYear) + #define TclDateMeridian (tclGlob->TclDateMeridian) + #define TclDateRelMonth (tclGlob->TclDateRelMonth) + #define TclDateRelSeconds (tclGlob->TclDateRelSeconds) + + /* + * Prototypes of internal functions. + */ + static void TclDateerror _ANSI_ARGS_((char *s)); + static time_t ToSeconds _ANSI_ARGS_((time_t Hours, time_t Minutes, + time_t Seconds, MERIDIAN Meridian)); + static int Convert _ANSI_ARGS_((time_t Month, time_t Day, time_t Year, + time_t Hours, time_t Minutes, time_t Seconds, + MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr)); + static time_t DSTcorrect _ANSI_ARGS_((time_t Start, time_t Future)); + static time_t RelativeDate _ANSI_ARGS_((time_t Start, time_t DayOrdinal, + time_t DayNumber)); + static int RelativeMonth _ANSI_ARGS_((time_t Start, time_t RelMonth, + time_t *TimePtr)); + static int LookupWord _ANSI_ARGS_((char *buff)); + static int TclDatelex _ANSI_ARGS_((void)); + + int + TclDateparse _ANSI_ARGS_((void)); + #if 0 + /* these are defined in tclVxWorksPort.h */ + typedef union + #ifdef __cplusplus + YYSTYPE + #endif + { + time_t Number; + enum _MERIDIAN Meridian; + } YYSTYPE; + #endif + # define tAGO 257 + # define tDAY 258 + # define tDAYZONE 259 + # define tID 260 + # define tMERIDIAN 261 + # define tMINUTE_UNIT 262 + # define tMONTH 263 + # define tMONTH_UNIT 264 + # define tSEC_UNIT 265 + # define tSNUMBER 266 + # define tUNUMBER 267 + # define tZONE 268 + # define tEPOCH 269 + # define tDST 270 + + + + #ifdef __cplusplus + + #ifndef TclDateerror + void TclDateerror(const char *); + #endif + + #ifndef TclDatelex + #ifdef __EXTERN_C__ + extern "C" { int TclDatelex(void); } + #else + int TclDatelex(void); + #endif + #endif + int TclDateparse(void); + + #endif + #define TclDateclearin TclDatechar = -1 + #define TclDateerrok TclDateerrflag = 0 + #define TclDatelval (tclGlob->TclDatelval) + #define TclDateval (tclGlob->TclDateval) + typedef int TclDatetabelem; + #ifndef YYMAXDEPTH + #define YYMAXDEPTH 150 + #endif + #if YYMAXDEPTH > 0 + #define TclDate_TclDates (tclGlob->TclDate_TclDates) + #define TclDates (tclGlob->TclDates) + #define TclDate_TclDatev (tclGlob->TclDate_TclDatev) + #define TclDatev (tclGlob->TclDatev) + #else /* user does initial allocation */ + #define TclDates (tclGlob->TclDates) + #define TclDatev (tclGlob->TclDatev) + #endif + #define TclDatemaxdepth (tclGlob->TclDatemaxdepth) + # define YYERRCODE 256 + + + /* + * Month and day table. + */ + static TABLE MonthDayTable[] = { + { "january", tMONTH, 1 }, + { "february", tMONTH, 2 }, + { "march", tMONTH, 3 }, + { "april", tMONTH, 4 }, + { "may", tMONTH, 5 }, + { "june", tMONTH, 6 }, + { "july", tMONTH, 7 }, + { "august", tMONTH, 8 }, + { "september", tMONTH, 9 }, + { "sept", tMONTH, 9 }, + { "october", tMONTH, 10 }, + { "november", tMONTH, 11 }, + { "december", tMONTH, 12 }, + { "sunday", tDAY, 0 }, + { "monday", tDAY, 1 }, + { "tuesday", tDAY, 2 }, + { "tues", tDAY, 2 }, + { "wednesday", tDAY, 3 }, + { "wednes", tDAY, 3 }, + { "thursday", tDAY, 4 }, + { "thur", tDAY, 4 }, + { "thurs", tDAY, 4 }, + { "friday", tDAY, 5 }, + { "saturday", tDAY, 6 }, + { NULL } + }; + + /* + * Time units table. + */ + static TABLE UnitsTable[] = { + { "year", tMONTH_UNIT, 12 }, + { "month", tMONTH_UNIT, 1 }, + { "fortnight", tMINUTE_UNIT, 14 * 24 * 60 }, + { "week", tMINUTE_UNIT, 7 * 24 * 60 }, + { "day", tMINUTE_UNIT, 1 * 24 * 60 }, + { "hour", tMINUTE_UNIT, 60 }, + { "minute", tMINUTE_UNIT, 1 }, + { "min", tMINUTE_UNIT, 1 }, + { "second", tSEC_UNIT, 1 }, + { "sec", tSEC_UNIT, 1 }, + { NULL } + }; + + /* + * Assorted relative-time words. + */ + static TABLE OtherTable[] = { + { "tomorrow", tMINUTE_UNIT, 1 * 24 * 60 }, + { "yesterday", tMINUTE_UNIT, -1 * 24 * 60 }, + { "today", tMINUTE_UNIT, 0 }, + { "now", tMINUTE_UNIT, 0 }, + { "last", tUNUMBER, -1 }, + { "this", tMINUTE_UNIT, 0 }, + { "next", tUNUMBER, 2 }, + #if 0 + { "first", tUNUMBER, 1 }, + /* { "second", tUNUMBER, 2 }, */ + { "third", tUNUMBER, 3 }, + { "fourth", tUNUMBER, 4 }, + { "fifth", tUNUMBER, 5 }, + { "sixth", tUNUMBER, 6 }, + { "seventh", tUNUMBER, 7 }, + { "eighth", tUNUMBER, 8 }, + { "ninth", tUNUMBER, 9 }, + { "tenth", tUNUMBER, 10 }, + { "eleventh", tUNUMBER, 11 }, + { "twelfth", tUNUMBER, 12 }, + #endif + { "ago", tAGO, 1 }, + { "epoch", tEPOCH, 0 }, + { NULL } + }; + + /* + * The timezone table. (Note: This table was modified to not use any floating + * point constants to work around an SGI compiler bug). + */ + static TABLE TimezoneTable[] = { + { "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */ + { "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */ + { "utc", tZONE, HOUR( 0) }, + { "wet", tZONE, HOUR( 0) } , /* Western European */ + { "bst", tDAYZONE, HOUR( 0) }, /* British Summer */ + { "wat", tZONE, HOUR( 1) }, /* West Africa */ + { "at", tZONE, HOUR( 2) }, /* Azores */ + #if 0 + /* For completeness. BST is also British Summer, and GST is + * also Guam Standard. */ + { "bst", tZONE, HOUR( 3) }, /* Brazil Standard */ + { "gst", tZONE, HOUR( 3) }, /* Greenland Standard */ + #endif + { "nft", tZONE, HOUR( 7/2) }, /* Newfoundland */ + { "nst", tZONE, HOUR( 7/2) }, /* Newfoundland Standard */ + { "ndt", tDAYZONE, HOUR( 7/2) }, /* Newfoundland Daylight */ + { "ast", tZONE, HOUR( 4) }, /* Atlantic Standard */ + { "adt", tDAYZONE, HOUR( 4) }, /* Atlantic Daylight */ + { "est", tZONE, HOUR( 5) }, /* Eastern Standard */ + { "edt", tDAYZONE, HOUR( 5) }, /* Eastern Daylight */ + { "cst", tZONE, HOUR( 6) }, /* Central Standard */ + { "cdt", tDAYZONE, HOUR( 6) }, /* Central Daylight */ + { "mst", tZONE, HOUR( 7) }, /* Mountain Standard */ + { "mdt", tDAYZONE, HOUR( 7) }, /* Mountain Daylight */ + { "pst", tZONE, HOUR( 8) }, /* Pacific Standard */ + { "pdt", tDAYZONE, HOUR( 8) }, /* Pacific Daylight */ + { "yst", tZONE, HOUR( 9) }, /* Yukon Standard */ + { "ydt", tDAYZONE, HOUR( 9) }, /* Yukon Daylight */ + { "hst", tZONE, HOUR(10) }, /* Hawaii Standard */ + { "hdt", tDAYZONE, HOUR(10) }, /* Hawaii Daylight */ + { "cat", tZONE, HOUR(10) }, /* Central Alaska */ + { "ahst", tZONE, HOUR(10) }, /* Alaska-Hawaii Standard */ + { "nt", tZONE, HOUR(11) }, /* Nome */ + { "idlw", tZONE, HOUR(12) }, /* International Date Line West */ + { "cet", tZONE, -HOUR( 1) }, /* Central European */ + { "met", tZONE, -HOUR( 1) }, /* Middle European */ + { "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */ + { "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */ + { "swt", tZONE, -HOUR( 1) }, /* Swedish Winter */ + { "sst", tDAYZONE, -HOUR( 1) }, /* Swedish Summer */ + { "fwt", tZONE, -HOUR( 1) }, /* French Winter */ + { "fst", tDAYZONE, -HOUR( 1) }, /* French Summer */ + { "eet", tZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 */ + { "bt", tZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 */ + { "it", tZONE, -HOUR( 7/2) }, /* Iran */ + { "zp4", tZONE, -HOUR( 4) }, /* USSR Zone 3 */ + { "zp5", tZONE, -HOUR( 5) }, /* USSR Zone 4 */ + { "ist", tZONE, -HOUR(11/2) }, /* Indian Standard */ + { "zp6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */ + #if 0 + /* For completeness. NST is also Newfoundland Stanard, nad SST is + * also Swedish Summer. */ + { "nst", tZONE, -HOUR(13/2) }, /* North Sumatra */ + { "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */ + #endif /* 0 */ + { "wast", tZONE, -HOUR( 7) }, /* West Australian Standard */ + { "wadt", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */ + { "jt", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */ + { "cct", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */ + { "jst", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */ + { "cast", tZONE, -HOUR(19/2) }, /* Central Australian Standard */ + { "cadt", tDAYZONE, -HOUR(19/2) }, /* Central Australian Daylight */ + { "east", tZONE, -HOUR(10) }, /* Eastern Australian Standard */ + { "eadt", tDAYZONE, -HOUR(10) }, /* Eastern Australian Daylight */ + { "gst", tZONE, -HOUR(10) }, /* Guam Standard, USSR Zone 9 */ + { "nzt", tZONE, -HOUR(12) }, /* New Zealand */ + { "nzst", tZONE, -HOUR(12) }, /* New Zealand Standard */ + { "nzdt", tDAYZONE, -HOUR(12) }, /* New Zealand Daylight */ + { "idle", tZONE, -HOUR(12) }, /* International Date Line East */ + /* ADDED BY Marco Nijdam */ + { "dst", tDST, HOUR( 0) }, /* DST on (hour is ignored) */ + /* End ADDED */ + { NULL } + }; + + /* + * Military timezone table. + */ + static TABLE MilitaryTable[] = { + { "a", tZONE, HOUR( 1) }, + { "b", tZONE, HOUR( 2) }, + { "c", tZONE, HOUR( 3) }, + { "d", tZONE, HOUR( 4) }, + { "e", tZONE, HOUR( 5) }, + { "f", tZONE, HOUR( 6) }, + { "g", tZONE, HOUR( 7) }, + { "h", tZONE, HOUR( 8) }, + { "i", tZONE, HOUR( 9) }, + { "k", tZONE, HOUR( 10) }, + { "l", tZONE, HOUR( 11) }, + { "m", tZONE, HOUR( 12) }, + { "n", tZONE, HOUR(- 1) }, + { "o", tZONE, HOUR(- 2) }, + { "p", tZONE, HOUR(- 3) }, + { "q", tZONE, HOUR(- 4) }, + { "r", tZONE, HOUR(- 5) }, + { "s", tZONE, HOUR(- 6) }, + { "t", tZONE, HOUR(- 7) }, + { "u", tZONE, HOUR(- 8) }, + { "v", tZONE, HOUR(- 9) }, + { "w", tZONE, HOUR(-10) }, + { "x", tZONE, HOUR(-11) }, + { "y", tZONE, HOUR(-12) }, + { "z", tZONE, HOUR( 0) }, + { NULL } + }; + + + /* + * Dump error messages in the bit bucket. + */ + static void + TclDateerror(s) + char *s; + { + } + + + static time_t + ToSeconds(Hours, Minutes, Seconds, Meridian) + time_t Hours; + time_t Minutes; + time_t Seconds; + MERIDIAN Meridian; + { + if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) + return -1; + switch (Meridian) { + case MER24: + if (Hours < 0 || Hours > 23) + return -1; + return (Hours * 60L + Minutes) * 60L + Seconds; + case MERam: + if (Hours < 1 || Hours > 12) + return -1; + return ((Hours % 12) * 60L + Minutes) * 60L + Seconds; + case MERpm: + if (Hours < 1 || Hours > 12) + return -1; + return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds; + } + return -1; /* Should never be reached */ + } + + + static int + Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr) + time_t Month; + time_t Day; + time_t Year; + time_t Hours; + time_t Minutes; + time_t Seconds; + MERIDIAN Meridian; + DSTMODE DSTmode; + time_t *TimePtr; + { + static int DaysInMonth[12] = { + 31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 + }; + time_t tod; + time_t Julian; + int i; + struct tm buf; + + DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0) + ? 29 : 28; + if (Month < 1 || Month > 12 + || Year < START_OF_TIME || Year > END_OF_TIME + || Day < 1 || Day > DaysInMonth[(int)--Month]) + return -1; + + for (Julian = Day - 1, i = 0; i < Month; i++) + Julian += DaysInMonth[i]; + if (Year >= EPOCH) { + for (i = EPOCH; i < Year; i++) + Julian += 365 + (i % 4 == 0); + } else { + for (i = Year; i < EPOCH; i++) + Julian -= 365 + (i % 4 == 0); + } + Julian *= SECSPERDAY; + Julian += TclDateTimezone * 60L; + if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0) + return -1; + Julian += tod; + localtime_r(&Julian,&buf); + if (DSTmode == DSTon + || (DSTmode == DSTmaybe && buf.tm_isdst)) + Julian -= 60 * 60; + *TimePtr = Julian; + return 0; + } + + + static time_t + DSTcorrect(Start, Future) + time_t Start; + time_t Future; + { + time_t StartDay; + time_t FutureDay; + struct tm start,future; + + localtime_r(&Start,&start); + localtime_r(&Future,&future); + StartDay = (start.tm_hour + 1) % 24; + FutureDay = (future.tm_hour + 1) % 24; + return (Future - Start) + (StartDay - FutureDay) * 60L * 60L; + } + + + static time_t + RelativeDate(Start, DayOrdinal, DayNumber) + time_t Start; + time_t DayOrdinal; + time_t DayNumber; + { + struct tm *tm,buf; + time_t now; + + now = Start; + localtime_r(&now,&buf); + tm = &buf; + now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7); + now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1); + return DSTcorrect(Start, now); + } + + + static int + RelativeMonth(Start, RelMonth, TimePtr) + time_t Start; + time_t RelMonth; + time_t *TimePtr; + { + struct tm *tm,buf; + time_t Month; + time_t Year; + time_t Julian; + int result; + + if (RelMonth == 0) { + *TimePtr = 0; + return 0; + } + localtime_r(&Start,&buf); + tm = &buf; + Month = 12 * (tm->tm_year + TM_YEAR_BASE) + tm->tm_mon + RelMonth; + Year = Month / 12; + Month = Month % 12 + 1; + result = Convert(Month, (time_t) tm->tm_mday, Year, + (time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec, + MER24, DSTmaybe, &Julian); + /* + * The following iteration takes into account the case were we jump + * into a "short month". Far example, "one month from Jan 31" will + * fail because there is no Feb 31. The code below will reduce the + * day and try converting the date until we succed or the date equals + * 28 (which always works unless the date is bad in another way). + */ + + while ((result != 0) && (tm->tm_mday > 28)) { + tm->tm_mday--; + result = Convert(Month, (time_t) tm->tm_mday, Year, + (time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec, + MER24, DSTmaybe, &Julian); + } + if (result != 0) { + return -1; + } + *TimePtr = DSTcorrect(Start, Julian); + return 0; + } + + + static int + LookupWord(buff) + char *buff; + { + register char *p; + register char *q; + register TABLE *tp; + int i; + int abbrev; + + /* + * Make it lowercase. + */ + for (p = buff; *p; p++) { + if (isupper(UCHAR(*p))) { + *p = (char) tolower(UCHAR(*p)); + } + } + + if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) { + TclDatelval.Meridian = MERam; + return tMERIDIAN; + } + if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) { + TclDatelval.Meridian = MERpm; + return tMERIDIAN; + } + + /* + * See if we have an abbreviation for a month. + */ + if (strlen(buff) == 3) { + abbrev = 1; + } else if (strlen(buff) == 4 && buff[3] == '.') { + abbrev = 1; + buff[3] = '\0'; + } else { + abbrev = 0; + } + + for (tp = MonthDayTable; tp->name; tp++) { + if (abbrev) { + if (strncmp(buff, tp->name, 3) == 0) { + TclDatelval.Number = tp->value; + return tp->type; + } + } else if (strcmp(buff, tp->name) == 0) { + TclDatelval.Number = tp->value; + return tp->type; + } + } + + for (tp = TimezoneTable; tp->name; tp++) { + if (strcmp(buff, tp->name) == 0) { + TclDatelval.Number = tp->value; + return tp->type; + } + } + + for (tp = UnitsTable; tp->name; tp++) { + if (strcmp(buff, tp->name) == 0) { + TclDatelval.Number = tp->value; + return tp->type; + } + } + + /* + * Strip off any plural and try the units table again. + */ + i = strlen(buff) - 1; + if (buff[i] == 's') { + buff[i] = '\0'; + for (tp = UnitsTable; tp->name; tp++) { + if (strcmp(buff, tp->name) == 0) { + TclDatelval.Number = tp->value; + return tp->type; + } + } + } + + for (tp = OtherTable; tp->name; tp++) { + if (strcmp(buff, tp->name) == 0) { + TclDatelval.Number = tp->value; + return tp->type; + } + } + + /* + * Military timezones. + */ + if (buff[1] == '\0' && isalpha(UCHAR(*buff))) { + for (tp = MilitaryTable; tp->name; tp++) { + if (strcmp(buff, tp->name) == 0) { + TclDatelval.Number = tp->value; + return tp->type; + } + } + } + + /* + * Drop out any periods and try the timezone table again. + */ + for (i = 0, p = q = buff; *q; q++) + if (*q != '.') { + *p++ = *q; + } else { + i++; + } + *p = '\0'; + if (i) { + for (tp = TimezoneTable; tp->name; tp++) { + if (strcmp(buff, tp->name) == 0) { + TclDatelval.Number = tp->value; + return tp->type; + } + } + } + + return tID; + } + + #undef isspace + #define isspace(c) (__ctype[(c)] & (_C_WHITE_SPACE | _C_CONTROL)) + #undef isdigit + #define isdigit(c) (__ctype[(c)] & (_C_NUMBER)) + #undef isalpha + #define isalpha(c) (__ctype[(c)] & (_C_UPPER | _C_LOWER)) + + static int + TclDatelex() + { + register char c; + register char *p; + char buff[20]; + int Count; + int sign; + + for ( ; ; ) { + while (isspace((unsigned char) (*TclDateInput))) { + TclDateInput++; + } + + if (isdigit(c = *TclDateInput) || c == '-' || c == '+') { + if (c == '-' || c == '+') { + sign = c == '-' ? -1 : 1; + if (!isdigit(*++TclDateInput)) { + /* + * skip the '-' sign + */ + continue; + } + } else { + sign = 0; + } + for (TclDatelval.Number = 0; isdigit(c = *TclDateInput++); ) { + TclDatelval.Number = 10 * TclDatelval.Number + c - '0'; + } + TclDateInput--; + if (sign < 0) { + TclDatelval.Number = -TclDatelval.Number; + } + return sign ? tSNUMBER : tUNUMBER; + } + if (isalpha(UCHAR(c))) { + for (p = buff; isalpha(c = *TclDateInput++) || c == '.'; ) { + if (p < &buff[sizeof buff - 1]) { + *p++ = c; + } + } + *p = '\0'; + TclDateInput--; + return LookupWord(buff); + } + if (c != '(') { + return *TclDateInput++; + } + Count = 0; + do { + c = *TclDateInput++; + if (c == '\0') { + return c; + } else if (c == '(') { + Count++; + } else if (c == ')') { + Count--; + } + } while (Count > 0); + } + } + + /* + * Specify zone is of -50000 to force GMT. (This allows BST to work). + */ + + int + TclGetDate(p, now, zone, timePtr) + char *p; + unsigned long now; + long zone; + unsigned long *timePtr; + { + struct tm *tm,buf; + time_t Start; + time_t Time; + time_t tod; + int thisyear; + + TclDateInput = p; + localtime_r((time_t *) &now,&buf); + tm = &buf; + thisyear = tm->tm_year + TM_YEAR_BASE; + TclDateYear = thisyear; + TclDateMonth = tm->tm_mon + 1; + TclDateDay = tm->tm_mday; + TclDateTimezone = zone; + if (zone == -50000) { + TclDateDSTmode = DSToff; /* assume GMT */ + TclDateTimezone = 0; + } else { + TclDateDSTmode = DSTmaybe; + } + TclDateHour = 0; + TclDateMinutes = 0; + TclDateSeconds = 0; + TclDateMeridian = MER24; + TclDateRelSeconds = 0; + TclDateRelMonth = 0; + TclDateHaveDate = 0; + TclDateHaveDay = 0; + TclDateHaveRel = 0; + TclDateHaveTime = 0; + TclDateHaveZone = 0; + + if (TclDateparse() || TclDateHaveTime > 1 || TclDateHaveZone > 1 || TclDateHaveDate > 1 || + TclDateHaveDay > 1) { + return -1; + } + + if (TclDateHaveDate || TclDateHaveTime || TclDateHaveDay) { + if (TclDateYear < 0) { + TclDateYear = -TclDateYear; + } + /* + * The following line handles years that are specified using + * only two digits. The line of code below implements a policy + * defined by the X/Open workgroup on the millinium rollover. + * Note: some of those dates may not actually be valid on some + * platforms. The POSIX standard startes that the dates 70-99 + * shall refer to 1970-1999 and 00-38 shall refer to 2000-2038. + * This later definition should work on all platforms. + */ + + if (TclDateYear < 100) { + if (TclDateYear >= 69) { + TclDateYear += 1900; + } else { + TclDateYear += 2000; + } + } + if (Convert(TclDateMonth, TclDateDay, TclDateYear, TclDateHour, TclDateMinutes, TclDateSeconds, + TclDateMeridian, TclDateDSTmode, &Start) < 0) { + return -1; + } + } else { + Start = now; + if (!TclDateHaveRel) { + Start -= ((tm->tm_hour * 60L) + tm->tm_min * 60L) + tm->tm_sec; + } + } + + Start += TclDateRelSeconds; + if (RelativeMonth(Start, TclDateRelMonth, &Time) < 0) { + return -1; + } + Start += Time; + + if (TclDateHaveDay && !TclDateHaveDate) { + tod = RelativeDate(Start, TclDateDayOrdinal, TclDateDayNumber); + Start += tod; + } + + *timePtr = Start; + return 0; + } + TclDatetabelem TclDateexca[] ={ + -1, 1, + 0, -1, + -2, 0, + }; + # define YYNPROD 41 + # define YYLAST 227 + TclDatetabelem TclDateact[]={ + + 14, 11, 23, 28, 17, 12, 19, 18, 16, 9, + 10, 13, 42, 21, 46, 45, 44, 48, 41, 37, + 36, 35, 32, 29, 34, 33, 31, 43, 39, 38, + 30, 15, 8, 7, 6, 5, 4, 3, 2, 1, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 47, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 22, 0, 0, 20, 25, 24, 27, + 26, 42, 0, 0, 0, 0, 40 }; + TclDatetabelem TclDatepact[]={ + + -10000000, -258,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000, -45, + -267,-10000000, -244,-10000000, -14, -231, -240,-10000000,-10000000,-10000000, + -10000000, -246,-10000000, -247, -248,-10000000,-10000000,-10000000,-10000000, -15, + -10000000,-10000000,-10000000,-10000000,-10000000, -40, -20,-10000000, -251,-10000000, + -10000000, -252,-10000000, -253,-10000000, -249,-10000000,-10000000,-10000000 }; + TclDatetabelem TclDatepgo[]={ + + 0, 28, 39, 38, 37, 36, 35, 34, 33, 32, + 31 }; + TclDatetabelem TclDater1[]={ + + 0, 2, 2, 3, 3, 3, 3, 3, 3, 4, + 4, 4, 4, 4, 5, 5, 5, 7, 7, 7, + 6, 6, 6, 6, 6, 6, 6, 8, 8, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 9, 1, + 1 }; + TclDatetabelem TclDater2[]={ + + 0, 0, 4, 3, 3, 3, 3, 3, 2, 5, + 9, 9, 13, 13, 5, 3, 3, 3, 5, 5, + 7, 11, 5, 9, 5, 3, 7, 5, 2, 5, + 5, 3, 5, 5, 3, 5, 5, 3, 3, 1, + 3 }; + TclDatetabelem TclDatechk[]={ + + -10000000, -2, -3, -4, -5, -6, -7, -8, -9, 267, + 268, 259, 263, 269, 258, -10, 266, 262, 265, 264, + 261, 58, 258, 47, 263, 262, 265, 264, 270, 267, + 44, 257, 262, 265, 264, 267, 267, 267, 44, -1, + 266, 58, 261, 47, 267, 267, 267, -1, 266 }; + TclDatetabelem TclDatedef[]={ + + 1, -2, 2, 3, 4, 5, 6, 7, 8, 38, + 15, 16, 0, 25, 17, 28, 0, 31, 34, 37, + 9, 0, 19, 0, 24, 29, 33, 36, 14, 22, + 18, 27, 30, 32, 35, 39, 20, 26, 0, 10, + 11, 0, 40, 0, 23, 39, 21, 12, 13 }; + typedef struct + #ifdef __cplusplus + TclDatetoktype + #endif + { char *t_name; int t_val; } TclDatetoktype; + #ifndef YYDEBUG + # define YYDEBUG 0 /* don't allow debugging */ + #endif + + #if YYDEBUG + + TclDatetoktype TclDatetoks[] = + { + "tAGO", 257, + "tDAY", 258, + "tDAYZONE", 259, + "tID", 260, + "tMERIDIAN", 261, + "tMINUTE_UNIT", 262, + "tMONTH", 263, + "tMONTH_UNIT", 264, + "tSEC_UNIT", 265, + "tSNUMBER", 266, + "tUNUMBER", 267, + "tZONE", 268, + "tEPOCH", 269, + "tDST", 270, + "-unknown-", -1 /* ends search */ + }; + + char * TclDatereds[] = + { + "-no such reduction-", + "spec : /* empty */", + "spec : spec item", + "item : time", + "item : zone", + "item : date", + "item : day", + "item : rel", + "item : number", + "time : tUNUMBER tMERIDIAN", + "time : tUNUMBER ':' tUNUMBER o_merid", + "time : tUNUMBER ':' tUNUMBER tSNUMBER", + "time : tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid", + "time : tUNUMBER ':' tUNUMBER ':' tUNUMBER tSNUMBER", + "zone : tZONE tDST", + "zone : tZONE", + "zone : tDAYZONE", + "day : tDAY", + "day : tDAY ','", + "day : tUNUMBER tDAY", + "date : tUNUMBER '/' tUNUMBER", + "date : tUNUMBER '/' tUNUMBER '/' tUNUMBER", + "date : tMONTH tUNUMBER", + "date : tMONTH tUNUMBER ',' tUNUMBER", + "date : tUNUMBER tMONTH", + "date : tEPOCH", + "date : tUNUMBER tMONTH tUNUMBER", + "rel : relunit tAGO", + "rel : relunit", + "relunit : tUNUMBER tMINUTE_UNIT", + "relunit : tSNUMBER tMINUTE_UNIT", + "relunit : tMINUTE_UNIT", + "relunit : tSNUMBER tSEC_UNIT", + "relunit : tUNUMBER tSEC_UNIT", + "relunit : tSEC_UNIT", + "relunit : tSNUMBER tMONTH_UNIT", + "relunit : tUNUMBER tMONTH_UNIT", + "relunit : tMONTH_UNIT", + "number : tUNUMBER", + "o_merid : /* empty */", + "o_merid : tMERIDIAN", + }; + #endif /* YYDEBUG */ + /* + * Copyright (c) 1993 by Sun Microsystems, Inc. + */ + + + /* + ** Skeleton parser driver for yacc output + */ + + /* + ** yacc user known macros and defines + */ + #define YYERROR goto TclDateerrlab + #define YYACCEPT return(0) + #define YYABORT return(1) + #define YYBACKUP( newtoken, newvalue )\ + {\ + if ( TclDatechar >= 0 || ( TclDater2[ TclDatetmp ] >> 1 ) != 1 )\ + {\ + TclDateerror( "syntax error - cannot backup" );\ + goto TclDateerrlab;\ + }\ + TclDatechar = newtoken;\ + TclDatestate = *TclDateps;\ + TclDatelval = newvalue;\ + goto TclDatenewstate;\ + } + #define YYRECOVERING() (!!TclDateerrflag) + #define YYNEW(type) ckalloc(sizeof(type) * TclDatenewmax) + #define YYCOPY(to, from, type) \ + (type *) memcpy(to, (char *) from, TclDatenewmax * sizeof(type)) + #define YYENLARGE( from, type) \ + (type *) ckrealloc((char *) from, TclDatenewmax * sizeof(type)) + #ifndef YYDEBUG + # define YYDEBUG 1 /* make debugging available */ + #endif + + /* + ** user known globals + */ + #define TclDatedebug (tclGlob->TclDatedebug) /* set to 1 to get debugging */ + + /* + ** driver internal defines + */ + #define YYFLAG (-10000000) + + /* + ** global variables used by the parser + */ + #define TclDatepv (tclGlob->TclDatepv) /* top of value stack */ + #define TclDateps (tclGlob->TclDateps) /* top of state stack */ + + #define TclDatestate (tclGlob->TclDatestate) /* current state */ + #define TclDatetmp (tclGlob->TclDatetmp) /* extra var (lasts between blocks) */ + + #define TclDatenerrs (tclGlob->TclDatenerrs) /* number of errors */ + #define TclDateerrflag (tclGlob->TclDateerrflag)/* error recovery flag */ + #define TclDatechar (tclGlob->TclDatechar) /* current input token number */ + + + + #ifdef YYNMBCHARS + #define YYLEX() TclDatecvtok(TclDatelex()) + /* + ** TclDatecvtok - return a token if i is a wchar_t value that exceeds 255. + ** If i<255, i itself is the token. If i>255 but the neither + ** of the 30th or 31st bit is on, i is already a token. + */ + #if defined(__STDC__) || defined(__cplusplus) + int TclDatecvtok(int i) + #else + int TclDatecvtok(i) int i; + #endif + { + int first = 0; + int last = YYNMBCHARS - 1; + int mid; + wchar_t j; + + if(i&0x60000000){/*Must convert to a token. */ + if( TclDatembchars[last].character < i ){ + return i;/*Giving up*/ + } + while ((last>=first)&&(first>=0)) {/*Binary search loop*/ + mid = (first+last)/2; + j = TclDatembchars[mid].character; + if( j==i ){/*Found*/ + return TclDatembchars[mid].tvalue; + }else if( j= 0; + TclDate_i++ ) + { + if ( TclDatetoks[TclDate_i].t_val == TclDatechar ) + break; + } + printf( "%s\n", TclDatetoks[TclDate_i].t_name ); + } + } + #endif /* YYDEBUG */ + if ( ++TclDate_ps >= &TclDates[ TclDatemaxdepth ] ) /* room on stack? */ + { + /* + ** reallocate and recover. Note that pointers + ** have to be reset, or bad things will happen + */ + int TclDateps_index = (TclDate_ps - TclDates); + int TclDatepv_index = (TclDate_pv - TclDatev); + int TclDatepvt_index = (TclDatepvt - TclDatev); + int TclDatenewmax; + #ifdef YYEXPAND + TclDatenewmax = YYEXPAND(TclDatemaxdepth); + #else + TclDatenewmax = 2 * TclDatemaxdepth; /* double table size */ + if (TclDatemaxdepth == YYMAXDEPTH) /* first time growth */ + { + char *newTclDates = (char *)YYNEW(int); + char *newTclDatev = (char *)YYNEW(YYSTYPE); + if (newTclDates != 0 && newTclDatev != 0) + { + TclDates = YYCOPY(newTclDates, TclDates, int); + TclDatev = YYCOPY(newTclDatev, TclDatev, YYSTYPE); + } + else + TclDatenewmax = 0; /* failed */ + } + else /* not first time */ + { + TclDates = YYENLARGE(TclDates, int); + TclDatev = YYENLARGE(TclDatev, YYSTYPE); + if (TclDates == 0 || TclDatev == 0) + TclDatenewmax = 0; /* failed */ + } + #endif + if (TclDatenewmax <= TclDatemaxdepth) /* tables not expanded */ + { + TclDateerror( "yacc stack overflow" ); + YYABORT; + } + TclDatemaxdepth = TclDatenewmax; + + TclDate_ps = TclDates + TclDateps_index; + TclDate_pv = TclDatev + TclDatepv_index; + TclDatepvt = TclDatev + TclDatepvt_index; + } + *TclDate_ps = TclDate_state; + *++TclDate_pv = TclDateval; + + /* + ** we have a new state - find out what to do + */ + TclDate_newstate: + if ( ( TclDate_n = TclDatepact[ TclDate_state ] ) <= YYFLAG ) + goto TclDatedefault; /* simple state */ + #if YYDEBUG + /* + ** if debugging, need to mark whether new token grabbed + */ + TclDatetmp = TclDatechar < 0; + #endif + if ( ( TclDatechar < 0 ) && ( ( TclDatechar = YYLEX() ) < 0 ) ) + TclDatechar = 0; /* reached EOF */ + #if YYDEBUG + if ( TclDatedebug && TclDatetmp ) + { + register int TclDate_i; + + printf( "Received token " ); + if ( TclDatechar == 0 ) + printf( "end-of-file\n" ); + else if ( TclDatechar < 0 ) + printf( "-none-\n" ); + else + { + for ( TclDate_i = 0; TclDatetoks[TclDate_i].t_val >= 0; + TclDate_i++ ) + { + if ( TclDatetoks[TclDate_i].t_val == TclDatechar ) + break; + } + printf( "%s\n", TclDatetoks[TclDate_i].t_name ); + } + } + #endif /* YYDEBUG */ + if ( ( ( TclDate_n += TclDatechar ) < 0 ) || ( TclDate_n >= YYLAST ) ) + goto TclDatedefault; + if ( TclDatechk[ TclDate_n = TclDateact[ TclDate_n ] ] == TclDatechar ) /*valid shift*/ + { + TclDatechar = -1; + TclDateval = TclDatelval; + TclDate_state = TclDate_n; + if ( TclDateerrflag > 0 ) + TclDateerrflag--; + goto TclDate_stack; + } + + TclDatedefault: + if ( ( TclDate_n = TclDatedef[ TclDate_state ] ) == -2 ) + { + #if YYDEBUG + TclDatetmp = TclDatechar < 0; + #endif + if ( ( TclDatechar < 0 ) && ( ( TclDatechar = YYLEX() ) < 0 ) ) + TclDatechar = 0; /* reached EOF */ + #if YYDEBUG + if ( TclDatedebug && TclDatetmp ) + { + register int TclDate_i; + + printf( "Received token " ); + if ( TclDatechar == 0 ) + printf( "end-of-file\n" ); + else if ( TclDatechar < 0 ) + printf( "-none-\n" ); + else + { + for ( TclDate_i = 0; + TclDatetoks[TclDate_i].t_val >= 0; + TclDate_i++ ) + { + if ( TclDatetoks[TclDate_i].t_val + == TclDatechar ) + { + break; + } + } + printf( "%s\n", TclDatetoks[TclDate_i].t_name ); + } + } + #endif /* YYDEBUG */ + /* + ** look through exception table + */ + { + register int *TclDatexi = TclDateexca; + + while ( ( *TclDatexi != -1 ) || + ( TclDatexi[1] != TclDate_state ) ) + { + TclDatexi += 2; + } + while ( ( *(TclDatexi += 2) >= 0 ) && + ( *TclDatexi != TclDatechar ) ) + ; + if ( ( TclDate_n = TclDatexi[1] ) < 0 ) + YYACCEPT; + } + } + + /* + ** check for syntax error + */ + if ( TclDate_n == 0 ) /* have an error */ + { + /* no worry about speed here! */ + switch ( TclDateerrflag ) + { + case 0: /* new error */ + TclDateerror( "syntax error" ); + goto skip_init; + /* + ** get globals into registers. + ** we have a user generated syntax type error + */ + TclDate_pv = TclDatepv; + TclDate_ps = TclDateps; + TclDate_state = TclDatestate; + skip_init: + TclDatenerrs++; + /* FALLTHRU */ + case 1: + case 2: /* incompletely recovered error */ + /* try again... */ + TclDateerrflag = 3; + /* + ** find state where "error" is a legal + ** shift action + */ + while ( TclDate_ps >= TclDates ) + { + TclDate_n = TclDatepact[ *TclDate_ps ] + YYERRCODE; + if ( TclDate_n >= 0 && TclDate_n < YYLAST && + TclDatechk[TclDateact[TclDate_n]] == YYERRCODE) { + /* + ** simulate shift of "error" + */ + TclDate_state = TclDateact[ TclDate_n ]; + goto TclDate_stack; + } + /* + ** current state has no shift on + ** "error", pop stack + */ + #if YYDEBUG + # define _POP_ "Error recovery pops state %d, uncovers state %d\n" + if ( TclDatedebug ) + printf( _POP_, *TclDate_ps, + TclDate_ps[-1] ); + # undef _POP_ + #endif + TclDate_ps--; + TclDate_pv--; + } + /* + ** there is no state on stack with "error" as + ** a valid shift. give up. + */ + YYABORT; + case 3: /* no shift yet; eat a token */ + #if YYDEBUG + /* + ** if debugging, look up token in list of + ** pairs. 0 and negative shouldn't occur, + ** but since timing doesn't matter when + ** debugging, it doesn't hurt to leave the + ** tests here. + */ + if ( TclDatedebug ) + { + register int TclDate_i; + + printf( "Error recovery discards " ); + if ( TclDatechar == 0 ) + printf( "token end-of-file\n" ); + else if ( TclDatechar < 0 ) + printf( "token -none-\n" ); + else + { + for ( TclDate_i = 0; + TclDatetoks[TclDate_i].t_val >= 0; + TclDate_i++ ) + { + if ( TclDatetoks[TclDate_i].t_val + == TclDatechar ) + { + break; + } + } + printf( "token %s\n", + TclDatetoks[TclDate_i].t_name ); + } + } + #endif /* YYDEBUG */ + if ( TclDatechar == 0 ) /* reached EOF. quit */ + YYABORT; + TclDatechar = -1; + goto TclDate_newstate; + } + }/* end if ( TclDate_n == 0 ) */ + /* + ** reduction by production TclDate_n + ** put stack tops, etc. so things right after switch + */ + #if YYDEBUG + /* + ** if debugging, print the string that is the user's + ** specification of the reduction which is just about + ** to be done. + */ + if ( TclDatedebug ) + printf( "Reduce by (%d) \"%s\"\n", + TclDate_n, TclDatereds[ TclDate_n ] ); + #endif + TclDatetmp = TclDate_n; /* value to switch over */ + TclDatepvt = TclDate_pv; /* $vars top of value stack */ + /* + ** Look in goto table for next state + ** Sorry about using TclDate_state here as temporary + ** register variable, but why not, if it works... + ** If TclDater2[ TclDate_n ] doesn't have the low order bit + ** set, then there is no action to be done for + ** this reduction. So, no saving & unsaving of + ** registers done. The only difference between the + ** code just after the if and the body of the if is + ** the goto TclDate_stack in the body. This way the test + ** can be made before the choice of what to do is needed. + */ + { + /* length of production doubled with extra bit */ + register int TclDate_len = TclDater2[ TclDate_n ]; + + if ( !( TclDate_len & 01 ) ) + { + TclDate_len >>= 1; + TclDateval = ( TclDate_pv -= TclDate_len )[1]; /* $$ = $1 */ + TclDate_state = TclDatepgo[ TclDate_n = TclDater1[ TclDate_n ] ] + + *( TclDate_ps -= TclDate_len ) + 1; + if ( TclDate_state >= YYLAST || + TclDatechk[ TclDate_state = + TclDateact[ TclDate_state ] ] != -TclDate_n ) + { + TclDate_state = TclDateact[ TclDatepgo[ TclDate_n ] ]; + } + goto TclDate_stack; + } + TclDate_len >>= 1; + TclDateval = ( TclDate_pv -= TclDate_len )[1]; /* $$ = $1 */ + TclDate_state = TclDatepgo[ TclDate_n = TclDater1[ TclDate_n ] ] + + *( TclDate_ps -= TclDate_len ) + 1; + if ( TclDate_state >= YYLAST || + TclDatechk[ TclDate_state = TclDateact[ TclDate_state ] ] != -TclDate_n ) + { + TclDate_state = TclDateact[ TclDatepgo[ TclDate_n ] ]; + } + } + /* save until reenter driver code */ + TclDatestate = TclDate_state; + TclDateps = TclDate_ps; + TclDatepv = TclDate_pv; + } + /* + ** code supplied by user is placed in this switch + */ + switch( TclDatetmp ) + { + + case 3:{ + TclDateHaveTime++; + } break; + case 4:{ + TclDateHaveZone++; + } break; + case 5:{ + TclDateHaveDate++; + } break; + case 6:{ + TclDateHaveDay++; + } break; + case 7:{ + TclDateHaveRel++; + } break; + case 9:{ + TclDateHour = TclDatepvt[-1].Number; + TclDateMinutes = 0; + TclDateSeconds = 0; + TclDateMeridian = TclDatepvt[-0].Meridian; + } break; + case 10:{ + TclDateHour = TclDatepvt[-3].Number; + TclDateMinutes = TclDatepvt[-1].Number; + TclDateSeconds = 0; + TclDateMeridian = TclDatepvt[-0].Meridian; + } break; + case 11:{ + TclDateHour = TclDatepvt[-3].Number; + TclDateMinutes = TclDatepvt[-1].Number; + TclDateMeridian = MER24; + TclDateDSTmode = DSToff; + TclDateTimezone = - (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60); + } break; + case 12:{ + TclDateHour = TclDatepvt[-5].Number; + TclDateMinutes = TclDatepvt[-3].Number; + TclDateSeconds = TclDatepvt[-1].Number; + TclDateMeridian = TclDatepvt[-0].Meridian; + } break; + case 13:{ + TclDateHour = TclDatepvt[-5].Number; + TclDateMinutes = TclDatepvt[-3].Number; + TclDateSeconds = TclDatepvt[-1].Number; + TclDateMeridian = MER24; + TclDateDSTmode = DSToff; + TclDateTimezone = - (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60); + } break; + case 14:{ + TclDateTimezone = TclDatepvt[-1].Number; + TclDateDSTmode = DSTon; + } break; + case 15:{ + TclDateTimezone = TclDatepvt[-0].Number; + TclDateDSTmode = DSToff; + } break; + case 16:{ + TclDateTimezone = TclDatepvt[-0].Number; + TclDateDSTmode = DSTon; + } break; + case 17:{ + TclDateDayOrdinal = 1; + TclDateDayNumber = TclDatepvt[-0].Number; + } break; + case 18:{ + TclDateDayOrdinal = 1; + TclDateDayNumber = TclDatepvt[-1].Number; + } break; + case 19:{ + TclDateDayOrdinal = TclDatepvt[-1].Number; + TclDateDayNumber = TclDatepvt[-0].Number; + } break; + case 20:{ + TclDateMonth = TclDatepvt[-2].Number; + TclDateDay = TclDatepvt[-0].Number; + } break; + case 21:{ + TclDateMonth = TclDatepvt[-4].Number; + TclDateDay = TclDatepvt[-2].Number; + TclDateYear = TclDatepvt[-0].Number; + } break; + case 22:{ + TclDateMonth = TclDatepvt[-1].Number; + TclDateDay = TclDatepvt[-0].Number; + } break; + case 23:{ + TclDateMonth = TclDatepvt[-3].Number; + TclDateDay = TclDatepvt[-2].Number; + TclDateYear = TclDatepvt[-0].Number; + } break; + case 24:{ + TclDateMonth = TclDatepvt[-0].Number; + TclDateDay = TclDatepvt[-1].Number; + } break; + case 25:{ + TclDateMonth = 1; + TclDateDay = 1; + TclDateYear = EPOCH; + } break; + case 26:{ + TclDateMonth = TclDatepvt[-1].Number; + TclDateDay = TclDatepvt[-2].Number; + TclDateYear = TclDatepvt[-0].Number; + } break; + case 27:{ + TclDateRelSeconds = -TclDateRelSeconds; + TclDateRelMonth = -TclDateRelMonth; + } break; + case 29:{ + TclDateRelSeconds += TclDatepvt[-1].Number * TclDatepvt[-0].Number * 60L; + } break; + case 30:{ + TclDateRelSeconds += TclDatepvt[-1].Number * TclDatepvt[-0].Number * 60L; + } break; + case 31:{ + TclDateRelSeconds += TclDatepvt[-0].Number * 60L; + } break; + case 32:{ + TclDateRelSeconds += TclDatepvt[-1].Number; + } break; + case 33:{ + TclDateRelSeconds += TclDatepvt[-1].Number; + } break; + case 34:{ + TclDateRelSeconds++; + } break; + case 35:{ + TclDateRelMonth += TclDatepvt[-1].Number * TclDatepvt[-0].Number; + } break; + case 36:{ + TclDateRelMonth += TclDatepvt[-1].Number * TclDatepvt[-0].Number; + } break; + case 37:{ + TclDateRelMonth += TclDatepvt[-0].Number; + } break; + case 38:{ + if (TclDateHaveTime && TclDateHaveDate && !TclDateHaveRel) { + TclDateYear = TclDatepvt[-0].Number; + } else { + TclDateHaveTime++; + if (TclDatepvt[-0].Number < 100) { + TclDateHour = 0; + TclDateMinutes = TclDatepvt[-0].Number; + } else { + TclDateHour = TclDatepvt[-0].Number / 100; + TclDateMinutes = TclDatepvt[-0].Number % 100; + } + TclDateSeconds = 0; + TclDateMeridian = MER24; + } + } break; + case 39:{ + TclDateval.Meridian = MER24; + } break; + case 40:{ + TclDateval.Meridian = TclDatepvt[-0].Meridian; + } break; + } + goto TclDatestack; /* reset registers in driver code */ + } + diff -rc tcl8.0/vxworks/tclVxWorksFCmd.c tcl8.0-vxworks/vxworks/tclVxWorksFCmd.c *** tcl8.0/vxworks/tclVxWorksFCmd.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksFCmd.c Fri Oct 24 10:59:00 1997 *************** *** 0 **** --- 1,1029 ---- + /* + * tclVxWorksFCmd.c + * + * This file implements the VxWors 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. + * + * based on: + * SCCS: @(#) tclUnixFCmd.c 1.29 97/06/16 16:28:25 + * + * 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 + + #undef ENOENT + #define ENOENT S_nfsLib_NFSERR_NOENT + #undef EEXIST + #define EEXIST S_nfsLib_NFSERR_NOTEMPTY + #undef EISDIR + #define EISDIR S_nfsLib_NFSERR_ISDIR + + /* + * 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)); + static int copy _ANSI_ARGS_(( + char *source, char *target)); + + /* + *--------------------------------------------------------------------------- + * + * 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 (copy(src,dst) != OK) { + return TCL_ERROR; + } + if (unlink(src) != OK) { + return TCL_ERROR; + } + return TCL_OK; + } + + + /* + *--------------------------------------------------------------------------- + * + * 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; + + /* + * 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: + case S_IFBLK: + case S_IFCHR: + case S_IFIFO: + return TCL_ERROR; + 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 */ + { + if (copy(src,dst) != OK) { + 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. + * + *--------------------------------------------------------------------------- + */ + + int + TclpCreateDirectory(path) + char *path; /* Pathname of directory to create. */ + { + if (mkdir(path) != 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 */ + { + 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; + char buf[20]; + + if (stat(fileName, &statBuf) != 0) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "could not stat file \"", fileName, "\": ", + Tcl_PosixError(interp), (char *) NULL); + return TCL_ERROR; + } + + sprintf(buf,"%d",statBuf.st_gid); + *attributePtrPtr = Tcl_NewStringObj(buf, -1); + + 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; + char buf[20]; + + if (stat(fileName, &statBuf) != 0) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "could not stat file \"", fileName, "\": ", + Tcl_PosixError(interp), (char *) NULL); + return TCL_ERROR; + } + + sprintf(buf,"%d",statBuf.st_uid); + *attributePtrPtr = Tcl_NewStringObj(buf, -1); + + 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", + (long unsigned int)(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. */ + { + char *groupString = Tcl_GetStringFromObj(attributePtr, NULL); + + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "could not set group for file \"", fileName, + "\": group \"", groupString, "\" does not exist", + (char *) NULL); + return TCL_ERROR; + } + + /* + *---------------------------------------------------------------------- + * + * 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. */ + { + char *ownerString = Tcl_GetStringFromObj(attributePtr, NULL); + + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "could not set owner for file \"", fileName, + "\": user \"", ownerString, "\" does not exist", + (char *) NULL); + return TCL_ERROR; + } + + /* + *---------------------------------------------------------------------- + * + * 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. */ + { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "could not set permissions for file \"", fileName, "\": ", + Tcl_PosixError(interp), (char *) NULL); + return TCL_ERROR; + } + /* + *--------------------------------------------------------------------------- + * + * 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; + } + + /* from VxWorks usrLib.c */ + static int + copy(char *source, char *target) + { + int sourceFd = source ? open (source, O_RDONLY, 0) : ERROR; + int targetFd = target ? creat (target, O_WRONLY) : ERROR; + char buffer [1 * 1024]; + int totalBytes = 0; + int nbytes; + + if (sourceFd < OK) { return ERROR; } + if (targetFd < OK) { if (source) close(sourceFd); return ERROR; } + + while ((nbytes = fioRead (sourceFd, buffer, sizeof (buffer))) > 0) { + if (write (targetFd, buffer, nbytes) != nbytes) { + return (ERROR); + } + totalBytes += nbytes; + if (nbytes != sizeof (buffer)) break; + } + if (nbytes < 0) { return ERROR; } + + if (source) close(sourceFd); + if (target && close (targetFd) == ERROR) return ERROR; + return OK; + } diff -rc tcl8.0/vxworks/tclVxWorksFile.c tcl8.0-vxworks/vxworks/tclVxWorksFile.c *** tcl8.0/vxworks/tclVxWorksFile.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksFile.c Fri Oct 24 09:43:16 1997 *************** *** 0 **** --- 1,385 ---- + /* + * tclVxWorksFile.c -- + * + * This file contains wrappers around VxWorks file handling functions. + * + * 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. + * + * based on: + * 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. + */ + + #define currentDir (tclGlob->currentDir) + #define currentDirExitHandlerSet (tclGlob->currentDirExitHandlerSet) + + /* + * Static routines for this file: + */ + + static void FreeCurrentDir _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; + } + } + + /* + *---------------------------------------------------------------------- + * + * 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]. */ + { + strcpy(tclExecutableName,argv0); + } + + /* + *---------------------------------------------------------------------- + * + * 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. */ + { + char user[80]; + char *home; + + Tcl_DStringInit(bufferPtr); + + remCurIdGet(user,NULL); + if (strcmp(name,user)) return NULL; + + home = getenv("HOME"); + if (!home) home = "/"; + + Tcl_DStringAppend(bufferPtr, home, -1); + 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 -rc tcl8.0/vxworks/tclVxWorksInit.c tcl8.0-vxworks/vxworks/tclVxWorksInit.c *** tcl8.0/vxworks/tclVxWorksInit.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksInit.c Fri Oct 24 10:57:55 1997 *************** *** 0 **** --- 1,420 ---- + /* + * tclVxWorksInit.c -- + * + * Contains the VxWorks-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. + * + * based on: + * SCCS: @(#) tclUnixInit.c 1.21 96/12/06 13:57:34 + */ + + #include "tclInt.h" + #include "tclPort.h" + #include "version.h" + + static void TclPlatformDeleteTaskHook(int tid); + static void TclPlatformDeleteTask(int tid); + + #if CPU==PPC860 + static char *cpu = "PPC860"; + #endif /* CPU==PPC860 */ + + struct tclglob *tclGlob = NULL; + + SEM_ID loadSem = 0; + + /* + * Default directory in which to look for Tcl library scripts. The + * symbol is defined by Makefile. + */ + + #define defaultLibraryDir (tclGlob->defaultLibDir) + + /* + * Directory in which to look for packages (each package is typically + * installed as a subdirectory of this directory). The symbol is + * defined by Makefile. + */ + + #define packagePath (tclGlob->pkgPath) + + /* + * 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\n\ + rename tclInit {}\n\ + set dirs bin/tcl\n\ + foreach i $dirs {\n\ + set tcl_library $i\n\ + if ![catch {uplevel #0 [list source [file join $i init.tcl]]}] {\n\ + return\n\ + }\n\ + }\n\ + set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\ + append msg \" $dirs\n\"\n\ + append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\ + error $msg\n\ + }\n\ + tclInit"; + + /* + *---------------------------------------------------------------------- + * + * TclPlatformInit -- + * + * Performs VxWorks-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; + { + tclPlatform = TCL_PLATFORM_VXWORKS; + Tcl_SetVar(interp, "tcl_library", defaultLibraryDir, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "tcl_pkgPath", packagePath, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform", "platform", "vxworks",TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform", "os", "VxWorks", TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform", "osVersion", VXWORKS_VERSION, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform", "machine", cpu, TCL_GLOBAL_ONLY); + } + + /* + *---------------------------------------------------------------------- + * + * TclPlatformDeleteTask -- + * + * Performs VxWorks-specific cleanup on task deletion. + * + * Results: + * None. + * + * Side effects: + * + * + *---------------------------------------------------------------------- + */ + + static void + TclPlatformDeleteTask(int tid) + { + extern void cleanupSystemMemory(void); + void *ptr = tclGlob; + + #ifdef USE_TCLALLOC + cleanupSystemMemory(); + #endif + + if (taskVarDelete(tid,(int *)&tclGlob) == OK) + if (ptr) free(ptr); + } + + /* + *---------------------------------------------------------------------- + * + * TclPlatformCreateTask -- + * + * Performs VxWorks-specific initialization on task creation. + * + * Results: + * None. + * + * Side effects: + * + * + *---------------------------------------------------------------------- + */ + void + TclPlatformCreateTask(int tid) + { + if (taskVarAdd(tid,(int *)&tclGlob) == ERROR) + panic("error adding VxWorks task variable tclGlob\n"); + if ((tclGlob = (struct tclglob *)malloc(sizeof(struct tclglob))) == NULL) + panic("Unable to alloc memory for VxWorks TCL global structure"); + bzero((void *)tclGlob,sizeof(struct tclglob)); + + #ifdef TCL_MEM_DEBUG + tclGlob->init_malloced_bodies = TRUE; + #ifdef MEM_VALIDATE + tclGlob->validate_memory = TRUE; + #else + tclGlob->validate_memory = FALSE; + #endif + #endif /* TCL_MEM_DEBUG */ + + tclGlob->TclDates = tclGlob->TclDate_TclDates; + tclGlob->TclDatev = tclGlob->TclDate_TclDatev; + tclGlob->TclDatemaxdepth = YYMAXDEPTH; + + tclGlob->nextAfterID = 1; + + tclGlob->tclPlat = TCL_PLATFORM_VXWORKS; + + #ifdef INCLUDE_TEST + tclGlob->nextTestAsyncId = 1; + tclGlob->intVar = 43; + tclGlob->boolVar = 4; + tclGlob->realVar = 1.23; + #endif + + #ifdef TCL_COMPILE_STATS + tclGlob->TotalSourceBytes = 0.0; + tclGlob->TotalCodeBytes = 0.0; + tclGlob->TotalInstBytes = 0.0; + tclGlob->TotalObjBytes = 0.0; + tclGlob->TotalExceptBytes = 0.0; + tclGlob->TotalAuxBytes = 0.0; + tclGlob->TotalCmdMapBytes = 0.0; + tclGlob->CurrentSourceBytes = 0.0; + tclGlob->CurrentCodeBytes = 0.0; + tclGlob->TotalSourceBytes = 0.0; + #endif + + #ifdef USE_TCLALLOC + lstInit(&tclGlob->systemMemory); + #endif + + strcpy(tclGlob->defaultLibDir,TCL_LIBRARY); + strcpy(tclGlob->pkgPath,TCL_PACKAGE_PATH); + + strcpy(tclGlob->precisionString,"12"); + strcpy(tclGlob->precisionFormat,"%.12g"); + + #if defined(INCLUDE_TCLBIN) + tclGlob->GNid = 1; + #endif + + if (loadSem == (SEM_ID)0) { + loadSem = semMCreate(SEM_Q_PRIORITY); + if (!loadSem) + panic("Unable to create loadSem"); + } + + taskDeleteHookAdd((FUNCPTR)TclPlatformDeleteTaskHook); + } + + /* + *---------------------------------------------------------------------- + * + * TclPlatformCallExitHandlers -- + * + * Calls all defined exit handlers. Just like Tcl_Exit(), but + * does not call TclPlatformExit() or exit(). + * + * Results: + * None. + * + * Side effects: + * All existing exit handlers are invoked. + * + *---------------------------------------------------------------------- + */ + + /* + * maybe this should have been left in tclEvent.c, but I really wanted + * it here (seems like it belongs here - TclPlatformCallExitHandlers() + * that is). It's only a small structure ... + */ + typedef struct ExitHandler { + Tcl_ExitProc *proc; + ClientData clientData; + struct ExitHandler *nextPtr; + } ExitHandler; + #define firstExitPtr ((ExitHandler *)(tclGlob->firstExitPtr)) + + static void + TclPlatformCallExitHandlers(void) + { + ExitHandler *exitPtr; + + for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { + firstExitPtr = exitPtr->nextPtr; + (*exitPtr->proc)(exitPtr->clientData); + ckfree((char *) exitPtr); + } + } + + /* + *---------------------------------------------------------------------- + * + * TclPlatformExit -- + * + * Performs VxWorks-specific exit (Tcl_Exit()). + * + * Results: + * None. + * + * Side effects: + * Major problems if we ever get here. + * + *---------------------------------------------------------------------- + */ + + void + TclPlatformExit(status) + int status; + { + logMsg("Whoops! TclPlatformExit: %d\n",status,0,0,0,0,0); + taskDelete(taskIdSelf()); + } + + /* + *---------------------------------------------------------------------- + * + * TclPlatformDeleteTaskHook -- + * + * Cleans up on task deletion. + * + * Results: + * None. + * + * Side effects: + * The interp is deleted if the task is the shell. + * All exit handlers are called and tclGlob is free'd. + * + *---------------------------------------------------------------------- + */ + + static void + TclPlatformDeleteTaskHook(int tid) + { + struct tclglob *ptr = (struct tclglob *)taskVarGet(tid,(int *)&tclGlob); + Interp *iPtr; + + if (ptr == (struct tclglob *)ERROR) + if (taskIdSelf() != taskNameToId("tExcTask") && \ + taskIdSelf() != taskNameToId("tRestart")) + return; + + tclGlob = ptr; + if (tclGlob == NULL || tclGlob == (struct tclglob *)ERROR) return; + + /* I do not like this one bit, but the only command that this + should ever be a factor with is logout from a remote + telnet/rlogin session. + The problem is that the shell gets restarted while in the + middle of the logout() command, which means a panic due + to deleting an interp with active evals unless this is done. + */ + iPtr = (Interp *) tclGlob->mainInterp; + if (iPtr) { iPtr->numLevels = 0; } + + /* delete the main interp */ + if (tclGlob->mainInterp) Tcl_DeleteInterp(tclGlob->mainInterp); + + /* call all exit handlers */ + TclPlatformCallExitHandlers(); + + /* delete tclGlob */ + TclPlatformDeleteTask(tid); + + tclGlob = NULL; /* just in case */ + } + + /* + *---------------------------------------------------------------------- + * + * 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 -rc tcl8.0/vxworks/tclVxWorksLoad.c tcl8.0-vxworks/vxworks/tclVxWorksLoad.c *** tcl8.0/vxworks/tclVxWorksLoad.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksLoad.c Fri Oct 24 09:43:16 1997 *************** *** 0 **** --- 1,156 ---- + /* + * tclVxWorksLoad.c -- + * + * This procedure provides a version of the TclLoadFile that + * works with the "dlopen" and "dlsym" library procedures for + * dynamic loading. + * + * portions + * 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. + * + * based on: + * SCCS: @(#) tclLoadDl2.c 1.3 96/02/15 11:58:45 + */ + + #include "tcl.h" + #include "tclPort.h" + #include + #include + #include + #include + + + /* + *---------------------------------------------------------------------- + * + * 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. */ + { + int fd; + char type[20]; + char *pValue; + MODULE_ID handle; + Tcl_DString newName; + int alreadyLoaded = 0; + + *proc1Ptr = *proc2Ptr = NULL; + + semTake(loadSem,WAIT_FOREVER); + + /* + if it's already loaded, don't load it again. + */ + Tcl_DStringInit(&newName); + #if (CPU != PPC860) + Tcl_DStringAppend(&newName, "_", 1); + #endif + Tcl_DStringAppend(&newName, sym1, -1); + if (symFindByName(sysSymTbl, + Tcl_DStringValue(&newName), + &pValue, (SYM_TYPE *)type) == OK) { + alreadyLoaded = 1; + } + + if (!alreadyLoaded) { + fd = open(fileName, O_RDONLY, 0); + if (fd == ERROR) { + Tcl_AppendResult(interp, "couldn't open file \"", fileName, + "\": ", strerror(errno), (char *) NULL); + goto error; + } + handle = loadModule(fd, 1); + close(fd); + if (handle == NULL) { + Tcl_AppendResult(interp, "couldn't load file \"", fileName, + "\": ", strerror(errno), (char *) NULL); + goto error; + } + } + + Tcl_DStringInit(&newName); + #if (CPU != PPC860) + Tcl_DStringAppend(&newName, "_", 1); + #endif + Tcl_DStringAppend(&newName, sym1, -1); + if (symFindByName(sysSymTbl, + Tcl_DStringValue(&newName), + &pValue, (SYM_TYPE *)type) == OK) + *proc1Ptr = (Tcl_PackageInitProc *)pValue; + + Tcl_DStringSetLength(&newName, 0); + #if (CPU != PPC860) + Tcl_DStringAppend(&newName, "_", 1); + #endif + Tcl_DStringAppend(&newName, sym2, -1); + if (symFindByName(sysSymTbl, + Tcl_DStringValue(&newName), + &pValue, (SYM_TYPE *)type) == OK) + *proc2Ptr = (Tcl_PackageInitProc *)pValue; + Tcl_DStringFree(&newName); + + semGive(loadSem); + return TCL_OK; + + error: + semGive(loadSem); + return TCL_ERROR; + } + + /* + *---------------------------------------------------------------------- + * + * 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 -rc tcl8.0/vxworks/tclVxWorksPort.h tcl8.0-vxworks/vxworks/tclVxWorksPort.h *** tcl8.0/vxworks/tclVxWorksPort.h Fri Oct 24 10:24:09 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksPort.h Fri Oct 24 11:02:49 1997 *************** *** 0 **** --- 1,522 ---- + #ifndef __INCtclVxWorksPorth + #define __INCtclVxWorksPorth + + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + + #define INCLUDE_TEST + + #include "tclInt.h" /* pick up a few strays for tclglob */ + + #include + + #ifndef USE_TCLALLOC + #define USE_TCLALLOC 1 + #endif + #ifndef USE_PUTENV + #define USE_PUTENV 1 + #endif + #ifndef HAVE_STRCASECMP + #define HAVE_STRCASECMP 1 + #endif + #ifndef HAVE_GETTIMEOFDAY + #define HAVE_GETTIMEOFDAY 1 + #endif + + #define MAX_EVAL_FILE_SIZE 150000 + + #define TCL_SHLIB_EXT ".o" + + #define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_LF + + #define MAXPATHLEN MAX_FILENAME_LENGTH + + #define MASK_SIZE howmany(FD_SETSIZE, NFDBITS) + #define SELECT_MASK fd_set + + #define MAXSIG _NSIGS + + #define TCL_LIBRARY "bin/tcl" + #define TCL_PACKAGE_PATH "bin/tcl" + + #define F_OK 0 + #define X_OK 1 + #define W_OK 2 + #define R_OK 4 + + #if !defined(USE_TCLALLOC) + #define TclpAlloc(size) malloc(size) + #define TclpFree(ptr) free(ptr) + #define TclpRealloc(ptr, size) realloc(ptr, size) + #endif /* USE_TCLALLOC */ + + #define TclSetSystemEnv(a,b) setenv(a,b) + + #define TclStrftime strftime + + #define getpid taskIdSelf + #define lstat stat + #define chdir(dir) ioDefPathCat(dir) + #define tzset() + + extern char **ppGlobalEnviron; + + extern int shellLedId; + + extern SEM_ID loadSem; + + extern int access(const char *, int); + extern short geteuid(void); + extern void _panic(char *,...); + #ifndef __INCtimeh + extern int gmtime_r(const long *timer,struct tm *timeBuffer); + extern int localtime_r(const long *timer,struct tm *timeBuffer); + #endif + extern int setenv(const char *name,const char *value); + extern int gettimeofday(struct timeval *tp,struct timezone *tzp); + + extern void TclPlatformCreateTask(int tid); + extern void TclPlatformExit(int status); + + #define TclHasSockets(interp) (TCL_OK) + + /* lots of horrid stuff from tclVxWorksDate.c */ + typedef struct _TABLE { + char *name; + int type; + time_t value; + } TABLE; + + typedef enum _DSTMODE { + DSTon, DSToff, DSTmaybe + } DSTMODE; + + typedef enum _MERIDIAN { + MERam, MERpm, MER24 + } MERIDIAN; + + typedef union _YYSTYPE { + time_t Number; + enum _MERIDIAN Meridian; + } YYSTYPE; + + /* lots of horrid stuff from tclUnixNotfy.c */ + typedef struct FileHandler { + int fd; + int mask; + int readyMask; + Tcl_FileProc *proc; + ClientData clientData; + struct FileHandler *nextPtr; + } FileHandler; + + struct notifier_private { + FileHandler *firstFileHandlerPtr; + fd_mask checkMasks[3*MASK_SIZE]; + fd_mask readyMasks[3*MASK_SIZE]; + int numFdBits; + }; + + /* lots of horrid stuff from tkOption.c */ + typedef struct tkopElement { + char *nameUid; + union { + struct ElArray *arrayPtr; + char *valueUid; + } child; + int priority; + int flags; + } tkopElement; + typedef struct ElArray { + int arraySize; + int numUsed; + tkopElement *nextToUse; + tkopElement els[1]; + } ElArray; + + /* lots of horrid stuff from tclAlloc.c */ + union overhead { + union overhead *ov_next; /* when free */ + struct { + unsigned char ovu_magic0; /* magic number */ + unsigned char ovu_index; /* bucket # */ + unsigned char ovu_unused; /* unused */ + unsigned char ovu_magic1; /* other magic number */ + #ifdef RCHECK + unsigned short ovu_rmagic; /* range magic number */ + unsigned long ovu_size; /* actual block size */ + #endif + } ovu; + #define ov_magic0 ovu.ovu_magic0 + #define ov_magic1 ovu.ovu_magic1 + #define ov_index ovu.ovu_index + #define ov_rmagic ovu.ovu_rmagic + #define ov_size ovu.ovu_size + }; + + /* + * global data structure for each interpreter + */ + struct tclglob { /* default value */ + + /* strftime.c */ + size_t gsize; + char *pt; + + /* regexp.c */ + char *errMsg; /* NULL */ + + #ifdef USE_TCLALLOC + /* tclAlloc.c */ + union overhead *nextf[13]; /* keep in sync! */ + int nmalloc[13+1]; /* keep in sync! */ + #endif /* USE_TCLALLOC */ + + /* tclAsync.c */ + void *firstHandler; + void *lastHandler; + int asyncReady; /* 0 */ + int asyncActive; /* 0 */ + + /* tclBasic.c */ + int assocDataCtr; /* 0 */ + + #ifdef TCL_MEM_DEBUG + /* tclCkalloc.c */ + void *curTagPtr; /* NULL */ + struct mem_header *allocHead; /* NULL */ + int total_mallocs; /* 0 */ + int total_frees; /* 0 */ + int current_bytes_malloced; /* 0 */ + int maximum_bytes_malloced; /* 0 */ + int current_malloc_packets; /* 0 */ + int maximum_malloc_packets; /* 0 */ + int break_on_malloc; /* 0 */ + int trace_on_at_malloc; /* 0 */ + int alloc_tracing; /* FALSE */ + int init_malloced_bodies; /* TRUE */ + int validate_memory; /* TRUE ifdef MEM_VALIDATE */ + #endif /* TCL_MEM_DEBUG */ + + /* tclCmdIL.c */ + char tclExecutable[80]; /* NULL */ + #define tclExecutableName (tclGlob->tclExecutable) + + /* tclCompile.c */ + int tclCompileEpoch; /* 0 */ + #define tclCompileEpoch (tclGlob->tclCompileEpoch) + int tclTraceCompile; /* 0 */ + #define tclTraceCompile (tclGlob->tclTraceCompile) + int traceInitialized; /* 0 */ + #ifdef TCL_COMPILE_STATS + long tclNumCompilations; /* 0 */ + #define tclNumCompilations (tclGlob->tclNumCompilations) + double TotalSourceBytes; /* 0.0 */ + #define tclTotalSourceBytes (tclGlob->TotalSourceBytes) + double TotalCodeBytes; /* 0.0 */ + #define tclTotalCodeBytes (tclGlob->TotalCodeBytes) + double TotalInstBytes; /* 0.0 */ + #define tclTotalInstBytes (tclGlob->TotalInstBytes) + double TotalObjBytes; /* 0.0 */ + #define tclTotalObjBytes (tclGlob->TotalObjBytes) + double TotalExceptBytes; /* 0.0 */ + #define tclTotalExceptBytes (tclGlob->TotalExceptBytes) + double TotalAuxBytes; /* 0.0 */ + #define tclTotalAuxBytes (tclGlob->TotalAuxBytes) + double TotalCmdMapBytes; /* 0.0 */ + #define tclTotalCmdMapBytes (tclGlob->TotalCmdMapBytes) + double CurrentSourceBytes; /* 0.0 */ + #define tclCurrentSourceBytes (tclGlob->CurrentSourceBytes) + double CurrentCodeBytes; /* 0.0 */ + #define tclCurrentCodeBytes (tclGlob->CurrentCodeBytes) + int SourceCount[32]; + #define tclSourceCount (tclGlob->SourceCount) + int ByteCodeCount[32]; + #define tclByteCodeCount (tclGlob->ByteCodeCount) + #endif /* TCL_COMPILE_STATS */ + Tcl_ObjType tclCmdNameType; + + /* tclCompExpr.c */ + int traceCompileExpr; /* 0 */ + + /* tclDate.c */ + char *TclDateInput; + DSTMODE TclDateDSTmode; + long TclDateDayOrdinal; + long TclDateDayNumber; + int TclDateHaveDate; + int TclDateHaveDay; + int TclDateHaveRel; + int TclDateHaveTime; + int TclDateHaveZone; + long TclDateTimezone; + long TclDateDay; + long TclDateHour; + long TclDateMinutes; + long TclDateMonth; + long TclDateSeconds; + long TclDateYear; + MERIDIAN TclDateMeridian; + long TclDateRelMonth; + long TclDateRelSeconds; + YYSTYPE TclDatelval; + YYSTYPE TclDateval; + #define YYMAXDEPTH 150 + int TclDate_TclDates[YYMAXDEPTH]; + int *TclDates; /* TclDate_TclDates */ + YYSTYPE TclDate_TclDatev[YYMAXDEPTH]; + YYSTYPE *TclDatev; /* TclDate_TclDatev */ + int TclDatemaxdepth; /* YYMAXDEPTH */ + int TclDatedebug; + YYSTYPE *TclDatepv; + int *TclDateps; + int TclDatestate; + int TclDatetmp; + int TclDatenerrs; + int TclDateerrflag; + int TclDatechar; + + /* tclEvent.c */ + void *firstExitPtr; /* NULL */ + char *tclMemDumpFile; /* NULL */ + #define tclMemDumpFileName (tclGlob->tclMemDumpFile) + int tclInExit; /* 0 */ + + /* tclExecute.c */ + int execInitialized; /* 0 */ + int tclTraceExec; /* 0 */ + #define tclTraceExec (tclGlob->tclTraceExec) + int tcl_MathInProg; /* 0 */ + #define tcl_MathInProgress (tclGlob->tcl_MathInProg) + char *opName[256]; + #ifdef TCL_COMPILE_STATS + int instructionCount[256]; + long numExecutions; /* 0 */ + #endif /* TCL_COMPILE_STATS */ + char SFRCbuf[20]; + + /* tclEnv.c */ + void *firstEnvInterpPtr; + int cacheSize; /* 0 */ + char **environCache; /* NULL */ + + /* tclFileName.c */ + int fileNameExitHandlerInitialized; /* 0 */ + void *winRootPatternPtr; /* NULL */ + void *macRootPatternPtr; /* NULL */ + TclPlatformType tclPlat; /* TCL_PLATFORM_UNIX */ + #define tclPlatform (tclGlob->tclPlat) + + /* tclIO.c */ + void *nestedHandlerPtr; /* NULL */ + void *firstChanPtr; /* NULL */ + int channelExitHandlerCreated; /* 0 */ + int channelEventSourceCreated; /* 0 */ + Tcl_Channel stdinChannel; /* NULL */ + int stdinInitialized; /* 0 */ + Tcl_Channel stdoutChannel; /* NULL */ + int stdoutInitialized; /* 0 */ + Tcl_Channel stderrChannel; /* NULL */ + int stderrInitialized; /* 0 */ + + /* tclInterp.c */ + int aliasCounter; /* 0 */ + int interpCounter; /* 0 */ + + /* tclLoad.c */ + void *firstPackagePtr; /* NULL */ + + /* tclMain.c */ + Tcl_Interp *mainInterp; + Tcl_DString command; + #ifdef TCL_MEM_DEBUG + char dumpFile[100]; + int quitFlag; /* 0 */ + #endif /* TCL_MEM_DEBUG */ + + /* tclNamesp.c */ + long numNsCreated; /* 0 */ + int nsInitialized; /* 0 */ + + /* tclNotify.c */ + int notifyInitialized; /* 0 */ + + /* tclObj.c */ + int typeTableInitialized; /* 0 */ + Tcl_HashTable typeTable; + Tcl_Obj *tclFreeObjList; /* NULL */ + #define tclFreeObjList (tclGlob->tclFreeObjList) + char *tclEmptyStringRep; /* NULL */ + #define tclEmptyStringRep (tclGlob->tclEmptyStringRep) + #ifdef TCL_COMPILE_STATS + long tclObjsAlloced; /* 0 */ + #define tclObjsAlloced (tclGlob->tclObjsAlloced) + long tclObjsFreed; /* 0 */ + #define tclObjsFreed (tclGlob->tclObjsFreed) + #endif /* TCL_COMPILE_STATS */ + + /* tclPreserve.c */ + void *refArray; + int spaceAvl; /* 0 */ + int inUse; /* 0 */ + + /* tclTestObj.c */ + Tcl_Obj *varPtr[20]; + + /* tclTimer.c */ + int timerInitialized; /* 0 */ + void *FirstTimerHandlerPtr; /* NULL */ + int lastTimerId; + int timerPending; + void *idleList; + void *lastIdlePtr; + int idleGeneration; + int nextAfterID; /* 1 */ + + /* tclUnixNotfy.c */ + int unixNotifyInitialized; + struct notifier_private notifier; + + /* tclUtil.c */ + char precisionString[10]; /* "12" */ + char precisionFormat[10]; /* "%.12g" */ + + #if defined(USE_TCLALLOC) + LIST systemMemory; + #endif /* USE_TCLALLOC */ + + /* tclVxWorksFile.c */ + char *currentDir; /* NULL */ + int currentDirExitHandlerSet; /* 0 */ + + /* tclVxWorksInit.c */ + char defaultLibDir[200]; /* TCL_LIBRARY */ + char pkgPath[200]; /* TCL_PACKAGE_PATH */ + int wakeupPipe; + + /* tclVxWorksChan.c */ + void *firstFilePtr; /* NULL */ + fd_mask readyMasks[3*MASK_SIZE]; + + #ifdef INCLUDE_TEST + /* tclTest.c */ + Tcl_DString delString; + Tcl_Interp *delInterp; + void *firstTestHandler; /* NULL */ + Tcl_DString testDstring; + int nextTestAsyncId; /* 1 */ + int intVar; /* 43 */ + int boolVar; /* 4 */ + double realVar; /* 1.23 */ + char *stringVar; /* NULL */ + int created; /* 0 */ + Tcl_Interp *interp2; /* NULL */ + + /* tclVxWorksTest.c */ + #endif + + /* now comes all the globals that the various extensions use */ + + #if defined(INCLUDE_TCLX) + /* tclX */ + /* tclXgeneral.c */ + char *tclxVersion; /* TCLX_FULL_VERSION */ + int tclxPatchlevel; /* TCLX_PATCHLEVEL */ + char *tclAppName; /* NULL */ + char *tclAppLongName; /* NULL */ + char *tclAppVersion; /* NULL */ + int tclAppPatchlevel; /* -1 */ + + /* tclXhandles.c */ + int entryAlignment; /* 0 */ + int entryHeaderSize; /* 0 */ + + /* tclXlib.c */ + int haveNameSpaces; /* FALSE */ + + /* tclXshell.c */ + int tclDeleteInterpAtEnd; /* FALSE */ + #define tclDeleteInterpAtEnd (tclGlob->tclDeleteInterpAtEnd) + char dumpFileName[128]; + + /* tclXsignal.c */ + char *unknownSignalIdMsg; + Tcl_AsyncHandler asyncHandler; /* NULL */ + Tcl_Interp **interpTable; /* NULL */ + int interpTableSize; /* 0 */ + int numInterps; /* 0 */ + void *appSigErrorHandler; /* NULL */ + void *appSigErrorClientData; /* NULL */ + unsigned signalsReceived[MAXSIG]; + char *signalTrapCmds[MAXSIG]; + + /* getopt.c */ + int opterr; /* 1 */ + #define opterr (tclGlob->opterr) + int optind; /* 1 */ + #define optind (tclGlob->optind) + int optopt; + #define optopt (tclGlob->optopt) + int optreset; + #define optreset (tclGlob->optreset) + char *optarg; + #define optarg (tclGlob->optarg) + char *place; /* "" */ + + /* tclXVxWorksOS.c */ + struct timeval startTime; /* 0 */ + #endif /* INCLUDE_TCLX */ + + #if defined(INCLUDE_TCLBIN) + /* tclbin */ + /* bindata.c */ + int GNid; /* 1 */ + char GNname[10+22]; + char TOres[3]; /* 0 */ + char TCres[2]; /* 0 */ + char TIres[80]; + char TNIres[80]; + char TNSres[80]; + char TSres[80]; + char TDres[80]; + char TFres[80]; + char TPres[80]; + char ltoatmp[21]; + #endif /* INCLUDE_TCLBIN */ + + }; + extern struct tclglob *tclGlob; + + extern int shellTaskId; + + extern void TclPlatformCreateTask(int tid); + + #endif /* __INCtclVxWorksPorth */ diff -rc tcl8.0/vxworks/tclVxWorksSock.c tcl8.0-vxworks/vxworks/tclVxWorksSock.c *** tcl8.0/vxworks/tclVxWorksSock.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksSock.c Fri Oct 24 09:54:32 1997 *************** *** 0 **** --- 1,45 ---- + /* + * tclVxWorksSock.c -- + * + * This file contains VxWorks-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. + * + * based on: + * SCCS: @(#) tclUnixSock.c 1.7 97/07/24 17:54:02 + */ + + #include "tcl.h" + #include "tclPort.h" + + + /* + *---------------------------------------------------------------------- + * + * Tcl_GetHostName -- + * + * Get the network name for this machine, in a system dependent way. + * + * Results: + * A string containing the network name for this machine, or + * an empty string if we can't figure out the name. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + char * + Tcl_GetHostName() + { + /* hostname[] is defined/initialized elsewhere in the kernel + using gethostname(hostname,MAXHOSTNAMELEN). that way it + only needs to be done once (eliminated reentrancy problems) + */ + extern char hostname[]; + return hostname; + } diff -rc tcl8.0/vxworks/tclVxWorksTest.c tcl8.0-vxworks/vxworks/tclVxWorksTest.c *** tcl8.0/vxworks/tclVxWorksTest.c Fri Oct 24 10:25:15 1997 --- tcl8.0-vxworks/vxworks/tclVxWorksTest.c Fri Oct 24 09:43:16 1997 *************** *** 0 **** --- 1,99 ---- + /* + * tclVxWorksTest.c -- + * + * Contains platform specific test commands for the VxWorks 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. + * + * based on: + * SCCS: @(#) tclUnixTest.c 1.1 96/03/26 12:44:30 + * + * ############### + * This is not even remotely re-entrant (doesn't really need to be) + * ############### + */ + + #include "tclInt.h" + #include "tclPort.h" + + /* + * Forward declarations of procedures defined later in this file: + */ + + 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, "testgetopenfile", TestgetopenfileCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + 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; + }