1 |
;; popen emulation, for non-stdio based ports. |
;; popen emulation, for non-stdio based ports. |
2 |
|
|
3 |
;;;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. |
;;;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc. |
4 |
;;;; |
;;;; |
5 |
;;;; This library is free software; you can redistribute it and/or |
;;;; This library is free software; you can redistribute it and/or |
6 |
;;;; modify it under the terms of the GNU Lesser General Public |
;;;; modify it under the terms of the GNU Lesser General Public |
90 |
(set! output-fdes (dup->fdes 0))) |
(set! output-fdes (dup->fdes 0))) |
91 |
(if (= error-fdes 0) |
(if (= error-fdes 0) |
92 |
(set! error-fdes (dup->fdes 0))) |
(set! error-fdes (dup->fdes 0))) |
93 |
(dup2 input-fdes 0))) |
(dup2 input-fdes 0) |
94 |
|
(close-fdes input-fdes))) |
95 |
|
|
96 |
(cond ((not (= output-fdes 1)) |
(cond ((not (= output-fdes 1)) |
97 |
(if (= error-fdes 1) |
(if (= error-fdes 1) |
98 |
(set! error-fdes (dup->fdes 1))) |
(set! error-fdes (dup->fdes 1))) |
99 |
(dup2 output-fdes 1))) |
(dup2 output-fdes 1) |
100 |
|
(close-fdes output-fdes))) |
101 |
|
|
102 |
(dup2 error-fdes 2) |
(cond ((not (= error-fdes 2)) |
103 |
|
(dup2 error-fdes 2) |
104 |
|
(close-fdes error-fdes))) |
105 |
|
|
106 |
(apply execlp prog prog args))) |
(apply execlp prog prog args))) |
107 |
|
|