-/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- */
+ * If you do not wish that, delete this exception notice. */
\f
#include <stdio.h>
#include "_scm.h"
+#include "fports.h"
+#include "scmsigs.h"
+#include "feature.h"
+#include "posix.h"
\f
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
+#else
+#ifndef ttyname
+extern char *ttyname();
+#endif
#endif
-#ifdef HAVE_SYS_SELECT_H
-#include <sys/select.h>
+#ifdef LIBC_H_WITH_UNISTD_H
+#include <libc.h>
#endif
+#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <signal.h>
-#ifdef FD_SET
-
-#define SELECT_TYPE fd_set
-#define SELECT_SET_SIZE FD_SETSIZE
-
-#else /* no FD_SET */
-
-/* Define the macros to access a single-int bitmap of descriptors. */
-#define SELECT_SET_SIZE 32
-#define SELECT_TYPE int
-#define FD_SET(n, p) (*(p) |= (1 << (n)))
-#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
-#define FD_ISSET(n, p) (*(p) & (1 << (n)))
-#define FD_ZERO(p) (*(p) = 0)
-
-#endif /* no FD_SET */
-
-extern char *ttyname ();
extern FILE *popen ();
extern char ** environ;
# endif
#endif
-char *strptime ();
-
#ifdef HAVE_SETLOCALE
#include <locale.h>
#endif
+/* Some Unix systems don't define these. CPP hair is dangerous, but
+ this seems safe enough... */
+#ifndef R_OK
+#define R_OK 4
+#endif
+
+#ifndef W_OK
+#define W_OK 2
+#endif
+
+#ifndef X_OK
+#define X_OK 1
+#endif
+
+#ifndef F_OK
+#define F_OK 0
+#endif
+
+/* On NextStep, <utime.h> doesn't define struct utime, unless we
+ #define _POSIX_SOURCE before #including it. I think this is less
+ of a kludge than defining struct utimbuf ourselves. */
+#ifdef UTIMBUF_NEEDS_POSIX
+#define _POSIX_SOURCE
+#endif
+
+#ifdef HAVE_SYS_UTIME_H
+#include <sys/utime.h>
+#endif
+
+#ifdef HAVE_UTIME_H
+#include <utime.h>
+#endif
+
+/* Please don't add any more #includes or #defines here. The hack
+ above means that _POSIX_SOURCE may be #defined, which will
+ encourage header files to do strange things. */
\f
+SCM_SYMBOL (sym_read_pipe, "read pipe");
+SCM_SYMBOL (sym_write_pipe, "write pipe");
+SCM_PROC (s_pipe, "pipe", 0, 0, 0, scm_pipe);
-SCM_PROC (s_sys_pipe, "%pipe", 0, 0, 0, scm_sys_pipe);
-#ifdef __STDC__
-SCM
-scm_sys_pipe (void)
-#else
SCM
-scm_sys_pipe ()
-#endif
+scm_pipe ()
{
int fd[2], rv;
FILE *f_rd, *f_wt;
SCM p_rd, p_wt;
- SCM_NEWCELL (p_rd);
- SCM_NEWCELL (p_wt);
+
rv = pipe (fd);
if (rv)
- {
- SCM_ALLOW_INTS;
- return SCM_BOOL_F;
- }
+ scm_syserror (s_pipe);
f_rd = fdopen (fd[0], "r");
if (!f_rd)
{
SCM_SYSCALL (close (fd[0]));
SCM_SYSCALL (close (fd[1]));
- SCM_ALLOW_INTS;
- return SCM_BOOL_F;
+ scm_syserror (s_pipe);
}
f_wt = fdopen (fd[1], "w");
if (!f_wt)
en = errno;
fclose (f_rd);
SCM_SYSCALL (close (fd[1]));
- SCM_ALLOW_INTS;
- return SCM_MAKINUM (en);
- }
- {
- struct scm_port_table * ptr;
- struct scm_port_table * ptw;
-
- ptr = scm_add_to_port_table (p_rd);
- ptw = scm_add_to_port_table (p_wt);
- SCM_SETPTAB_ENTRY (p_rd, ptr);
- SCM_SETPTAB_ENTRY (p_wt, ptw);
- SCM_CAR (p_rd) = scm_tc16_fport | scm_mode_bits ("r");
- SCM_CAR (p_wt) = scm_tc16_fport | scm_mode_bits ("w");
- SCM_SETSTREAM (p_rd, (SCM)f_rd);
- SCM_SETSTREAM (p_wt, (SCM)f_wt);
+ errno = en;
+ scm_syserror (s_pipe);
}
+
+ p_rd = scm_stdio_to_port (f_rd, "r", sym_read_pipe);
+ p_wt = scm_stdio_to_port (f_wt, "w", sym_write_pipe);
+
SCM_ALLOW_INTS;
return scm_cons (p_rd, p_wt);
}
+#ifdef HAVE_GETGROUPS
+SCM_PROC (s_getgroups, "getgroups", 0, 0, 0, scm_getgroups);
-SCM_PROC (s_sys_getgroups, "%getgroups", 0, 0, 0, scm_sys_getgroups);
-#ifdef __STDC__
-SCM
-scm_sys_getgroups(void)
-#else
SCM
-scm_sys_getgroups()
-#endif
+scm_getgroups()
{
SCM grps, ans;
int ngroups = getgroups (0, NULL);
- if (!ngroups) return SCM_BOOL_F;
+ if (!ngroups)
+ scm_syserror (s_getgroups);
SCM_NEWCELL(grps);
SCM_DEFER_INTS;
{
GETGROUPS_T *groups;
int val;
- groups = (gid_t *)scm_must_malloc(ngroups * sizeof(GETGROUPS_T),
- s_sys_getgroups);
+ groups = (GETGROUPS_T *) scm_must_malloc(ngroups * sizeof(GETGROUPS_T),
+ s_getgroups);
val = getgroups(ngroups, groups);
if (val < 0)
{
scm_must_free((char *)groups);
- SCM_ALLOW_INTS;
- return SCM_MAKINUM (errno);
+ scm_syserror (s_getgroups);
}
SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */
SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string);
SCM_ALLOW_INTS;
- ans = scm_make_vector(SCM_MAKINUM(ngroups), SCM_UNDEFINED, SCM_BOOL_F);
+ ans = scm_make_vector (SCM_MAKINUM(ngroups), SCM_UNDEFINED);
while (--ngroups >= 0) SCM_VELTS(ans)[ngroups] = SCM_MAKINUM(groups[ngroups]);
SCM_SETCHARS(grps, groups); /* to make sure grps stays around. */
return ans;
}
}
+#endif
+SCM_PROC (s_getpwuid, "getpw", 0, 1, 0, scm_getpwuid);
-SCM_PROC (s_sys_getpwuid, "%getpw", 0, 1, 0, scm_sys_getpwuid);
-#ifdef __STDC__
-SCM
-scm_sys_getpwuid (SCM user)
-#else
SCM
-scm_sys_getpwuid (user)
+scm_getpwuid (user)
SCM user;
-#endif
{
SCM result;
struct passwd *entry;
SCM *ve;
- result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED, SCM_BOOL_F);
+ result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
if (SCM_UNBNDP (user) || SCM_FALSEP (user))
{
SCM_DEFER_INTS;
SCM_SYSCALL (entry = getpwent ());
+ if (! entry)
+ {
+ SCM_ALLOW_INTS;
+ return SCM_BOOL_F;
+ }
}
else if (SCM_INUMP (user))
{
}
else
{
- SCM_ASSERT (SCM_NIMP (user) && SCM_ROSTRINGP (user), user, SCM_ARG1, s_sys_getpwuid);
+ SCM_ASSERT (SCM_NIMP (user) && SCM_ROSTRINGP (user), user, SCM_ARG1, s_getpwuid);
if (SCM_SUBSTRP (user))
user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user), 0);
SCM_DEFER_INTS;
entry = getpwnam (SCM_ROCHARS (user));
}
if (!entry)
- {
- SCM_ALLOW_INTS;
- return SCM_BOOL_F;
- }
+ scm_misc_error (s_getpwuid, "entry not found", SCM_EOL);
+
ve[0] = scm_makfrom0str (entry->pw_name);
ve[1] = scm_makfrom0str (entry->pw_passwd);
ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
}
-
+#ifdef HAVE_SETPWENT
SCM_PROC (s_setpwent, "setpw", 0, 1, 0, scm_setpwent);
-#ifdef __STDC__
-SCM
-scm_setpwent (SCM arg)
-#else
+
SCM
scm_setpwent (arg)
SCM arg;
-#endif
{
if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
endpwent ();
setpwent ();
return SCM_UNSPECIFIED;
}
+#endif
/* Combines getgrgid and getgrnam. */
-SCM_PROC (s_sys_getgrgid, "%getgr", 0, 1, 0, scm_sys_getgrgid);
-#ifdef __STDC__
-SCM
-scm_sys_getgrgid (SCM name)
-#else
+SCM_PROC (s_getgrgid, "getgr", 0, 1, 0, scm_getgrgid);
+
SCM
-scm_sys_getgrgid (name)
+scm_getgrgid (name)
SCM name;
-#endif
{
SCM result;
struct group *entry;
SCM *ve;
- result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
+ result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
SCM_DEFER_INTS;
if (SCM_UNBNDP (name) || (name == SCM_BOOL_F))
- SCM_SYSCALL (entry = getgrent ());
+ {
+ SCM_SYSCALL (entry = getgrent ());
+ if (! entry)
+ {
+ SCM_ALLOW_INTS;
+ return SCM_BOOL_F;
+ }
+ }
else if (SCM_INUMP (name))
SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
else
{
- SCM_ASSERT (SCM_NIMP (name) && SCM_STRINGP (name), name, SCM_ARG1, s_sys_getgrgid);
- if (SCM_SUBSTRP (name))
- name = scm_makfromstr (SCM_ROCHARS (name), SCM_ROLENGTH (name), 0);
- SCM_SYSCALL (entry = getgrnam (SCM_CHARS (name)));
+ SCM_ASSERT (SCM_NIMP (name) && SCM_ROSTRINGP (name), name, SCM_ARG1,
+ s_getgrgid);
+ SCM_COERCE_SUBSTR (name);
+ SCM_SYSCALL (entry = getgrnam (SCM_ROCHARS (name)));
}
if (!entry)
- {
- SCM_ALLOW_INTS;
- return SCM_MAKINUM (errno);
- }
+ scm_syserror (s_getgrgid);
+
ve[0] = scm_makfrom0str (entry->gr_name);
ve[1] = scm_makfrom0str (entry->gr_passwd);
ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
SCM_PROC (s_setgrent, "setgr", 0, 1, 0, scm_setgrent);
-#ifdef __STDC__
-SCM
-scm_setgrent (SCM arg)
-#else
+
SCM
scm_setgrent (arg)
SCM arg;
-#endif
{
if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
endgrent ();
-SCM_PROC (s_sys_kill, "%kill", 2, 0, 0, scm_sys_kill);
-#ifdef __STDC__
-SCM
-scm_sys_kill (SCM pid, SCM sig)
-#else
+SCM_PROC (s_kill, "kill", 2, 0, 0, scm_kill);
+
SCM
-scm_sys_kill (pid, sig)
+scm_kill (pid, sig)
SCM pid;
SCM sig;
-#endif
{
- int i;
- SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_kill);
- SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_sys_kill);
+ SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_kill);
+ SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_kill);
/* Signal values are interned in scm_init_posix(). */
- SCM_SYSCALL (i = kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)));
- return i ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
+ scm_syserror (s_kill);
+ return SCM_UNSPECIFIED;
}
-SCM_PROC (s_sys_waitpid, "%waitpid", 1, 1, 0, scm_sys_waitpid);
-#ifdef __STDC__
-SCM
-scm_sys_waitpid (SCM pid, SCM options)
-#else
+SCM_PROC (s_waitpid, "waitpid", 1, 1, 0, scm_waitpid);
+
SCM
-scm_sys_waitpid (pid, options)
+scm_waitpid (pid, options)
SCM pid;
SCM options;
-#endif
{
+#ifdef HAVE_WAITPID
int i;
int status;
int ioptions;
- SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_waitpid);
+ SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_waitpid);
if (SCM_UNBNDP (options))
ioptions = 0;
else
{
- SCM_ASSERT (SCM_INUMP (options), options, SCM_ARG2, s_sys_waitpid);
+ SCM_ASSERT (SCM_INUMP (options), options, SCM_ARG2, s_waitpid);
/* Flags are interned in scm_init_posix. */
ioptions = SCM_INUM (options);
}
SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
- return ((i == -1)
- ? SCM_MAKINUM (errno)
- : scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status)));
+ if (i == -1)
+ scm_syserror (s_waitpid);
+ return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
+#else
+ scm_sysmissing (s_waitpid);
+ /* not reached. */
+ return SCM_BOOL_F;
+#endif
}
+SCM_PROC (s_status_exit_val, "status:exit-val", 1, 0, 0, scm_status_exit_val);
+SCM
+scm_status_exit_val (status)
+ SCM status;
+{
+ int lstatus;
+
+ SCM_ASSERT (SCM_INUMP (status), status, SCM_ARG1,s_status_exit_val);
+ /* On Ultrix, the WIF... macros assume their argument is an lvalue;
+ go figure. SCM_INUM does not yield an lvalue. */
+ lstatus = SCM_INUM (status);
+ if (WIFEXITED (lstatus))
+ return (SCM_MAKINUM (WEXITSTATUS (lstatus)));
+ else
+ return SCM_BOOL_F;
+}
+
+SCM_PROC (s_status_term_sig, "status:term-sig", 1, 0, 0, scm_status_term_sig);
+SCM
+scm_status_term_sig (status)
+ SCM status;
+{
+ int lstatus;
+
+ SCM_ASSERT (SCM_INUMP (status), status, SCM_ARG1,s_status_term_sig);
+
+ lstatus = SCM_INUM (status);
+ if (WIFSIGNALED (lstatus))
+ return SCM_MAKINUM (WTERMSIG (lstatus));
+ else
+ return SCM_BOOL_F;
+}
+
+SCM_PROC (s_status_stop_sig, "status:stop-sig", 1, 0, 0, scm_status_stop_sig);
+SCM
+scm_status_stop_sig (status)
+ SCM status;
+{
+ int lstatus;
+
+ SCM_ASSERT (SCM_INUMP (status), status, SCM_ARG1,s_status_stop_sig);
+
+ lstatus = SCM_INUM (status);
+ if (WIFSTOPPED (lstatus))
+ return SCM_MAKINUM (WSTOPSIG (lstatus));
+ else
+ return SCM_BOOL_F;
+}
SCM_PROC (s_getppid, "getppid", 0, 0, 0, scm_getppid);
-#ifdef __STDC__
-SCM
-scm_getppid (void)
-#else
+
SCM
scm_getppid ()
-#endif
{
return SCM_MAKINUM (0L + getppid ());
}
SCM_PROC (s_getuid, "getuid", 0, 0, 0, scm_getuid);
-#ifdef __STDC__
-SCM
-scm_getuid (void)
-#else
+
SCM
scm_getuid ()
-#endif
{
return SCM_MAKINUM (0L + getuid ());
}
SCM_PROC (s_getgid, "getgid", 0, 0, 0, scm_getgid);
-#ifdef __STDC__
-SCM
-scm_getgid (void)
-#else
+
SCM
scm_getgid ()
-#endif
{
return SCM_MAKINUM (0L + getgid ());
}
SCM_PROC (s_geteuid, "geteuid", 0, 0, 0, scm_geteuid);
-#ifdef __STDC__
-SCM
-scm_geteuid (void)
-#else
+
SCM
scm_geteuid ()
-#endif
{
#ifdef HAVE_GETEUID
return SCM_MAKINUM (0L + geteuid ());
SCM_PROC (s_getegid, "getegid", 0, 0, 0, scm_getegid);
-#ifdef __STDC__
-SCM
-scm_getegid (void)
-#else
+
SCM
scm_getegid ()
-#endif
{
#ifdef HAVE_GETEUID
return SCM_MAKINUM (0L + getegid ());
}
-SCM_PROC (s_sys_setuid, "%setuid", 1, 0, 0, scm_sys_setuid);
-#ifdef __STDC__
-SCM
-scm_sys_setuid (SCM id)
-#else
+SCM_PROC (s_setuid, "setuid", 1, 0, 0, scm_setuid);
+
SCM
-scm_sys_setuid (id)
+scm_setuid (id)
SCM id;
-#endif
{
- SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid);
- return setuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_setuid);
+ if (setuid (SCM_INUM (id)) != 0)
+ scm_syserror (s_setuid);
+ return SCM_UNSPECIFIED;
}
-SCM_PROC (s_sys_setgid, "%setgid", 1, 0, 0, scm_sys_setgid);
-#ifdef __STDC__
-SCM
-scm_sys_setgid (SCM id)
-#else
+SCM_PROC (s_setgid, "setgid", 1, 0, 0, scm_setgid);
+
SCM
-scm_sys_setgid (id)
+scm_setgid (id)
SCM id;
-#endif
{
- SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid);
- return setgid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_setgid);
+ if (setgid (SCM_INUM (id)) != 0)
+ scm_syserror (s_setgid);
+ return SCM_UNSPECIFIED;
}
-SCM_PROC (s_sys_seteuid, "%seteuid", 1, 0, 0, scm_sys_seteuid);
-#ifdef __STDC__
-SCM
-scm_sys_seteuid (SCM id)
-#else
+SCM_PROC (s_seteuid, "seteuid", 1, 0, 0, scm_seteuid);
+
SCM
-scm_sys_seteuid (id)
+scm_seteuid (id)
SCM id;
-#endif
{
- SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_seteuid);
+ int rv;
+
+ SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_seteuid);
#ifdef HAVE_SETEUID
- return seteuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ rv = seteuid (SCM_INUM (id));
#else
- return setuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ rv = setuid (SCM_INUM (id));
#endif
+ if (rv != 0)
+ scm_syserror (s_seteuid);
+ return SCM_UNSPECIFIED;
}
-SCM_PROC (s_sys_setegid, "%setegid", 1, 0, 0, scm_sys_setegid);
-#ifdef __STDC__
-SCM
-scm_sys_setegid (SCM id)
-#else
+#ifdef HAVE_SETEGID
+SCM_PROC (s_setegid, "setegid", 1, 0, 0, scm_setegid);
+
SCM
-scm_sys_setegid (id)
+scm_setegid (id)
SCM id;
-#endif
{
- SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setegid);
+ int rv;
+
+ SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_setegid);
#ifdef HAVE_SETEUID
- return setegid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ rv = setegid (SCM_INUM (id));
#else
- return setgid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ rv = setgid (SCM_INUM (id));
#endif
+ if (rv != 0)
+ scm_syserror (s_setegid);
+ return SCM_UNSPECIFIED;
+
}
+#endif
SCM_PROC (s_getpgrp, "getpgrp", 0, 0, 0, scm_getpgrp);
SCM
scm_getpgrp ()
{
int (*fn)();
- fn = getpgrp;
+ fn = (int (*) ()) getpgrp;
return SCM_MAKINUM (fn (0));
}
-SCM_PROC (s_setpgid, "%setpgid", 2, 0, 0, scm_setpgid);
+SCM_PROC (s_setpgid, "setpgid", 2, 0, 0, scm_setpgid);
SCM
scm_setpgid (pid, pgid)
SCM pid, pgid;
{
+#ifdef HAVE_SETPGID
SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_setpgid);
SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_setpgid);
- /* This may be known as setpgrp, from BSD. */
- return setpgid (SCM_INUM (pid), SCM_INUM (pgid)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ /* FIXME(?): may be known as setpgrp. */
+ if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
+ scm_syserror (s_setpgid);
+ return SCM_UNSPECIFIED;
+#else
+ scm_sysmissing (s_setpgid);
+ /* not reached. */
+ return SCM_BOOL_F;
+#endif
}
-SCM_PROC (s_setsid, "%setsid", 0, 0, 0, scm_setsid);
+SCM_PROC (s_setsid, "setsid", 0, 0, 0, scm_setsid);
SCM
scm_setsid ()
{
+#ifdef HAVE_SETSID
pid_t sid = setsid ();
- return (sid == -1) ? SCM_BOOL_F : SCM_MAKINUM (sid);
+ if (sid == -1)
+ scm_syserror (s_setsid);
+ return SCM_UNSPECIFIED;
+#else
+ scm_sysmissing (s_setsid);
+ /* not reached. */
+ return SCM_BOOL_F;
+#endif
}
-#ifndef ttyname
-extern char * ttyname();
-#endif
+SCM_PROC (s_ttyname, "ttyname", 1, 0, 0, scm_ttyname);
-SCM_PROC (s_ttyname, "%ttyname", 1, 0, 0, scm_ttyname);
-#ifdef __STDC__
-SCM
-scm_ttyname (SCM port)
-#else
SCM
scm_ttyname (port)
SCM port;
-#endif
{
char *ans;
int fd;
+
+ port = SCM_COERCE_OUTPORT (port);
SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_ttyname);
if (scm_tc16_fport != SCM_TYP16 (port))
return SCM_BOOL_F;
fd = fileno ((FILE *)SCM_STREAM (port));
- if (fd != -1)
- SCM_SYSCALL (ans = ttyname (fd));
+ if (fd == -1)
+ scm_syserror (s_ttyname);
+ SCM_SYSCALL (ans = ttyname (fd));
+ if (!ans)
+ scm_syserror (s_ttyname);
/* ans could be overwritten by another call to ttyname */
- return (((fd != -1) && ans)
- ? scm_makfrom0str (ans)
- : SCM_MAKINUM (errno));
+ return (scm_makfrom0str (ans));
}
-SCM_PROC (s_ctermid, "%ctermid", 0, 0, 0, scm_ctermid);
+SCM_PROC (s_ctermid, "ctermid", 0, 0, 0, scm_ctermid);
SCM
scm_ctermid ()
{
+#ifdef HAVE_CTERMID
char *result = ctermid (NULL);
- return *result == '\0' ? SCM_BOOL_F : scm_makfrom0str (result);
+ if (*result == '\0')
+ scm_syserror (s_ctermid);
+ return scm_makfrom0str (result);
+#else
+ scm_sysmissing (s_ctermid);
+ /* not reached. */
+ return SCM_BOOL_F;
+#endif
}
-SCM_PROC (s_tcgetpgrp, "%tcgetpgrp", 1, 0, 0, scm_tcgetpgrp);
+SCM_PROC (s_tcgetpgrp, "tcgetpgrp", 1, 0, 0, scm_tcgetpgrp);
SCM
scm_tcgetpgrp (port)
SCM port;
{
+#ifdef HAVE_TCGETPGRP
int fd;
pid_t pgid;
+
+ port = SCM_COERCE_OUTPORT (port);
+
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcgetpgrp);
fd = fileno ((FILE *)SCM_STREAM (port));
if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1)
- return SCM_BOOL_F;
- else
- return SCM_MAKINUM (pgid);
+ scm_syserror (s_tcgetpgrp);
+ return SCM_MAKINUM (pgid);
+#else
+ scm_sysmissing (s_tcgetpgrp);
+ /* not reached. */
+ return SCM_BOOL_F;
+#endif
}
-SCM_PROC (s_tcsetpgrp, "%tcsetpgrp", 2, 0, 0, scm_tcsetpgrp);
+SCM_PROC (s_tcsetpgrp, "tcsetpgrp", 2, 0, 0, scm_tcsetpgrp);
SCM
scm_tcsetpgrp (port, pgid)
SCM port, pgid;
{
+#ifdef HAVE_TCSETPGRP
int fd;
+
+ port = SCM_COERCE_OUTPORT (port);
+
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcsetpgrp);
SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_tcsetpgrp);
fd = fileno ((FILE *)SCM_STREAM (port));
if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
- return SCM_BOOL_F;
- else
- return SCM_BOOL_T;
+ scm_syserror (s_tcsetpgrp);
+ return SCM_UNSPECIFIED;
+#else
+ scm_sysmissing (s_tcsetpgrp);
+ /* not reached. */
+ return SCM_BOOL_F;
+#endif
}
/* Copy exec args from an SCM vector into a new C array. */
-#ifdef __STDC__
-static char **
-scm_convert_exec_args (SCM args)
-#else
+
static char **
-scm_convert_exec_args (args)
- SCM args;
-#endif
+scm_convert_exec_args (SCM args, int pos, const char *subr)
{
char **execargv;
int num_args;
int i;
+
+ SCM_ASSERT (SCM_NULLP (args)
+ || (SCM_NIMP (args) && SCM_CONSP (args)),
+ args, pos, subr);
SCM_DEFER_INTS;
num_args = scm_ilength (args);
execargv = (char **)
- scm_must_malloc ((num_args + 1) * sizeof (char *), s_ttyname);
+ scm_must_malloc ((num_args + 1) * sizeof (char *), subr);
for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
{
scm_sizet len;
char *dst;
char *src;
- SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)), SCM_CAR (args),
- "wrong type in SCM_ARG", "exec arg");
+ SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)),
+ SCM_CAR (args), SCM_ARGn, subr);
len = 1 + SCM_ROLENGTH (SCM_CAR (args));
- dst = (char *) scm_must_malloc ((long) len, s_ttyname);
+ dst = (char *) scm_must_malloc ((long) len, subr);
src = SCM_ROCHARS (SCM_CAR (args));
while (len--)
dst[len] = src[len];
return execargv;
}
-SCM_PROC (s_sys_execl, "%execl", 0, 0, 1, scm_sys_execl);
-#ifdef __STDC__
-SCM
-scm_sys_execl (SCM args)
-#else
+SCM_PROC (s_execl, "execl", 1, 0, 1, scm_execl);
+
SCM
-scm_sys_execl (args)
- SCM args;
-#endif
+scm_execl (filename, args)
+ SCM filename, args;
{
char **execargv;
- SCM filename = SCM_CAR (args);
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execl);
- if (SCM_SUBSTRP (filename))
- filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
- args = SCM_CDR (args);
- execargv = scm_convert_exec_args (args);
+ SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
+ SCM_ARG1, s_execl);
+ SCM_COERCE_SUBSTR (filename);
+ execargv = scm_convert_exec_args (args, SCM_ARG2, s_execl);
execv (SCM_ROCHARS (filename), execargv);
- return SCM_MAKINUM (errno);
+ scm_syserror (s_execl);
+ /* not reached. */
+ return SCM_BOOL_F;
}
-SCM_PROC (s_sys_execlp, "%execlp", 0, 0, 1, scm_sys_execlp);
-#ifdef __STDC__
-SCM
-scm_sys_execlp (SCM args)
-#else
+SCM_PROC (s_execlp, "execlp", 1, 0, 1, scm_execlp);
+
SCM
-scm_sys_execlp (args)
- SCM args;
-#endif
+scm_execlp (filename, args)
+ SCM filename, args;
{
char **execargv;
- SCM filename = SCM_CAR (args);
- SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execlp);
- if (SCM_SUBSTRP (filename))
- filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
- args = SCM_CDR (args);
- execargv = scm_convert_exec_args (args);
+ SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
+ SCM_ARG1, s_execlp);
+ SCM_COERCE_SUBSTR (filename);
+ execargv = scm_convert_exec_args (args, SCM_ARG2, s_execlp);
execvp (SCM_ROCHARS (filename), execargv);
- return SCM_MAKINUM (errno);
+ scm_syserror (s_execlp);
+ /* not reached. */
+ return SCM_BOOL_F;
+}
+
+static char **
+environ_list_to_c (SCM envlist, int arg, const char *proc)
+{
+ int num_strings;
+ char **result;
+ int i = 0;
+
+ SCM_REDEFER_INTS;
+ SCM_ASSERT (SCM_NULLP (envlist)
+ || (SCM_NIMP (envlist) && SCM_CONSP (envlist)),
+ envlist, arg, proc);
+ num_strings = scm_ilength (envlist);
+ result = (char **) malloc ((num_strings + 1) * sizeof (char *));
+ if (result == NULL)
+ scm_memory_error (proc);
+ while (SCM_NNULLP (envlist))
+ {
+ int len;
+ char *src;
+
+ SCM_ASSERT (SCM_NIMP (SCM_CAR (envlist))
+ && SCM_ROSTRINGP (SCM_CAR (envlist)),
+ envlist, arg, proc);
+ len = 1 + SCM_ROLENGTH (SCM_CAR (envlist));
+ result[i] = malloc ((long) len);
+ if (result[i] == NULL)
+ scm_memory_error (proc);
+ src = SCM_ROCHARS (SCM_CAR (envlist));
+ while (len--)
+ result[i][len] = src[len];
+ envlist = SCM_CDR (envlist);
+ i++;
+ }
+ result[i] = 0;
+ SCM_REALLOW_INTS;
+ return result;
}
-/* Flushing streams etc., is not done here. */
-SCM_PROC (s_sys_fork, "%fork", 0, 0, 0, scm_sys_fork);
-#ifdef __STDC__
+SCM_PROC (s_execle, "execle", 2, 0, 1, scm_execle);
+
SCM
-scm_sys_fork(void)
-#else
+scm_execle (filename, env, args)
+ SCM filename, env, args;
+{
+ char **execargv;
+ char **exec_env;
+
+ SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
+ SCM_ARG1, s_execle);
+ SCM_COERCE_SUBSTR (filename);
+
+ execargv = scm_convert_exec_args (args, SCM_ARG1, s_execle);
+ exec_env = environ_list_to_c (env, SCM_ARG2, s_execle);
+ execve (SCM_ROCHARS (filename), execargv, exec_env);
+ scm_syserror (s_execle);
+ /* not reached. */
+ return SCM_BOOL_F;
+}
+
+SCM_PROC (s_fork, "primitive-fork", 0, 0, 0, scm_fork);
+
SCM
-scm_sys_fork()
-#endif
+scm_fork()
{
- pid_t pid;
+ int pid;
pid = fork ();
if (pid == -1)
- return SCM_BOOL_F;
- else
- return SCM_MAKINUM (0L+pid);
+ scm_syserror (s_fork);
+ return SCM_MAKINUM (0L+pid);
}
-SCM_PROC (s_sys_uname, "%uname", 0, 0, 0, scm_sys_uname);
-#ifdef __STDC__
-SCM
-scm_sys_uname (void)
-#else
+SCM_PROC (s_uname, "uname", 0, 0, 0, scm_uname);
+
SCM
-scm_sys_uname ()
-#endif
+scm_uname ()
{
#ifdef HAVE_UNAME
struct utsname buf;
- SCM ans = scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED, SCM_BOOL_F);
+ SCM ans = scm_make_vector (SCM_MAKINUM(5), SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
- if (uname (&buf))
- return SCM_MAKINUM (errno);
+ SCM_DEFER_INTS;
+ if (uname (&buf) < 0)
+ scm_syserror (s_uname);
ve[0] = scm_makfrom0str (buf.sysname);
ve[1] = scm_makfrom0str (buf.nodename);
ve[2] = scm_makfrom0str (buf.release);
ve[3] = scm_makfrom0str (buf.version);
ve[4] = scm_makfrom0str (buf.machine);
/*
- FIXME
+ a linux special?
ve[5] = scm_makfrom0str (buf.domainname);
*/
+ SCM_ALLOW_INTS;
return ans;
#else
- return SCM_MAKINUM (ENOSYS);
+ scm_sysmissing (s_uname);
+ /* not reached. */
+ return SCM_BOOL_F;
#endif
}
SCM_PROC (s_environ, "environ", 0, 1, 0, scm_environ);
-#ifdef __STDC__
-SCM
-scm_environ (SCM env)
-#else
+
SCM
scm_environ (env)
SCM env;
-#endif
{
if (SCM_UNBNDP (env))
return scm_makfromstrs (-1, environ);
else
{
- int num_strings;
char **new_environ;
- int i = 0;
- SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)),
- env, SCM_ARG1, s_environ);
- num_strings = scm_ilength (env);
- new_environ = (char **) scm_must_malloc ((num_strings + 1)
- * sizeof (char *),
- s_environ);
- while (SCM_NNULLP (env))
- {
- int len;
- char *src;
- SCM_ASSERT (SCM_NIMP (SCM_CAR (env)) && SCM_ROSTRINGP (SCM_CAR (env)), env, SCM_ARG1,
- s_environ);
- len = 1 + SCM_ROLENGTH (SCM_CAR (env));
- new_environ[i] = scm_must_malloc ((long) len, s_environ);
- src = SCM_ROCHARS (SCM_CAR (env));
- while (len--)
- new_environ[i][len] = src[len];
- env = SCM_CDR (env);
- i++;
- }
- new_environ[i] = 0;
+
+ SCM_DEFER_INTS;
+ new_environ = environ_list_to_c (env, SCM_ARG1, s_environ);
/* Free the old environment, except when called for the first
* time.
*/
if (!first)
{
for (ep = environ; *ep != NULL; ep++)
- scm_must_free (*ep);
- scm_must_free ((char *) environ);
+ free (*ep);
+ free ((char *) environ);
}
first = 0;
}
environ = new_environ;
+ SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
}
+#ifdef L_tmpnam
+
+SCM_PROC (s_tmpnam, "tmpnam", 0, 0, 0, scm_tmpnam);
+
+SCM scm_tmpnam()
+{
+ char name[L_tmpnam];
+ SCM_SYSCALL (tmpnam (name););
+ return scm_makfrom0str (name);
+}
+#endif
SCM_PROC (s_open_pipe, "open-pipe", 2, 0, 0, scm_open_pipe);
-#ifdef __STDC__
-SCM
-scm_open_pipe (SCM pipestr, SCM modes)
-#else
+
SCM
scm_open_pipe (pipestr, modes)
SCM pipestr;
SCM modes;
-#endif
{
FILE *f;
register SCM z;
- SCM_ASSERT (SCM_NIMP (pipestr) && SCM_ROSTRINGP (pipestr), pipestr, SCM_ARG1, s_open_pipe);
+ struct scm_port_table * pt;
+
+ SCM_ASSERT (SCM_NIMP (pipestr) && SCM_ROSTRINGP (pipestr), pipestr,
+ SCM_ARG1, s_open_pipe);
if (SCM_SUBSTRP (pipestr))
- pipestr = scm_makfromstr (SCM_ROCHARS (pipestr), SCM_ROLENGTH (pipestr), 0);
- SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_pipe);
+ pipestr = scm_makfromstr (SCM_ROCHARS (pipestr),
+ SCM_ROLENGTH (pipestr), 0);
+ SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2,
+ s_open_pipe);
if (SCM_SUBSTRP (modes))
modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
SCM_NEWCELL (z);
SCM_DEFER_INTS;
- scm_ignore_signals ();
SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes)));
- scm_unignore_signals ();
if (!f)
- z = SCM_BOOL_F;
- else
- {
- struct scm_port_table * pt;
- pt = scm_add_to_port_table (z);
- SCM_SETPTAB_ENTRY (z, pt);
- SCM_CAR (z) = scm_tc16_pipe | SCM_OPN | (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG);
- SCM_SETSTREAM (z, (SCM)f);
- }
+ scm_syserror (s_open_pipe);
+ pt = scm_add_to_port_table (z);
+ SCM_SETPTAB_ENTRY (z, pt);
+ SCM_SETCAR (z, scm_tc16_pipe | SCM_OPN
+ | (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG));
+ SCM_SETSTREAM (z, (SCM)f);
SCM_ALLOW_INTS;
return z;
}
+SCM_PROC (s_close_pipe, "close-pipe", 1, 0, 0, scm_close_pipe);
-SCM_PROC (s_open_input_pipe, "open-input-pipe", 1, 0, 0, scm_open_input_pipe);
-#ifdef __STDC__
-SCM
-scm_open_input_pipe(SCM pipestr)
-#else
-SCM
-scm_open_input_pipe(pipestr)
- SCM pipestr;
-#endif
+SCM
+scm_close_pipe (port)
+ SCM port;
{
- return scm_open_pipe(pipestr, scm_makfromstr("r", (sizeof "r")-1, 0));
-}
+ int rv;
-SCM_PROC (s_open_output_pipe, "open-output-pipe", 1, 0, 0, scm_open_output_pipe);
-#ifdef __STDC__
-SCM
-scm_open_output_pipe(SCM pipestr)
-#else
-SCM
-scm_open_output_pipe(pipestr)
- SCM pipestr;
-#endif
-{
- return scm_open_pipe(pipestr, scm_makfromstr("w", (sizeof "w")-1, 0));
+ SCM_ASSERT (SCM_NIMP (port) && SCM_TYP16(port) == scm_tc16_pipe
+ && SCM_OPENP (port), port, SCM_ARG1, s_close_pipe);
+ SCM_DEFER_INTS;
+ rv = pclose ((FILE *) SCM_STREAM (port));
+ scm_remove_from_port_table (port);
+ SCM_SETAND_CAR (port, ~SCM_OPN);
+ if (rv == -1)
+ scm_syserror (s_close_pipe);
+ SCM_ALLOW_INTS;
+ return SCM_MAKINUM (rv);
}
+SCM_PROC (s_utime, "utime", 1, 2, 0, scm_utime);
-#ifdef __EMX__
-#include <sys/utime.h>
-#else
-#include <utime.h>
-#endif
-
-SCM_PROC (s_sys_utime, "%utime", 1, 2, 0, scm_sys_utime);
-#ifdef __STDC__
SCM
-scm_sys_utime (SCM pathname, SCM actime, SCM modtime)
-#else
-SCM
-scm_sys_utime (pathname, actime, modtime)
+scm_utime (pathname, actime, modtime)
SCM pathname;
SCM actime;
SCM modtime;
-#endif
{
int rv;
struct utimbuf utm_tmp;
- SCM_ASSERT (SCM_NIMP (pathname) && SCM_STRINGP (pathname), pathname, SCM_ARG1, s_sys_utime);
+ SCM_ASSERT (SCM_NIMP (pathname) && SCM_ROSTRINGP (pathname), pathname,
+ SCM_ARG1, s_utime);
+ SCM_COERCE_SUBSTR (pathname);
if (SCM_UNBNDP (actime))
SCM_SYSCALL (time (&utm_tmp.actime));
else
- utm_tmp.actime = scm_num2ulong (actime, (char *) SCM_ARG2, s_sys_utime);
+ utm_tmp.actime = scm_num2ulong (actime, (char *) SCM_ARG2, s_utime);
if (SCM_UNBNDP (modtime))
SCM_SYSCALL (time (&utm_tmp.modtime));
else
- utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_sys_utime);
+ utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_utime);
- SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp));
- return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ SCM_SYSCALL (rv = utime (SCM_ROCHARS (pathname), &utm_tmp));
+ if (rv != 0)
+ scm_syserror (s_utime);
+ return SCM_UNSPECIFIED;
}
+SCM_PROC (s_access, "access?", 2, 0, 0, scm_access);
-
-
-
-SCM_PROC (s_sys_access, "access?", 2, 0, 0, scm_sys_access);
-#ifdef __STDC__
SCM
-scm_sys_access (SCM path, SCM how)
-#else
-SCM
-scm_sys_access (path, how)
+scm_access (path, how)
SCM path;
SCM how;
-#endif
{
int rv;
- SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_access);
+ SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
+ s_access);
if (SCM_SUBSTRP (path))
path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
- SCM_ASSERT (SCM_INUMP (how), how, SCM_ARG2, s_sys_access);
+ SCM_ASSERT (SCM_INUMP (how), how, SCM_ARG2, s_access);
rv = access (SCM_ROCHARS (path), SCM_INUM (how));
return rv ? SCM_BOOL_F : SCM_BOOL_T;
}
-
-
SCM_PROC (s_getpid, "getpid", 0, 0, 0, scm_getpid);
-#ifdef __STDC__
-SCM
-scm_getpid (void)
-#else
+
SCM
scm_getpid ()
-#endif
{
return SCM_MAKINUM ((unsigned long) getpid ());
}
+SCM_PROC (s_putenv, "putenv", 1, 0, 0, scm_putenv);
-SCM_PROC (s_sys_putenv, "%putenv", 1, 0, 0, scm_sys_putenv);
-#ifdef __STDC__
SCM
-scm_sys_putenv (SCM str)
-#else
-SCM
-scm_sys_putenv (str)
- SCM str;
-#endif
-{
-#ifdef HAVE_PUTENV
- SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_putenv);
- return putenv (SCM_CHARS (str)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
-#else
- return SCM_MAKINUM (ENOSYS);
-#endif
-}
-
-
-SCM_PROC (s_read_line, "read-line", 0, 2, 0, scm_read_line);
-#ifdef __STDC__
-SCM
-scm_read_line (SCM port, SCM include_terminator)
-#else
-SCM
-scm_read_line (port, include_terminator)
- SCM port;
- SCM include_terminator;
-#endif
-{
- register int c;
- register int j = 0;
- scm_sizet len = 30;
- SCM tok_buf;
- register char *p;
- int include;
-
- tok_buf = scm_makstr ((long) len, 0);
- p = SCM_CHARS (tok_buf);
- if (SCM_UNBNDP (port))
- port = scm_cur_inp;
- else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_line);
-
- if (SCM_UNBNDP (include_terminator))
- include = 0;
- else
- include = SCM_NFALSEP (include_terminator);
-
- if (EOF == (c = scm_gen_getc (port)))
- return SCM_EOF_VAL;
- while (1)
- {
- switch (c)
- {
- case SCM_LINE_INCREMENTORS:
- if (j >= len)
- {
- p = scm_grow_tok_buf (&tok_buf);
- len = SCM_LENGTH (tok_buf);
- }
- p[j++] = c;
- /* fallthrough */
- case EOF:
- if (len == j)
- return tok_buf;
- return scm_vector_set_length_x (tok_buf, (SCM) SCM_MAKINUM (j));
-
- default:
- if (j >= len)
- {
- p = scm_grow_tok_buf (&tok_buf);
- len = SCM_LENGTH (tok_buf);
- }
- p[j++] = c;
- c = scm_gen_getc (port);
- break;
- }
- }
-}
-
-
-
-SCM_PROC (s_read_line_x, "read-line!", 1, 1, 0, scm_read_line_x);
-#ifdef __STDC__
-SCM
-scm_read_line_x (SCM str, SCM port)
-#else
-SCM
-scm_read_line_x (str, port)
+scm_putenv (str)
SCM str;
- SCM port;
-#endif
{
- register int c;
- register int j = 0;
- register char *p;
- scm_sizet len;
- SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_read_line_x);
- p = SCM_CHARS (str);
- len = SCM_LENGTH (str);
- if SCM_UNBNDP
- (port) port = scm_cur_inp;
- else
- SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG2, s_read_line_x);
- c = scm_gen_getc (port);
- if (EOF == c)
- return SCM_EOF_VAL;
- while (1)
- {
- switch (c)
- {
- case SCM_LINE_INCREMENTORS:
- case EOF:
- return SCM_MAKINUM (j);
- default:
- if (j >= len)
- {
- scm_gen_ungetc (c, port);
- return SCM_BOOL_F;
- }
- p[j++] = c;
- c = scm_gen_getc (port);
- }
- }
-}
-
-
-
-SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line);
-#ifdef __STDC__
-SCM
-scm_write_line (SCM obj, SCM port)
-#else
-SCM
-scm_write_line (obj, port)
- SCM obj;
- SCM port;
-#endif
-{
- scm_display (obj, port);
- return scm_newline (port);
+ int rv;
+ char *ptr;
+
+ SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_putenv);
+ /* must make a new copy to be left in the environment, safe from gc. */
+ ptr = malloc (SCM_LENGTH (str) + 1);
+ if (ptr == NULL)
+ scm_memory_error (s_putenv);
+ strncpy (ptr, SCM_ROCHARS (str), SCM_LENGTH (str));
+ ptr[SCM_LENGTH(str)] = 0;
+ rv = putenv (ptr);
+ if (rv < 0)
+ scm_syserror (s_putenv);
+ return SCM_UNSPECIFIED;
}
+SCM_PROC (s_setlocale, "setlocale", 1, 1, 0, scm_setlocale);
-
-SCM_PROC (s_setlocale, "%setlocale", 1, 1, 0, scm_setlocale);
-#ifdef __STDC__
-SCM
-scm_setlocale (SCM category, SCM locale)
-#else
SCM
scm_setlocale (category, locale)
SCM category;
SCM locale;
-#endif
{
#ifdef HAVE_SETLOCALE
char *clocale;
}
else
{
- SCM_ASSERT (SCM_NIMP (locale) && SCM_STRINGP (locale), locale, SCM_ARG2, s_setlocale);
- clocale = SCM_CHARS (locale);
+ SCM_ASSERT (SCM_NIMP (locale) && SCM_ROSTRINGP (locale), locale,
+ SCM_ARG2, s_setlocale);
+ SCM_COERCE_SUBSTR (locale);
+ clocale = SCM_ROCHARS (locale);
}
rv = setlocale (SCM_INUM (category), clocale);
- return rv ? scm_makfrom0str (rv) : SCM_MAKINUM (errno);
-#else
- /* setlocale not available. */
- return SCM_MAKINUM (errno);
-#endif
-}
-
-SCM_PROC (s_strftime, "strftime", 2, 0, 0, scm_strftime);
-#ifdef __STDC__
-SCM
-scm_strftime (SCM format, SCM stime)
-#else
-SCM
-scm_strftime (format, stime)
- SCM format;
- SCM stime;
-#endif
-{
- struct tm t;
-
- char *tbuf;
- int n;
- int size = 50;
- char *fmt;
- int len;
-
- SCM_ASSERT (SCM_NIMP (format) && SCM_STRINGP (format), format, SCM_ARG1, s_strftime);
- SCM_ASSERT (SCM_NIMP (stime) && SCM_VECTORP (stime) && scm_obj_length (stime) == 9,
- stime, SCM_ARG2, s_strftime);
-
- fmt = SCM_ROCHARS (format);
- len = SCM_ROLENGTH (format);
-
-#define tm_deref scm_num2long (SCM_VELTS (stime)[n++], (char *)SCM_ARG2, s_strftime)
- n = 0;
- t.tm_sec = tm_deref;
- t.tm_min = tm_deref;
- t.tm_hour = tm_deref;
- t.tm_mday = tm_deref;
- t.tm_mon = tm_deref;
- t.tm_year = tm_deref;
- /* not used by mktime.
- t.tm_wday = tm_deref;
- t.tm_yday = tm_deref; */
- t.tm_isdst = tm_deref;
-#undef tm_deref
-
- /* fill in missing fields and set the timezone. */
- mktime (&t);
-
- tbuf = scm_must_malloc (size, s_strftime);
- while ((len = strftime (tbuf, size, fmt, &t)) == size)
- {
- scm_must_free (tbuf);
- size *= 2;
- tbuf = scm_must_malloc (size, s_strftime);
- }
- return scm_makfromstr (tbuf, len, 0);
-}
-
-
-
-SCM_PROC (s_sys_strptime, "%strptime", 2, 0, 0, scm_sys_strptime);
-#ifdef __STDC__
-SCM
-scm_sys_strptime (SCM format, SCM string)
+ if (rv == NULL)
+ scm_syserror (s_setlocale);
+ return scm_makfrom0str (rv);
#else
-SCM
-scm_sys_strptime (format, string)
- SCM format;
- SCM string;
-#endif
-{
-#ifdef HAVE_STRPTIME
- SCM stime;
- struct tm t;
-
- char *fmt, *str, *rest;
- int len;
- int n;
-
- SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1, s_sys_strptime);
- if (SCM_SUBSTRP (format))
- format = scm_makfromstr (SCM_ROCHARS (format), SCM_ROLENGTH (format), 0);
- SCM_ASSERT (SCM_NIMP (string) && SCM_ROSTRINGP (string), string, SCM_ARG2, s_sys_strptime);
- if (SCM_SUBSTRP (string))
- string = scm_makfromstr (SCM_ROCHARS (string), SCM_ROLENGTH (string), 0);
-
- fmt = SCM_CHARS (format);
- str = SCM_CHARS (string);
-
- /* initialize the struct tm */
-#define tm_init(field) t.field = 0
- tm_init (tm_sec);
- tm_init (tm_min);
- tm_init (tm_hour);
- tm_init (tm_mday);
- tm_init (tm_mon);
- tm_init (tm_year);
- tm_init (tm_wday);
- tm_init (tm_yday);
- tm_init (tm_isdst);
-#undef tm_init
-
- SCM_DEFER_INTS;
- rest = strptime (str, fmt, &t);
- SCM_ALLOW_INTS;
-
- if (rest == NULL) {
- return SCM_BOOL_F;
- }
-
- stime = scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED);
-
-#define stime_set(val) scm_vector_set_x (stime, SCM_MAKINUM (n++), scm_long2num (t.val));
- n = 0;
- stime_set (tm_sec);
- stime_set (tm_min);
- stime_set (tm_hour);
- stime_set (tm_mday);
- stime_set (tm_mon);
- stime_set (tm_year);
- stime_set (tm_wday);
- stime_set (tm_yday);
- stime_set (tm_isdst);
-#undef stime_set
-
- return scm_cons (stime, scm_makfrom0str (rest));
-#else
- scm_wta (SCM_UNSPECIFIED, "strptime is not available and no replacement has (yet) been supplied", "strptime");
+ scm_sysmissing (s_setlocale);
+ /* not reached. */
return SCM_BOOL_F;
#endif
}
-SCM_PROC (s_sys_mknod, "%mknod", 3, 0, 0, scm_sys_mknod);
-#ifdef __STDC__
-SCM
-scm_sys_mknod(SCM path, SCM mode, SCM dev)
-#else
+SCM_PROC (s_mknod, "mknod", 4, 0, 0, scm_mknod);
+
SCM
-scm_sys_mknod(path, mode, dev)
+scm_mknod(path, type, perms, dev)
SCM path;
- SCM mode;
+ SCM type;
+ SCM perms;
SCM dev;
-#endif
{
#ifdef HAVE_MKNOD
int val;
- SCM_ASSERT(SCM_NIMP(path) && SCM_STRINGP(path), path, SCM_ARG1, s_sys_mknod);
- SCM_ASSERT(SCM_INUMP(mode), mode, SCM_ARG2, s_sys_mknod);
- SCM_ASSERT(SCM_INUMP(dev), dev, SCM_ARG3, s_sys_mknod);
- SCM_SYSCALL(val = mknod(SCM_CHARS(path), SCM_INUM(mode), SCM_INUM(dev)));
- return val ? SCM_BOOL_F : SCM_BOOL_T;
+ char *p;
+ int ctype = 0;
+
+ SCM_ASSERT (SCM_NIMP(path) && SCM_ROSTRINGP(path), path, SCM_ARG1, s_mknod);
+ SCM_ASSERT (SCM_NIMP(type) && SCM_SYMBOLP (type), type, SCM_ARG2, s_mknod);
+ SCM_ASSERT (SCM_INUMP (perms), perms, SCM_ARG3, s_mknod);
+ SCM_ASSERT (SCM_INUMP(dev), dev, SCM_ARG4, s_mknod);
+ SCM_COERCE_SUBSTR (path);
+
+ p = SCM_CHARS (type);
+ if (strcmp (p, "regular") == 0)
+ ctype = S_IFREG;
+ else if (strcmp (p, "directory") == 0)
+ ctype = S_IFDIR;
+ else if (strcmp (p, "symlink") == 0)
+ ctype = S_IFLNK;
+ else if (strcmp (p, "block-special") == 0)
+ ctype = S_IFBLK;
+ else if (strcmp (p, "char-special") == 0)
+ ctype = S_IFCHR;
+ else if (strcmp (p, "fifo") == 0)
+ ctype = S_IFIFO;
+ else if (strcmp (p, "socket") == 0)
+ ctype = S_IFSOCK;
+ else
+ scm_out_of_range (s_mknod, type);
+
+ SCM_DEFER_INTS;
+ SCM_SYSCALL (val = mknod(SCM_ROCHARS(path), ctype | SCM_INUM (perms),
+ SCM_INUM (dev)));
+ if (val != 0)
+ scm_syserror (s_mknod);
+ SCM_ALLOW_INTS;
+ return SCM_UNSPECIFIED;
#else
+ scm_sysmissing (s_mknod);
+ /* not reached. */
return SCM_BOOL_F;
#endif
}
-SCM_PROC (s_sys_nice, "%nice", 1, 0, 0, scm_sys_nice);
-#ifdef __STDC__
-SCM
-scm_sys_nice(SCM incr)
-#else
+SCM_PROC (s_nice, "nice", 1, 0, 0, scm_nice);
+
SCM
-scm_sys_nice(incr)
+scm_nice(incr)
SCM incr;
-#endif
{
#ifdef HAVE_NICE
- SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice);
- return nice(SCM_INUM(incr)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+ SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_nice);
+ if (nice(SCM_INUM(incr)) != 0)
+ scm_syserror (s_nice);
+ return SCM_UNSPECIFIED;
#else
- return SCM_MAKINUM (ENOSYS);
+ scm_sysmissing (s_nice);
+ /* not reached. */
+ return SCM_BOOL_F;
#endif
}
SCM_PROC (s_sync, "sync", 0, 0, 0, scm_sync);
-#ifdef __STDC__
-SCM
-scm_sync(void)
-#else
+
SCM
scm_sync()
-#endif
{
#ifdef HAVE_SYNC
sync();
+#else
+ scm_sysmissing (s_sync);
+ /* not reached. */
#endif
return SCM_UNSPECIFIED;
}
-
-
-#ifdef __STDC__
-void
-scm_init_posix (void)
-#else
void
scm_init_posix ()
-#endif
{
scm_add_feature ("posix");
#ifdef HAVE_GETEUID
scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
#endif
-#ifdef EINTR
- scm_sysintern ("EINTR", SCM_MAKINUM (EINTR));
-#endif
-
-#ifdef SIGHUP
- scm_sysintern ("SIGHUP", SCM_MAKINUM (SIGHUP));
-#endif
-#ifdef SIGINT
- scm_sysintern ("SIGINT", SCM_MAKINUM (SIGINT));
-#endif
-#ifdef SIGQUIT
- scm_sysintern ("SIGQUIT", SCM_MAKINUM (SIGQUIT));
-#endif
-#ifdef SIGILL
- scm_sysintern ("SIGILL", SCM_MAKINUM (SIGILL));
-#endif
-#ifdef SIGTRAP
- scm_sysintern ("SIGTRAP", SCM_MAKINUM (SIGTRAP));
-#endif
-#ifdef SIGABRT
- scm_sysintern ("SIGABRT", SCM_MAKINUM (SIGABRT));
-#endif
-#ifdef SIGIOT
- scm_sysintern ("SIGIOT", SCM_MAKINUM (SIGIOT));
-#endif
-#ifdef SIGBUS
- scm_sysintern ("SIGBUS", SCM_MAKINUM (SIGBUS));
-#endif
-#ifdef SIGFPE
- scm_sysintern ("SIGFPE", SCM_MAKINUM (SIGFPE));
-#endif
-#ifdef SIGKILL
- scm_sysintern ("SIGKILL", SCM_MAKINUM (SIGKILL));
-#endif
-#ifdef SIGUSR1
- scm_sysintern ("SIGUSR1", SCM_MAKINUM (SIGUSR1));
-#endif
-#ifdef SIGSEGV
- scm_sysintern ("SIGSEGV", SCM_MAKINUM (SIGSEGV));
-#endif
-#ifdef SIGUSR2
- scm_sysintern ("SIGUSR2", SCM_MAKINUM (SIGUSR2));
-#endif
-#ifdef SIGPIPE
- scm_sysintern ("SIGPIPE", SCM_MAKINUM (SIGPIPE));
-#endif
-#ifdef SIGALRM
- scm_sysintern ("SIGALRM", SCM_MAKINUM (SIGALRM));
-#endif
-#ifdef SIGTERM
- scm_sysintern ("SIGTERM", SCM_MAKINUM (SIGTERM));
-#endif
-#ifdef SIGSTKFLT
- scm_sysintern ("SIGSTKFLT", SCM_MAKINUM (SIGSTKFLT));
-#endif
-#ifdef SIGCHLD
- scm_sysintern ("SIGCHLD", SCM_MAKINUM (SIGCHLD));
-#endif
-#ifdef SIGCONT
- scm_sysintern ("SIGCONT", SCM_MAKINUM (SIGCONT));
-#endif
-#ifdef SIGSTOP
- scm_sysintern ("SIGSTOP", SCM_MAKINUM (SIGSTOP));
-#endif
-#ifdef SIGTSTP
- scm_sysintern ("SIGTSTP", SCM_MAKINUM (SIGTSTP));
-#endif
-#ifdef SIGTTIN
- scm_sysintern ("SIGTTIN", SCM_MAKINUM (SIGTTIN));
-#endif
-#ifdef SIGTTOU
- scm_sysintern ("SIGTTOU", SCM_MAKINUM (SIGTTOU));
-#endif
-#ifdef SIGIO
- scm_sysintern ("SIGIO", SCM_MAKINUM (SIGIO));
-#endif
-#ifdef SIGPOLL
- scm_sysintern ("SIGPOLL", SCM_MAKINUM (SIGPOLL));
-#endif
-#ifdef SIGURG
- scm_sysintern ("SIGURG", SCM_MAKINUM (SIGURG));
-#endif
-#ifdef SIGXCPU
- scm_sysintern ("SIGXCPU", SCM_MAKINUM (SIGXCPU));
-#endif
-#ifdef SIGXFSZ
- scm_sysintern ("SIGXFSZ", SCM_MAKINUM (SIGXFSZ));
-#endif
-#ifdef SIGVTALRM
- scm_sysintern ("SIGVTALRM", SCM_MAKINUM (SIGVTALRM));
-#endif
-#ifdef SIGPROF
- scm_sysintern ("SIGPROF", SCM_MAKINUM (SIGPROF));
-#endif
-#ifdef SIGWINCH
- scm_sysintern ("SIGWINCH", SCM_MAKINUM (SIGWINCH));
-#endif
-#ifdef SIGLOST
- scm_sysintern ("SIGLOST", SCM_MAKINUM (SIGLOST));
-#endif
-#ifdef SIGPWR
- scm_sysintern ("SIGPWR", SCM_MAKINUM (SIGPWR));
-#endif
/* access() symbols. */
scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
#ifdef LC_ALL
scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
#endif
+#include "cpp_sig_symbols.c"
#include "posix.x"
}
HCoop / bpt / guile.git / blobdiff