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