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, 675 Mass Ave, Cambridge, MA 02139, USA.
17 * As a special exception, the Free Software Foundation gives permission
18 * for additional uses of the text contained in its release of GUILE.
20 * The exception is that, if you link the GUILE library with other files
21 * to produce an executable, this does not by itself cause the
22 * resulting executable to be covered by the GNU General Public License.
23 * Your use of that executable is in no way restricted on account of
24 * linking the GUILE library code into it.
26 * This exception does not however invalidate any other reasons why
27 * the executable file might be covered by the GNU General Public License.
29 * This exception applies only to the code released by the
30 * Free Software Foundation under the name GUILE. If you copy
31 * code from other Free Software Foundation releases into a copy of
32 * GUILE, as the General Public License permits, the exception does
33 * not apply to the code that you add in this way. To avoid misleading
34 * anyone as to the status of such modified files, you must delete
35 * this exception notice from them.
37 * If you write modifications of your own for GUILE, it is your choice
38 * whether to permit this exception to apply to your modifications.
39 * If you do not wish that, delete this exception notice.
48 #include "sequences.h"
56 #ifdef TIME_WITH_SYS_TIME
57 # include <sys/time.h>
61 # include <sys/time.h>
71 extern char *ttyname();
75 #ifdef LIBC_H_WITH_UNISTD_H
79 #ifdef HAVE_SYS_SELECT_H
80 #include <sys/select.h>
83 #include <sys/types.h>
90 # include <sys/wait.h>
93 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
96 # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
103 #define SELECT_TYPE fd_set
104 #define SELECT_SET_SIZE FD_SETSIZE
106 #else /* no FD_SET */
108 /* Define the macros to access a single-int bitmap of descriptors. */
109 #define SELECT_SET_SIZE 32
110 #define SELECT_TYPE int
111 #define FD_SET(n, p) (*(p) |= (1 << (n)))
112 #define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
113 #define FD_ISSET(n, p) (*(p) & (1 << (n)))
114 #define FD_ZERO(p) (*(p) = 0)
116 #endif /* no FD_SET */
118 extern FILE *popen ();
119 extern char ** environ
;
122 #include <sys/utsname.h>
126 # define NAMLEN(dirent) strlen((dirent)->d_name)
128 # define dirent direct
129 # define NAMLEN(dirent) (dirent)->d_namlen
131 # include <sys/ndir.h>
134 # include <sys/dir.h>
143 #ifdef HAVE_SETLOCALE
147 /* Some Unix systems don't define these. CPP hair is dangerous, but
148 this seems safe enough... */
165 /* On NextStep, <utime.h> doesn't define struct utime, unless we
166 #define _POSIX_SOURCE before #including it. I think this is less
167 of a kludge than defining struct utimbuf ourselves. */
168 #ifdef UTIMBUF_NEEDS_POSIX
169 #define _POSIX_SOURCE
172 #ifdef HAVE_SYS_UTIME_H
173 #include <sys/utime.h>
180 /* Please don't add any more #includes or #defines here. The hack
181 above means that _POSIX_SOURCE may be #defined, which will
182 encourage header files to do strange things. */
187 SCM_PROC (s_pipe
, "pipe", 0, 0, 0, scm_pipe
);
195 struct scm_port_table
* ptr
;
196 struct scm_port_table
* ptw
;
202 scm_syserror (s_pipe
);
203 f_rd
= fdopen (fd
[0], "r");
206 SCM_SYSCALL (close (fd
[0]));
207 SCM_SYSCALL (close (fd
[1]));
208 scm_syserror (s_pipe
);
210 f_wt
= fdopen (fd
[1], "w");
216 SCM_SYSCALL (close (fd
[1]));
218 scm_syserror (s_pipe
);
220 ptr
= scm_add_to_port_table (p_rd
);
221 ptw
= scm_add_to_port_table (p_wt
);
222 SCM_SETPTAB_ENTRY (p_rd
, ptr
);
223 SCM_SETPTAB_ENTRY (p_wt
, ptw
);
224 SCM_SETCAR (p_rd
, scm_tc16_fport
| scm_mode_bits ("r"));
225 SCM_SETCAR (p_wt
, scm_tc16_fport
| scm_mode_bits ("w"));
226 SCM_SETSTREAM (p_rd
, (SCM
)f_rd
);
227 SCM_SETSTREAM (p_wt
, (SCM
)f_wt
);
230 return scm_cons (p_rd
, p_wt
);
235 SCM_PROC (s_getgroups
, "getgroups", 0, 0, 0, scm_getgroups
);
241 int ngroups
= getgroups (0, NULL
);
243 scm_syserror (s_getgroups
);
250 groups
= (GETGROUPS_T
*) scm_must_malloc(ngroups
* sizeof(GETGROUPS_T
),
252 val
= getgroups(ngroups
, groups
);
255 scm_must_free((char *)groups
);
256 scm_syserror (s_getgroups
);
258 SCM_SETCHARS(grps
, groups
); /* set up grps as a GC protect */
259 SCM_SETLENGTH(grps
, 0L + ngroups
* sizeof(GETGROUPS_T
), scm_tc7_string
);
261 ans
= scm_make_vector(SCM_MAKINUM(ngroups
), SCM_UNDEFINED
, SCM_BOOL_F
);
262 while (--ngroups
>= 0) SCM_VELTS(ans
)[ngroups
] = SCM_MAKINUM(groups
[ngroups
]);
263 SCM_SETCHARS(grps
, groups
); /* to make sure grps stays around. */
270 SCM_PROC (s_getpwuid
, "getpw", 0, 1, 0, scm_getpwuid
);
277 struct passwd
*entry
;
280 result
= scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED
, SCM_BOOL_F
);
281 ve
= SCM_VELTS (result
);
282 if (SCM_UNBNDP (user
) || SCM_FALSEP (user
))
285 SCM_SYSCALL (entry
= getpwent ());
287 else if (SCM_INUMP (user
))
290 entry
= getpwuid (SCM_INUM (user
));
294 SCM_ASSERT (SCM_NIMP (user
) && SCM_ROSTRINGP (user
), user
, SCM_ARG1
, s_getpwuid
);
295 if (SCM_SUBSTRP (user
))
296 user
= scm_makfromstr (SCM_ROCHARS (user
), SCM_ROLENGTH (user
), 0);
298 entry
= getpwnam (SCM_ROCHARS (user
));
301 scm_syserror (s_getpwuid
);
303 ve
[0] = scm_makfrom0str (entry
->pw_name
);
304 ve
[1] = scm_makfrom0str (entry
->pw_passwd
);
305 ve
[2] = scm_ulong2num ((unsigned long) entry
->pw_uid
);
306 ve
[3] = scm_ulong2num ((unsigned long) entry
->pw_gid
);
307 ve
[4] = scm_makfrom0str (entry
->pw_gecos
);
309 ve
[5] = scm_makfrom0str ("");
311 ve
[5] = scm_makfrom0str (entry
->pw_dir
);
312 if (!entry
->pw_shell
)
313 ve
[6] = scm_makfrom0str ("");
315 ve
[6] = scm_makfrom0str (entry
->pw_shell
);
322 SCM_PROC (s_setpwent
, "setpw", 0, 1, 0, scm_setpwent
);
328 if (SCM_UNBNDP (arg
) || SCM_FALSEP (arg
))
332 return SCM_UNSPECIFIED
;
337 /* Combines getgrgid and getgrnam. */
338 SCM_PROC (s_getgrgid
, "getgr", 0, 1, 0, scm_getgrgid
);
347 result
= scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED
, SCM_BOOL_F
);
348 ve
= SCM_VELTS (result
);
350 if (SCM_UNBNDP (name
) || (name
== SCM_BOOL_F
))
351 SCM_SYSCALL (entry
= getgrent ());
352 else if (SCM_INUMP (name
))
353 SCM_SYSCALL (entry
= getgrgid (SCM_INUM (name
)));
356 SCM_ASSERT (SCM_NIMP (name
) && SCM_STRINGP (name
), name
, SCM_ARG1
, s_getgrgid
);
357 if (SCM_SUBSTRP (name
))
358 name
= scm_makfromstr (SCM_ROCHARS (name
), SCM_ROLENGTH (name
), 0);
359 SCM_SYSCALL (entry
= getgrnam (SCM_CHARS (name
)));
362 scm_syserror (s_getgrgid
);
364 ve
[0] = scm_makfrom0str (entry
->gr_name
);
365 ve
[1] = scm_makfrom0str (entry
->gr_passwd
);
366 ve
[2] = scm_ulong2num ((unsigned long) entry
->gr_gid
);
367 ve
[3] = scm_makfromstrs (-1, entry
->gr_mem
);
374 SCM_PROC (s_setgrent
, "setgr", 0, 1, 0, scm_setgrent
);
380 if (SCM_UNBNDP (arg
) || SCM_FALSEP (arg
))
384 return SCM_UNSPECIFIED
;
389 SCM_PROC (s_kill
, "kill", 2, 0, 0, scm_kill
);
396 SCM_ASSERT (SCM_INUMP (pid
), pid
, SCM_ARG1
, s_kill
);
397 SCM_ASSERT (SCM_INUMP (sig
), sig
, SCM_ARG2
, s_kill
);
398 /* Signal values are interned in scm_init_posix(). */
399 if (kill ((int) SCM_INUM (pid
), (int) SCM_INUM (sig
)) != 0)
400 scm_syserror (s_kill
);
401 return SCM_UNSPECIFIED
;
406 SCM_PROC (s_waitpid
, "waitpid", 1, 1, 0, scm_waitpid
);
409 scm_waitpid (pid
, options
)
417 SCM_ASSERT (SCM_INUMP (pid
), pid
, SCM_ARG1
, s_waitpid
);
418 if (SCM_UNBNDP (options
))
422 SCM_ASSERT (SCM_INUMP (options
), options
, SCM_ARG2
, s_waitpid
);
423 /* Flags are interned in scm_init_posix. */
424 ioptions
= SCM_INUM (options
);
426 SCM_SYSCALL (i
= waitpid (SCM_INUM (pid
), &status
, ioptions
));
428 scm_syserror (s_waitpid
);
429 return scm_cons (SCM_MAKINUM (0L + i
), SCM_MAKINUM (0L + status
));
431 scm_sysmissing (s_waitpid
);
439 SCM_PROC (s_getppid
, "getppid", 0, 0, 0, scm_getppid
);
444 return SCM_MAKINUM (0L + getppid ());
449 SCM_PROC (s_getuid
, "getuid", 0, 0, 0, scm_getuid
);
454 return SCM_MAKINUM (0L + getuid ());
459 SCM_PROC (s_getgid
, "getgid", 0, 0, 0, scm_getgid
);
464 return SCM_MAKINUM (0L + getgid ());
469 SCM_PROC (s_geteuid
, "geteuid", 0, 0, 0, scm_geteuid
);
475 return SCM_MAKINUM (0L + geteuid ());
477 return SCM_MAKINUM (0L + getuid ());
483 SCM_PROC (s_getegid
, "getegid", 0, 0, 0, scm_getegid
);
489 return SCM_MAKINUM (0L + getegid ());
491 return SCM_MAKINUM (0L + getgid ());
496 SCM_PROC (s_setuid
, "setuid", 1, 0, 0, scm_setuid
);
502 SCM_ASSERT (SCM_INUMP (id
), id
, SCM_ARG1
, s_setuid
);
503 if (setuid (SCM_INUM (id
)) != 0)
504 scm_syserror (s_setuid
);
505 return SCM_UNSPECIFIED
;
508 SCM_PROC (s_setgid
, "setgid", 1, 0, 0, scm_setgid
);
514 SCM_ASSERT (SCM_INUMP (id
), id
, SCM_ARG1
, s_setgid
);
515 if (setgid (SCM_INUM (id
)) != 0)
516 scm_syserror (s_setgid
);
517 return SCM_UNSPECIFIED
;
520 SCM_PROC (s_seteuid
, "seteuid", 1, 0, 0, scm_seteuid
);
528 SCM_ASSERT (SCM_INUMP (id
), id
, SCM_ARG1
, s_seteuid
);
530 rv
= seteuid (SCM_INUM (id
));
532 rv
= setuid (SCM_INUM (id
));
535 scm_syserror (s_seteuid
);
536 return SCM_UNSPECIFIED
;
539 SCM_PROC (s_setegid
, "setegid", 1, 0, 0, scm_setegid
);
547 SCM_ASSERT (SCM_INUMP (id
), id
, SCM_ARG1
, s_setegid
);
549 rv
= setegid (SCM_INUM (id
));
551 rv
= setgid (SCM_INUM (id
));
554 scm_syserror (s_setegid
);
555 return SCM_UNSPECIFIED
;
559 SCM_PROC (s_getpgrp
, "getpgrp", 0, 0, 0, scm_getpgrp
);
564 fn
= (int (*) ()) getpgrp
;
565 return SCM_MAKINUM (fn (0));
568 SCM_PROC (s_setpgid
, "setpgid", 2, 0, 0, scm_setpgid
);
570 scm_setpgid (pid
, pgid
)
574 SCM_ASSERT (SCM_INUMP (pid
), pid
, SCM_ARG1
, s_setpgid
);
575 SCM_ASSERT (SCM_INUMP (pgid
), pgid
, SCM_ARG2
, s_setpgid
);
576 /* FIXME(?): may be known as setpgrp. */
577 if (setpgid (SCM_INUM (pid
), SCM_INUM (pgid
)) != 0)
578 scm_syserror (s_setpgid
);
579 return SCM_UNSPECIFIED
;
581 scm_sysmissing (s_setpgid
);
587 SCM_PROC (s_setsid
, "setsid", 0, 0, 0, scm_setsid
);
592 pid_t sid
= setsid ();
594 scm_syserror (s_setsid
);
595 return SCM_UNSPECIFIED
;
597 scm_sysmissing (s_setsid
);
603 SCM_PROC (s_ttyname
, "ttyname", 1, 0, 0, scm_ttyname
);
611 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPPORTP (port
), port
, SCM_ARG1
, s_ttyname
);
612 if (scm_tc16_fport
!= SCM_TYP16 (port
))
614 fd
= fileno ((FILE *)SCM_STREAM (port
));
616 scm_syserror (s_ttyname
);
617 SCM_SYSCALL (ans
= ttyname (fd
));
619 scm_syserror (s_ttyname
);
620 /* ans could be overwritten by another call to ttyname */
621 return (scm_makfrom0str (ans
));
625 SCM_PROC (s_ctermid
, "ctermid", 0, 0, 0, scm_ctermid
);
630 char *result
= ctermid (NULL
);
632 scm_syserror (s_ctermid
);
633 return scm_makfrom0str (result
);
635 scm_sysmissing (s_ctermid
);
641 SCM_PROC (s_tcgetpgrp
, "tcgetpgrp", 1, 0, 0, scm_tcgetpgrp
);
646 #ifdef HAVE_TCGETPGRP
649 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_tcgetpgrp
);
650 fd
= fileno ((FILE *)SCM_STREAM (port
));
651 if (fd
== -1 || (pgid
= tcgetpgrp (fd
)) == -1)
652 scm_syserror (s_tcgetpgrp
);
653 return SCM_MAKINUM (pgid
);
655 scm_sysmissing (s_tcgetpgrp
);
661 SCM_PROC (s_tcsetpgrp
, "tcsetpgrp", 2, 0, 0, scm_tcsetpgrp
);
663 scm_tcsetpgrp (port
, pgid
)
666 #ifdef HAVE_TCSETPGRP
668 SCM_ASSERT (SCM_NIMP (port
) && SCM_OPFPORTP (port
), port
, SCM_ARG1
, s_tcsetpgrp
);
669 SCM_ASSERT (SCM_INUMP (pgid
), pgid
, SCM_ARG2
, s_tcsetpgrp
);
670 fd
= fileno ((FILE *)SCM_STREAM (port
));
671 if (fd
== -1 || tcsetpgrp (fd
, SCM_INUM (pgid
)) == -1)
672 scm_syserror (s_tcsetpgrp
);
673 return SCM_UNSPECIFIED
;
675 scm_sysmissing (s_tcsetpgrp
);
681 /* Copy exec args from an SCM vector into a new C array. */
683 static char ** scm_convert_exec_args
SCM_P ((SCM args
));
686 scm_convert_exec_args (args
)
693 num_args
= scm_ilength (args
);
695 scm_must_malloc ((num_args
+ 1) * sizeof (char *), s_ttyname
);
696 for (i
= 0; SCM_NNULLP (args
); args
= SCM_CDR (args
), ++i
)
701 SCM_ASSERT (SCM_NIMP (SCM_CAR (args
)) && SCM_ROSTRINGP (SCM_CAR (args
)), SCM_CAR (args
),
702 "wrong type in SCM_ARG", "exec arg");
703 len
= 1 + SCM_ROLENGTH (SCM_CAR (args
));
704 dst
= (char *) scm_must_malloc ((long) len
, s_ttyname
);
705 src
= SCM_ROCHARS (SCM_CAR (args
));
715 SCM_PROC (s_execl
, "execl", 0, 0, 1, scm_execl
);
722 SCM filename
= SCM_CAR (args
);
723 SCM_ASSERT (SCM_NIMP (filename
) && SCM_ROSTRINGP (filename
), filename
, SCM_ARG1
, s_execl
);
724 if (SCM_SUBSTRP (filename
))
725 filename
= scm_makfromstr (SCM_ROCHARS (filename
), SCM_ROLENGTH (filename
), 0);
726 args
= SCM_CDR (args
);
727 execargv
= scm_convert_exec_args (args
);
728 execv (SCM_ROCHARS (filename
), execargv
);
729 scm_syserror (s_execl
);
734 SCM_PROC (s_execlp
, "execlp", 0, 0, 1, scm_execlp
);
741 SCM filename
= SCM_CAR (args
);
742 SCM_ASSERT (SCM_NIMP (filename
) && SCM_ROSTRINGP (filename
), filename
, SCM_ARG1
, s_execlp
);
743 if (SCM_SUBSTRP (filename
))
744 filename
= scm_makfromstr (SCM_ROCHARS (filename
), SCM_ROLENGTH (filename
), 0);
745 args
= SCM_CDR (args
);
746 execargv
= scm_convert_exec_args (args
);
747 execvp (SCM_ROCHARS (filename
), execargv
);
748 scm_syserror (s_execlp
);
753 SCM_PROC (s_fork
, "primitive-fork", 0, 0, 0, scm_fork
);
761 scm_syserror (s_fork
);
762 return SCM_MAKINUM (0L+pid
);
766 SCM_PROC (s_uname
, "uname", 0, 0, 0, scm_uname
);
773 SCM ans
= scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED
, SCM_BOOL_F
);
774 SCM
*ve
= SCM_VELTS (ans
);
776 return SCM_MAKINUM (errno
);
777 ve
[0] = scm_makfrom0str (buf
.sysname
);
778 ve
[1] = scm_makfrom0str (buf
.nodename
);
779 ve
[2] = scm_makfrom0str (buf
.release
);
780 ve
[3] = scm_makfrom0str (buf
.version
);
781 ve
[4] = scm_makfrom0str (buf
.machine
);
784 ve[5] = scm_makfrom0str (buf.domainname);
788 scm_sysmissing (s_uname
);
794 SCM_PROC (s_environ
, "environ", 0, 1, 0, scm_environ
);
800 if (SCM_UNBNDP (env
))
801 return scm_makfromstrs (-1, environ
);
807 SCM_ASSERT (SCM_NULLP (env
) || (SCM_NIMP (env
) && SCM_CONSP (env
)),
808 env
, SCM_ARG1
, s_environ
);
809 num_strings
= scm_ilength (env
);
810 new_environ
= (char **) scm_must_malloc ((num_strings
+ 1)
813 while (SCM_NNULLP (env
))
817 SCM_ASSERT (SCM_NIMP (SCM_CAR (env
)) && SCM_ROSTRINGP (SCM_CAR (env
)), env
, SCM_ARG1
,
819 len
= 1 + SCM_ROLENGTH (SCM_CAR (env
));
820 new_environ
[i
] = scm_must_malloc ((long) len
, s_environ
);
821 src
= SCM_ROCHARS (SCM_CAR (env
));
823 new_environ
[i
][len
] = src
[len
];
828 /* Free the old environment, except when called for the first
833 static int first
= 1;
836 for (ep
= environ
; *ep
!= NULL
; ep
++)
838 scm_must_free ((char *) environ
);
842 environ
= new_environ
;
843 return SCM_UNSPECIFIED
;
849 SCM_PROC (s_tmpnam
, "tmpnam", 0, 0, 0, scm_tmpnam
);
854 SCM_SYSCALL (tmpnam (name
););
855 return scm_makfrom0str (name
);
859 SCM_PROC (s_open_pipe
, "open-pipe", 2, 0, 0, scm_open_pipe
);
862 scm_open_pipe (pipestr
, modes
)
868 struct scm_port_table
* pt
;
870 SCM_ASSERT (SCM_NIMP (pipestr
) && SCM_ROSTRINGP (pipestr
), pipestr
, SCM_ARG1
, s_open_pipe
);
871 if (SCM_SUBSTRP (pipestr
))
872 pipestr
= scm_makfromstr (SCM_ROCHARS (pipestr
), SCM_ROLENGTH (pipestr
), 0);
873 SCM_ASSERT (SCM_NIMP (modes
) && SCM_ROSTRINGP (modes
), modes
, SCM_ARG2
, s_open_pipe
);
874 if (SCM_SUBSTRP (modes
))
875 modes
= scm_makfromstr (SCM_ROCHARS (modes
), SCM_ROLENGTH (modes
), 0);
878 scm_ignore_signals ();
879 SCM_SYSCALL (f
= popen (SCM_ROCHARS (pipestr
), SCM_ROCHARS (modes
)));
880 scm_unignore_signals ();
882 scm_syserror (s_open_pipe
);
883 pt
= scm_add_to_port_table (z
);
884 SCM_SETPTAB_ENTRY (z
, pt
);
885 SCM_SETCAR (z
, scm_tc16_pipe
| SCM_OPN
886 | (strchr (SCM_ROCHARS (modes
), 'r') ? SCM_RDNG
: SCM_WRTNG
));
887 SCM_SETSTREAM (z
, (SCM
)f
);
893 SCM_PROC (s_open_input_pipe
, "open-input-pipe", 1, 0, 0, scm_open_input_pipe
);
896 scm_open_input_pipe(pipestr
)
899 return scm_open_pipe(pipestr
, scm_makfromstr("r", (sizeof "r")-1, 0));
902 SCM_PROC (s_open_output_pipe
, "open-output-pipe", 1, 0, 0, scm_open_output_pipe
);
905 scm_open_output_pipe(pipestr
)
908 return scm_open_pipe(pipestr
, scm_makfromstr("w", (sizeof "w")-1, 0));
912 SCM_PROC (s_utime
, "utime", 1, 2, 0, scm_utime
);
915 scm_utime (pathname
, actime
, modtime
)
921 struct utimbuf utm_tmp
;
923 SCM_ASSERT (SCM_NIMP (pathname
) && SCM_STRINGP (pathname
), pathname
, SCM_ARG1
, s_utime
);
925 if (SCM_UNBNDP (actime
))
926 SCM_SYSCALL (time (&utm_tmp
.actime
));
928 utm_tmp
.actime
= scm_num2ulong (actime
, (char *) SCM_ARG2
, s_utime
);
930 if (SCM_UNBNDP (modtime
))
931 SCM_SYSCALL (time (&utm_tmp
.modtime
));
933 utm_tmp
.modtime
= scm_num2ulong (modtime
, (char *) SCM_ARG3
, s_utime
);
935 SCM_SYSCALL (rv
= utime (SCM_CHARS (pathname
), &utm_tmp
));
937 scm_syserror (s_utime
);
938 return SCM_UNSPECIFIED
;
941 SCM_PROC (s_access
, "access?", 2, 0, 0, scm_access
);
944 scm_access (path
, how
)
950 SCM_ASSERT (SCM_NIMP (path
) && SCM_ROSTRINGP (path
), path
, SCM_ARG1
, s_access
);
951 if (SCM_SUBSTRP (path
))
952 path
= scm_makfromstr (SCM_ROCHARS (path
), SCM_ROLENGTH (path
), 0);
953 SCM_ASSERT (SCM_INUMP (how
), how
, SCM_ARG2
, s_access
);
954 rv
= access (SCM_ROCHARS (path
), SCM_INUM (how
));
955 return rv
? SCM_BOOL_F
: SCM_BOOL_T
;
958 SCM_PROC (s_getpid
, "getpid", 0, 0, 0, scm_getpid
);
963 return SCM_MAKINUM ((unsigned long) getpid ());
966 SCM_PROC (s_putenv
, "putenv", 1, 0, 0, scm_putenv
);
975 SCM_ASSERT (SCM_NIMP (str
) && SCM_STRINGP (str
), str
, SCM_ARG1
, s_putenv
);
976 rv
= putenv (SCM_CHARS (str
));
978 scm_syserror (s_putenv
);
979 return SCM_UNSPECIFIED
;
981 scm_sysmissing (s_putenv
);
987 SCM_PROC (s_setlocale
, "setlocale", 1, 1, 0, scm_setlocale
);
990 scm_setlocale (category
, locale
)
994 #ifdef HAVE_SETLOCALE
998 SCM_ASSERT (SCM_INUMP (category
), category
, SCM_ARG1
, s_setlocale
);
999 if (SCM_UNBNDP (locale
))
1005 SCM_ASSERT (SCM_NIMP (locale
) && SCM_STRINGP (locale
), locale
, SCM_ARG2
, s_setlocale
);
1006 clocale
= SCM_CHARS (locale
);
1009 rv
= setlocale (SCM_INUM (category
), clocale
);
1011 scm_syserror (s_setlocale
);
1012 return scm_makfrom0str (rv
);
1014 scm_sysmissing (s_setlocale
);
1020 SCM_PROC (s_strftime
, "strftime", 2, 0, 0, scm_strftime
);
1023 scm_strftime (format
, stime
)
1035 SCM_ASSERT (SCM_NIMP (format
) && SCM_STRINGP (format
), format
, SCM_ARG1
, s_strftime
);
1036 SCM_ASSERT (SCM_NIMP (stime
) && SCM_VECTORP (stime
) && scm_obj_length (stime
) == 9,
1037 stime
, SCM_ARG2
, s_strftime
);
1039 fmt
= SCM_ROCHARS (format
);
1040 len
= SCM_ROLENGTH (format
);
1042 #define tm_deref scm_num2long (SCM_VELTS (stime)[n++], (char *)SCM_ARG2, s_strftime)
1044 t
.tm_sec
= tm_deref
;
1045 t
.tm_min
= tm_deref
;
1046 t
.tm_hour
= tm_deref
;
1047 t
.tm_mday
= tm_deref
;
1048 t
.tm_mon
= tm_deref
;
1049 t
.tm_year
= tm_deref
;
1050 /* not used by mktime.
1051 t.tm_wday = tm_deref;
1052 t.tm_yday = tm_deref; */
1053 t
.tm_isdst
= tm_deref
;
1056 /* fill in missing fields and set the timezone. */
1059 tbuf
= scm_must_malloc (size
, s_strftime
);
1060 while ((len
= strftime (tbuf
, size
, fmt
, &t
)) == size
)
1062 scm_must_free (tbuf
);
1064 tbuf
= scm_must_malloc (size
, s_strftime
);
1066 return scm_makfromstr (tbuf
, len
, 0);
1069 SCM_PROC (s_strptime
, "strptime", 2, 0, 0, scm_strptime
);
1072 scm_strptime (format
, string
)
1076 #ifdef HAVE_STRPTIME
1080 char *fmt
, *str
, *rest
;
1083 SCM_ASSERT (SCM_NIMP (format
) && SCM_ROSTRINGP (format
), format
, SCM_ARG1
, s_strptime
);
1084 if (SCM_SUBSTRP (format
))
1085 format
= scm_makfromstr (SCM_ROCHARS (format
), SCM_ROLENGTH (format
), 0);
1086 SCM_ASSERT (SCM_NIMP (string
) && SCM_ROSTRINGP (string
), string
, SCM_ARG2
, s_strptime
);
1087 if (SCM_SUBSTRP (string
))
1088 string
= scm_makfromstr (SCM_ROCHARS (string
), SCM_ROLENGTH (string
), 0);
1090 fmt
= SCM_CHARS (format
);
1091 str
= SCM_CHARS (string
);
1093 /* initialize the struct tm */
1094 #define tm_init(field) t.field = 0
1107 rest
= strptime (str
, fmt
, &t
);
1111 scm_syserror (s_strptime
);
1113 stime
= scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED
);
1115 #define stime_set(val) scm_vector_set_x (stime, SCM_MAKINUM (n++), scm_long2num (t.val));
1119 stime_set (tm_hour
);
1120 stime_set (tm_mday
);
1122 stime_set (tm_year
);
1123 stime_set (tm_wday
);
1124 stime_set (tm_yday
);
1125 stime_set (tm_isdst
);
1128 return scm_cons (stime
, scm_makfrom0str (rest
));
1130 scm_sysmissing (s_strptime
);
1136 SCM_PROC (s_mknod
, "mknod", 3, 0, 0, scm_mknod
);
1139 scm_mknod(path
, mode
, dev
)
1146 SCM_ASSERT(SCM_NIMP(path
) && SCM_STRINGP(path
), path
, SCM_ARG1
, s_mknod
);
1147 SCM_ASSERT(SCM_INUMP(mode
), mode
, SCM_ARG2
, s_mknod
);
1148 SCM_ASSERT(SCM_INUMP(dev
), dev
, SCM_ARG3
, s_mknod
);
1149 SCM_SYSCALL(val
= mknod(SCM_CHARS(path
), SCM_INUM(mode
), SCM_INUM(dev
)));
1151 scm_syserror (s_mknod
);
1152 return SCM_UNSPECIFIED
;
1154 scm_sysmissing (s_mknod
);
1161 SCM_PROC (s_nice
, "nice", 1, 0, 0, scm_nice
);
1168 SCM_ASSERT(SCM_INUMP(incr
), incr
, SCM_ARG1
, s_nice
);
1169 if (nice(SCM_INUM(incr
)) != 0)
1170 scm_syserror (s_nice
);
1171 return SCM_UNSPECIFIED
;
1173 scm_sysmissing (s_nice
);
1180 SCM_PROC (s_sync
, "sync", 0, 0, 0, scm_sync
);
1188 scm_sysmissing (s_sync
);
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
));
1218 scm_sysintern ("EINTR", SCM_MAKINUM (EINTR
));
1222 scm_sysintern ("SIGHUP", SCM_MAKINUM (SIGHUP
));
1225 scm_sysintern ("SIGINT", SCM_MAKINUM (SIGINT
));
1228 scm_sysintern ("SIGQUIT", SCM_MAKINUM (SIGQUIT
));
1231 scm_sysintern ("SIGILL", SCM_MAKINUM (SIGILL
));
1234 scm_sysintern ("SIGTRAP", SCM_MAKINUM (SIGTRAP
));
1237 scm_sysintern ("SIGABRT", SCM_MAKINUM (SIGABRT
));
1240 scm_sysintern ("SIGIOT", SCM_MAKINUM (SIGIOT
));
1243 scm_sysintern ("SIGBUS", SCM_MAKINUM (SIGBUS
));
1246 scm_sysintern ("SIGFPE", SCM_MAKINUM (SIGFPE
));
1249 scm_sysintern ("SIGKILL", SCM_MAKINUM (SIGKILL
));
1252 scm_sysintern ("SIGUSR1", SCM_MAKINUM (SIGUSR1
));
1255 scm_sysintern ("SIGSEGV", SCM_MAKINUM (SIGSEGV
));
1258 scm_sysintern ("SIGUSR2", SCM_MAKINUM (SIGUSR2
));
1261 scm_sysintern ("SIGPIPE", SCM_MAKINUM (SIGPIPE
));
1264 scm_sysintern ("SIGALRM", SCM_MAKINUM (SIGALRM
));
1267 scm_sysintern ("SIGTERM", SCM_MAKINUM (SIGTERM
));
1270 scm_sysintern ("SIGSTKFLT", SCM_MAKINUM (SIGSTKFLT
));
1273 scm_sysintern ("SIGCHLD", SCM_MAKINUM (SIGCHLD
));
1276 scm_sysintern ("SIGCONT", SCM_MAKINUM (SIGCONT
));
1279 scm_sysintern ("SIGSTOP", SCM_MAKINUM (SIGSTOP
));
1282 scm_sysintern ("SIGTSTP", SCM_MAKINUM (SIGTSTP
));
1285 scm_sysintern ("SIGTTIN", SCM_MAKINUM (SIGTTIN
));
1288 scm_sysintern ("SIGTTOU", SCM_MAKINUM (SIGTTOU
));
1291 scm_sysintern ("SIGIO", SCM_MAKINUM (SIGIO
));
1294 scm_sysintern ("SIGPOLL", SCM_MAKINUM (SIGPOLL
));
1297 scm_sysintern ("SIGURG", SCM_MAKINUM (SIGURG
));
1300 scm_sysintern ("SIGXCPU", SCM_MAKINUM (SIGXCPU
));
1303 scm_sysintern ("SIGXFSZ", SCM_MAKINUM (SIGXFSZ
));
1306 scm_sysintern ("SIGVTALRM", SCM_MAKINUM (SIGVTALRM
));
1309 scm_sysintern ("SIGPROF", SCM_MAKINUM (SIGPROF
));
1312 scm_sysintern ("SIGWINCH", SCM_MAKINUM (SIGWINCH
));
1315 scm_sysintern ("SIGLOST", SCM_MAKINUM (SIGLOST
));
1318 scm_sysintern ("SIGPWR", SCM_MAKINUM (SIGPWR
));
1320 /* access() symbols. */
1321 scm_sysintern ("R_OK", SCM_MAKINUM (R_OK
));
1322 scm_sysintern ("W_OK", SCM_MAKINUM (W_OK
));
1323 scm_sysintern ("X_OK", SCM_MAKINUM (X_OK
));
1324 scm_sysintern ("F_OK", SCM_MAKINUM (F_OK
));
1327 scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE
));
1330 scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE
));
1333 scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY
));
1336 scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC
));
1339 scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME
));
1342 scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES
));
1345 scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL
));