1 /* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice. */
55 #ifdef TIME_WITH_SYS_TIME
56 # include <sys/time.h>
60 # include <sys/time.h>
70 extern char *ttyname();
74 #ifdef LIBC_H_WITH_UNISTD_H
78 #include <sys/types.h>
85 # include <sys/wait.h>
88 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
91 # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
96 extern FILE *popen ();
97 extern char ** environ
;
100 #include <sys/utsname.h>
104 # define NAMLEN(dirent) strlen((dirent)->d_name)
106 # define dirent direct
107 # define NAMLEN(dirent) (dirent)->d_namlen
109 # include <sys/ndir.h>
112 # include <sys/dir.h>
119 #ifdef HAVE_SETLOCALE
123 /* Some Unix systems don't define these. CPP hair is dangerous, but
124 this seems safe enough... */
141 /* On NextStep, <utime.h> doesn't define struct utime, unless we
142 #define _POSIX_SOURCE before #including it. I think this is less
143 of a kludge than defining struct utimbuf ourselves. */
144 #ifdef UTIMBUF_NEEDS_POSIX
145 #define _POSIX_SOURCE
148 #ifdef HAVE_SYS_UTIME_H
149 #include <sys/utime.h>
156 /* Please don't add any more #includes or #defines here. The hack
157 above means that _POSIX_SOURCE may be #defined, which will
158 encourage header files to do strange things. */
163 SCM_PROC (s_pipe
, "pipe", 0, 0, 0, scm_pipe
);
171 struct scm_port_table
* ptr
;
172 struct scm_port_table
* ptw
;
178 scm_syserror (s_pipe
);
179 f_rd
= fdopen (fd
[0], "r");
182 SCM_SYSCALL (close (fd
[0]));
183 SCM_SYSCALL (close (fd
[1]));
184 scm_syserror (s_pipe
);
186 f_wt
= fdopen (fd
[1], "w");
192 SCM_SYSCALL (close (fd
[1]));
194 scm_syserror (s_pipe
);
196 ptr
= scm_add_to_port_table (p_rd
);
197 ptw
= scm_add_to_port_table (p_wt
);
198 SCM_SETPTAB_ENTRY (p_rd
, ptr
);
199 SCM_SETPTAB_ENTRY (p_wt
, ptw
);
200 SCM_SETCAR (p_rd
, scm_tc16_fport
| scm_mode_bits ("r"));
201 SCM_SETCAR (p_wt
, scm_tc16_fport
| scm_mode_bits ("w"));
202 SCM_SETSTREAM (p_rd
, (SCM
)f_rd
);
203 SCM_SETSTREAM (p_wt
, (SCM
)f_wt
);
206 return scm_cons (p_rd
, p_wt
);
210 #ifdef HAVE_GETGROUPS
211 SCM_PROC (s_getgroups
, "getgroups", 0, 0, 0, scm_getgroups
);
217 int ngroups
= getgroups (0, NULL
);
219 scm_syserror (s_getgroups
);
226 groups
= (GETGROUPS_T
*) scm_must_malloc(ngroups
* sizeof(GETGROUPS_T
),
228 val
= getgroups(ngroups
, groups
);
231 scm_must_free((char *)groups
);
232 scm_syserror (s_getgroups
);
234 SCM_SETCHARS(grps
, groups
); /* set up grps as a GC protect */
235 SCM_SETLENGTH(grps
, 0L + ngroups
* sizeof(GETGROUPS_T
), scm_tc7_string
);
237 ans
= scm_make_vector(SCM_MAKINUM(ngroups
), SCM_UNDEFINED
, SCM_BOOL_F
);
238 while (--ngroups
>= 0) SCM_VELTS(ans
)[ngroups
] = SCM_MAKINUM(groups
[ngroups
]);
239 SCM_SETCHARS(grps
, groups
); /* to make sure grps stays around. */
246 SCM_PROC (s_getpwuid
, "getpw", 0, 1, 0, scm_getpwuid
);
253 struct passwd
*entry
;
256 result
= scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED
, SCM_BOOL_F
);
257 ve
= SCM_VELTS (result
);
258 if (SCM_UNBNDP (user
) || SCM_FALSEP (user
))
261 SCM_SYSCALL (entry
= getpwent ());
268 else if (SCM_INUMP (user
))
271 entry
= getpwuid (SCM_INUM (user
));
275 SCM_ASSERT (SCM_NIMP (user
) && SCM_ROSTRINGP (user
), user
, SCM_ARG1
, s_getpwuid
);
276 if (SCM_SUBSTRP (user
))
277 user
= scm_makfromstr (SCM_ROCHARS (user
), SCM_ROLENGTH (user
), 0);
279 entry
= getpwnam (SCM_ROCHARS (user
));
282 scm_syserror (s_getpwuid
);
284 ve
[0] = scm_makfrom0str (entry
->pw_name
);
285 ve
[1] = scm_makfrom0str (entry
->pw_passwd
);
286 ve
[2] = scm_ulong2num ((unsigned long) entry
->pw_uid
);
287 ve
[3] = scm_ulong2num ((unsigned long) entry
->pw_gid
);
288 ve
[4] = scm_makfrom0str (entry
->pw_gecos
);
290 ve
[5] = scm_makfrom0str ("");
292 ve
[5] = scm_makfrom0str (entry
->pw_dir
);
293 if (!entry
->pw_shell
)
294 ve
[6] = scm_makfrom0str ("");
296 ve
[6] = scm_makfrom0str (entry
->pw_shell
);
303 SCM_PROC (s_setpwent
, "setpw", 0, 1, 0, scm_setpwent
);
309 if (SCM_UNBNDP (arg
) || SCM_FALSEP (arg
))
313 return SCM_UNSPECIFIED
;
319 /* Combines getgrgid and getgrnam. */
320 SCM_PROC (s_getgrgid
, "getgr", 0, 1, 0, scm_getgrgid
);
329 result
= scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED
, SCM_BOOL_F
);
330 ve
= SCM_VELTS (result
);
332 if (SCM_UNBNDP (name
) || (name
== SCM_BOOL_F
))
334 SCM_SYSCALL (entry
= getgrent ());
341 else if (SCM_INUMP (name
))
342 SCM_SYSCALL (entry
= getgrgid (SCM_INUM (name
)));
345 SCM_ASSERT (SCM_NIMP (name
) && SCM_ROSTRINGP (name
), name
, SCM_ARG1
,
347 SCM_COERCE_SUBSTR (name
);
348 SCM_SYSCALL (entry
= getgrnam (SCM_ROCHARS (name
)));
351 scm_syserror (s_getgrgid
);
353 ve
[0] = scm_makfrom0str (entry
->gr_name
);
354 ve
[1] = scm_makfrom0str (entry
->gr_passwd
);
355 ve
[2] = scm_ulong2num ((unsigned long) entry
->gr_gid
);
356 ve
[3] = scm_makfromstrs (-1, entry
->gr_mem
);
363 SCM_PROC (s_setgrent
, "setgr", 0, 1, 0, scm_setgrent
);
369 if (SCM_UNBNDP (arg
) || SCM_FALSEP (arg
))
373 return SCM_UNSPECIFIED
;
378 SCM_PROC (s_kill
, "kill", 2, 0, 0, scm_kill
);
385 SCM_ASSERT (SCM_INUMP (pid
), pid
, SCM_ARG1
, s_kill
);
386 SCM_ASSERT (SCM_INUMP (sig
), sig
, SCM_ARG2
, s_kill
);
387 /* Signal values are interned in scm_init_posix(). */
388 if (kill ((int) SCM_INUM (pid
), (int) SCM_INUM (sig
)) != 0)
389 scm_syserror (s_kill
);
390 return SCM_UNSPECIFIED
;
395 SCM_PROC (s_waitpid
, "waitpid", 1, 1, 0, scm_waitpid
);
398 scm_waitpid (pid
, options
)
406 SCM_ASSERT (SCM_INUMP (pid
), pid
, SCM_ARG1
, s_waitpid
);
407 if (SCM_UNBNDP (options
))
411 SCM_ASSERT (SCM_INUMP (options
), options
, SCM_ARG2
, s_waitpid
);
412 /* Flags are interned in scm_init_posix. */
413 ioptions
= SCM_INUM (options
);
415 SCM_SYSCALL (i
= waitpid (SCM_INUM (pid
), &status
, ioptions
));
417 scm_syserror (s_waitpid
);
418 return scm_cons (SCM_MAKINUM (0L + i
), SCM_MAKINUM (0L + status
));
420 scm_sysmissing (s_waitpid
);
426 SCM_PROC (s_status_exit_val
, "status:exit-val", 1, 0, 0, scm_status_exit_val
);
428 scm_status_exit_val (status
)
433 SCM_ASSERT (SCM_INUMP (status
), status
, SCM_ARG1
,s_status_exit_val
);
435 /* On Ultrix, the WIF... macros assume their argument is an lvalue;
436 go figure. SCM_INUM does not yield an lvalue. */
437 lstatus
= SCM_INUM (status
);
438 if (WIFEXITED (lstatus
))
439 return (SCM_MAKINUM (WEXITSTATUS (lstatus
)));
444 SCM_PROC (s_status_term_sig
, "status:term-sig", 1, 0, 0, scm_status_term_sig
);
446 scm_status_term_sig (status
)
451 SCM_ASSERT (SCM_INUMP (status
), status
, SCM_ARG1
,s_status_term_sig
);
453 lstatus
= SCM_INUM (status
);
454 if (WIFSIGNALED (lstatus
))
455 return SCM_MAKINUM (WTERMSIG (lstatus
));
460 SCM_PROC (s_status_stop_sig
, "status:stop-sig", 1, 0, 0, scm_status_stop_sig
);
462 scm_status_stop_sig (status
)
467 SCM_ASSERT (SCM_INUMP (status
), status
, SCM_ARG1
,s_status_stop_sig
);
469 lstatus
= SCM_INUM (status
);
470 if (WIFSTOPPED (lstatus
))
471 return SCM_MAKINUM (WSTOPSIG (lstatus
));
476 SCM_PROC (s_getppid
, "getppid", 0, 0, 0, scm_getppid
);
481 return SCM_MAKINUM (0L + getppid ());
486 SCM_PROC (s_getuid
, "getuid", 0, 0, 0, scm_getuid
);
491 return SCM_MAKINUM (0L + getuid ());
496 SCM_PROC (s_getgid
, "getgid", 0, 0, 0, scm_getgid
);
501 return SCM_MAKINUM (0L + getgid ());
506 SCM_PROC (s_geteuid
, "geteuid", 0, 0, 0, scm_geteuid
);
512 return SCM_MAKINUM (0L + geteuid ());
514 return SCM_MAKINUM (0L + getuid ());
520 SCM_PROC (s_getegid
, "getegid", 0, 0, 0, scm_getegid
);
526 return SCM_MAKINUM (0L + getegid ());
528 return SCM_MAKINUM (0L + getgid ());
533 SCM_PROC (s_setuid
, "setuid", 1, 0, 0, scm_setuid
);
539 SCM_ASSERT (SCM_INUMP (id
), id
, SCM_ARG1
, s_setuid
);
540 if (setuid (SCM_INUM (id
)) != 0)
541 scm_syserror (s_setuid
);
542 return SCM_UNSPECIFIED
;
545 SCM_PROC (s_setgid
, "setgid", 1, 0, 0, scm_setgid
);
551 SCM_ASSERT (SCM_INUMP (id
), id
, SCM_ARG1
, s_setgid
);
552 if (setgid (SCM_INUM (id
)) != 0)
553 scm_syserror (s_setgid
);
554 return SCM_UNSPECIFIED
;
557 SCM_PROC (s_seteuid
, "seteuid", 1, 0, 0, scm_seteuid
);
565 SCM_ASSERT (SCM_INUMP (id
), id
, SCM_ARG1
, s_seteuid
);
567 rv
= seteuid (SCM_INUM (id
));
569 rv
= setuid (SCM_INUM (id
));
572 scm_syserror (s_seteuid
);
573 return SCM_UNSPECIFIED
;
577 SCM_PROC (s_setegid
, "setegid", 1, 0, 0, scm_setegid
);
585 SCM_ASSERT (SCM_INUMP (id
), id
, SCM_ARG1
, s_setegid
);
587 rv
= setegid (SCM_INUM (id
));
589 rv
= setgid (SCM_INUM (id
));
592 scm_syserror (s_setegid
);
593 return SCM_UNSPECIFIED
;
598 SCM_PROC (s_getpgrp
, "getpgrp", 0, 0, 0, scm_getpgrp
);
603 fn
= (int (*) ()) getpgrp
;
604 return SCM_MAKINUM (fn (0));
607 SCM_PROC (s_setpgid
, "setpgid", 2, 0, 0, scm_setpgid
);
609 scm_setpgid (pid
, pgid
)
613 SCM_ASSERT (SCM_INUMP (pid
), pid
, SCM_ARG1
, s_setpgid
);
614 SCM_ASSERT (SCM_INUMP (pgid
), pgid
, SCM_ARG2
, s_setpgid
);
615 /* FIXME(?): may be known as setpgrp. */
616 if (setpgid (SCM_INUM (pid
), SCM_INUM (pgid
)) != 0)
617 scm_syserror (s_setpgid
);
618 return SCM_UNSPECIFIED
;
620 scm_sysmissing (s_setpgid
);
626 SCM_PROC (s_setsid
, "setsid", 0, 0, 0, scm_setsid
);
631 pid_t sid
= setsid ();
633 scm_syserror (s_setsid
);
634 return SCM_UNSPECIFIED
;
636 scm_sysmissing (s_setsid
);
642 SCM_PROC (s_ttyname
, "ttyname", 1, 0, 0, scm_ttyname
);
651 port
= SCM_COERCE_OUTPORT (port
);
652 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPPORTP (port
), port
, SCM_ARG1
, s_ttyname
);
653 if (scm_tc16_fport
!= SCM_TYP16 (port
))
655 fd
= fileno ((FILE *)SCM_STREAM (port
));
657 scm_syserror (s_ttyname
);
658 SCM_SYSCALL (ans
= ttyname (fd
));
660 scm_syserror (s_ttyname
);
661 /* ans could be overwritten by another call to ttyname */
662 return (scm_makfrom0str (ans
));
666 SCM_PROC (s_ctermid
, "ctermid", 0, 0, 0, scm_ctermid
);
671 char *result
= ctermid (NULL
);
673 scm_syserror (s_ctermid
);
674 return scm_makfrom0str (result
);
676 scm_sysmissing (s_ctermid
);
682 SCM_PROC (s_tcgetpgrp
, "tcgetpgrp", 1, 0, 0, scm_tcgetpgrp
);
687 #ifdef HAVE_TCGETPGRP
691 port
= SCM_COERCE_OUTPORT (port
);
693 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_tcgetpgrp
);
694 fd
= fileno ((FILE *)SCM_STREAM (port
));
695 if (fd
== -1 || (pgid
= tcgetpgrp (fd
)) == -1)
696 scm_syserror (s_tcgetpgrp
);
697 return SCM_MAKINUM (pgid
);
699 scm_sysmissing (s_tcgetpgrp
);
705 SCM_PROC (s_tcsetpgrp
, "tcsetpgrp", 2, 0, 0, scm_tcsetpgrp
);
707 scm_tcsetpgrp (port
, pgid
)
710 #ifdef HAVE_TCSETPGRP
713 port
= SCM_COERCE_OUTPORT (port
);
715 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_tcsetpgrp
);
716 SCM_ASSERT (SCM_INUMP (pgid
), pgid
, SCM_ARG2
, s_tcsetpgrp
);
717 fd
= fileno ((FILE *)SCM_STREAM (port
));
718 if (fd
== -1 || tcsetpgrp (fd
, SCM_INUM (pgid
)) == -1)
719 scm_syserror (s_tcsetpgrp
);
720 return SCM_UNSPECIFIED
;
722 scm_sysmissing (s_tcsetpgrp
);
728 /* Copy exec args from an SCM vector into a new C array. */
731 scm_convert_exec_args (SCM args
, int pos
, char *subr
)
737 SCM_ASSERT (SCM_NULLP (args
)
738 || (SCM_NIMP (args
) && SCM_CONSP (args
)),
741 num_args
= scm_ilength (args
);
743 scm_must_malloc ((num_args
+ 1) * sizeof (char *), subr
);
744 for (i
= 0; SCM_NNULLP (args
); args
= SCM_CDR (args
), ++i
)
749 SCM_ASSERT (SCM_NIMP (SCM_CAR (args
)) && SCM_ROSTRINGP (SCM_CAR (args
)),
750 SCM_CAR (args
), SCM_ARGn
, subr
);
751 len
= 1 + SCM_ROLENGTH (SCM_CAR (args
));
752 dst
= (char *) scm_must_malloc ((long) len
, subr
);
753 src
= SCM_ROCHARS (SCM_CAR (args
));
763 SCM_PROC (s_execl
, "execl", 1, 0, 1, scm_execl
);
766 scm_execl (filename
, args
)
770 SCM_ASSERT (SCM_NIMP (filename
) && SCM_ROSTRINGP (filename
), filename
,
772 SCM_COERCE_SUBSTR (filename
);
773 execargv
= scm_convert_exec_args (args
, SCM_ARG2
, s_execl
);
774 execv (SCM_ROCHARS (filename
), execargv
);
775 scm_syserror (s_execl
);
780 SCM_PROC (s_execlp
, "execlp", 1, 0, 1, scm_execlp
);
783 scm_execlp (filename
, args
)
787 SCM_ASSERT (SCM_NIMP (filename
) && SCM_ROSTRINGP (filename
), filename
,
789 SCM_COERCE_SUBSTR (filename
);
790 execargv
= scm_convert_exec_args (args
, SCM_ARG2
, s_execlp
);
791 execvp (SCM_ROCHARS (filename
), execargv
);
792 scm_syserror (s_execlp
);
798 environ_list_to_c (SCM envlist
, int arg
, char *proc
)
805 SCM_ASSERT (SCM_NULLP (envlist
)
806 || (SCM_NIMP (envlist
) && SCM_CONSP (envlist
)),
808 num_strings
= scm_ilength (envlist
);
809 result
= (char **) malloc ((num_strings
+ 1) * sizeof (char *));
811 scm_memory_error (proc
);
812 while (SCM_NNULLP (envlist
))
817 SCM_ASSERT (SCM_NIMP (SCM_CAR (envlist
))
818 && SCM_ROSTRINGP (SCM_CAR (envlist
)),
820 len
= 1 + SCM_ROLENGTH (SCM_CAR (envlist
));
821 result
[i
] = malloc ((long) len
);
822 if (result
[i
] == NULL
)
823 scm_memory_error (proc
);
824 src
= SCM_ROCHARS (SCM_CAR (envlist
));
826 result
[i
][len
] = src
[len
];
827 envlist
= SCM_CDR (envlist
);
835 SCM_PROC (s_execle
, "execle", 2, 0, 1, scm_execle
);
838 scm_execle (filename
, env
, args
)
839 SCM filename
, env
, args
;
844 SCM_ASSERT (SCM_NIMP (filename
) && SCM_ROSTRINGP (filename
), filename
,
846 SCM_COERCE_SUBSTR (filename
);
848 execargv
= scm_convert_exec_args (args
, SCM_ARG1
, s_execle
);
849 exec_env
= environ_list_to_c (env
, SCM_ARG2
, s_execle
);
850 execve (SCM_ROCHARS (filename
), execargv
, exec_env
);
851 scm_syserror (s_execle
);
856 SCM_PROC (s_fork
, "primitive-fork", 0, 0, 0, scm_fork
);
864 scm_syserror (s_fork
);
865 return SCM_MAKINUM (0L+pid
);
869 SCM_PROC (s_uname
, "uname", 0, 0, 0, scm_uname
);
876 SCM ans
= scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED
, SCM_BOOL_F
);
877 SCM
*ve
= SCM_VELTS (ans
);
879 if (uname (&buf
) < 0)
880 scm_syserror (s_uname
);
881 ve
[0] = scm_makfrom0str (buf
.sysname
);
882 ve
[1] = scm_makfrom0str (buf
.nodename
);
883 ve
[2] = scm_makfrom0str (buf
.release
);
884 ve
[3] = scm_makfrom0str (buf
.version
);
885 ve
[4] = scm_makfrom0str (buf
.machine
);
888 ve[5] = scm_makfrom0str (buf.domainname);
893 scm_sysmissing (s_uname
);
899 SCM_PROC (s_environ
, "environ", 0, 1, 0, scm_environ
);
905 if (SCM_UNBNDP (env
))
906 return scm_makfromstrs (-1, environ
);
912 new_environ
= environ_list_to_c (env
, SCM_ARG1
, s_environ
);
913 /* Free the old environment, except when called for the first
918 static int first
= 1;
921 for (ep
= environ
; *ep
!= NULL
; ep
++)
923 free ((char *) environ
);
927 environ
= new_environ
;
929 return SCM_UNSPECIFIED
;
935 SCM_PROC (s_tmpnam
, "tmpnam", 0, 0, 0, scm_tmpnam
);
940 SCM_SYSCALL (tmpnam (name
););
941 return scm_makfrom0str (name
);
945 SCM_PROC (s_open_pipe
, "open-pipe", 2, 0, 0, scm_open_pipe
);
948 scm_open_pipe (pipestr
, modes
)
954 struct scm_port_table
* pt
;
956 SCM_ASSERT (SCM_NIMP (pipestr
) && SCM_ROSTRINGP (pipestr
), pipestr
,
957 SCM_ARG1
, s_open_pipe
);
958 if (SCM_SUBSTRP (pipestr
))
959 pipestr
= scm_makfromstr (SCM_ROCHARS (pipestr
),
960 SCM_ROLENGTH (pipestr
), 0);
961 SCM_ASSERT (SCM_NIMP (modes
) && SCM_ROSTRINGP (modes
), modes
, SCM_ARG2
,
963 if (SCM_SUBSTRP (modes
))
964 modes
= scm_makfromstr (SCM_ROCHARS (modes
), SCM_ROLENGTH (modes
), 0);
967 SCM_SYSCALL (f
= popen (SCM_ROCHARS (pipestr
), SCM_ROCHARS (modes
)));
969 scm_syserror (s_open_pipe
);
970 pt
= scm_add_to_port_table (z
);
971 SCM_SETPTAB_ENTRY (z
, pt
);
972 SCM_SETCAR (z
, scm_tc16_pipe
| SCM_OPN
973 | (strchr (SCM_ROCHARS (modes
), 'r') ? SCM_RDNG
: SCM_WRTNG
));
974 SCM_SETSTREAM (z
, (SCM
)f
);
979 SCM_PROC (s_close_pipe
, "close-pipe", 1, 0, 0, scm_close_pipe
);
982 scm_close_pipe (port
)
987 SCM_ASSERT (SCM_NIMP (port
) && SCM_TYP16(port
) == scm_tc16_pipe
988 && SCM_OPENP (port
), port
, SCM_ARG1
, s_close_pipe
);
990 rv
= pclose ((FILE *) SCM_STREAM (port
));
992 scm_syserror (s_close_pipe
);
994 return SCM_MAKINUM (rv
);
997 SCM_PROC (s_utime
, "utime", 1, 2, 0, scm_utime
);
1000 scm_utime (pathname
, actime
, modtime
)
1006 struct utimbuf utm_tmp
;
1008 SCM_ASSERT (SCM_NIMP (pathname
) && SCM_ROSTRINGP (pathname
), pathname
,
1011 SCM_COERCE_SUBSTR (pathname
);
1012 if (SCM_UNBNDP (actime
))
1013 SCM_SYSCALL (time (&utm_tmp
.actime
));
1015 utm_tmp
.actime
= scm_num2ulong (actime
, (char *) SCM_ARG2
, s_utime
);
1017 if (SCM_UNBNDP (modtime
))
1018 SCM_SYSCALL (time (&utm_tmp
.modtime
));
1020 utm_tmp
.modtime
= scm_num2ulong (modtime
, (char *) SCM_ARG3
, s_utime
);
1022 SCM_SYSCALL (rv
= utime (SCM_ROCHARS (pathname
), &utm_tmp
));
1024 scm_syserror (s_utime
);
1025 return SCM_UNSPECIFIED
;
1028 SCM_PROC (s_access
, "access?", 2, 0, 0, scm_access
);
1031 scm_access (path
, how
)
1037 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
,
1039 if (SCM_SUBSTRP (path
))
1040 path
= scm_makfromstr (SCM_ROCHARS (path
), SCM_ROLENGTH (path
), 0);
1041 SCM_ASSERT (SCM_INUMP (how
), how
, SCM_ARG2
, s_access
);
1042 rv
= access (SCM_ROCHARS (path
), SCM_INUM (how
));
1043 return rv
? SCM_BOOL_F
: SCM_BOOL_T
;
1046 SCM_PROC (s_getpid
, "getpid", 0, 0, 0, scm_getpid
);
1051 return SCM_MAKINUM ((unsigned long) getpid ());
1054 SCM_PROC (s_putenv
, "putenv", 1, 0, 0, scm_putenv
);
1063 SCM_ASSERT (SCM_NIMP (str
) && SCM_ROSTRINGP (str
), str
, SCM_ARG1
, s_putenv
);
1064 /* must make a new copy to be left in the environment, safe from gc. */
1065 ptr
= malloc (SCM_LENGTH (str
) + 1);
1067 scm_memory_error (s_putenv
);
1068 strncpy (ptr
, SCM_ROCHARS (str
), SCM_LENGTH (str
));
1069 ptr
[SCM_LENGTH(str
)] = 0;
1072 scm_syserror (s_putenv
);
1073 return SCM_UNSPECIFIED
;
1076 SCM_PROC (s_setlocale
, "setlocale", 1, 1, 0, scm_setlocale
);
1079 scm_setlocale (category
, locale
)
1083 #ifdef HAVE_SETLOCALE
1087 SCM_ASSERT (SCM_INUMP (category
), category
, SCM_ARG1
, s_setlocale
);
1088 if (SCM_UNBNDP (locale
))
1094 SCM_ASSERT (SCM_NIMP (locale
) && SCM_ROSTRINGP (locale
), locale
,
1095 SCM_ARG2
, s_setlocale
);
1096 SCM_COERCE_SUBSTR (locale
);
1097 clocale
= SCM_ROCHARS (locale
);
1100 rv
= setlocale (SCM_INUM (category
), clocale
);
1102 scm_syserror (s_setlocale
);
1103 return scm_makfrom0str (rv
);
1105 scm_sysmissing (s_setlocale
);
1111 SCM_PROC (s_mknod
, "mknod", 4, 0, 0, scm_mknod
);
1114 scm_mknod(path
, type
, perms
, dev
)
1125 SCM_ASSERT (SCM_NIMP(path
) && SCM_ROSTRINGP(path
), path
, SCM_ARG1
, s_mknod
);
1126 SCM_ASSERT (SCM_NIMP(type
) && SCM_SYMBOLP (type
), type
, SCM_ARG2
, s_mknod
);
1127 SCM_ASSERT (SCM_INUMP (perms
), perms
, SCM_ARG3
, s_mknod
);
1128 SCM_ASSERT (SCM_INUMP(dev
), dev
, SCM_ARG4
, s_mknod
);
1129 SCM_COERCE_SUBSTR (path
);
1131 p
= SCM_CHARS (type
);
1132 if (strcmp (p
, "regular") == 0)
1134 else if (strcmp (p
, "directory") == 0)
1136 else if (strcmp (p
, "symlink") == 0)
1138 else if (strcmp (p
, "block-special") == 0)
1140 else if (strcmp (p
, "char-special") == 0)
1142 else if (strcmp (p
, "fifo") == 0)
1144 else if (strcmp (p
, "socket") == 0)
1147 scm_out_of_range (s_mknod
, type
);
1150 SCM_SYSCALL (val
= mknod(SCM_ROCHARS(path
), ctype
| SCM_INUM (perms
),
1153 scm_syserror (s_mknod
);
1155 return SCM_UNSPECIFIED
;
1157 scm_sysmissing (s_mknod
);
1164 SCM_PROC (s_nice
, "nice", 1, 0, 0, scm_nice
);
1171 SCM_ASSERT(SCM_INUMP(incr
), incr
, SCM_ARG1
, s_nice
);
1172 if (nice(SCM_INUM(incr
)) != 0)
1173 scm_syserror (s_nice
);
1174 return SCM_UNSPECIFIED
;
1176 scm_sysmissing (s_nice
);
1183 SCM_PROC (s_sync
, "sync", 0, 0, 0, scm_sync
);
1191 scm_sysmissing (s_sync
);
1194 return SCM_UNSPECIFIED
;
1200 scm_add_feature ("posix");
1202 scm_add_feature ("EIDs");
1205 scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY
));
1208 scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP
));
1211 scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG
));
1214 scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED
));
1217 /* access() symbols. */
1218 scm_sysintern ("R_OK", SCM_MAKINUM (R_OK
));
1219 scm_sysintern ("W_OK", SCM_MAKINUM (W_OK
));
1220 scm_sysintern ("X_OK", SCM_MAKINUM (X_OK
));
1221 scm_sysintern ("F_OK", SCM_MAKINUM (F_OK
));
1224 scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE
));
1227 scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE
));
1230 scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY
));
1233 scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC
));
1236 scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME
));
1239 scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES
));
1242 scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL
));
1244 #include "cpp_sig_symbols.c"