diff options
Diffstat (limited to 'generic/tclIOCmd.c')
| -rw-r--r-- | generic/tclIOCmd.c | 733 |
1 files changed, 349 insertions, 384 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index b1ed0c8..f88840b 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -3,22 +3,16 @@ * * Contains the definitions of most of the Tcl commands relating to IO. * - * Copyright (c) 1995-1996 Sun Microsystems, Inc. + * 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. * - * RCS: @(#) $Id: tclIOCmd.c,v 1.4 1999/02/02 22:25:42 stanton Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.5 1999/04/16 00:46:47 stanton Exp $ */ -#include "tclInt.h" -#include "tclPort.h" - -/* - * Return at most this number of bytes in one call to Tcl_Read: - */ - -#define TCL_READ_CHUNK_SIZE 4096 +#include "tclInt.h" +#include "tclPort.h" /* * Callback structure for accept callback in a TCP server. @@ -76,12 +70,10 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv) int mode; /* Mode in which channel is opened. */ char *arg; int length; - Tcl_Obj *resultPtr; i = 1; newline = 1; - if ((objc >= 2) && (strcmp(Tcl_GetStringFromObj(objv[1], NULL), - "-nonewline") == 0)) { + if ((objc >= 2) && (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0)) { newline = 0; i++; } @@ -95,53 +87,46 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv) * form of the command that is no longer recommended or documented. */ - resultPtr = Tcl_NewObj(); if (i == (objc-3)) { - arg = Tcl_GetStringFromObj(objv[i+2], &length); + arg = Tcl_GetStringFromObj(objv[i + 2], &length); if (strncmp(arg, "nonewline", (size_t) length) != 0) { - Tcl_AppendStringsToObj(resultPtr, "bad argument \"", arg, + Tcl_AppendResult(interp, "bad argument \"", arg, "\": should be \"nonewline\"", (char *) NULL); - Tcl_SetObjResult(interp, resultPtr); return TCL_ERROR; } newline = 0; } - if (i == (objc-1)) { + if (i == (objc - 1)) { channelId = "stdout"; } else { - channelId = Tcl_GetStringFromObj(objv[i], NULL); + channelId = Tcl_GetString(objv[i]); i++; } chan = Tcl_GetChannel(interp, channelId, &mode); if (chan == (Tcl_Channel) NULL) { - Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendStringsToObj(resultPtr, "channel \"", channelId, + Tcl_AppendResult(interp, "channel \"", channelId, "\" wasn't opened for writing", (char *) NULL); - Tcl_SetObjResult(interp, resultPtr); return TCL_ERROR; } - arg = Tcl_GetStringFromObj(objv[i], &length); - result = Tcl_Write(chan, arg, length); + result = Tcl_WriteObj(chan, objv[i]); if (result < 0) { goto error; } if (newline != 0) { - result = Tcl_Write(chan, "\n", 1); + result = Tcl_WriteChars(chan, "\n", 1); if (result < 0) { goto error; } } - Tcl_SetObjResult(interp, resultPtr); return TCL_OK; -error: - Tcl_AppendStringsToObj(resultPtr, "error writing \"", - Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp), - (char *) NULL); - Tcl_SetObjResult(interp, resultPtr); + + error: + Tcl_AppendResult(interp, "error writing \"", channelId, "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } @@ -171,31 +156,27 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Channel chan; /* The channel to flush on. */ - char *arg; - Tcl_Obj *resultPtr; + char *channelId; int mode; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } - arg = Tcl_GetStringFromObj(objv[1], NULL); - chan = Tcl_GetChannel(interp, arg, &mode); + channelId = Tcl_GetString(objv[1]); + chan = Tcl_GetChannel(interp, channelId, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - resultPtr = Tcl_GetObjResult(interp); if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendStringsToObj(resultPtr, "channel \"", - Tcl_GetStringFromObj(objv[1], NULL), - "\" wasn't opened for writing", (char *) NULL); + Tcl_AppendResult(interp, "channel \"", channelId, + "\" wasn't opened for writing", (char *) NULL); return TCL_ERROR; } if (Tcl_Flush(chan) != TCL_OK) { - Tcl_AppendStringsToObj(resultPtr, "error flushing \"", - Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp), - (char *) NULL); + Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; @@ -229,51 +210,56 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv) Tcl_Channel chan; /* The channel to read from. */ int lineLen; /* Length of line just read. */ int mode; /* Mode in which channel is opened. */ - char *arg; - Tcl_Obj *resultPtr, *objPtr; + char *name; + Tcl_Obj *resultPtr, *linePtr; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?"); return TCL_ERROR; } - arg = Tcl_GetStringFromObj(objv[1], NULL); - chan = Tcl_GetChannel(interp, arg, &mode); + name = Tcl_GetString(objv[1]); + chan = Tcl_GetChannel(interp, name, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - resultPtr = Tcl_NewObj(); if ((mode & TCL_READABLE) == 0) { - Tcl_AppendStringsToObj(resultPtr, "channel \"", arg, - "\" wasn't opened for reading", (char *) NULL); - Tcl_SetObjResult(interp, resultPtr); + Tcl_AppendResult(interp, "channel \"", name, + "\" wasn't opened for reading", (char *) NULL); return TCL_ERROR; } - lineLen = Tcl_GetsObj(chan, resultPtr); + resultPtr = Tcl_GetObjResult(interp); + linePtr = resultPtr; + if (objc == 3) { + /* + * Variable gets line, interp get bytecount. + */ + + linePtr = Tcl_NewObj(); + } + + lineLen = Tcl_GetsObj(chan, linePtr); if (lineLen < 0) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { - Tcl_SetObjLength(resultPtr, 0); - Tcl_AppendStringsToObj(resultPtr, "error reading \"", - Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp), - (char *) NULL); - Tcl_SetObjResult(interp, resultPtr); + if (linePtr != resultPtr) { + Tcl_DecrRefCount(linePtr); + } + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "error reading \"", name, "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } lineLen = -1; } if (objc == 3) { - Tcl_ResetResult(interp); - objPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, - resultPtr, TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1); - if (objPtr == NULL) { - Tcl_DecrRefCount(resultPtr); + if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr, + TCL_LEAVE_ERR_MSG) == NULL) { + Tcl_DecrRefCount(linePtr); return TCL_ERROR; } - Tcl_ResetResult(interp); - Tcl_SetIntObj(Tcl_GetObjResult(interp), lineLen); + Tcl_SetIntObj(resultPtr, lineLen); return TCL_OK; } - Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } @@ -302,32 +288,25 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - Tcl_Channel chan; /* The channel to read from. */ - int newline, i; /* Discard newline at end? */ - int toRead; /* How many bytes to read? */ - int toReadNow; /* How many bytes to attempt to - * read in the current iteration? */ - int charactersRead; /* How many characters were read? */ - int charactersReadNow; /* How many characters were read - * in this iteration? */ - int mode; /* Mode in which channel is opened. */ - int bufSize; /* Channel buffer size; used to decide - * in what chunk sizes to read from - * the channel. */ - char *arg; + Tcl_Channel chan; /* The channel to read from. */ + int newline, i; /* Discard newline at end? */ + int toRead; /* How many bytes to read? */ + int charactersRead; /* How many characters were read? */ + int mode; /* Mode in which channel is opened. */ + char *name; Tcl_Obj *resultPtr; if ((objc != 2) && (objc != 3)) { -argerror: + argerror: Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numBytes?"); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), " or \"", - Tcl_GetStringFromObj(objv[0], NULL), + Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), " ?-nonewline? channelId\"", (char *) NULL); return TCL_ERROR; } + i = 1; newline = 0; - if (strcmp(Tcl_GetStringFromObj(objv[1], NULL), "-nonewline") == 0) { + if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) { newline = 1; i++; } @@ -336,18 +315,16 @@ argerror: goto argerror; } - arg = Tcl_GetStringFromObj(objv[i], NULL); - chan = Tcl_GetChannel(interp, arg, &mode); + name = Tcl_GetString(objv[i]); + chan = Tcl_GetChannel(interp, name, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { - resultPtr = Tcl_GetObjResult(interp); - Tcl_AppendStringsToObj(resultPtr, "channel \"", arg, + Tcl_AppendResult(interp, "channel \"", name, "\" wasn't opened for reading", (char *) NULL); return TCL_ERROR; } - i++; /* Consumed channel name. */ /* @@ -355,112 +332,53 @@ argerror: * newline should be dropped. */ - toRead = INT_MAX; + toRead = -1; if (i < objc) { - arg = Tcl_GetStringFromObj(objv[i], NULL); - if (isdigit((unsigned char) (arg[0]))) { + char *arg; + + arg = Tcl_GetString(objv[i]); + if (isdigit(UCHAR(arg[0]))) { /* INTL: digit */ if (Tcl_GetIntFromObj(interp, objv[i], &toRead) != TCL_OK) { return TCL_ERROR; } - Tcl_ResetResult(interp); } else if (strcmp(arg, "nonewline") == 0) { newline = 1; } else { - resultPtr = Tcl_GetObjResult(interp); - Tcl_AppendStringsToObj(resultPtr, "bad argument \"", arg, + Tcl_AppendResult(interp, "bad argument \"", arg, "\": should be \"nonewline\"", (char *) NULL); return TCL_ERROR; } } - /* - * Create a new object and use that instead of the interpreter - * result. We cannot use the interpreter's result object because - * it may get smashed at any time by recursive calls. - */ - - resultPtr = Tcl_NewObj(); - - bufSize = Tcl_GetChannelBufferSize(chan); - - /* - * If the caller specified a maximum length to read, then that is - * a good size to preallocate. - */ - - if ((toRead != INT_MAX) && (toRead > bufSize)) { - Tcl_SetObjLength(resultPtr, toRead); - } - - for (charactersRead = 0; charactersRead < toRead; ) { - toReadNow = toRead - charactersRead; - if (toReadNow > bufSize) { - toReadNow = bufSize; - } - - /* - * NOTE: This is a NOOP if we set the size (above) to the - * number of bytes we expect to read. In the degenerate - * case, however, it will grow the buffer by the channel - * buffersize, which is 4K in most cases. This will result - * in inefficient copying for large files. This will be - * fixed in a future release. - */ - - Tcl_SetObjLength(resultPtr, charactersRead + toReadNow); - charactersReadNow = - Tcl_Read(chan, Tcl_GetStringFromObj(resultPtr, NULL) - + charactersRead, toReadNow); - if (charactersReadNow < 0) { - Tcl_SetObjLength(resultPtr, 0); - Tcl_AppendStringsToObj(resultPtr, "error reading \"", - Tcl_GetChannelName(chan), "\": ", - Tcl_PosixError(interp), (char *) NULL); - Tcl_SetObjResult(interp, resultPtr); - - return TCL_ERROR; - } - - /* - * If we had a short read it means that we have either EOF - * or BLOCKED on the channel, so break out. - */ - - charactersRead += charactersReadNow; - - /* - * Do not call the driver again if we got a short read - */ - - if (charactersReadNow < toReadNow) { - break; /* Out of "for" loop. */ - } + resultPtr = Tcl_GetObjResult(interp); + charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); + if (charactersRead < 0) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "error reading \"", name, "\": ", + Tcl_PosixError(interp), (char *) NULL); + return TCL_ERROR; } /* * If requested, remove the last newline in the channel if at EOF. */ - if ((charactersRead > 0) && (newline) && - (Tcl_GetStringFromObj(resultPtr, NULL)[charactersRead-1] == '\n')) { - charactersRead--; - } - Tcl_SetObjLength(resultPtr, charactersRead); - - /* - * Now set the object into the interpreter result and release our - * hold on it by decrrefing it. - */ + if ((charactersRead > 0) && (newline != 0)) { + char *result; + int length; - Tcl_SetObjResult(interp, resultPtr); - + result = Tcl_GetStringFromObj(resultPtr, &length); + if (result[length - 1] == '\n') { + Tcl_SetObjLength(resultPtr, length - 1); + } + } return TCL_OK; } /* *---------------------------------------------------------------------- * - * Tcl_SeekCmd -- + * Tcl_SeekObjCmd -- * * This procedure is invoked to process the Tcl "seek" command. See * the user documentation for details on what it does. @@ -477,53 +395,45 @@ argerror: /* ARGSUSED */ int -Tcl_SeekCmd(clientData, interp, argc, argv) +Tcl_SeekObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ int offset, mode; /* Where to seek? */ int result; /* Of calling Tcl_Seek. */ + char *chanName; + int optionIndex; + static char *originOptions[] = {"start", "current", "end", (char *) NULL}; + static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelId offset ?origin?\"", (char *) NULL); + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?"); return TCL_ERROR; } - chan = Tcl_GetChannel(interp, argv[1], NULL); + chanName = Tcl_GetString(objv[1]); + chan = Tcl_GetChannel(interp, chanName, NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - if (Tcl_GetInt(interp, argv[2], &offset) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], &offset) != TCL_OK) { return TCL_ERROR; } mode = SEEK_SET; - if (argc == 4) { - size_t length; - int c; - - length = strlen(argv[3]); - c = argv[3][0]; - if ((c == 's') && (strncmp(argv[3], "start", length) == 0)) { - mode = SEEK_SET; - } else if ((c == 'c') && (strncmp(argv[3], "current", length) == 0)) { - mode = SEEK_CUR; - } else if ((c == 'e') && (strncmp(argv[3], "end", length) == 0)) { - mode = SEEK_END; - } else { - Tcl_AppendResult(interp, "bad origin \"", argv[3], - "\": should be start, current, or end", (char *) NULL); + if (objc == 4) { + if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0, + &optionIndex) != TCL_OK) { return TCL_ERROR; } + mode = modeArray[optionIndex]; } result = Tcl_Seek(chan, offset, mode); if (result == -1) { Tcl_AppendResult(interp, "error during seek on \"", - Tcl_GetChannelName(chan), "\": ", - Tcl_PosixError(interp), (char *) NULL); + chanName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; @@ -532,7 +442,7 @@ Tcl_SeekCmd(clientData, interp, argc, argv) /* *---------------------------------------------------------------------- * - * Tcl_TellCmd -- + * Tcl_TellObjCmd -- * * This procedure is invoked to process the Tcl "tell" command. * See the user documentation for details on what it does. @@ -548,18 +458,17 @@ Tcl_SeekCmd(clientData, interp, argc, argv) /* ARGSUSED */ int -Tcl_TellCmd(clientData, interp, argc, argv) +Tcl_TellObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ - char buf[40]; + char *chanName; - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelId\"", (char *) NULL); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } /* @@ -567,12 +476,12 @@ Tcl_TellCmd(clientData, interp, argc, argv) * the IO channel table of this interpreter. */ - chan = Tcl_GetChannel(interp, argv[1], NULL); + chanName = Tcl_GetString(objv[1]); + chan = Tcl_GetChannel(interp, chanName, NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - TclFormatInt(buf, Tcl_Tell(chan)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan)); return TCL_OK; } @@ -602,7 +511,6 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Channel chan; /* The channel to close. */ - int len; /* Length of error output. */ char *arg; if (objc != 2) { @@ -610,7 +518,7 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } - arg = Tcl_GetStringFromObj(objv[1], NULL); + arg = Tcl_GetString(objv[1]); chan = Tcl_GetChannel(interp, arg, NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; @@ -620,7 +528,7 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv) /* * If there is an error message and it ends with a newline, remove * the newline. This is done for command pipeline channels where the - * error output from the subprocesses is stored in interp->result. + * error output from the subprocesses is stored in interp's result. * * NOTE: This is likely to not have any effect on regular error * messages produced by drivers during the closing of a channel, @@ -628,11 +536,15 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv) * have a terminating newline. */ - len = strlen(interp->result); - if ((len > 0) && (interp->result[len - 1] == '\n')) { - interp->result[len - 1] = '\0'; + Tcl_Obj *resultPtr; + char *string; + int len; + + resultPtr = Tcl_GetObjResult(interp); + string = Tcl_GetStringFromObj(resultPtr, &len); + if ((len > 0) && (string[len - 1] == '\n')) { + Tcl_SetObjLength(resultPtr, len - 1); } - return TCL_ERROR; } @@ -642,7 +554,7 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv) /* *---------------------------------------------------------------------- * - * Tcl_FconfigureCmd -- + * Tcl_FconfigureObjCmd -- * * This procedure is invoked to process the Tcl "fconfigure" command. * See the user documentation for details on what it does. @@ -658,28 +570,29 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv) /* ARGSUSED */ int -Tcl_FconfigureCmd(clientData, interp, argc, argv) +Tcl_FconfigureObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { + char *chanName, *optionName, *valueName; Tcl_Channel chan; /* The channel to set a mode on. */ int i; /* Iterate over arg-value pairs. */ Tcl_DString ds; /* DString to hold result of * calling Tcl_GetChannelOption. */ - if ((argc < 2) || (((argc % 2) == 1) && (argc != 3))) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelId ?optionName? ?value? ?optionName value?...\"", - (char *) NULL); + if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) { + Tcl_WrongNumArgs(interp, 1, objv, + "channelId ?optionName? ?value? ?optionName value?..."); return TCL_ERROR; } - chan = Tcl_GetChannel(interp, argv[1], NULL); + chanName = Tcl_GetString(objv[1]); + chan = Tcl_GetChannel(interp, chanName, NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - if (argc == 2) { + if (objc == 2) { Tcl_DStringInit(&ds); if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) { Tcl_DStringFree(&ds); @@ -688,17 +601,21 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv) Tcl_DStringResult(interp, &ds); return TCL_OK; } - if (argc == 3) { + if (objc == 3) { Tcl_DStringInit(&ds); - if (Tcl_GetChannelOption(interp, chan, argv[2], &ds) != TCL_OK) { + optionName = Tcl_GetString(objv[2]); + if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } Tcl_DStringResult(interp, &ds); return TCL_OK; } - for (i = 3; i < argc; i += 2) { - if (Tcl_SetChannelOption(interp, chan, argv[i-1], argv[i]) != TCL_OK) { + for (i = 3; i < objc; i += 2) { + optionName = Tcl_GetString(objv[i-1]); + valueName = Tcl_GetString(objv[i]); + if (Tcl_SetChannelOption(interp, chan, optionName, valueName) + != TCL_OK) { return TCL_ERROR; } } @@ -706,7 +623,7 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv) } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * Tcl_EofObjCmd -- * @@ -717,10 +634,10 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv) * A standard Tcl result. * * Side effects: - * Sets interp->result to "0" or "1" depending on whether the - * specified channel has an EOF condition. + * Sets interp's result to boolean true or false depending on whether + * the specified channel has an EOF condition. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ /* ARGSUSED */ @@ -731,9 +648,8 @@ Tcl_EofObjCmd(unused, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - Tcl_Channel chan; /* The channel to query for EOF. */ - int mode; /* Mode in which channel is opened. */ - char buf[40]; + Tcl_Channel chan; + int dummy; char *arg; if (objc != 2) { @@ -741,21 +657,20 @@ Tcl_EofObjCmd(unused, interp, objc, objv) return TCL_ERROR; } - arg = Tcl_GetStringFromObj(objv[1], NULL); - chan = Tcl_GetChannel(interp, arg, &mode); - if (chan == (Tcl_Channel) NULL) { + arg = Tcl_GetString(objv[1]); + chan = Tcl_GetChannel(interp, arg, &dummy); + if (chan == NULL) { return TCL_ERROR; } - TclFormatInt(buf, Tcl_Eof(chan) ? 1 : 0); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_Eof(chan)); return TCL_OK; } /* *---------------------------------------------------------------------- * - * Tcl_ExecCmd -- + * Tcl_ExecObjCmd -- * * This procedure is invoked to process the "exec" Tcl command. * See the user documentation for details on what it does. @@ -771,44 +686,63 @@ Tcl_EofObjCmd(unused, interp, objc, objv) /* ARGSUSED */ int -Tcl_ExecCmd(dummy, interp, argc, argv) +Tcl_ExecObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { #ifdef MAC_TCL + Tcl_AppendResult(interp, "exec not implemented under Mac OS", (char *)NULL); return TCL_ERROR; + #else /* !MAC_TCL */ - int keepNewline, firstWord, background, length, result; + + /* + * This procedure generates an argv array for the string arguments. It + * starts out with stack-allocated space but uses dynamically-allocated + * storage if needed. + */ + +#define NUM_ARGS 20 + Tcl_Obj *resultPtr; + char **argv; + char *string; Tcl_Channel chan; - Tcl_DString ds; - int readSoFar, readNow, bufSize; + char *argStorage[NUM_ARGS]; + int argc, background, i, index, keepNewline, result, skip, length; + static char *options[] = { + "-keepnewline", "--", NULL + }; + enum options { + EXEC_KEEPNEWLINE, EXEC_LAST + }; /* * Check for a leading "-keepnewline" argument. */ keepNewline = 0; - for (firstWord = 1; (firstWord < argc) && (argv[firstWord][0] == '-'); - firstWord++) { - if (strcmp(argv[firstWord], "-keepnewline") == 0) { - keepNewline = 1; - } else if (strcmp(argv[firstWord], "--") == 0) { - firstWord++; + for (skip = 1; skip < objc; skip++) { + string = Tcl_GetString(objv[skip]); + if (string[0] != '-') { break; - } else { - Tcl_AppendResult(interp, "bad switch \"", argv[firstWord], - "\": must be -keepnewline or --", (char *) NULL); + } + if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch", + TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } + if (index == EXEC_KEEPNEWLINE) { + keepNewline = 1; + } else { + skip++; + break; + } } - - if (argc <= firstWord) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?switches? arg ?arg ...?\"", (char *) NULL); + if (objc <= skip) { + Tcl_WrongNumArgs(interp, 1, objv, "?switches? arg ?arg ...?"); return TCL_ERROR; } @@ -817,84 +751,100 @@ Tcl_ExecCmd(dummy, interp, argc, argv) */ background = 0; - if ((argv[argc-1][0] == '&') && (argv[argc-1][1] == 0)) { - argc--; - argv[argc] = NULL; + string = Tcl_GetString(objv[objc - 1]); + if ((string[0] == '&') && (string[1] == '\0')) { + objc--; background = 1; } - - chan = Tcl_OpenCommandChannel(interp, argc-firstWord, - argv+firstWord, - (background ? 0 : TCL_STDOUT | TCL_STDERR)); + + /* + * Create the string argument array "argv". Make sure argv is large + * enough to hold the argc arguments plus 1 extra for the zero + * end-of-argv word. + */ + + argv = argStorage; + argc = objc - skip; + if ((argc + 1) > sizeof(argv) / sizeof(argv[0])) { + argv = (char **) ckalloc((unsigned)(argc + 1) * sizeof(char *)); + } + + /* + * Copy the string conversions of each (post option) object into the + * argument vector. + */ + + for (i = 0; i < argc; i++) { + argv[i] = Tcl_GetString(objv[i + skip]); + } + argv[argc] = NULL; + chan = Tcl_OpenCommandChannel(interp, argc, argv, + (background ? 0 : TCL_STDOUT | TCL_STDERR)); + + /* + * Free the argv array if malloc'ed storage was used. + */ + + if (argv != argStorage) { + ckfree((char *)argv); + } if (chan == (Tcl_Channel) NULL) { - return TCL_ERROR; + return TCL_ERROR; } if (background) { - /* - * Get the list of PIDs from the pipeline into interp->result and - * detach the PIDs (instead of waiting for them). - */ + * Store the list of PIDs from the pipeline in interp's result and + * detach the PIDs (instead of waiting for them). + */ TclGetAndDetachPids(interp, chan); - if (Tcl_Close(interp, chan) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } - return TCL_OK; + return TCL_OK; } + resultPtr = Tcl_NewObj(); if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) { -#define EXEC_BUFFER_SIZE 4096 - - Tcl_DStringInit(&ds); - readSoFar = 0; bufSize = 0; - while (1) { - bufSize += EXEC_BUFFER_SIZE; - Tcl_DStringSetLength(&ds, bufSize); - readNow = Tcl_Read(chan, Tcl_DStringValue(&ds) + readSoFar, - EXEC_BUFFER_SIZE); - if (readNow < 0) { - Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "error reading output from command: ", - Tcl_PosixError(interp), (char *) NULL); - return TCL_ERROR; - } - readSoFar += readNow; - if (readNow < EXEC_BUFFER_SIZE) { - break; /* Out of "while (1)" loop. */ - } - } - Tcl_DStringSetLength(&ds, readSoFar); - Tcl_DStringResult(interp, &ds); + if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "error reading output from command: ", + Tcl_PosixError(interp), (char *) NULL); + Tcl_DecrRefCount(resultPtr); + return TCL_ERROR; + } } + /* + * If the process produced anything on stderr, it will have been + * returned in the interpreter result. It needs to be appended to + * the result string. + */ result = Tcl_Close(interp, chan); + string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); + Tcl_AppendToObj(resultPtr, string, length); /* - * If the last character of interp->result is a newline, then remove - * the newline character (the newline would just confuse things). - * Special hack: must replace the old terminating null character - * as a signal to Tcl_AppendResult et al. that we've mucked with - * the string. + * If the last character of the result is a newline, then remove + * the newline character. */ - length = strlen(interp->result); - if (!keepNewline && (length > 0) && - (interp->result[length-1] == '\n')) { - interp->result[length-1] = '\0'; - interp->result[length] = 'x'; + if (keepNewline == 0) { + string = Tcl_GetStringFromObj(resultPtr, &length); + if ((length > 0) && (string[length - 1] == '\n')) { + Tcl_SetObjLength(resultPtr, length - 1); + } } + Tcl_SetObjResult(interp, resultPtr); return result; #endif /* !MAC_TCL */ } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * Tcl_FblockedObjCmd -- * @@ -905,10 +855,10 @@ Tcl_ExecCmd(dummy, interp, argc, argv) * A standard Tcl result. * * Side effects: - * Sets interp->result to "0" or "1" depending on whether the - * a preceding input operation on the channel would have blocked. + * Sets interp's result to boolean true or false depending on whether + * the preceeding input operation on the channel would have blocked. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ /* ARGSUSED */ @@ -919,9 +869,8 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - Tcl_Channel chan; /* The channel to query for blocked. */ - int mode; /* Mode in which channel was opened. */ - char buf[40]; + Tcl_Channel chan; + int mode; char *arg; if (objc != 2) { @@ -929,20 +878,18 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv) return TCL_ERROR; } - arg = Tcl_GetStringFromObj(objv[1], NULL); + arg = Tcl_GetString(objv[1]); chan = Tcl_GetChannel(interp, arg, &mode); - if (chan == (Tcl_Channel) NULL) { + if (chan == NULL) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", - Tcl_GetStringFromObj(objv[1], NULL), - "\" wasn't opened for reading", (char *) NULL); + arg, "\" wasn't opened for reading", (char *) NULL); return TCL_ERROR; } - TclFormatInt(buf, Tcl_InputBlocked(chan) ? 1 : 0); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_InputBlocked(chan)); return TCL_OK; } @@ -965,35 +912,35 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv) /* ARGSUSED */ int -Tcl_OpenObjCmd(notUsed, interp, argc, objv) +Tcl_OpenObjCmd(notUsed, interp, objc, objv) ClientData notUsed; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - Tcl_Obj * CONST objv[]; /* Argument objects. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { int pipeline, prot; - char *modeString, *arg1; + char *modeString, *what; Tcl_Channel chan; - if ((argc < 2) || (argc > 4)) { + if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "fileName ?access? ?permissions?"); return TCL_ERROR; } prot = 0666; - if (argc == 2) { + if (objc == 2) { modeString = "r"; } else { - modeString = Tcl_GetStringFromObj(objv[2], NULL); - if (argc == 4) { + modeString = Tcl_GetString(objv[2]); + if (objc == 4) { if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) { return TCL_ERROR; } } } - arg1 = Tcl_GetStringFromObj(objv[1], NULL); pipeline = 0; - if (arg1[0] == '|') { + what = Tcl_GetString(objv[1]); + if (what[0] == '|') { pipeline = 1; } @@ -1002,18 +949,18 @@ Tcl_OpenObjCmd(notUsed, interp, argc, objv) */ if (!pipeline) { - chan = Tcl_OpenFileChannel(interp, arg1, modeString, prot); + chan = Tcl_OpenFileChannel(interp, what, modeString, prot); } else { #ifdef MAC_TCL - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + Tcl_AppendResult(interp, "command pipelines not supported on Macintosh OS", (char *)NULL); return TCL_ERROR; #else - int mode, seekFlag, cmdArgc; + int mode, seekFlag, cmdObjc; char **cmdArgv; - if (Tcl_SplitList(interp, arg1+1, &cmdArgc, &cmdArgv) != TCL_OK) { + if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) { return TCL_ERROR; } @@ -1036,7 +983,7 @@ Tcl_OpenObjCmd(notUsed, interp, argc, objv) panic("Tcl_OpenCmd: invalid mode value"); break; } - chan = Tcl_OpenCommandChannel(interp, cmdArgc, cmdArgv, flags); + chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags); } ckfree((char *) cmdArgv); #endif @@ -1045,8 +992,7 @@ Tcl_OpenObjCmd(notUsed, interp, argc, objv) return TCL_ERROR; } Tcl_RegisterChannel(interp, chan); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - Tcl_GetChannelName(chan), (char *) NULL); + Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL); return TCL_OK; } @@ -1218,7 +1164,7 @@ AcceptCallbackProc(callbackData, chan, address, port) AcceptCallback *acceptCallbackPtr; Tcl_Interp *interp; char *script; - char portBuf[10]; + char portBuf[TCL_INTEGER_SPACE]; int result; acceptCallbackPtr = (AcceptCallback *) callbackData; @@ -1315,7 +1261,7 @@ TcpServerCloseProc(callbackData) /* *---------------------------------------------------------------------- * - * Tcl_SocketCmd -- + * Tcl_SocketObjCmd -- * * This procedure is invoked to process the "socket" Tcl command. * See the user documentation for details on what it does. @@ -1330,13 +1276,19 @@ TcpServerCloseProc(callbackData) */ int -Tcl_SocketCmd(notUsed, interp, argc, argv) +Tcl_SocketObjCmd(notUsed, interp, objc, objv) ClientData notUsed; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int a, server, port; + static char *socketOptions[] = { + "-async", "-myaddr", "-myport","-server", (char *) NULL + }; + enum socketOptions { + SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER + }; + int optionIndex, a, server, port; char *arg, *copyScript, *host, *script; char *myaddr = NULL; int myport = 0; @@ -1347,66 +1299,78 @@ Tcl_SocketCmd(notUsed, interp, argc, argv) server = 0; script = NULL; - if (TclHasSockets(interp) != TCL_OK) { + if (TclpHasSockets(interp) != TCL_OK) { return TCL_ERROR; } - for (a = 1; a < argc; a++) { - arg = argv[a]; - if (arg[0] == '-') { - if (strcmp(arg, "-server") == 0) { - if (async == 1) { + for (a = 1; a < objc; a++) { + arg = Tcl_GetString(objv[a]); + if (arg[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, + "option", TCL_EXACT, &optionIndex) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum socketOptions) optionIndex) { + case SKT_ASYNC: { + if (server == 1) { Tcl_AppendResult(interp, "cannot set -async option for server sockets", (char *) NULL); return TCL_ERROR; } - server = 1; - a++; - if (a >= argc) { - Tcl_AppendResult(interp, - "no argument given for -server option", - (char *) NULL); - return TCL_ERROR; - } - script = argv[a]; - } else if (strcmp(arg, "-myaddr") == 0) { + async = 1; + break; + } + case SKT_MYADDR: { a++; - if (a >= argc) { + if (a >= objc) { Tcl_AppendResult(interp, "no argument given for -myaddr option", (char *) NULL); return TCL_ERROR; } - myaddr = argv[a]; - } else if (strcmp(arg, "-myport") == 0) { + myaddr = Tcl_GetString(objv[a]); + break; + } + case SKT_MYPORT: { + char *myPortName; a++; - if (a >= argc) { + if (a >= objc) { Tcl_AppendResult(interp, "no argument given for -myport option", (char *) NULL); return TCL_ERROR; } - if (TclSockGetPort(interp, argv[a], "tcp", &myport) - != TCL_OK) { + myPortName = Tcl_GetString(objv[a]); + if (TclSockGetPort(interp, myPortName, "tcp", &myport) + != TCL_OK) { return TCL_ERROR; } - } else if (strcmp(arg, "-async") == 0) { - if (server == 1) { + break; + } + case SKT_SERVER: { + if (async == 1) { Tcl_AppendResult(interp, "cannot set -async option for server sockets", (char *) NULL); return TCL_ERROR; } - async = 1; - } else { - Tcl_AppendResult(interp, "bad option \"", arg, - "\", must be -async, -myaddr, -myport, or -server", - (char *) NULL); - return TCL_ERROR; + server = 1; + a++; + if (a >= objc) { + Tcl_AppendResult(interp, + "no argument given for -server option", + (char *) NULL); + return TCL_ERROR; + } + script = Tcl_GetString(objv[a]); + break; + } + default: { + panic("Tcl_SocketObjCmd: bad option index to SocketOptions"); } - } else { - break; } } if (server) { @@ -1416,22 +1380,23 @@ Tcl_SocketCmd(notUsed, interp, argc, argv) NULL); return TCL_ERROR; } - } else if (a < argc) { - host = argv[a]; + } else if (a < objc) { + host = Tcl_GetString(objv[a]); a++; } else { wrongNumArgs: Tcl_AppendResult(interp, "wrong # args: should be either:\n", - argv[0], + Tcl_GetString(objv[0]), " ?-myaddr addr? ?-myport myport? ?-async? host port\n", - argv[0], + Tcl_GetString(objv[0]), " -server command ?-myaddr addr? port", (char *) NULL); return TCL_ERROR; } - if (a == argc-1) { - if (TclSockGetPort(interp, argv[a], "tcp", &port) != TCL_OK) { + if (a == objc-1) { + if (TclSockGetPort(interp, Tcl_GetString(objv[a]), + "tcp", &port) != TCL_OK) { return TCL_ERROR; } } else { @@ -1510,10 +1475,10 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv) Tcl_Channel inChan, outChan; char *arg; int mode, i; - int toRead; + int toRead, index; Tcl_Obj *cmdPtr; static char* switches[] = { "-size", "-command", NULL }; - enum { FcopySize, FcopyCommand } index; + enum { FcopySize, FcopyCommand }; if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1526,25 +1491,25 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv) * or writable, as appropriate. */ - arg = Tcl_GetStringFromObj(objv[1], NULL); + arg = Tcl_GetString(objv[1]); inChan = Tcl_GetChannel(interp, arg, &mode); if (inChan == (Tcl_Channel) NULL) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", - Tcl_GetStringFromObj(objv[1], NULL), + Tcl_GetString(objv[1]), "\" wasn't opened for reading", (char *) NULL); return TCL_ERROR; } - arg = Tcl_GetStringFromObj(objv[2], NULL); + arg = Tcl_GetString(objv[2]); outChan = Tcl_GetChannel(interp, arg, &mode); if (outChan == (Tcl_Channel) NULL) { return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"", - Tcl_GetStringFromObj(objv[1], NULL), + Tcl_GetString(objv[1]), "\" wasn't opened for writing", (char *) NULL); return TCL_ERROR; } |