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