]>
cvs.zerfleddert.de Git - micropolis/blob - src/tcl/tclunxut.c
4 * This file contains a collection of utility procedures that
5 * are present in the Tcl's UNIX core but not in the generic
6 * core. For example, they do file manipulation and process
9 * The Tcl_Fork and Tcl_WaitPids procedures are based on code
10 * contributed by Karl Lehenbauer, Mark Diekhans and Peter
13 * Copyright 1991 Regents of the University of California
14 * Permission to use, copy, modify, and distribute this
15 * software and its documentation for any purpose and without
16 * fee is hereby granted, provided that this copyright
17 * notice appears in all copies. The University of California
18 * makes no representations about the suitability of this
19 * software for any purpose. It is provided "as is" without
20 * express or implied warranty.
24 static char rcsid
[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.18 91/11/21 14:53:46 ouster Exp $ SPRITE (Berkeley)";
31 * Data structures of the following type are used by Tcl_Fork and
32 * Tcl_WaitPids to keep track of child processes.
36 int pid
; /* Process id of child. */
37 WAIT_STATUS_TYPE status
; /* Status returned when child exited or
39 int flags
; /* Various flag bits; see below for
44 * Flag bits in WaitInfo structures:
46 * WI_READY - Non-zero means process has exited or
47 * suspended since it was forked or last
48 * returned by Tcl_WaitPids.
49 * WI_DETACHED - Non-zero means no-one cares about the
50 * process anymore. Ignore it until it
51 * exits, then forget about it.
57 static WaitInfo
*waitTable
= NULL
;
58 static int waitTableSize
= 0; /* Total number of entries available in
60 static int waitTableUsed
= 0; /* Number of entries in waitTable that
61 * are actually in use right now. Active
62 * entries are always at the beginning
64 #define WAIT_TABLE_GROW_BY 4
67 *----------------------------------------------------------------------
71 * Read in a file and process the entire file as one gigantic
75 * A standard Tcl result, which is either the result of executing
76 * the file or an error indicating why the file couldn't be read.
79 * Depends on the commands in the file.
81 *----------------------------------------------------------------------
86 Tcl_Interp
*interp
, /* Interpreter in which to process file. */
87 char *fileName
/* Name of file to process. Tilde-substitution
88 * will be performed on this name. */
93 char *cmdBuffer
, *end
, *oldScriptFile
;
94 Interp
*iPtr
= (Interp
*) interp
;
96 oldScriptFile
= iPtr
->scriptFile
;
97 iPtr
->scriptFile
= fileName
;
98 fileName
= Tcl_TildeSubst(interp
, fileName
);
99 if (fileName
== NULL
) {
103 filename2DOS(fileName
);
105 fileId
= open(fileName
, O_RDONLY
, 0);
108 Tcl_AppendResult(interp
, "couldn't read file \"", fileName
,
109 "\": ", Tcl_UnixError(interp
), (char *) NULL
);
112 if (fstat(fileId
, &statBuf
) == -1) {
113 Tcl_AppendResult(interp
, "couldn't stat file \"", fileName
,
114 "\": ", Tcl_UnixError(interp
), (char *) NULL
);
118 cmdBuffer
= (char *) ckalloc((unsigned) statBuf
.st_size
+1);
120 if (read(fileId
, cmdBuffer
, (int) statBuf
.st_size
) < 0) {
122 if (read(fileId
, cmdBuffer
, (int) statBuf
.st_size
) != statBuf
.st_size
) {
124 Tcl_AppendResult(interp
, "error in reading file \"", fileName
,
125 "\": ", Tcl_UnixError(interp
), (char *) NULL
);
129 if (close(fileId
) != 0) {
130 Tcl_AppendResult(interp
, "error closing file \"", fileName
,
131 "\": ", Tcl_UnixError(interp
), (char *) NULL
);
134 cmdBuffer
[statBuf
.st_size
] = 0;
135 result
= Tcl_Eval(interp
, cmdBuffer
, 0, &end
);
136 if (result
== TCL_RETURN
) {
139 if (result
== TCL_ERROR
) {
143 * Record information telling where the error occurred.
146 sprintf(msg
, "\n (file \"%.150s\" line %d)", fileName
,
148 Tcl_AddErrorInfo(interp
, msg
);
151 iPtr
->scriptFile
= oldScriptFile
;
155 iPtr
->scriptFile
= oldScriptFile
;
160 *----------------------------------------------------------------------
164 * Create a new process using the vfork system call, and keep
165 * track of it for "safe" waiting with Tcl_WaitPids.
168 * The return value is the value returned by the vfork system
169 * call (0 means child, > 0 means parent (value is child id),
173 * A new process is created, and an entry is added to an internal
174 * table of child processes if the process is created successfully.
176 *----------------------------------------------------------------------
186 * Disable SIGPIPE signals: if they were allowed, this process
187 * might go away unexpectedly if children misbehave. This code
188 * can potentially interfere with other application code that
189 * expects to handle SIGPIPEs; what's really needed is an
190 * arbiter for signals to allow them to be "shared".
193 if (waitTable
== NULL
) {
194 (void) signal(SIGPIPE
, SIG_IGN
);
198 * Enlarge the wait table if there isn't enough space for a new
202 if (waitTableUsed
== waitTableSize
) {
204 WaitInfo
*newWaitTable
;
206 newSize
= waitTableSize
+ WAIT_TABLE_GROW_BY
;
207 newWaitTable
= (WaitInfo
*) ckalloc((unsigned)
208 (newSize
* sizeof(WaitInfo
)));
209 memcpy((VOID
*) newWaitTable
, (VOID
*) waitTable
,
210 (waitTableSize
* sizeof(WaitInfo
)));
211 if (waitTable
!= NULL
) {
212 ckfree((char *) waitTable
);
214 waitTable
= newWaitTable
;
215 waitTableSize
= newSize
;
219 * Make a new process and enter it into the table if the fork
223 waitPtr
= &waitTable
[waitTableUsed
];
234 *----------------------------------------------------------------------
238 * This procedure is used to wait for one or more processes created
239 * by Tcl_Fork to exit or suspend. It records information about
240 * all processes that exit or suspend, even those not waited for,
241 * so that later waits for them will be able to get the status
245 * -1 is returned if there is an error in the wait kernel call.
246 * Otherwise the pid of an exited/suspended process from *pidPtr
247 * is returned and *statusPtr is set to the status value returned
248 * by the wait kernel call.
251 * Doesn't return until one of the pids at *pidPtr exits or suspends.
253 *----------------------------------------------------------------------
258 int numPids
, /* Number of pids to wait on: gives size
259 * of array pointed to by pidPtr. */
260 int *pidPtr
, /* Pids to wait on: return when one of
261 * these processes exits or suspends. */
262 int *statusPtr
/* Wait status is returned here. */
266 register WaitInfo
*waitPtr
;
268 WAIT_STATUS_TYPE status
;
272 * Scan the table of child processes to see if one of the
273 * specified children has already exited or suspended. If so,
274 * remove it from the table and return its status.
278 for (waitPtr
= waitTable
, count
= waitTableUsed
;
279 count
> 0; waitPtr
++, count
--) {
280 for (i
= 0; i
< numPids
; i
++) {
281 if (pidPtr
[i
] != waitPtr
->pid
) {
285 if (waitPtr
->flags
& WI_READY
) {
286 *statusPtr
= *((int *) &waitPtr
->status
);
288 if (WIFEXITED(waitPtr
->status
)
289 || WIFSIGNALED(waitPtr
->status
)) {
290 *waitPtr
= waitTable
[waitTableUsed
-1];
293 waitPtr
->flags
&= ~WI_READY
;
301 * Make sure that the caller at least specified one valid
302 * process to wait for.
311 * Wait for a process to exit or suspend, then update its
312 * entry in the table and go back to the beginning of the
313 * loop to see if it's one of the desired processes.
320 for (waitPtr
= waitTable
, count
= waitTableUsed
; ;
321 waitPtr
++, count
--) {
323 break; /* Ignore unknown processes. */
325 if (pid
!= waitPtr
->pid
) {
330 * If the process has been detached, then ignore anything
331 * other than an exit, and drop the entry on exit.
334 if (waitPtr
->flags
& WI_DETACHED
) {
335 if (WIFEXITED(status
) || WIFSIGNALED(status
)) {
336 *waitPtr
= waitTable
[waitTableUsed
-1];
340 waitPtr
->status
= status
;
341 waitPtr
->flags
|= WI_READY
;
349 *----------------------------------------------------------------------
353 * This procedure is called to indicate that one or more child
354 * processes have been placed in background and are no longer
355 * cared about. They should be ignored in future calls to
364 *----------------------------------------------------------------------
369 int numPids
, /* Number of pids to detach: gives size
370 * of array pointed to by pidPtr. */
371 int *pidPtr
/* Array of pids to detach: must have
372 * been created by Tcl_Fork. */
375 register WaitInfo
*waitPtr
;
378 for (i
= 0; i
< numPids
; i
++) {
380 for (waitPtr
= waitTable
, count
= waitTableUsed
;
381 count
> 0; waitPtr
++, count
--) {
382 if (pid
!= waitPtr
->pid
) {
387 * If the process has already exited then destroy its
391 if ((waitPtr
->flags
& WI_READY
) && (WIFEXITED(waitPtr
->status
)
392 || WIFSIGNALED(waitPtr
->status
))) {
393 *waitPtr
= waitTable
[waitTableUsed
-1];
396 waitPtr
->flags
|= WI_DETACHED
;
400 panic("Tcl_Detach couldn't find process");
408 *----------------------------------------------------------------------
410 * Tcl_CreatePipeline --
412 * Given an argc/argv array, instantiate a pipeline of processes
413 * as described by the argv.
416 * The return value is a count of the number of new processes
417 * created, or -1 if an error occurred while creating the pipeline.
418 * *pidArrayPtr is filled in with the address of a dynamically
419 * allocated array giving the ids of all of the processes. It
420 * is up to the caller to free this array when it isn't needed
421 * anymore. If inPipePtr is non-NULL, *inPipePtr is filled in
422 * with the file id for the input pipe for the pipeline (if any):
423 * the caller must eventually close this file. If outPipePtr
424 * isn't NULL, then *outPipePtr is filled in with the file id
425 * for the output pipe from the pipeline: the caller must close
426 * this file. If errFilePtr isn't NULL, then *errFilePtr is filled
427 * with a file id that may be used to read error output after the
428 * pipeline completes.
431 * Processes and pipes are created.
433 *----------------------------------------------------------------------
438 Tcl_Interp
*interp
, /* Interpreter to use for error reporting. */
439 int argc
, /* Number of entries in argv. */
440 char **argv
, /* Array of strings describing commands in
441 * pipeline plus I/O redirection with <,
442 * <<, and >. Argv[argc] must be NULL. */
443 int **pidArrayPtr
, /* Word at *pidArrayPtr gets filled in with
444 * address of array of pids for processes
445 * in pipeline (first pid is first process
447 int *inPipePtr
, /* If non-NULL, input to the pipeline comes
448 * from a pipe (unless overridden by
449 * redirection in the command). The file
450 * id with which to write to this pipe is
451 * stored at *inPipePtr. -1 means command
452 * specified its own input source. */
453 int *outPipePtr
, /* If non-NULL, output to the pipeline goes
454 * to a pipe, unless overriden by redirection
455 * in the command. The file id with which to
456 * read frome this pipe is stored at
457 * *outPipePtr. -1 means command specified
458 * its own output sink. */
459 int *errFilePtr
/* If non-NULL, all stderr output from the
460 * pipeline will go to a temporary file
461 * created here, and a descriptor to read
462 * the file will be left at *errFilePtr.
463 * The file will be removed already, so
464 * closing this descriptor will be the end
465 * of the file. If this is NULL, then
466 * all stderr output goes to our stderr. */
469 int *pidPtr
= NULL
; /* Points to malloc-ed array holding all
470 * the pids of child processes. */
471 int numPids
= 0; /* Actual number of processes that exist
472 * at *pidPtr right now. */
473 int cmdCount
; /* Count of number of distinct commands
474 * found in argc/argv. */
475 char *input
= NULL
; /* Describes input for pipeline, depending
476 * on "inputFile". NULL means take input
477 * from stdin/pipe. */
478 int inputFile
= 0; /* Non-zero means input is name of input
479 * file. Zero means input holds actual
480 * text to be input to command. */
481 char *output
= NULL
; /* Holds name of output file to pipe to,
482 * or NULL if output goes to stdout/pipe. */
483 int inputId
= -1; /* Readable file id input to current command in
484 * pipeline (could be file or pipe). -1
485 * means use stdin. */
486 int outputId
= -1; /* Writable file id for output from current
487 * command in pipeline (could be file or pipe).
488 * -1 means use stdout. */
489 int errorId
= -1; /* Writable file id for all standard error
490 * output from all commands in pipeline. -1
491 * means use stderr. */
492 int lastOutputId
= -1; /* Write file id for output from last command
493 * in pipeline (could be file or pipe).
494 * -1 means use stdout. */
495 int pipeIds
[2]; /* File ids for pipe that's being created. */
496 int firstArg
, lastArg
; /* Indexes of first and last arguments in
497 * current command. */
502 if (inPipePtr
!= NULL
) {
505 if (outPipePtr
!= NULL
) {
508 if (errFilePtr
!= NULL
) {
511 pipeIds
[0] = pipeIds
[1] = -1;
514 * First, scan through all the arguments to figure out the structure
515 * of the pipeline. Count the number of distinct processes (it's the
516 * number of "|" arguments). If there are "<", "<<", or ">" arguments
517 * then make note of input and output redirection and remove these
518 * arguments and the arguments that follow them.
523 for (i
= 0; i
< argc
; i
++) {
524 if ((argv
[i
][0] == '|') && ((argv
[i
][1] == 0))) {
525 if ((i
== (lastBar
+1)) || (i
== (argc
-1))) {
526 interp
->result
= "illegal use of | in command";
532 } else if (argv
[i
][0] == '<') {
533 if (argv
[i
][1] == 0) {
536 } else if ((argv
[i
][1] == '<') && (argv
[i
][2] == 0)) {
542 } else if ((argv
[i
][0] == '>') && (argv
[i
][1] == 0)) {
548 Tcl_AppendResult(interp
, "can't specify \"", argv
[i
],
549 "\" as last word in command", (char *) NULL
);
552 for (j
= i
+2; j
< argc
; j
++) {
556 i
--; /* Process new arg from same position. */
559 interp
->result
= "didn't specify command to execute";
564 * Set up the redirected input source for the pipeline, if
571 * Immediate data in command. Create temporary file and
572 * put data into file.
576 # define TMP_STDIN_NAME "tcl.in"
578 # define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
580 char inName
[sizeof(TMP_STDIN_NAME
) + 1];
583 strcpy(inName
, TMP_STDIN_NAME
);
585 inputId
= open(inName
, O_RDWR
|O_CREAT
|O_TRUNC
, 0600);
587 Tcl_AppendResult(interp
,
588 "couldn't create input file for command: ",
589 Tcl_UnixError(interp
), (char *) NULL
);
592 length
= strlen(input
);
594 if (write(inputId
, input
, length
) < 0) {
596 if (write(inputId
, input
, length
) != length
) {
598 Tcl_AppendResult(interp
,
599 "couldn't write file input for command: ",
600 Tcl_UnixError(interp
), (char *) NULL
);
603 if ((lseek(inputId
, 0L, 0) == -1) || (unlink(inName
) == -1)) {
604 Tcl_AppendResult(interp
,
605 "couldn't reset or remove input file for command: ",
606 Tcl_UnixError(interp
), (char *) NULL
);
611 * File redirection. Just open the file.
614 inputId
= open(input
, O_RDONLY
, 0);
616 Tcl_AppendResult(interp
,
617 "couldn't read file \"", input
, "\": ",
618 Tcl_UnixError(interp
), (char *) NULL
);
622 } else if (inPipePtr
!= NULL
) {
623 if (pipe(pipeIds
) != 0) {
624 Tcl_AppendResult(interp
,
625 "couldn't create input pipe for command: ",
626 Tcl_UnixError(interp
), (char *) NULL
);
629 inputId
= pipeIds
[0];
630 *inPipePtr
= pipeIds
[1];
631 pipeIds
[0] = pipeIds
[1] = -1;
635 * Set up the redirected output sink for the pipeline from one
636 * of two places, if requested.
639 if (output
!= NULL
) {
641 * Output is to go to a file.
644 lastOutputId
= open(output
, O_WRONLY
|O_CREAT
|O_TRUNC
, 0666);
645 if (lastOutputId
< 0) {
646 Tcl_AppendResult(interp
,
647 "couldn't write file \"", output
, "\": ",
648 Tcl_UnixError(interp
), (char *) NULL
);
651 } else if (outPipePtr
!= NULL
) {
653 * Output is to go to a pipe.
656 if (pipe(pipeIds
) != 0) {
657 Tcl_AppendResult(interp
,
658 "couldn't create output pipe: ",
659 Tcl_UnixError(interp
), (char *) NULL
);
662 lastOutputId
= pipeIds
[1];
663 *outPipePtr
= pipeIds
[0];
664 pipeIds
[0] = pipeIds
[1] = -1;
668 * Set up the standard error output sink for the pipeline, if
669 * requested. Use a temporary file which is opened, then deleted.
670 * Could potentially just use pipe, but if it filled up it could
671 * cause the pipeline to deadlock: we'd be waiting for processes
672 * to complete before reading stderr, and processes couldn't complete
673 * because stderr was backed up.
676 if (errFilePtr
!= NULL
) {
677 # define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
678 char errName
[sizeof(TMP_STDERR_NAME
) + 1];
680 strcpy(errName
, TMP_STDERR_NAME
);
682 errorId
= open(errName
, O_WRONLY
|O_CREAT
|O_TRUNC
, 0600);
685 Tcl_AppendResult(interp
,
686 "couldn't create error file for command: ",
687 Tcl_UnixError(interp
), (char *) NULL
);
690 *errFilePtr
= open(errName
, O_RDONLY
, 0);
691 if (*errFilePtr
< 0) {
694 if (unlink(errName
) == -1) {
695 Tcl_AppendResult(interp
,
696 "couldn't remove error file for command: ",
697 Tcl_UnixError(interp
), (char *) NULL
);
703 * Scan through the argc array, forking off a process for each
704 * group of arguments between "|" arguments.
707 pidPtr
= (int *) ckalloc((unsigned) (cmdCount
* sizeof(int)));
708 for (i
= 0; i
< numPids
; i
++) {
711 for (firstArg
= 0; firstArg
< argc
; numPids
++, firstArg
= lastArg
+1) {
712 for (lastArg
= firstArg
; lastArg
< argc
; lastArg
++) {
713 if ((argv
[lastArg
][0] == '|') && (argv
[lastArg
][1] == 0)) {
717 argv
[lastArg
] = NULL
;
718 if (lastArg
== argc
) {
719 outputId
= lastOutputId
;
721 if (pipe(pipeIds
) != 0) {
722 Tcl_AppendResult(interp
, "couldn't create pipe: ",
723 Tcl_UnixError(interp
), (char *) NULL
);
726 outputId
= pipeIds
[1];
728 execName
= Tcl_TildeSubst(interp
, argv
[firstArg
]);
731 Tcl_AppendResult(interp
, "couldn't fork child process: ",
732 Tcl_UnixError(interp
), (char *) NULL
);
738 if (((inputId
!= -1) && (dup2(inputId
, 0) == -1))
739 || ((outputId
!= -1) && (dup2(outputId
, 1) == -1))
740 || ((errorId
!= -1) && (dup2(errorId
, 2) == -1))) {
742 err
= "forked process couldn't set up input/output\n";
743 write(errorId
< 0 ? 2 : errorId
, err
, strlen(err
));
746 for (i
= 3; (i
<= outputId
) || (i
<= inputId
) || (i
<= errorId
);
750 execvp(execName
, &argv
[firstArg
]);
751 sprintf(errSpace
, "couldn't find \"%.150s\" to execute\n",
753 write(2, errSpace
, strlen(errSpace
));
756 pidPtr
[numPids
] = pid
;
760 * Close off our copies of file descriptors that were set up for
761 * this child, then set up the input for the next child.
767 if (outputId
!= -1) {
770 inputId
= pipeIds
[0];
771 pipeIds
[0] = pipeIds
[1] = -1;
773 *pidArrayPtr
= pidPtr
;
776 * All done. Cleanup open files lying around and then return.
783 if (lastOutputId
!= -1) {
792 * An error occurred. There could have been extra files open, such
793 * as pipes between children. Clean them all up. Detach any child
794 * processes that have been created.
798 if ((inPipePtr
!= NULL
) && (*inPipePtr
!= -1)) {
802 if ((outPipePtr
!= NULL
) && (*outPipePtr
!= -1)) {
806 if ((errFilePtr
!= NULL
) && (*errFilePtr
!= -1)) {
810 if (pipeIds
[0] != -1) {
813 if (pipeIds
[1] != -1) {
816 if (pidPtr
!= NULL
) {
817 for (i
= 0; i
< numPids
; i
++) {
818 if (pidPtr
[i
] != -1) {
819 Tcl_DetachPids(1, &pidPtr
[i
]);
822 ckfree((char *) pidPtr
);
829 *----------------------------------------------------------------------
833 * This procedure is typically called after UNIX kernel calls
834 * return errors. It stores machine-readable information about
835 * the error in $errorCode returns an information string for
839 * The return value is a human-readable string describing the
840 * error, as returned by strerror.
843 * The global variable $errorCode is reset.
845 *----------------------------------------------------------------------
850 Tcl_Interp
*interp
/* Interpreter whose $errorCode variable
851 * is to be changed. */
857 msg
= strerror(errno
);
858 Tcl_SetErrorCode(interp
, "UNIX", id
, msg
, (char *) NULL
);
863 *----------------------------------------------------------------------
865 * TclMakeFileTable --
867 * Create or enlarge the file table for the interpreter, so that
868 * there is room for a given index.
874 * The file table for iPtr will be created if it doesn't exist
875 * (and entries will be added for stdin, stdout, and stderr).
876 * If it already exists, then it will be grown if necessary.
878 *----------------------------------------------------------------------
883 Interp
*iPtr
, /* Interpreter whose table of files is
884 * to be manipulated. */
885 int index
/* Make sure table is large enough to
886 * hold at least this index. */
890 * If the table doesn't even exist, then create it and initialize
891 * entries for standard files.
894 if (iPtr
->numFiles
== 0) {
901 iPtr
->numFiles
= index
+1;
903 iPtr
->filePtrArray
= (OpenFile
**) ckalloc((unsigned)
904 ((iPtr
->numFiles
)*sizeof(OpenFile
*)));
905 for (i
= iPtr
->numFiles
-1; i
>= 0; i
--) {
906 iPtr
->filePtrArray
[i
] = NULL
;
909 filePtr
= (OpenFile
*) ckalloc(sizeof(OpenFile
));
912 filePtr
->readable
= 1;
913 filePtr
->writable
= 0;
914 filePtr
->numPids
= 0;
915 filePtr
->pidPtr
= NULL
;
916 filePtr
->errorId
= -1;
917 iPtr
->filePtrArray
[0] = filePtr
;
919 filePtr
= (OpenFile
*) ckalloc(sizeof(OpenFile
));
922 filePtr
->readable
= 0;
923 filePtr
->writable
= 1;
924 filePtr
->numPids
= 0;
925 filePtr
->pidPtr
= NULL
;
926 filePtr
->errorId
= -1;
927 iPtr
->filePtrArray
[1] = filePtr
;
929 filePtr
= (OpenFile
*) ckalloc(sizeof(OpenFile
));
932 filePtr
->readable
= 0;
933 filePtr
->writable
= 1;
934 filePtr
->numPids
= 0;
935 filePtr
->pidPtr
= NULL
;
936 filePtr
->errorId
= -1;
937 iPtr
->filePtrArray
[2] = filePtr
;
938 } else if (index
>= iPtr
->numFiles
) {
940 OpenFile
**newPtrArray
;
944 newPtrArray
= (OpenFile
**) ckalloc((unsigned)
945 ((newSize
)*sizeof(OpenFile
*)));
946 memcpy((VOID
*) newPtrArray
, (VOID
*) iPtr
->filePtrArray
,
947 iPtr
->numFiles
*sizeof(OpenFile
*));
948 for (i
= iPtr
->numFiles
; i
< newSize
; i
++) {
949 newPtrArray
[i
] = NULL
;
951 ckfree((char *) iPtr
->filePtrArray
);
952 iPtr
->numFiles
= newSize
;
953 iPtr
->filePtrArray
= newPtrArray
;
958 *----------------------------------------------------------------------
962 * Given a string identifier for an open file, find the corresponding
963 * open file structure, if there is one.
966 * A standard Tcl return value. If the open file is successfully
967 * located, *filePtrPtr is modified to point to its structure.
968 * If TCL_ERROR is returned then interp->result contains an error
974 *----------------------------------------------------------------------
979 Tcl_Interp
*interp
, /* Interpreter in which to find file. */
980 char *string
, /* String that identifies file. */
981 OpenFile
**filePtrPtr
/* Address of word in which to store pointer
982 * to structure about open file. */
985 int fd
= 0; /* Initial value needed only to stop compiler
987 Interp
*iPtr
= (Interp
*) interp
;
989 if ((string
[0] == 'f') && (string
[1] == 'i') && (string
[2] == 'l')
990 & (string
[3] == 'e')) {
993 fd
= strtoul(string
+4, &end
, 10);
994 if ((end
== string
+4) || (*end
!= 0)) {
997 } else if ((string
[0] == 's') && (string
[1] == 't')
998 && (string
[2] == 'd')) {
999 if (strcmp(string
+3, "in") == 0) {
1001 } else if (strcmp(string
+3, "out") == 0) {
1003 } else if (strcmp(string
+3, "err") == 0) {
1010 Tcl_AppendResult(interp
, "bad file identifier \"", string
,
1011 "\"", (char *) NULL
);
1015 if (fd
>= iPtr
->numFiles
) {
1016 if ((iPtr
->numFiles
== 0) && (fd
<= 2)) {
1017 TclMakeFileTable(iPtr
, fd
);
1020 Tcl_AppendResult(interp
, "file \"", string
, "\" isn't open",
1025 if (iPtr
->filePtrArray
[fd
] == NULL
) {
1028 *filePtrPtr
= iPtr
->filePtrArray
[fd
];
1037 for ( ; *name
; name
++) if (*name
== '/') *name
= '\\';