mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
1fd838affc
* configure.in (AC_CHECK_FUNCS): Add ctermid, setpgid, setsid, tcgetpgrp, tcsetpgrp, and waitpid to the list of functions to check for. * configure, scmconfig.h.in: Updated, using autoconf and autoheader. * posix.c (scm_sys_ctermid, scm_sys_setpgid, scm_sys_setsid, scm_sys_tcgetpgrp, scm_sys_tcsetpgrp, scm_sys_waitpid): Put the bodies of these functions in "#ifdef HAVE_MUMBLE" clauses, with a stub that signals an error as the #else.
1564 lines
34 KiB
C
1564 lines
34 KiB
C
/* Copyright (C) 1995, 1996 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
|
||
* the Free Software Foundation; either version 2, or (at your option)
|
||
* any later version.
|
||
*
|
||
* This program is distributed in the hope that it will be useful,
|
||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
* GNU General Public License for more details.
|
||
*
|
||
* 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.
|
||
*
|
||
* As a special exception, the Free Software Foundation gives permission
|
||
* for additional uses of the text contained in its release of GUILE.
|
||
*
|
||
* The exception is that, if you link the GUILE library with other files
|
||
* to produce an executable, this does not by itself cause the
|
||
* resulting executable to be covered by the GNU General Public License.
|
||
* Your use of that executable is in no way restricted on account of
|
||
* linking the GUILE library code into it.
|
||
*
|
||
* This exception does not however invalidate any other reasons why
|
||
* the executable file might be covered by the GNU General Public License.
|
||
*
|
||
* This exception applies only to the code released by the
|
||
* Free Software Foundation under the name GUILE. If you copy
|
||
* code from other Free Software Foundation releases into a copy of
|
||
* GUILE, as the General Public License permits, the exception does
|
||
* not apply to the code that you add in this way. To avoid misleading
|
||
* anyone as to the status of such modified files, you must delete
|
||
* this exception notice from them.
|
||
*
|
||
* 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.
|
||
*/
|
||
|
||
|
||
#include <stdio.h>
|
||
#include "_scm.h"
|
||
|
||
|
||
|
||
#ifdef HAVE_STRING_H
|
||
#include <string.h>
|
||
#endif
|
||
#ifdef TIME_WITH_SYS_TIME
|
||
# include <sys/time.h>
|
||
# include <time.h>
|
||
#else
|
||
# if HAVE_SYS_TIME_H
|
||
# include <sys/time.h>
|
||
# else
|
||
# include <time.h>
|
||
# endif
|
||
#endif
|
||
|
||
#ifdef HAVE_UNISTD_H
|
||
#include <unistd.h>
|
||
#else
|
||
#ifndef ttyname
|
||
extern char *ttyname();
|
||
#endif
|
||
#endif
|
||
|
||
#ifdef HAVE_SYS_SELECT_H
|
||
#include <sys/select.h>
|
||
#endif
|
||
|
||
#include <sys/types.h>
|
||
#include <sys/stat.h>
|
||
#include <fcntl.h>
|
||
|
||
#include <pwd.h>
|
||
|
||
#if HAVE_SYS_WAIT_H
|
||
# include <sys/wait.h>
|
||
#endif
|
||
#ifndef WEXITSTATUS
|
||
# define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
|
||
#endif
|
||
#ifndef WIFEXITED
|
||
# define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
|
||
#endif
|
||
|
||
#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 FILE *popen ();
|
||
extern char ** environ;
|
||
|
||
#include <grp.h>
|
||
#include <sys/utsname.h>
|
||
|
||
#if HAVE_DIRENT_H
|
||
# include <dirent.h>
|
||
# define NAMLEN(dirent) strlen((dirent)->d_name)
|
||
#else
|
||
# define dirent direct
|
||
# define NAMLEN(dirent) (dirent)->d_namlen
|
||
# if HAVE_SYS_NDIR_H
|
||
# include <sys/ndir.h>
|
||
# endif
|
||
# if HAVE_SYS_DIR_H
|
||
# include <sys/dir.h>
|
||
# endif
|
||
# if HAVE_NDIR_H
|
||
# include <ndir.h>
|
||
# endif
|
||
#endif
|
||
|
||
char *strptime ();
|
||
|
||
#ifdef HAVE_SETLOCALE
|
||
#include <locale.h>
|
||
#endif
|
||
|
||
|
||
|
||
|
||
|
||
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
|
||
{
|
||
int fd[2], rv;
|
||
FILE *f_rd, *f_wt;
|
||
SCM p_rd, p_wt;
|
||
struct scm_port_table * ptr;
|
||
struct scm_port_table * ptw;
|
||
|
||
SCM_NEWCELL (p_rd);
|
||
SCM_NEWCELL (p_wt);
|
||
rv = pipe (fd);
|
||
if (rv)
|
||
SCM_SYSERROR (s_sys_pipe);
|
||
f_rd = fdopen (fd[0], "r");
|
||
if (!f_rd)
|
||
{
|
||
SCM_SYSCALL (close (fd[0]));
|
||
SCM_SYSCALL (close (fd[1]));
|
||
SCM_SYSERROR (s_sys_pipe);
|
||
}
|
||
f_wt = fdopen (fd[1], "w");
|
||
if (!f_wt)
|
||
{
|
||
int en;
|
||
en = errno;
|
||
fclose (f_rd);
|
||
SCM_SYSCALL (close (fd[1]));
|
||
errno = en;
|
||
SCM_SYSERROR (s_sys_pipe);
|
||
}
|
||
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);
|
||
|
||
SCM_ALLOW_INTS;
|
||
return scm_cons (p_rd, p_wt);
|
||
}
|
||
|
||
|
||
|
||
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 grps, ans;
|
||
int ngroups = getgroups (0, NULL);
|
||
if (!ngroups)
|
||
SCM_SYSERROR (s_sys_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);
|
||
val = getgroups(ngroups, groups);
|
||
if (val < 0)
|
||
{
|
||
scm_must_free((char *)groups);
|
||
SCM_SYSERROR (s_sys_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);
|
||
while (--ngroups >= 0) SCM_VELTS(ans)[ngroups] = SCM_MAKINUM(groups[ngroups]);
|
||
SCM_SETCHARS(grps, groups); /* to make sure grps stays around. */
|
||
return ans;
|
||
}
|
||
}
|
||
|
||
|
||
|
||
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 user;
|
||
#endif
|
||
{
|
||
SCM result;
|
||
struct passwd *entry;
|
||
SCM *ve;
|
||
|
||
result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED, SCM_BOOL_F);
|
||
ve = SCM_VELTS (result);
|
||
if (SCM_UNBNDP (user) || SCM_FALSEP (user))
|
||
{
|
||
SCM_DEFER_INTS;
|
||
SCM_SYSCALL (entry = getpwent ());
|
||
}
|
||
else if (SCM_INUMP (user))
|
||
{
|
||
SCM_DEFER_INTS;
|
||
entry = getpwuid (SCM_INUM (user));
|
||
}
|
||
else
|
||
{
|
||
SCM_ASSERT (SCM_NIMP (user) && SCM_ROSTRINGP (user), user, SCM_ARG1, s_sys_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_SYSERROR (s_sys_getpwuid);
|
||
|
||
ve[0] = scm_makfrom0str (entry->pw_name);
|
||
ve[1] = scm_makfrom0str (entry->pw_passwd);
|
||
ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
|
||
ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
|
||
ve[4] = scm_makfrom0str (entry->pw_gecos);
|
||
if (!entry->pw_dir)
|
||
ve[5] = scm_makfrom0str ("");
|
||
else
|
||
ve[5] = scm_makfrom0str (entry->pw_dir);
|
||
if (!entry->pw_shell)
|
||
ve[6] = scm_makfrom0str ("");
|
||
else
|
||
ve[6] = scm_makfrom0str (entry->pw_shell);
|
||
SCM_ALLOW_INTS;
|
||
return result;
|
||
}
|
||
|
||
|
||
|
||
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 ();
|
||
else
|
||
setpwent ();
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
|
||
|
||
/* 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
|
||
scm_sys_getgrgid (name)
|
||
SCM name;
|
||
#endif
|
||
{
|
||
SCM result;
|
||
struct group *entry;
|
||
SCM *ve;
|
||
result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
|
||
ve = SCM_VELTS (result);
|
||
SCM_DEFER_INTS;
|
||
if (SCM_UNBNDP (name) || (name == SCM_BOOL_F))
|
||
SCM_SYSCALL (entry = getgrent ());
|
||
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)));
|
||
}
|
||
if (!entry)
|
||
SCM_SYSERROR (s_sys_getgrgid);
|
||
|
||
ve[0] = scm_makfrom0str (entry->gr_name);
|
||
ve[1] = scm_makfrom0str (entry->gr_passwd);
|
||
ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
|
||
ve[3] = scm_makfromstrs (-1, entry->gr_mem);
|
||
SCM_ALLOW_INTS;
|
||
return result;
|
||
}
|
||
|
||
|
||
|
||
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 ();
|
||
else
|
||
setgrent ();
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
|
||
|
||
SCM_PROC (s_sys_kill, "kill", 2, 0, 0, scm_sys_kill);
|
||
#ifdef __STDC__
|
||
SCM
|
||
scm_sys_kill (SCM pid, SCM sig)
|
||
#else
|
||
SCM
|
||
scm_sys_kill (pid, sig)
|
||
SCM pid;
|
||
SCM sig;
|
||
#endif
|
||
{
|
||
SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_kill);
|
||
SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_sys_kill);
|
||
/* Signal values are interned in scm_init_posix(). */
|
||
if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
|
||
SCM_SYSERROR (s_sys_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
|
||
scm_sys_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);
|
||
if (SCM_UNBNDP (options))
|
||
ioptions = 0;
|
||
else
|
||
{
|
||
SCM_ASSERT (SCM_INUMP (options), options, SCM_ARG2, s_sys_waitpid);
|
||
/* Flags are interned in scm_init_posix. */
|
||
ioptions = SCM_INUM (options);
|
||
}
|
||
SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
|
||
if (i == -1)
|
||
SCM_SYSERROR (s_sys_waitpid);
|
||
return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
|
||
#else
|
||
SCM_SYSMISSING (s_sys_waitpid);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
#endif
|
||
}
|
||
|
||
|
||
|
||
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 ());
|
||
#else
|
||
return SCM_MAKINUM (0L + getuid ());
|
||
#endif
|
||
}
|
||
|
||
|
||
|
||
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 ());
|
||
#else
|
||
return SCM_MAKINUM (0L + getgid ());
|
||
#endif
|
||
}
|
||
|
||
|
||
SCM_PROC (s_sys_setuid, "setuid", 1, 0, 0, scm_sys_setuid);
|
||
#ifdef __STDC__
|
||
SCM
|
||
scm_sys_setuid (SCM id)
|
||
#else
|
||
SCM
|
||
scm_sys_setuid (id)
|
||
SCM id;
|
||
#endif
|
||
{
|
||
SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid);
|
||
if (setuid (SCM_INUM (id)) != 0)
|
||
SCM_SYSERROR (s_sys_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
|
||
scm_sys_setgid (id)
|
||
SCM id;
|
||
#endif
|
||
{
|
||
SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid);
|
||
if (setgid (SCM_INUM (id)) != 0)
|
||
SCM_SYSERROR (s_sys_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
|
||
scm_sys_seteuid (id)
|
||
SCM id;
|
||
#endif
|
||
{
|
||
int rv;
|
||
|
||
SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_seteuid);
|
||
#ifdef HAVE_SETEUID
|
||
rv = seteuid (SCM_INUM (id));
|
||
#else
|
||
rv = setuid (SCM_INUM (id));
|
||
#endif
|
||
if (rv != 0)
|
||
SCM_SYSERROR (s_sys_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
|
||
SCM
|
||
scm_sys_setegid (id)
|
||
SCM id;
|
||
#endif
|
||
{
|
||
int rv;
|
||
|
||
SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setegid);
|
||
#ifdef HAVE_SETEUID
|
||
rv = setegid (SCM_INUM (id));
|
||
#else
|
||
rv = setgid (SCM_INUM (id));
|
||
#endif
|
||
if (rv != 0)
|
||
SCM_SYSERROR (s_sys_setegid);
|
||
return SCM_UNSPECIFIED;
|
||
|
||
}
|
||
|
||
SCM_PROC (s_getpgrp, "getpgrp", 0, 0, 0, scm_getpgrp);
|
||
SCM
|
||
scm_getpgrp ()
|
||
{
|
||
int (*fn)();
|
||
fn = getpgrp;
|
||
return SCM_MAKINUM (fn (0));
|
||
}
|
||
|
||
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);
|
||
/* 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_sys_setpgid);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
#endif
|
||
}
|
||
|
||
SCM_PROC (s_setsid, "setsid", 0, 0, 0, scm_setsid);
|
||
SCM
|
||
scm_setsid ()
|
||
{
|
||
#ifdef HAVE_SETSID
|
||
pid_t sid = setsid ();
|
||
if (sid == -1)
|
||
SCM_SYSERROR (s_setsid);
|
||
return SCM_UNSPECIFIED;
|
||
#else
|
||
SCM_SYSMISSING (s_sys_setsid);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
#endif
|
||
}
|
||
|
||
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;
|
||
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_SYSERROR (s_ttyname);
|
||
SCM_SYSCALL (ans = ttyname (fd));
|
||
if (!ans)
|
||
SCM_SYSERROR (s_ttyname);
|
||
/* ans could be overwritten by another call to ttyname */
|
||
return (scm_makfrom0str (ans));
|
||
}
|
||
|
||
|
||
SCM_PROC (s_ctermid, "ctermid", 0, 0, 0, scm_ctermid);
|
||
SCM
|
||
scm_ctermid ()
|
||
{
|
||
#ifdef HAVE_CTERMID
|
||
char *result = ctermid (NULL);
|
||
if (*result == '\0')
|
||
SCM_SYSERROR (s_ctermid);
|
||
return scm_makfrom0str (result);
|
||
#else
|
||
SCM_SYSMISSING (s_sys_ctermid);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
#endif
|
||
}
|
||
|
||
SCM_PROC (s_tcgetpgrp, "tcgetpgrp", 1, 0, 0, scm_tcgetpgrp);
|
||
SCM
|
||
scm_tcgetpgrp (port)
|
||
SCM port;
|
||
{
|
||
#ifdef HAVE_TCGETPGRP
|
||
int fd;
|
||
pid_t pgid;
|
||
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)
|
||
SCM_SYSERROR (s_tcgetpgrp);
|
||
return SCM_MAKINUM (pgid);
|
||
#else
|
||
SCM_SYSMISSING (s_sys_tcgetpgrp);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
#endif
|
||
}
|
||
|
||
SCM_PROC (s_tcsetpgrp, "tcsetpgrp", 2, 0, 0, scm_tcsetpgrp);
|
||
SCM
|
||
scm_tcsetpgrp (port, pgid)
|
||
SCM port, pgid;
|
||
{
|
||
#ifdef HAVE_TCSETPGRP
|
||
int fd;
|
||
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)
|
||
SCM_SYSERROR (s_tcsetpgrp);
|
||
return SCM_UNSPECIFIED;
|
||
#else
|
||
SCM_SYSMISSING (s_sys_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
|
||
{
|
||
char **execargv;
|
||
int num_args;
|
||
int i;
|
||
SCM_DEFER_INTS;
|
||
num_args = scm_ilength (args);
|
||
execargv = (char **)
|
||
scm_must_malloc ((num_args + 1) * sizeof (char *), s_ttyname);
|
||
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");
|
||
len = 1 + SCM_ROLENGTH (SCM_CAR (args));
|
||
dst = (char *) scm_must_malloc ((long) len, s_ttyname);
|
||
src = SCM_ROCHARS (SCM_CAR (args));
|
||
while (len--)
|
||
dst[len] = src[len];
|
||
execargv[i] = dst;
|
||
}
|
||
execargv[i] = 0;
|
||
SCM_ALLOW_INTS;
|
||
return execargv;
|
||
}
|
||
|
||
SCM_PROC (s_sys_execl, "execl", 0, 0, 1, scm_sys_execl);
|
||
#ifdef __STDC__
|
||
SCM
|
||
scm_sys_execl (SCM args)
|
||
#else
|
||
SCM
|
||
scm_sys_execl (args)
|
||
SCM args;
|
||
#endif
|
||
{
|
||
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);
|
||
execv (SCM_ROCHARS (filename), execargv);
|
||
SCM_SYSERROR (s_sys_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
|
||
scm_sys_execlp (args)
|
||
SCM args;
|
||
#endif
|
||
{
|
||
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);
|
||
execvp (SCM_ROCHARS (filename), execargv);
|
||
SCM_SYSERROR (s_sys_execlp);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
}
|
||
|
||
/* Flushing streams etc., is not done here. */
|
||
SCM_PROC (s_sys_fork, "fork", 0, 0, 0, scm_sys_fork);
|
||
#ifdef __STDC__
|
||
SCM
|
||
scm_sys_fork(void)
|
||
#else
|
||
SCM
|
||
scm_sys_fork()
|
||
#endif
|
||
{
|
||
pid_t pid;
|
||
pid = fork ();
|
||
if (pid == -1)
|
||
SCM_SYSERROR (s_sys_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
|
||
scm_sys_uname ()
|
||
#endif
|
||
{
|
||
#ifdef HAVE_UNAME
|
||
struct utsname buf;
|
||
SCM ans = scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED, SCM_BOOL_F);
|
||
SCM *ve = SCM_VELTS (ans);
|
||
if (uname (&buf))
|
||
return SCM_MAKINUM (errno);
|
||
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);
|
||
/*
|
||
a linux special?
|
||
ve[5] = scm_makfrom0str (buf.domainname);
|
||
*/
|
||
return ans;
|
||
#else
|
||
SCM_SYSMISSING (s_sys_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;
|
||
/* Free the old environment, except when called for the first
|
||
* time.
|
||
*/
|
||
{
|
||
char **ep;
|
||
static int first = 1;
|
||
if (!first)
|
||
{
|
||
for (ep = environ; *ep != NULL; ep++)
|
||
scm_must_free (*ep);
|
||
scm_must_free ((char *) environ);
|
||
}
|
||
first = 0;
|
||
}
|
||
environ = new_environ;
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
}
|
||
|
||
|
||
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;
|
||
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);
|
||
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)
|
||
SCM_SYSERROR (s_open_pipe);
|
||
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_ALLOW_INTS;
|
||
return z;
|
||
}
|
||
|
||
|
||
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
|
||
{
|
||
return scm_open_pipe(pipestr, scm_makfromstr("r", (sizeof "r")-1, 0));
|
||
}
|
||
|
||
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));
|
||
}
|
||
|
||
|
||
#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 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);
|
||
|
||
if (SCM_UNBNDP (actime))
|
||
SCM_SYSCALL (time (&utm_tmp.actime));
|
||
else
|
||
utm_tmp.actime = scm_num2ulong (actime, (char *) SCM_ARG2, s_sys_utime);
|
||
|
||
if (SCM_UNBNDP (modtime))
|
||
SCM_SYSCALL (time (&utm_tmp.modtime));
|
||
else
|
||
utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_sys_utime);
|
||
|
||
SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp));
|
||
if (rv != 0)
|
||
SCM_SYSERROR (s_sys_utime);
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
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 path;
|
||
SCM how;
|
||
#endif
|
||
{
|
||
int rv;
|
||
|
||
SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_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);
|
||
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_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
|
||
SCM_SYSMISSING (s_sys_putenv);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
#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 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);
|
||
}
|
||
|
||
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;
|
||
char *rv;
|
||
|
||
SCM_ASSERT (SCM_INUMP (category), category, SCM_ARG1, s_setlocale);
|
||
if (SCM_UNBNDP (locale))
|
||
{
|
||
clocale = NULL;
|
||
}
|
||
else
|
||
{
|
||
SCM_ASSERT (SCM_NIMP (locale) && SCM_STRINGP (locale), locale, SCM_ARG2, s_setlocale);
|
||
clocale = SCM_CHARS (locale);
|
||
}
|
||
|
||
rv = setlocale (SCM_INUM (category), clocale);
|
||
if (rv == NULL)
|
||
SCM_SYSERROR (s_setlocale);
|
||
return scm_makfrom0str (rv);
|
||
#else
|
||
SCM_SYSMISSING (s_setlocale);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
#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)
|
||
#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 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)
|
||
SCM_SYSERROR (s_sys_strptime);
|
||
|
||
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_SYSMISSING (s_sys_strptime);
|
||
/* 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
|
||
scm_sys_mknod(path, mode, dev)
|
||
SCM path;
|
||
SCM mode;
|
||
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)));
|
||
if (val != 0)
|
||
SCM_SYSERROR (s_sys_mknod);
|
||
return SCM_UNSPECIFIED;
|
||
#else
|
||
SCM_SYSMISSING (s_sys_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
|
||
scm_sys_nice(incr)
|
||
SCM incr;
|
||
#endif
|
||
{
|
||
#ifdef HAVE_NICE
|
||
SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice);
|
||
if (nice(SCM_INUM(incr)) != 0)
|
||
SCM_SYSERROR (s_sys_nice);
|
||
return SCM_UNSPECIFIED;
|
||
#else
|
||
SCM_SYSMISSING (s_sys_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();
|
||
#endif
|
||
SCM_SYSMISSING (s_sync);
|
||
/* not reached. */
|
||
return SCM_BOOL_F;
|
||
}
|
||
|
||
|
||
|
||
#ifdef __STDC__
|
||
void
|
||
scm_init_posix (void)
|
||
#else
|
||
void
|
||
scm_init_posix ()
|
||
#endif
|
||
{
|
||
scm_add_feature ("posix");
|
||
#ifdef HAVE_GETEUID
|
||
scm_add_feature ("EIDs");
|
||
#endif
|
||
#ifdef WAIT_ANY
|
||
scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
|
||
#endif
|
||
#ifdef WAIT_MYPGRP
|
||
scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
|
||
#endif
|
||
#ifdef WNOHANG
|
||
scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
|
||
#endif
|
||
#ifdef WUNTRACED
|
||
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));
|
||
scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
|
||
scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
|
||
|
||
#ifdef LC_COLLATE
|
||
scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
|
||
#endif
|
||
#ifdef LC_CTYPE
|
||
scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
|
||
#endif
|
||
#ifdef LC_MONETARY
|
||
scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
|
||
#endif
|
||
#ifdef LC_NUMERIC
|
||
scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
|
||
#endif
|
||
#ifdef LC_TIME
|
||
scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
|
||
#endif
|
||
#ifdef LC_MESSAGES
|
||
scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
|
||
#endif
|
||
#ifdef LC_ALL
|
||
scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
|
||
#endif
|
||
#include "posix.x"
|
||
}
|