.
[bpt/guile.git] / libguile / posix.c
CommitLineData
0f2d19dd
JB
1/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
2 *
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)
6 * any later version.
7 *
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.
12 *
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.
16 *
17 * As a special exception, the Free Software Foundation gives permission
18 * for additional uses of the text contained in its release of GUILE.
19 *
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.
25 *
26 * This exception does not however invalidate any other reasons why
27 * the executable file might be covered by the GNU General Public License.
28 *
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.
36 *
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.
40 */
41\f
42
43#include <stdio.h>
44#include "_scm.h"
45
46\f
47
02b754d3
GH
48#ifdef HAVE_STRING_H
49#include <string.h>
50#endif
0f2d19dd
JB
51#ifdef TIME_WITH_SYS_TIME
52# include <sys/time.h>
53# include <time.h>
54#else
55# if HAVE_SYS_TIME_H
56# include <sys/time.h>
57# else
58# include <time.h>
59# endif
60#endif
61
62#ifdef HAVE_UNISTD_H
63#include <unistd.h>
64#endif
65
66#ifdef HAVE_SYS_SELECT_H
67#include <sys/select.h>
68#endif
69
8cc71382 70#include <sys/types.h>
0f2d19dd
JB
71#include <sys/stat.h>
72#include <fcntl.h>
73
74#include <pwd.h>
75
76#if HAVE_SYS_WAIT_H
77# include <sys/wait.h>
78#endif
79#ifndef WEXITSTATUS
80# define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
81#endif
82#ifndef WIFEXITED
83# define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
84#endif
85
86#include <signal.h>
87
88#ifdef FD_SET
89
90#define SELECT_TYPE fd_set
91#define SELECT_SET_SIZE FD_SETSIZE
92
93#else /* no FD_SET */
94
95/* Define the macros to access a single-int bitmap of descriptors. */
96#define SELECT_SET_SIZE 32
97#define SELECT_TYPE int
98#define FD_SET(n, p) (*(p) |= (1 << (n)))
99#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
100#define FD_ISSET(n, p) (*(p) & (1 << (n)))
101#define FD_ZERO(p) (*(p) = 0)
102
103#endif /* no FD_SET */
104
105extern char *ttyname ();
106extern FILE *popen ();
107extern char ** environ;
108
109#include <grp.h>
110#include <sys/utsname.h>
111
112#if HAVE_DIRENT_H
113# include <dirent.h>
114# define NAMLEN(dirent) strlen((dirent)->d_name)
115#else
116# define dirent direct
117# define NAMLEN(dirent) (dirent)->d_namlen
118# if HAVE_SYS_NDIR_H
119# include <sys/ndir.h>
120# endif
121# if HAVE_SYS_DIR_H
122# include <sys/dir.h>
123# endif
124# if HAVE_NDIR_H
125# include <ndir.h>
126# endif
127#endif
128
129char *strptime ();
130
131#ifdef HAVE_SETLOCALE
132#include <locale.h>
133#endif
134
135
136\f
137
138
02b754d3 139SCM_PROC (s_sys_pipe, "pipe", 0, 0, 0, scm_sys_pipe);
0f2d19dd
JB
140#ifdef __STDC__
141SCM
142scm_sys_pipe (void)
143#else
144SCM
145scm_sys_pipe ()
146#endif
147{
148 int fd[2], rv;
149 FILE *f_rd, *f_wt;
150 SCM p_rd, p_wt;
02b754d3
GH
151 struct scm_port_table * ptr;
152 struct scm_port_table * ptw;
153
0f2d19dd
JB
154 SCM_NEWCELL (p_rd);
155 SCM_NEWCELL (p_wt);
156 rv = pipe (fd);
157 if (rv)
02b754d3 158 SCM_SYSERROR (s_sys_pipe);
0f2d19dd
JB
159 f_rd = fdopen (fd[0], "r");
160 if (!f_rd)
161 {
162 SCM_SYSCALL (close (fd[0]));
163 SCM_SYSCALL (close (fd[1]));
02b754d3 164 SCM_SYSERROR (s_sys_pipe);
0f2d19dd
JB
165 }
166 f_wt = fdopen (fd[1], "w");
167 if (!f_wt)
168 {
169 int en;
170 en = errno;
171 fclose (f_rd);
172 SCM_SYSCALL (close (fd[1]));
02b754d3
GH
173 errno = en;
174 SCM_SYSERROR (s_sys_pipe);
0f2d19dd 175 }
02b754d3
GH
176 ptr = scm_add_to_port_table (p_rd);
177 ptw = scm_add_to_port_table (p_wt);
178 SCM_SETPTAB_ENTRY (p_rd, ptr);
179 SCM_SETPTAB_ENTRY (p_wt, ptw);
180 SCM_CAR (p_rd) = scm_tc16_fport | scm_mode_bits ("r");
181 SCM_CAR (p_wt) = scm_tc16_fport | scm_mode_bits ("w");
182 SCM_SETSTREAM (p_rd, (SCM)f_rd);
183 SCM_SETSTREAM (p_wt, (SCM)f_wt);
184
0f2d19dd
JB
185 SCM_ALLOW_INTS;
186 return scm_cons (p_rd, p_wt);
187}
188
189
190
02b754d3 191SCM_PROC (s_sys_getgroups, "getgroups", 0, 0, 0, scm_sys_getgroups);
0f2d19dd
JB
192#ifdef __STDC__
193SCM
194scm_sys_getgroups(void)
195#else
196SCM
197scm_sys_getgroups()
198#endif
199{
200 SCM grps, ans;
201 int ngroups = getgroups (0, NULL);
02b754d3
GH
202 if (!ngroups)
203 SCM_SYSERROR (s_sys_getgroups);
0f2d19dd
JB
204 SCM_NEWCELL(grps);
205 SCM_DEFER_INTS;
206 {
207 GETGROUPS_T *groups;
208 int val;
209
210 groups = (gid_t *)scm_must_malloc(ngroups * sizeof(GETGROUPS_T),
211 s_sys_getgroups);
212 val = getgroups(ngroups, groups);
213 if (val < 0)
214 {
215 scm_must_free((char *)groups);
02b754d3 216 SCM_SYSERROR (s_sys_getgroups);
0f2d19dd
JB
217 }
218 SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */
219 SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string);
220 SCM_ALLOW_INTS;
221 ans = scm_make_vector(SCM_MAKINUM(ngroups), SCM_UNDEFINED, SCM_BOOL_F);
222 while (--ngroups >= 0) SCM_VELTS(ans)[ngroups] = SCM_MAKINUM(groups[ngroups]);
223 SCM_SETCHARS(grps, groups); /* to make sure grps stays around. */
224 return ans;
225 }
226}
227
228
229
02b754d3 230SCM_PROC (s_sys_getpwuid, "getpw", 0, 1, 0, scm_sys_getpwuid);
0f2d19dd
JB
231#ifdef __STDC__
232SCM
233scm_sys_getpwuid (SCM user)
234#else
235SCM
236scm_sys_getpwuid (user)
237 SCM user;
238#endif
239{
240 SCM result;
241 struct passwd *entry;
242 SCM *ve;
243
244 result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED, SCM_BOOL_F);
245 ve = SCM_VELTS (result);
246 if (SCM_UNBNDP (user) || SCM_FALSEP (user))
247 {
248 SCM_DEFER_INTS;
249 SCM_SYSCALL (entry = getpwent ());
250 }
251 else if (SCM_INUMP (user))
252 {
253 SCM_DEFER_INTS;
254 entry = getpwuid (SCM_INUM (user));
255 }
256 else
257 {
258 SCM_ASSERT (SCM_NIMP (user) && SCM_ROSTRINGP (user), user, SCM_ARG1, s_sys_getpwuid);
259 if (SCM_SUBSTRP (user))
260 user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user), 0);
261 SCM_DEFER_INTS;
262 entry = getpwnam (SCM_ROCHARS (user));
263 }
264 if (!entry)
02b754d3
GH
265 SCM_SYSERROR (s_sys_getpwuid);
266
0f2d19dd
JB
267 ve[0] = scm_makfrom0str (entry->pw_name);
268 ve[1] = scm_makfrom0str (entry->pw_passwd);
269 ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
270 ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
271 ve[4] = scm_makfrom0str (entry->pw_gecos);
272 if (!entry->pw_dir)
273 ve[5] = scm_makfrom0str ("");
274 else
275 ve[5] = scm_makfrom0str (entry->pw_dir);
276 if (!entry->pw_shell)
277 ve[6] = scm_makfrom0str ("");
278 else
279 ve[6] = scm_makfrom0str (entry->pw_shell);
280 SCM_ALLOW_INTS;
281 return result;
282}
283
284
285
286SCM_PROC (s_setpwent, "setpw", 0, 1, 0, scm_setpwent);
287#ifdef __STDC__
288SCM
289scm_setpwent (SCM arg)
290#else
291SCM
292scm_setpwent (arg)
293 SCM arg;
294#endif
295{
296 if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
297 endpwent ();
298 else
299 setpwent ();
300 return SCM_UNSPECIFIED;
301}
302
303
304
305/* Combines getgrgid and getgrnam. */
02b754d3 306SCM_PROC (s_sys_getgrgid, "getgr", 0, 1, 0, scm_sys_getgrgid);
0f2d19dd
JB
307#ifdef __STDC__
308SCM
309scm_sys_getgrgid (SCM name)
310#else
311SCM
312scm_sys_getgrgid (name)
313 SCM name;
314#endif
315{
316 SCM result;
317 struct group *entry;
318 SCM *ve;
319 result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
320 ve = SCM_VELTS (result);
321 SCM_DEFER_INTS;
322 if (SCM_UNBNDP (name) || (name == SCM_BOOL_F))
323 SCM_SYSCALL (entry = getgrent ());
324 else if (SCM_INUMP (name))
325 SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
326 else
327 {
328 SCM_ASSERT (SCM_NIMP (name) && SCM_STRINGP (name), name, SCM_ARG1, s_sys_getgrgid);
329 if (SCM_SUBSTRP (name))
330 name = scm_makfromstr (SCM_ROCHARS (name), SCM_ROLENGTH (name), 0);
331 SCM_SYSCALL (entry = getgrnam (SCM_CHARS (name)));
332 }
333 if (!entry)
02b754d3
GH
334 SCM_SYSERROR (s_sys_getgrgid);
335
0f2d19dd
JB
336 ve[0] = scm_makfrom0str (entry->gr_name);
337 ve[1] = scm_makfrom0str (entry->gr_passwd);
338 ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
339 ve[3] = scm_makfromstrs (-1, entry->gr_mem);
340 SCM_ALLOW_INTS;
341 return result;
342}
343
344
345
346SCM_PROC (s_setgrent, "setgr", 0, 1, 0, scm_setgrent);
347#ifdef __STDC__
348SCM
349scm_setgrent (SCM arg)
350#else
351SCM
352scm_setgrent (arg)
353 SCM arg;
354#endif
355{
356 if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
357 endgrent ();
358 else
359 setgrent ();
360 return SCM_UNSPECIFIED;
361}
362
363
364
02b754d3 365SCM_PROC (s_sys_kill, "kill", 2, 0, 0, scm_sys_kill);
0f2d19dd
JB
366#ifdef __STDC__
367SCM
368scm_sys_kill (SCM pid, SCM sig)
369#else
370SCM
371scm_sys_kill (pid, sig)
372 SCM pid;
373 SCM sig;
374#endif
375{
0f2d19dd
JB
376 SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_kill);
377 SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_sys_kill);
378 /* Signal values are interned in scm_init_posix(). */
02b754d3
GH
379 if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
380 SCM_SYSERROR (s_sys_kill);
381 return SCM_UNSPECIFIED;
0f2d19dd
JB
382}
383
384
385
02b754d3 386SCM_PROC (s_sys_waitpid, "waitpid", 1, 1, 0, scm_sys_waitpid);
0f2d19dd
JB
387#ifdef __STDC__
388SCM
389scm_sys_waitpid (SCM pid, SCM options)
390#else
391SCM
392scm_sys_waitpid (pid, options)
393 SCM pid;
394 SCM options;
395#endif
396{
397 int i;
398 int status;
399 int ioptions;
400 SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_waitpid);
401 if (SCM_UNBNDP (options))
402 ioptions = 0;
403 else
404 {
405 SCM_ASSERT (SCM_INUMP (options), options, SCM_ARG2, s_sys_waitpid);
406 /* Flags are interned in scm_init_posix. */
407 ioptions = SCM_INUM (options);
408 }
409 SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
02b754d3
GH
410 if (i == -1)
411 SCM_SYSERROR (s_sys_waitpid);
412 return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
0f2d19dd
JB
413}
414
415
416
417SCM_PROC (s_getppid, "getppid", 0, 0, 0, scm_getppid);
418#ifdef __STDC__
419SCM
420scm_getppid (void)
421#else
422SCM
423scm_getppid ()
424#endif
425{
426 return SCM_MAKINUM (0L + getppid ());
427}
428
429
430
431SCM_PROC (s_getuid, "getuid", 0, 0, 0, scm_getuid);
432#ifdef __STDC__
433SCM
434scm_getuid (void)
435#else
436SCM
437scm_getuid ()
438#endif
439{
440 return SCM_MAKINUM (0L + getuid ());
441}
442
443
444
445SCM_PROC (s_getgid, "getgid", 0, 0, 0, scm_getgid);
446#ifdef __STDC__
447SCM
448scm_getgid (void)
449#else
450SCM
451scm_getgid ()
452#endif
453{
454 return SCM_MAKINUM (0L + getgid ());
455}
456
457
458
459SCM_PROC (s_geteuid, "geteuid", 0, 0, 0, scm_geteuid);
460#ifdef __STDC__
461SCM
462scm_geteuid (void)
463#else
464SCM
465scm_geteuid ()
466#endif
467{
468#ifdef HAVE_GETEUID
469 return SCM_MAKINUM (0L + geteuid ());
470#else
471 return SCM_MAKINUM (0L + getuid ());
472#endif
473}
474
475
476
477SCM_PROC (s_getegid, "getegid", 0, 0, 0, scm_getegid);
478#ifdef __STDC__
479SCM
480scm_getegid (void)
481#else
482SCM
483scm_getegid ()
484#endif
485{
486#ifdef HAVE_GETEUID
487 return SCM_MAKINUM (0L + getegid ());
488#else
489 return SCM_MAKINUM (0L + getgid ());
490#endif
491}
492
493
02b754d3 494SCM_PROC (s_sys_setuid, "setuid", 1, 0, 0, scm_sys_setuid);
0f2d19dd
JB
495#ifdef __STDC__
496SCM
497scm_sys_setuid (SCM id)
498#else
499SCM
500scm_sys_setuid (id)
501 SCM id;
502#endif
503{
504 SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid);
02b754d3
GH
505 if (setuid (SCM_INUM (id)) != 0)
506 SCM_SYSERROR (s_sys_setuid);
507 return SCM_UNSPECIFIED;
0f2d19dd
JB
508}
509
02b754d3 510SCM_PROC (s_sys_setgid, "setgid", 1, 0, 0, scm_sys_setgid);
0f2d19dd
JB
511#ifdef __STDC__
512SCM
513scm_sys_setgid (SCM id)
514#else
515SCM
516scm_sys_setgid (id)
517 SCM id;
518#endif
519{
520 SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid);
02b754d3
GH
521 if (setgid (SCM_INUM (id)) != 0)
522 SCM_SYSERROR (s_sys_setgid);
523 return SCM_UNSPECIFIED;
0f2d19dd
JB
524}
525
02b754d3 526SCM_PROC (s_sys_seteuid, "seteuid", 1, 0, 0, scm_sys_seteuid);
0f2d19dd
JB
527#ifdef __STDC__
528SCM
529scm_sys_seteuid (SCM id)
530#else
531SCM
532scm_sys_seteuid (id)
533 SCM id;
534#endif
535{
02b754d3
GH
536 int rv;
537
0f2d19dd
JB
538 SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_seteuid);
539#ifdef HAVE_SETEUID
02b754d3 540 rv = seteuid (SCM_INUM (id));
0f2d19dd 541#else
02b754d3 542 rv = setuid (SCM_INUM (id));
0f2d19dd 543#endif
02b754d3
GH
544 if (rv != 0)
545 SCM_SYSERROR (s_sys_seteuid);
546 return SCM_UNSPECIFIED;
0f2d19dd
JB
547}
548
02b754d3 549SCM_PROC (s_sys_setegid, "setegid", 1, 0, 0, scm_sys_setegid);
0f2d19dd
JB
550#ifdef __STDC__
551SCM
552scm_sys_setegid (SCM id)
553#else
554SCM
555scm_sys_setegid (id)
556 SCM id;
557#endif
558{
02b754d3
GH
559 int rv;
560
0f2d19dd
JB
561 SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setegid);
562#ifdef HAVE_SETEUID
02b754d3 563 rv = setegid (SCM_INUM (id));
0f2d19dd 564#else
02b754d3 565 rv = setgid (SCM_INUM (id));
0f2d19dd 566#endif
02b754d3
GH
567 if (rv != 0)
568 SCM_SYSERROR (s_sys_setegid);
569 return SCM_UNSPECIFIED;
570
0f2d19dd
JB
571}
572
573SCM_PROC (s_getpgrp, "getpgrp", 0, 0, 0, scm_getpgrp);
574SCM
575scm_getpgrp ()
576{
577 int (*fn)();
578 fn = getpgrp;
579 return SCM_MAKINUM (fn (0));
580}
581
02b754d3 582SCM_PROC (s_setpgid, "setpgid", 2, 0, 0, scm_setpgid);
0f2d19dd
JB
583SCM
584scm_setpgid (pid, pgid)
585 SCM pid, pgid;
586{
587 SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_setpgid);
588 SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_setpgid);
02b754d3
GH
589 /* FIXME(?): may be known as setpgrp. */
590 if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
591 SCM_SYSERROR (s_setpgid);
592 return SCM_UNSPECIFIED;
0f2d19dd
JB
593}
594
02b754d3 595SCM_PROC (s_setsid, "setsid", 0, 0, 0, scm_setsid);
0f2d19dd
JB
596SCM
597scm_setsid ()
598{
599 pid_t sid = setsid ();
02b754d3
GH
600 if (sid == -1)
601 SCM_SYSERROR (s_setsid);
602 return SCM_UNSPECIFIED;
0f2d19dd
JB
603}
604
605#ifndef ttyname
606extern char * ttyname();
607#endif
608
02b754d3 609SCM_PROC (s_ttyname, "ttyname", 1, 0, 0, scm_ttyname);
0f2d19dd
JB
610#ifdef __STDC__
611SCM
612scm_ttyname (SCM port)
613#else
614SCM
615scm_ttyname (port)
616 SCM port;
617#endif
618{
619 char *ans;
620 int fd;
621 SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_ttyname);
622 if (scm_tc16_fport != SCM_TYP16 (port))
623 return SCM_BOOL_F;
624 fd = fileno ((FILE *)SCM_STREAM (port));
02b754d3
GH
625 if (fd == -1)
626 SCM_SYSERROR (s_ttyname);
627 SCM_SYSCALL (ans = ttyname (fd));
628 if (!ans)
629 SCM_SYSERROR (s_ttyname);
0f2d19dd 630 /* ans could be overwritten by another call to ttyname */
02b754d3 631 return (scm_makfrom0str (ans));
0f2d19dd
JB
632}
633
634
02b754d3 635SCM_PROC (s_ctermid, "ctermid", 0, 0, 0, scm_ctermid);
0f2d19dd
JB
636SCM
637scm_ctermid ()
638{
639 char *result = ctermid (NULL);
02b754d3
GH
640 if (*result == '\0')
641 SCM_SYSERROR (s_ctermid);
642 return scm_makfrom0str (result);
0f2d19dd
JB
643}
644
02b754d3 645SCM_PROC (s_tcgetpgrp, "tcgetpgrp", 1, 0, 0, scm_tcgetpgrp);
0f2d19dd
JB
646SCM
647scm_tcgetpgrp (port)
648 SCM port;
649{
650 int fd;
651 pid_t pgid;
652 SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcgetpgrp);
653 fd = fileno ((FILE *)SCM_STREAM (port));
654 if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1)
02b754d3
GH
655 SCM_SYSERROR (s_tcgetpgrp);
656 return SCM_MAKINUM (pgid);
0f2d19dd
JB
657}
658
02b754d3 659SCM_PROC (s_tcsetpgrp, "tcsetpgrp", 2, 0, 0, scm_tcsetpgrp);
0f2d19dd
JB
660SCM
661scm_tcsetpgrp (port, pgid)
662 SCM port, pgid;
663{
664 int fd;
665 SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcsetpgrp);
666 SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_tcsetpgrp);
667 fd = fileno ((FILE *)SCM_STREAM (port));
668 if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
02b754d3
GH
669 SCM_SYSERROR (s_tcsetpgrp);
670 return SCM_UNSPECIFIED;
0f2d19dd
JB
671}
672
673/* Copy exec args from an SCM vector into a new C array. */
674#ifdef __STDC__
675static char **
676scm_convert_exec_args (SCM args)
677#else
678static char **
679scm_convert_exec_args (args)
680 SCM args;
681#endif
682{
683 char **execargv;
684 int num_args;
685 int i;
686 SCM_DEFER_INTS;
687 num_args = scm_ilength (args);
688 execargv = (char **)
689 scm_must_malloc ((num_args + 1) * sizeof (char *), s_ttyname);
690 for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
691 {
692 scm_sizet len;
693 char *dst;
694 char *src;
695 SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)), SCM_CAR (args),
696 "wrong type in SCM_ARG", "exec arg");
697 len = 1 + SCM_ROLENGTH (SCM_CAR (args));
698 dst = (char *) scm_must_malloc ((long) len, s_ttyname);
699 src = SCM_ROCHARS (SCM_CAR (args));
700 while (len--)
701 dst[len] = src[len];
702 execargv[i] = dst;
703 }
704 execargv[i] = 0;
705 SCM_ALLOW_INTS;
706 return execargv;
707}
708
02b754d3 709SCM_PROC (s_sys_execl, "execl", 0, 0, 1, scm_sys_execl);
0f2d19dd
JB
710#ifdef __STDC__
711SCM
712scm_sys_execl (SCM args)
713#else
714SCM
715scm_sys_execl (args)
716 SCM args;
717#endif
718{
719 char **execargv;
720 SCM filename = SCM_CAR (args);
721 SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execl);
722 if (SCM_SUBSTRP (filename))
723 filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
724 args = SCM_CDR (args);
725 execargv = scm_convert_exec_args (args);
726 execv (SCM_ROCHARS (filename), execargv);
02b754d3
GH
727 SCM_SYSERROR (s_sys_execl);
728 /* not reached. */
729 return SCM_BOOL_F;
0f2d19dd
JB
730}
731
02b754d3 732SCM_PROC (s_sys_execlp, "execlp", 0, 0, 1, scm_sys_execlp);
0f2d19dd
JB
733#ifdef __STDC__
734SCM
735scm_sys_execlp (SCM args)
736#else
737SCM
738scm_sys_execlp (args)
739 SCM args;
740#endif
741{
742 char **execargv;
743 SCM filename = SCM_CAR (args);
744 SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execlp);
745 if (SCM_SUBSTRP (filename))
746 filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
747 args = SCM_CDR (args);
748 execargv = scm_convert_exec_args (args);
749 execvp (SCM_ROCHARS (filename), execargv);
02b754d3
GH
750 SCM_SYSERROR (s_sys_execlp);
751 /* not reached. */
752 return SCM_BOOL_F;
0f2d19dd
JB
753}
754
755/* Flushing streams etc., is not done here. */
02b754d3 756SCM_PROC (s_sys_fork, "fork", 0, 0, 0, scm_sys_fork);
0f2d19dd
JB
757#ifdef __STDC__
758SCM
759scm_sys_fork(void)
760#else
761SCM
762scm_sys_fork()
763#endif
764{
765 pid_t pid;
766 pid = fork ();
767 if (pid == -1)
02b754d3
GH
768 SCM_SYSERROR (s_sys_fork);
769 return SCM_MAKINUM (0L+pid);
0f2d19dd
JB
770}
771
772
02b754d3 773SCM_PROC (s_sys_uname, "uname", 0, 0, 0, scm_sys_uname);
0f2d19dd
JB
774#ifdef __STDC__
775SCM
776scm_sys_uname (void)
777#else
778SCM
779scm_sys_uname ()
780#endif
781{
782#ifdef HAVE_UNAME
783 struct utsname buf;
784 SCM ans = scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED, SCM_BOOL_F);
785 SCM *ve = SCM_VELTS (ans);
786 if (uname (&buf))
787 return SCM_MAKINUM (errno);
788 ve[0] = scm_makfrom0str (buf.sysname);
789 ve[1] = scm_makfrom0str (buf.nodename);
790 ve[2] = scm_makfrom0str (buf.release);
791 ve[3] = scm_makfrom0str (buf.version);
792 ve[4] = scm_makfrom0str (buf.machine);
793/*
02b754d3 794 a linux special?
0f2d19dd
JB
795 ve[5] = scm_makfrom0str (buf.domainname);
796*/
797 return ans;
798#else
02b754d3
GH
799 SCM_SYSMISSING (s_sys_uname);
800 /* not reached. */
801 return SCM_BOOL_F;
0f2d19dd
JB
802#endif
803}
804
805SCM_PROC (s_environ, "environ", 0, 1, 0, scm_environ);
806#ifdef __STDC__
807SCM
808scm_environ (SCM env)
809#else
810SCM
811scm_environ (env)
812 SCM env;
813#endif
814{
815 if (SCM_UNBNDP (env))
816 return scm_makfromstrs (-1, environ);
817 else
818 {
819 int num_strings;
820 char **new_environ;
821 int i = 0;
822 SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)),
823 env, SCM_ARG1, s_environ);
824 num_strings = scm_ilength (env);
825 new_environ = (char **) scm_must_malloc ((num_strings + 1)
826 * sizeof (char *),
827 s_environ);
828 while (SCM_NNULLP (env))
829 {
830 int len;
831 char *src;
832 SCM_ASSERT (SCM_NIMP (SCM_CAR (env)) && SCM_ROSTRINGP (SCM_CAR (env)), env, SCM_ARG1,
833 s_environ);
834 len = 1 + SCM_ROLENGTH (SCM_CAR (env));
835 new_environ[i] = scm_must_malloc ((long) len, s_environ);
836 src = SCM_ROCHARS (SCM_CAR (env));
837 while (len--)
838 new_environ[i][len] = src[len];
839 env = SCM_CDR (env);
840 i++;
841 }
842 new_environ[i] = 0;
843 /* Free the old environment, except when called for the first
844 * time.
845 */
846 {
847 char **ep;
848 static int first = 1;
849 if (!first)
850 {
851 for (ep = environ; *ep != NULL; ep++)
852 scm_must_free (*ep);
853 scm_must_free ((char *) environ);
854 }
855 first = 0;
856 }
857 environ = new_environ;
858 return SCM_UNSPECIFIED;
859 }
860}
861
862
863SCM_PROC (s_open_pipe, "open-pipe", 2, 0, 0, scm_open_pipe);
864#ifdef __STDC__
865SCM
866scm_open_pipe (SCM pipestr, SCM modes)
867#else
868SCM
869scm_open_pipe (pipestr, modes)
870 SCM pipestr;
871 SCM modes;
872#endif
873{
874 FILE *f;
875 register SCM z;
02b754d3
GH
876 struct scm_port_table * pt;
877
0f2d19dd
JB
878 SCM_ASSERT (SCM_NIMP (pipestr) && SCM_ROSTRINGP (pipestr), pipestr, SCM_ARG1, s_open_pipe);
879 if (SCM_SUBSTRP (pipestr))
880 pipestr = scm_makfromstr (SCM_ROCHARS (pipestr), SCM_ROLENGTH (pipestr), 0);
881 SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_pipe);
882 if (SCM_SUBSTRP (modes))
883 modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
884 SCM_NEWCELL (z);
885 SCM_DEFER_INTS;
886 scm_ignore_signals ();
887 SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes)));
888 scm_unignore_signals ();
889 if (!f)
02b754d3
GH
890 SCM_SYSERROR (s_open_pipe);
891 pt = scm_add_to_port_table (z);
892 SCM_SETPTAB_ENTRY (z, pt);
893 SCM_CAR (z) = scm_tc16_pipe | SCM_OPN
894 | (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG);
895 SCM_SETSTREAM (z, (SCM)f);
0f2d19dd
JB
896 SCM_ALLOW_INTS;
897 return z;
898}
899
900
901SCM_PROC (s_open_input_pipe, "open-input-pipe", 1, 0, 0, scm_open_input_pipe);
902#ifdef __STDC__
903SCM
904scm_open_input_pipe(SCM pipestr)
905#else
906SCM
907scm_open_input_pipe(pipestr)
908 SCM pipestr;
909#endif
910{
911 return scm_open_pipe(pipestr, scm_makfromstr("r", (sizeof "r")-1, 0));
912}
913
914SCM_PROC (s_open_output_pipe, "open-output-pipe", 1, 0, 0, scm_open_output_pipe);
915#ifdef __STDC__
916SCM
917scm_open_output_pipe(SCM pipestr)
918#else
919SCM
920scm_open_output_pipe(pipestr)
921 SCM pipestr;
922#endif
923{
924 return scm_open_pipe(pipestr, scm_makfromstr("w", (sizeof "w")-1, 0));
925}
926
927
928#ifdef __EMX__
929#include <sys/utime.h>
930#else
931#include <utime.h>
932#endif
933
02b754d3 934SCM_PROC (s_sys_utime, "utime", 1, 2, 0, scm_sys_utime);
0f2d19dd
JB
935#ifdef __STDC__
936SCM
937scm_sys_utime (SCM pathname, SCM actime, SCM modtime)
938#else
939SCM
940scm_sys_utime (pathname, actime, modtime)
941 SCM pathname;
942 SCM actime;
943 SCM modtime;
944#endif
945{
946 int rv;
947 struct utimbuf utm_tmp;
948
949 SCM_ASSERT (SCM_NIMP (pathname) && SCM_STRINGP (pathname), pathname, SCM_ARG1, s_sys_utime);
950
951 if (SCM_UNBNDP (actime))
952 SCM_SYSCALL (time (&utm_tmp.actime));
953 else
954 utm_tmp.actime = scm_num2ulong (actime, (char *) SCM_ARG2, s_sys_utime);
955
956 if (SCM_UNBNDP (modtime))
957 SCM_SYSCALL (time (&utm_tmp.modtime));
958 else
959 utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_sys_utime);
960
961 SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp));
02b754d3
GH
962 if (rv != 0)
963 SCM_SYSERROR (s_sys_utime);
964 return SCM_UNSPECIFIED;
0f2d19dd
JB
965}
966
0f2d19dd
JB
967SCM_PROC (s_sys_access, "access?", 2, 0, 0, scm_sys_access);
968#ifdef __STDC__
969SCM
970scm_sys_access (SCM path, SCM how)
971#else
972SCM
973scm_sys_access (path, how)
974 SCM path;
975 SCM how;
976#endif
977{
978 int rv;
979
980 SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_access);
981 if (SCM_SUBSTRP (path))
982 path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
983 SCM_ASSERT (SCM_INUMP (how), how, SCM_ARG2, s_sys_access);
984 rv = access (SCM_ROCHARS (path), SCM_INUM (how));
985 return rv ? SCM_BOOL_F : SCM_BOOL_T;
986}
987
0f2d19dd
JB
988SCM_PROC (s_getpid, "getpid", 0, 0, 0, scm_getpid);
989#ifdef __STDC__
990SCM
991scm_getpid (void)
992#else
993SCM
994scm_getpid ()
995#endif
996{
997 return SCM_MAKINUM ((unsigned long) getpid ());
998}
999
02b754d3 1000SCM_PROC (s_sys_putenv, "putenv", 1, 0, 0, scm_sys_putenv);
0f2d19dd
JB
1001#ifdef __STDC__
1002SCM
1003scm_sys_putenv (SCM str)
1004#else
1005SCM
1006scm_sys_putenv (str)
1007 SCM str;
1008#endif
1009{
1010#ifdef HAVE_PUTENV
1011 SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_putenv);
1012 return putenv (SCM_CHARS (str)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
1013#else
02b754d3
GH
1014 SCM_SYSMISSING (s_sys_putenv);
1015 /* not reached. */
1016 return SCM_BOOL_F;
0f2d19dd
JB
1017#endif
1018}
1019
0f2d19dd
JB
1020SCM_PROC (s_read_line, "read-line", 0, 2, 0, scm_read_line);
1021#ifdef __STDC__
1022SCM
1023scm_read_line (SCM port, SCM include_terminator)
1024#else
1025SCM
1026scm_read_line (port, include_terminator)
1027 SCM port;
1028 SCM include_terminator;
1029#endif
1030{
1031 register int c;
1032 register int j = 0;
1033 scm_sizet len = 30;
1034 SCM tok_buf;
1035 register char *p;
1036 int include;
1037
1038 tok_buf = scm_makstr ((long) len, 0);
1039 p = SCM_CHARS (tok_buf);
1040 if (SCM_UNBNDP (port))
1041 port = scm_cur_inp;
1042 else
1043 SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_line);
1044
1045 if (SCM_UNBNDP (include_terminator))
1046 include = 0;
1047 else
1048 include = SCM_NFALSEP (include_terminator);
1049
1050 if (EOF == (c = scm_gen_getc (port)))
1051 return SCM_EOF_VAL;
1052 while (1)
1053 {
1054 switch (c)
1055 {
1056 case SCM_LINE_INCREMENTORS:
1057 if (j >= len)
1058 {
1059 p = scm_grow_tok_buf (&tok_buf);
1060 len = SCM_LENGTH (tok_buf);
1061 }
1062 p[j++] = c;
1063 /* fallthrough */
1064 case EOF:
1065 if (len == j)
1066 return tok_buf;
1067 return scm_vector_set_length_x (tok_buf, (SCM) SCM_MAKINUM (j));
1068
1069 default:
1070 if (j >= len)
1071 {
1072 p = scm_grow_tok_buf (&tok_buf);
1073 len = SCM_LENGTH (tok_buf);
1074 }
1075 p[j++] = c;
1076 c = scm_gen_getc (port);
1077 break;
1078 }
1079 }
1080}
1081
0f2d19dd
JB
1082SCM_PROC (s_read_line_x, "read-line!", 1, 1, 0, scm_read_line_x);
1083#ifdef __STDC__
1084SCM
1085scm_read_line_x (SCM str, SCM port)
1086#else
1087SCM
1088scm_read_line_x (str, port)
1089 SCM str;
1090 SCM port;
1091#endif
1092{
1093 register int c;
1094 register int j = 0;
1095 register char *p;
1096 scm_sizet len;
1097 SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_read_line_x);
1098 p = SCM_CHARS (str);
1099 len = SCM_LENGTH (str);
1100 if SCM_UNBNDP
1101 (port) port = scm_cur_inp;
1102 else
1103 SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG2, s_read_line_x);
1104 c = scm_gen_getc (port);
1105 if (EOF == c)
1106 return SCM_EOF_VAL;
1107 while (1)
1108 {
1109 switch (c)
1110 {
1111 case SCM_LINE_INCREMENTORS:
1112 case EOF:
1113 return SCM_MAKINUM (j);
1114 default:
1115 if (j >= len)
1116 {
1117 scm_gen_ungetc (c, port);
1118 return SCM_BOOL_F;
1119 }
1120 p[j++] = c;
1121 c = scm_gen_getc (port);
1122 }
1123 }
1124}
1125
0f2d19dd
JB
1126SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line);
1127#ifdef __STDC__
1128SCM
1129scm_write_line (SCM obj, SCM port)
1130#else
1131SCM
1132scm_write_line (obj, port)
1133 SCM obj;
1134 SCM port;
1135#endif
1136{
1137 scm_display (obj, port);
1138 return scm_newline (port);
1139}
1140
02b754d3 1141SCM_PROC (s_setlocale, "setlocale", 1, 1, 0, scm_setlocale);
0f2d19dd
JB
1142#ifdef __STDC__
1143SCM
1144scm_setlocale (SCM category, SCM locale)
1145#else
1146SCM
1147scm_setlocale (category, locale)
1148 SCM category;
1149 SCM locale;
1150#endif
1151{
1152#ifdef HAVE_SETLOCALE
1153 char *clocale;
1154 char *rv;
1155
1156 SCM_ASSERT (SCM_INUMP (category), category, SCM_ARG1, s_setlocale);
1157 if (SCM_UNBNDP (locale))
1158 {
1159 clocale = NULL;
1160 }
1161 else
1162 {
1163 SCM_ASSERT (SCM_NIMP (locale) && SCM_STRINGP (locale), locale, SCM_ARG2, s_setlocale);
1164 clocale = SCM_CHARS (locale);
1165 }
1166
1167 rv = setlocale (SCM_INUM (category), clocale);
02b754d3
GH
1168 if (rv == NULL)
1169 SCM_SYSERROR (s_setlocale);
1170 return scm_makfrom0str (rv);
0f2d19dd 1171#else
02b754d3
GH
1172 SCM_SYSMISSING (s_setlocale);
1173 /* not reached. */
1174 return SCM_BOOL_F;
0f2d19dd
JB
1175#endif
1176}
1177
1178SCM_PROC (s_strftime, "strftime", 2, 0, 0, scm_strftime);
1179#ifdef __STDC__
1180SCM
1181scm_strftime (SCM format, SCM stime)
1182#else
1183SCM
1184scm_strftime (format, stime)
1185 SCM format;
1186 SCM stime;
1187#endif
1188{
1189 struct tm t;
1190
1191 char *tbuf;
1192 int n;
1193 int size = 50;
1194 char *fmt;
1195 int len;
1196
1197 SCM_ASSERT (SCM_NIMP (format) && SCM_STRINGP (format), format, SCM_ARG1, s_strftime);
1198 SCM_ASSERT (SCM_NIMP (stime) && SCM_VECTORP (stime) && scm_obj_length (stime) == 9,
1199 stime, SCM_ARG2, s_strftime);
1200
1201 fmt = SCM_ROCHARS (format);
1202 len = SCM_ROLENGTH (format);
1203
1204#define tm_deref scm_num2long (SCM_VELTS (stime)[n++], (char *)SCM_ARG2, s_strftime)
1205 n = 0;
1206 t.tm_sec = tm_deref;
1207 t.tm_min = tm_deref;
1208 t.tm_hour = tm_deref;
1209 t.tm_mday = tm_deref;
1210 t.tm_mon = tm_deref;
1211 t.tm_year = tm_deref;
1212 /* not used by mktime.
1213 t.tm_wday = tm_deref;
1214 t.tm_yday = tm_deref; */
1215 t.tm_isdst = tm_deref;
1216#undef tm_deref
1217
1218 /* fill in missing fields and set the timezone. */
1219 mktime (&t);
1220
1221 tbuf = scm_must_malloc (size, s_strftime);
1222 while ((len = strftime (tbuf, size, fmt, &t)) == size)
1223 {
1224 scm_must_free (tbuf);
1225 size *= 2;
1226 tbuf = scm_must_malloc (size, s_strftime);
1227 }
1228 return scm_makfromstr (tbuf, len, 0);
1229}
1230
02b754d3 1231SCM_PROC (s_sys_strptime, "strptime", 2, 0, 0, scm_sys_strptime);
0f2d19dd
JB
1232#ifdef __STDC__
1233SCM
1234scm_sys_strptime (SCM format, SCM string)
1235#else
1236SCM
1237scm_sys_strptime (format, string)
1238 SCM format;
1239 SCM string;
1240#endif
1241{
1242#ifdef HAVE_STRPTIME
1243 SCM stime;
1244 struct tm t;
1245
1246 char *fmt, *str, *rest;
0f2d19dd
JB
1247 int n;
1248
1249 SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1, s_sys_strptime);
1250 if (SCM_SUBSTRP (format))
1251 format = scm_makfromstr (SCM_ROCHARS (format), SCM_ROLENGTH (format), 0);
1252 SCM_ASSERT (SCM_NIMP (string) && SCM_ROSTRINGP (string), string, SCM_ARG2, s_sys_strptime);
1253 if (SCM_SUBSTRP (string))
1254 string = scm_makfromstr (SCM_ROCHARS (string), SCM_ROLENGTH (string), 0);
1255
1256 fmt = SCM_CHARS (format);
1257 str = SCM_CHARS (string);
1258
1259 /* initialize the struct tm */
1260#define tm_init(field) t.field = 0
1261 tm_init (tm_sec);
1262 tm_init (tm_min);
1263 tm_init (tm_hour);
1264 tm_init (tm_mday);
1265 tm_init (tm_mon);
1266 tm_init (tm_year);
1267 tm_init (tm_wday);
1268 tm_init (tm_yday);
1269 tm_init (tm_isdst);
1270#undef tm_init
1271
1272 SCM_DEFER_INTS;
1273 rest = strptime (str, fmt, &t);
1274 SCM_ALLOW_INTS;
1275
02b754d3
GH
1276 if (rest == NULL)
1277 SCM_SYSERROR (s_sys_strptime);
0f2d19dd
JB
1278
1279 stime = scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED);
1280
1281#define stime_set(val) scm_vector_set_x (stime, SCM_MAKINUM (n++), scm_long2num (t.val));
1282 n = 0;
1283 stime_set (tm_sec);
1284 stime_set (tm_min);
1285 stime_set (tm_hour);
1286 stime_set (tm_mday);
1287 stime_set (tm_mon);
1288 stime_set (tm_year);
1289 stime_set (tm_wday);
1290 stime_set (tm_yday);
1291 stime_set (tm_isdst);
1292#undef stime_set
1293
1294 return scm_cons (stime, scm_makfrom0str (rest));
1295#else
02b754d3
GH
1296 SCM_SYSMISSING (s_sys_strptime);
1297 /* not reached. */
0f2d19dd
JB
1298 return SCM_BOOL_F;
1299#endif
1300}
1301
02b754d3 1302SCM_PROC (s_sys_mknod, "mknod", 3, 0, 0, scm_sys_mknod);
0f2d19dd
JB
1303#ifdef __STDC__
1304SCM
1305scm_sys_mknod(SCM path, SCM mode, SCM dev)
1306#else
1307SCM
1308scm_sys_mknod(path, mode, dev)
1309 SCM path;
1310 SCM mode;
1311 SCM dev;
1312#endif
1313{
1314#ifdef HAVE_MKNOD
1315 int val;
1316 SCM_ASSERT(SCM_NIMP(path) && SCM_STRINGP(path), path, SCM_ARG1, s_sys_mknod);
1317 SCM_ASSERT(SCM_INUMP(mode), mode, SCM_ARG2, s_sys_mknod);
1318 SCM_ASSERT(SCM_INUMP(dev), dev, SCM_ARG3, s_sys_mknod);
1319 SCM_SYSCALL(val = mknod(SCM_CHARS(path), SCM_INUM(mode), SCM_INUM(dev)));
02b754d3
GH
1320 if (val != 0)
1321 SCM_SYSERROR (s_sys_mknod);
1322 return SCM_UNSPECIFIED;
0f2d19dd 1323#else
02b754d3
GH
1324 SCM_SYSMISSING (s_sys_mknod);
1325 /* not reached. */
0f2d19dd
JB
1326 return SCM_BOOL_F;
1327#endif
1328}
1329
1330
02b754d3 1331SCM_PROC (s_sys_nice, "nice", 1, 0, 0, scm_sys_nice);
0f2d19dd
JB
1332#ifdef __STDC__
1333SCM
1334scm_sys_nice(SCM incr)
1335#else
1336SCM
1337scm_sys_nice(incr)
1338 SCM incr;
1339#endif
1340{
1341#ifdef HAVE_NICE
1342 SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice);
02b754d3
GH
1343 if (nice(SCM_INUM(incr)) != 0)
1344 SCM_SYSERROR (s_sys_nice);
1345 return SCM_UNSPECIFIED;
0f2d19dd 1346#else
02b754d3
GH
1347 SCM_SYSMISSING (s_sys_nice);
1348 /* not reached. */
1349 return SCM_BOOL_F;
0f2d19dd
JB
1350#endif
1351}
1352
1353
1354SCM_PROC (s_sync, "sync", 0, 0, 0, scm_sync);
1355#ifdef __STDC__
1356SCM
1357scm_sync(void)
1358#else
1359SCM
1360scm_sync()
1361#endif
1362{
1363#ifdef HAVE_SYNC
1364 sync();
1365#endif
02b754d3
GH
1366 SCM_SYSMISSING (s_sync);
1367 /* not reached. */
1368 return SCM_BOOL_F;
0f2d19dd
JB
1369}
1370
1371
1372
1373#ifdef __STDC__
1374void
1375scm_init_posix (void)
1376#else
1377void
1378scm_init_posix ()
1379#endif
1380{
1381 scm_add_feature ("posix");
1382#ifdef HAVE_GETEUID
1383 scm_add_feature ("EIDs");
1384#endif
1385#ifdef WAIT_ANY
1386 scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
1387#endif
1388#ifdef WAIT_MYPGRP
1389 scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
1390#endif
1391#ifdef WNOHANG
1392 scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
1393#endif
1394#ifdef WUNTRACED
1395 scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
1396#endif
1397
1398#ifdef EINTR
1399 scm_sysintern ("EINTR", SCM_MAKINUM (EINTR));
1400#endif
1401
1402#ifdef SIGHUP
1403 scm_sysintern ("SIGHUP", SCM_MAKINUM (SIGHUP));
1404#endif
1405#ifdef SIGINT
1406 scm_sysintern ("SIGINT", SCM_MAKINUM (SIGINT));
1407#endif
1408#ifdef SIGQUIT
1409 scm_sysintern ("SIGQUIT", SCM_MAKINUM (SIGQUIT));
1410#endif
1411#ifdef SIGILL
1412 scm_sysintern ("SIGILL", SCM_MAKINUM (SIGILL));
1413#endif
1414#ifdef SIGTRAP
1415 scm_sysintern ("SIGTRAP", SCM_MAKINUM (SIGTRAP));
1416#endif
1417#ifdef SIGABRT
1418 scm_sysintern ("SIGABRT", SCM_MAKINUM (SIGABRT));
1419#endif
1420#ifdef SIGIOT
1421 scm_sysintern ("SIGIOT", SCM_MAKINUM (SIGIOT));
1422#endif
1423#ifdef SIGBUS
1424 scm_sysintern ("SIGBUS", SCM_MAKINUM (SIGBUS));
1425#endif
1426#ifdef SIGFPE
1427 scm_sysintern ("SIGFPE", SCM_MAKINUM (SIGFPE));
1428#endif
1429#ifdef SIGKILL
1430 scm_sysintern ("SIGKILL", SCM_MAKINUM (SIGKILL));
1431#endif
1432#ifdef SIGUSR1
1433 scm_sysintern ("SIGUSR1", SCM_MAKINUM (SIGUSR1));
1434#endif
1435#ifdef SIGSEGV
1436 scm_sysintern ("SIGSEGV", SCM_MAKINUM (SIGSEGV));
1437#endif
1438#ifdef SIGUSR2
1439 scm_sysintern ("SIGUSR2", SCM_MAKINUM (SIGUSR2));
1440#endif
1441#ifdef SIGPIPE
1442 scm_sysintern ("SIGPIPE", SCM_MAKINUM (SIGPIPE));
1443#endif
1444#ifdef SIGALRM
1445 scm_sysintern ("SIGALRM", SCM_MAKINUM (SIGALRM));
1446#endif
1447#ifdef SIGTERM
1448 scm_sysintern ("SIGTERM", SCM_MAKINUM (SIGTERM));
1449#endif
1450#ifdef SIGSTKFLT
1451 scm_sysintern ("SIGSTKFLT", SCM_MAKINUM (SIGSTKFLT));
1452#endif
1453#ifdef SIGCHLD
1454 scm_sysintern ("SIGCHLD", SCM_MAKINUM (SIGCHLD));
1455#endif
1456#ifdef SIGCONT
1457 scm_sysintern ("SIGCONT", SCM_MAKINUM (SIGCONT));
1458#endif
1459#ifdef SIGSTOP
1460 scm_sysintern ("SIGSTOP", SCM_MAKINUM (SIGSTOP));
1461#endif
1462#ifdef SIGTSTP
1463 scm_sysintern ("SIGTSTP", SCM_MAKINUM (SIGTSTP));
1464#endif
1465#ifdef SIGTTIN
1466 scm_sysintern ("SIGTTIN", SCM_MAKINUM (SIGTTIN));
1467#endif
1468#ifdef SIGTTOU
1469 scm_sysintern ("SIGTTOU", SCM_MAKINUM (SIGTTOU));
1470#endif
1471#ifdef SIGIO
1472 scm_sysintern ("SIGIO", SCM_MAKINUM (SIGIO));
1473#endif
1474#ifdef SIGPOLL
1475 scm_sysintern ("SIGPOLL", SCM_MAKINUM (SIGPOLL));
1476#endif
1477#ifdef SIGURG
1478 scm_sysintern ("SIGURG", SCM_MAKINUM (SIGURG));
1479#endif
1480#ifdef SIGXCPU
1481 scm_sysintern ("SIGXCPU", SCM_MAKINUM (SIGXCPU));
1482#endif
1483#ifdef SIGXFSZ
1484 scm_sysintern ("SIGXFSZ", SCM_MAKINUM (SIGXFSZ));
1485#endif
1486#ifdef SIGVTALRM
1487 scm_sysintern ("SIGVTALRM", SCM_MAKINUM (SIGVTALRM));
1488#endif
1489#ifdef SIGPROF
1490 scm_sysintern ("SIGPROF", SCM_MAKINUM (SIGPROF));
1491#endif
1492#ifdef SIGWINCH
1493 scm_sysintern ("SIGWINCH", SCM_MAKINUM (SIGWINCH));
1494#endif
1495#ifdef SIGLOST
1496 scm_sysintern ("SIGLOST", SCM_MAKINUM (SIGLOST));
1497#endif
1498#ifdef SIGPWR
1499 scm_sysintern ("SIGPWR", SCM_MAKINUM (SIGPWR));
1500#endif
1501 /* access() symbols. */
1502 scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
1503 scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
1504 scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
1505 scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
1506
1507#ifdef LC_COLLATE
1508 scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
1509#endif
1510#ifdef LC_CTYPE
1511 scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
1512#endif
1513#ifdef LC_MONETARY
1514 scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
1515#endif
1516#ifdef LC_NUMERIC
1517 scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
1518#endif
1519#ifdef LC_TIME
1520 scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
1521#endif
1522#ifdef LC_MESSAGES
1523 scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
1524#endif
1525#ifdef LC_ALL
1526 scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
1527#endif
1528#include "posix.x"
1529}