
/* Scheme implementation intended for JACAL.
   Copyright (C) 1990, 1991, 1992, 1993, 1994 Aubrey Jaffer.

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 1, 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 program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

The author can be reached at jaffer@ai.mit.edu or
Aubrey Jaffer, 84 Pleasant St., Wakefield MA 01880
*/

#include "scm.h"

#ifdef __EMX__
# include <sys/types.h>
#endif

#ifdef __EMX__
# include <sys/types.h>
#endif

#ifndef THINK_C
# ifdef vms
#  include <stat.h>
# else
#  ifdef HAVE_UNISTD_H
#   include <unistd.h>
#  endif
#  include <sys/stat.h>
# endif
SCM scm_stat2scm P ((struct stat * stat_temp));
/* int	mkdir P((const char *path, mode_t mode)); */
#endif

#if !defined(STDC_HEADERS) && !defined(HAVE_UNISTD_H)
int chdir P ((const char *path));
int unlink P ((const char *name));
int link P ((const char *from, const char *to));
char *getcwd P ((char *buf, sizet size));
int access P ((const char *name, int type));
int dup P ((int fd));
int dup2 P ((int fd, int fd2));
int close P ((int fd));
int rmdir P ((const char *path));
int execv P ((const char *, char *const *));
int execvp P ((const char *, char *const *));
int putenv P ((const char *));
#endif /* STDC_HEADERS */

#ifdef __EMX__
int execv P ((const char *, char *const *));
int execvp P ((const char *, char *const *));
int putenv P ((const char *));
#endif

static char s_read_line[] = "read-line";
SCM 
scm_read_line (port)
     SCM port;
{
  register int c;
  register int j = 0;
  sizet len = 30;
  SCM tok_buf = scm_makstr ((long) len, 0);
  register char *p = CHARS (tok_buf);
  if (UNBNDP (port))
    port = cur_inp;
  else
    ASSERT (NIMP (port) && OPINPORTP (port), port, ARG1, s_read_line);
  if (EOF == (c = scm_lgetc (port)))
    return EOF_VAL;
  while (1)
    {
      switch (c)
	{
	case LINE_INCREMENTORS:
	case EOF:
	  if (len == j)
	    return tok_buf;
	  return scm_resizuve (tok_buf, (SCM) MAKINUM (j));
	default:
	  if (j >= len)
	    {
	      p = scm_grow_tok_buf (tok_buf);
	      len = LENGTH (tok_buf);
	    }
	  p[j++] = c;
	  c = scm_lgetc (port);
	}
    }
}

static char s_read_line1[] = "read-line!";
SCM 
scm_read_line1 (str, port)
     SCM str, port;
{
  register int c;
  register int j = 0;
  register char *p;
  sizet len;
  ASSERT (NIMP (str) && STRINGP (str), str, ARG1, s_read_line1);
  p = CHARS (str);
  len = LENGTH (str);
  if UNBNDP
    (port) port = cur_inp;
  else
    ASSERT (NIMP (port) && OPINPORTP (port), port, ARG2, s_read_line1);
  c = scm_lgetc (port);
  if (EOF == c)
    return EOF_VAL;
  while (1)
    {
      switch (c)
	{
	case LINE_INCREMENTORS:
	case EOF:
	  return MAKINUM (j);
	default:
	  if (j >= len)
	    {
	      scm_lungetc (c, port);
	      return BOOL_F;
	    }
	  p[j++] = c;
	  c = scm_lgetc (port);
	}
    }
}

static char s_write_line[] = "write-line";
SCM 
scm_write_line (obj, port)
     SCM obj, port;
{
  scm_display (obj, port);
  return scm_newline (port);
}

static char s_ftell[] = "%ftell";
SCM 
scm_ftell (port)
     SCM port;
{
  long pos;
  ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_ftell);
  SYSCALL (pos = ftell (STREAM (port)));
  if (pos < 0)
    return BOOL_F;
  if (pos > 0 && CRDYP (port))
    pos--;
  return MAKINUM (pos);
}

static char s_fseek[] = "%fseek";
SCM 
scm_fseek (port, offset, whence)
     SCM port, offset, whence;
{
  int rv;
  ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_fseek);
  ASSERT (INUMP (offset), offset, ARG2, s_fseek);
  ASSERT (INUMP (whence) && (INUM (whence) < 3) && (INUM (whence) >= 0),
	  whence, ARG3, s_fseek);
  CLRDY (port);			/* Clear ungetted char */
  /* Values of whence are interned in scm_init_ioext.  */
  rv = fseek (STREAM (port), INUM (offset), INUM (whence));
  return rv ? BOOL_F : BOOL_T;
}

static char s_freopen[] = "%freopen";
SCM 
scm_freopen (filename, modes, port)
     SCM filename, modes, port;
{
  FILE *f;
  ASSERT (NIMP (filename) && STRINGP (filename), filename, ARG1, s_freopen);
  ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_freopen);
  DEFER_INTS;
  ASSERT (NIMP (port) && FPORTP (port) && CLOSEDP (port), port, ARG3, s_freopen);
  SYSCALL (f = freopen (CHARS (filename), CHARS (modes), STREAM (port)));
  if (!f)
    {
      CAR (port) &= ~OPN;
      scm_remove_from_port_table (port);
      port = BOOL_F;
    }
  else
    {
      CAR (port) = tc16_fport | scm_mode_bits (CHARS (modes));
      SETSTREAM (port, f);
      if (BUF0 & (CAR (port) = tc16_fport | scm_mode_bits (CHARS (modes))))
	i_setbuf0 (port);
    }
  ALLOW_INTS;
  return port;
}

#ifndef MCH_AMIGA

static char s_dup[] = "%duplicate-port";
SCM 
scm_dup (oldpt, modes)
     SCM oldpt, modes;
{
  int oldfd;
  int newfd;
  FILE *f;
  SCM newpt;
  ASSERT (NIMP (oldpt) && OPPORTP (oldpt), oldpt, ARG1, s_dup);
  ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_dup);
  NEWCELL (newpt);
  DEFER_INTS;
  oldfd = fileno (STREAM (oldpt));
  if (oldfd == -1)
    {
      ALLOW_INTS;
      return BOOL_F;
    };
  SYSCALL (newfd = dup (oldfd));
  if (newfd == -1)
    {
      ALLOW_INTS;
      return BOOL_F;
    };
  f = fdopen (newfd, CHARS (modes));
  if (!f)
    {
      SYSCALL (close (newfd));
      ALLOW_INTS;
      return BOOL_F;
    }
  SETSTREAM (newpt, f);
  if (BUF0 & (CAR (newpt) = tc16_fport | scm_mode_bits (CHARS (modes))))
    i_setbuf0 (newpt);
  scm_add_to_port_table (newpt);
  ALLOW_INTS;
  return newpt;
}

static char s_dup2[] = "%redirect-port!";
SCM 
scm_dup2 (into_pt, from_pt)
     SCM into_pt, from_pt;
{
  int ans, oldfd, newfd;
  DEFER_INTS;
  ASSERT (NIMP (into_pt) && OPPORTP (into_pt), into_pt, ARG1, s_dup2);
  ASSERT (NIMP (from_pt) && OPPORTP (from_pt), from_pt, ARG2, s_dup2);
  oldfd = fileno (STREAM (into_pt));
  newfd = fileno (STREAM (from_pt));
  if (oldfd == -1 || newfd == -1)
    ans = -1;
  else
    SYSCALL (ans = dup2 (oldfd, newfd));
  ALLOW_INTS;
  return (ans == -1) ? BOOL_F : BOOL_T;
}

# ifndef vms
#  include <dirent.h>
static char s_opendir[] = "%opendir";
SCM 
scm_opendir (dirname)
     SCM dirname;
{
  DIR *ds;
  SCM dir;
  ASSERT (NIMP (dirname) && STRINGP (dirname), dirname, ARG1, s_opendir);
  NEWCELL (dir);
  DEFER_INTS;
  SYSCALL (ds = opendir (CHARS (dirname)));
  if (!ds)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  CAR (dir) = scm_tc16_dir | OPN;
  SETCDR (dir, ds);
  ALLOW_INTS;
  return dir;
}

static char s_readdir[] = "%readdir";
SCM 
scm_readdir (port)
     SCM port;
{
  struct dirent *rdent;
  DEFER_INTS;
  ASSERT (OPDIRP (port), port, ARG1, s_readdir);
  errno = 0;
  SYSCALL (rdent = readdir ((DIR *) CDR (port)));
  ALLOW_INTS;
  return (rdent
	  ? scm_makfromstr (rdent->d_name, strlen (rdent->d_name), 0)
	  : (errno ? BOOL_F : EOF_VAL));
}

static char s_rewinddir[] = "rewinddir";
SCM 
scm_rewinddir (port)
     SCM port;
{
  ASSERT (OPDIRP (port), port, ARG1, s_rewinddir);
  rewinddir ((DIR *) CDR (port));
  return UNSPECIFIED;
}

static char s_closedir[] = "%closedir";
SCM 
scm_closedir (port)
     SCM port;
{
  int sts;
  ASSERT (DIRP (port), port, ARG1, s_closedir);
  DEFER_INTS;
  if (CLOSEDP (port))
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  SYSCALL (sts = closedir ((DIR *) CDR (port)));
  if (sts)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  CAR (port) = scm_tc16_dir;
  ALLOW_INTS;
  return BOOL_T;
}

int 
scm_dir_print (sexp, port, writing)
     SCM sexp;
     SCM port;
     int writing;
{
  scm_prinport (sexp, port, "directory");
  return !0;
}

sizet 
scm_dir_free (p)
     CELLPTR p;
{
  if OPENP
    ((SCM) p) closedir ((DIR *) CDR ((SCM) p));
  return 0;
}

long scm_tc16_dir;
static scm_smobfuns dir_smob =
{scm_mark0, scm_dir_free, scm_dir_print, 0};
# endif /* vms */

static char s_mkdir[] = "%mkdir";
SCM 
scm_mkdir (path, mode)
     SCM path, mode;
{
  int rv;
  mode_t mask;
  ASSERT (NIMP (path) && STRINGP (path), path, ARG1, s_mkdir);
  if (UNBNDP (mode))
    {
      mask = umask (0);
      umask (mask);
      SYSCALL (rv = mkdir (CHARS (path), 0777 ^ mask));
    }
  else
    {
      ASSERT (INUMP (mode), mode, ARG2, s_mkdir);
      SYSCALL (rv = mkdir (CHARS (path), INUM (mode)));
    }
  return rv ? BOOL_F : BOOL_T;
}

# ifdef vms
static char s_dot_dir[] = ".DIR";
# endif

static char s_rmdir[] = "%rmdir";
SCM 
scm_rmdir (path)
     SCM path;
{
  int val;
  ASSERT (NIMP (path) && STRINGP (path), path, ARG1, s_rmdir);
# ifdef vms
  return scm_del_fil (scm_st_append (scm_cons2 (path, s_dot_dir, EOL)));
# else
  SYSCALL (val = rmdir (CHARS (path)));
  return val ? BOOL_F : BOOL_T;
# endif
}

#endif /* MCH_AMIGA */

#ifndef THINK_C
static char s_chdir[] = "%chdir";
SCM 
scm_chdir (str)
     SCM str;
{
  int ans;
  ASSERT (NIMP (str) && STRINGP (str), str, ARG1, s_chdir);
  SYSCALL (ans = chdir (CHARS (str)));
  return ans ? BOOL_F : BOOL_T;
}

# ifndef MCH_AMIGA
static char s_getcwd[] = "%getcwd";

SCM 
scm_getcwd ()
{
  char *rv;

#ifndef vms
  sizet size = 100;
  char *wd;
  SCM result = BOOL_F;

  DEFER_INTS;
  wd = scm_must_malloc (size, s_getcwd);
  while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
    {
      scm_must_free (wd);
      size *= 2;
      wd = scm_must_malloc (size, s_getcwd);
    }
  if (rv != 0)
    result = scm_makfromstr (wd, strlen (wd), 0);
  scm_must_free (wd);
  ALLOW_INTS;
  return result;
#else
  SYSCALL (rv = getenv ("PATH"));
  return rv ? scm_makfromstr (rv, strlen (rv), 0) : BOOL_F;
#endif
}

static char s_chmod[] = "%chmod";
SCM 
scm_chmod (port_or_path, mode)
     SCM port_or_path, mode;
{
  int rv;
  ASSERT (INUMP (mode), mode, ARG2, s_chmod);
  ASSERT (NIMP (port_or_path), port_or_path, ARG1, s_chmod);
  if (STRINGP (port_or_path))
    SYSCALL (rv = chmod (CHARS (port_or_path), INUM (mode)));
  else
    {
      ASSERT (OPFPORTP (port_or_path), port_or_path, ARG1, s_chmod);
      rv = fileno (STREAM (port_or_path));
      if (rv != -1)
	SYSCALL (rv = fchmod (rv, INUM (mode)));
    }
  return rv ? BOOL_F : BOOL_T;
}

#  ifndef vms
#   ifdef __EMX__
#    include <sys/utime.h>
#   else
#    include <utime.h>
#   endif

static char s_utime[] = "%utime";
SCM 
scm_utime (pathname, actime, modtime)
     SCM pathname, actime, modtime;
{
  int rv;
  struct utimbuf utm_tmp;

  ASSERT (NIMP (pathname) && STRINGP (pathname), pathname, ARG1, s_utime);

  if (UNBNDP (actime))
    SYSCALL (time (&utm_tmp.actime));
  else
    utm_tmp.actime = scm_num2ulong (actime, (char *) ARG2, s_utime);

  if (UNBNDP (modtime))
    SYSCALL (time (&utm_tmp.modtime));
  else
    utm_tmp.modtime = scm_num2ulong (modtime, (char *) ARG3, s_utime);

  SYSCALL (rv = utime (CHARS (pathname), &utm_tmp));
  return rv ? BOOL_F : BOOL_T;
}

#  endif /* vms */

static char s_umask[] = "umask";
SCM 
scm_umask (mode)
     SCM mode;
{
  mode_t mask;
  if (UNBNDP (mode))
    {
      mask = umask (0);
      umask (mask);
    }
  else {
    ASSERT (INUMP (mode), mode, ARG1, s_umask);
    mask = umask (INUM (mode));
  }
  return MAKINUM (mask);
}
# endif /* MCH_AMIGA */
#endif /* THINK_C */

static char s_rename[] = "%rename-file";
SCM 
scm_rename (oldname, newname)
     SCM oldname, newname;
{
  int rv;
  ASSERT (NIMP (oldname) && STRINGP (oldname), oldname, ARG1, s_rename);
  ASSERT (NIMP (newname) && STRINGP (newname), newname, ARG2, s_rename);
#ifdef STDC_HEADERS
  SYSCALL (rv = rename (CHARS (oldname), CHARS (newname)));
  return rv ? BOOL_F : BOOL_T;
#else
  DEFER_INTS;
  SYSCALL (rv = link (CHARS (oldname), CHARS (newname)));
  if (!rv)
    {
      SYSCALL (rv = unlink (CHARS (oldname)));;
      if (rv)
	/* unlink failed.  remove new name */
	SYSCALL (unlink (CHARS (newname))); 
    }
  ALLOW_INTS;
  return rv ? BOOL_F : BOOL_T;
#endif
}

static char s_fileno[] = "%fileno";
SCM 
scm_fileno (port)
     SCM port;
{
  int fd;
  ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_fileno);
  fd = fileno (STREAM (port));
  return (fd == -1) ? BOOL_F : MAKINUM (fd);
}

static char s_isatty[] = "%isatty?";
SCM 
scm_isatty (port)
     SCM port;
{
  int rv;
  ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_isatty);
  rv = fileno (STREAM (port));
  if (rv == -1)
    return EOF_VAL;
  else
    {
      rv = isatty (rv);
      return  rv ? BOOL_T : BOOL_F;
    }
}


static char s_fdopen[] = "%fdopen";
SCM scm_fdopen (fdes, modes)
     SCM fdes, modes;
{
  FILE *f;
  SCM port;

  ASSERT (INUMP (fdes), fdes, ARG1, s_fdopen);
  ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_fdopen);
  DEFER_INTS;
  f = fdopen (INUM (fdes), CHARS (modes));
  if (f == NULL)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  NEWCELL (port);
  CAR (port) = tc16_fport | scm_mode_bits (CHARS (modes));
  SETSTREAM (port,f);
  scm_add_to_port_table (port);
  ALLOW_INTS;
  return port;
}

/* Move a port's underlying file descriptor to a given value.
 * Returns: #f for error.
 *           0 if fdes is already the given value.
 *           1 if fdes moved. 
 * MOVE->FDES is implemented in Scheme and calls this primitive.
 */
static char s_move_fdes[] = "%primitive-move->fdes";
SCM
scm_move_fdes (port, fd)
     SCM port, fd;
{
  FILE *stream;
  int old_fd;
  int new_fd;
  int rv;

  ASSERT (NIMP (port) && OPFPORTP (port), port, ARG1, s_move_fdes);
  ASSERT (INUMP (fd), fd, ARG2, s_move_fdes);
  DEFER_INTS;
  stream = STREAM (port);
  old_fd = fileno (stream);
  new_fd = INUM (fd);
  if  (old_fd == new_fd)
    {
      ALLOW_INTS;
      return MAKINUM (0);
    }
  scm_evict_ports (new_fd);
  rv = dup2 (old_fd, new_fd);
  if (rv == -1)
    {
      ALLOW_INTS;
      return BOOL_F;
    }
  scm_setfileno (stream, new_fd);
  SYSCALL (close (old_fd));  
  ALLOW_INTS;
  return MAKINUM (1);
}

static char s_access[] = "%access";
SCM 
scm_access (path, how)
     SCM path, how;
{
  int rv;
  int ihow;
  ASSERT (NIMP (path) && STRINGP (path), path, ARG1, s_access);
  ASSERT (INUMP (how), how, ARG2, s_access);
  /* "how" values are interned in scm_init_ioext.  */
  rv = access (CHARS (path), INUM (how));
  return rv ? BOOL_F : BOOL_T;
}

#ifndef THINK_C

char s_stat[] = "%stat";
SCM 
scm_stat (port_or_path)
     SCM port_or_path;
{
  int rv;
  struct stat stat_temp;
  ASSERT (NIMP (port_or_path), port_or_path, ARG1, s_stat);
#ifdef MCH_AMIGA
  ASSERT (STRING (port_or_path), port_or_path, ARG1, s_stat);
#endif
  if (STRINGP (port_or_path))
    SYSCALL (rv = stat (CHARS (port_or_path), &stat_temp));
#ifndef MCH_AMIGA
  else
    {
      ASSERT (OPFPORTP (port_or_path), port_or_path, ARG1, s_stat);
      DEFER_INTS;
      rv = fileno (STREAM (port_or_path));
      ALLOW_INTS;
      if (rv != -1)
	SYSCALL (rv = fstat (rv, &stat_temp));
    }
#endif
  return rv ? BOOL_F : scm_stat2scm (&stat_temp);
}

# ifdef MCH_AMIGA

SCM 
scm_stat2scm (stat_temp)
     struct stat *stat_temp;
{
  SCM ans = scm_make_vector (MAKINUM (3), UNSPECIFIED);
  SCM *ve = VELTS (ans);
  ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_attr);
  ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_mtime);
  ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_size);
  return ans;
}
# else

SCM 
scm_stat2scm (stat_temp)
     struct stat *stat_temp;
{
  SCM ans = scm_make_vector (MAKINUM (11), UNSPECIFIED);
  SCM *ve = VELTS (ans);
  ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);
  ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino);
  ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode);
  ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink);
  ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid);
  ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid);
  ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev);
  ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size);
  ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime);
  ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime);
  ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime);
  return ans;
}

#  ifdef __TURBOC__
#   include <process.h>
#  endif

static char s_getpid[] = "getpid";
SCM 
scm_getpid ()
{
  return MAKINUM ((unsigned long) getpid ());
}

# endif /* MCH_AMIGA */
#endif /* THINK_C */

static char scm_s_putenv[] = "%putenv";
SCM
scm_putenv (str)
     SCM str;
{
  ASSERT (NIMP (str) && STRINGP (str), str, ARG1, scm_s_putenv);
  return putenv (CHARS (str)) ? BOOL_F : BOOL_T;
}

static scm_iproc subr1s[] =
{
  {s_ftell, scm_ftell},
  {s_fileno, scm_fileno},
  {s_isatty, scm_isatty},
#ifndef MCH_AMIGA
#ifndef vms
  {s_opendir, scm_opendir},
  {s_readdir, scm_readdir},
  {s_rewinddir, scm_rewinddir},
  {s_closedir, scm_closedir},
#endif
  {s_rmdir, scm_rmdir},
#endif
#ifndef THINK_C
  {s_chdir, scm_chdir},
  {s_stat, scm_stat},
#endif
  {scm_s_putenv, scm_putenv},
#ifdef HAVE_PIPE
/*
  {"open-input-pipe", l_open_input_pipe},
  {"open-output-pipe", l_open_output_pipe},
*/
#endif
  {0, 0}};

#ifndef MCH_AMIGA
static scm_iproc subr0s[] =
{
  {s_getpid, scm_getpid},
  {s_getcwd, scm_getcwd},
  {0, 0}
};
#endif

static scm_iproc subr1os[] =
{
  {s_read_line, scm_read_line},
#ifndef MCH_AMIGA
#ifndef THINK_C
  {s_umask, scm_umask},
#endif
#endif
  {0, 0}};

static scm_iproc subr2s[] =
{
#ifdef HAVE_PIPE
/*  {s_op_pipe, scm_open_pipe}, */
#endif
  {s_fdopen, scm_fdopen},
  {s_move_fdes, scm_move_fdes},
  {s_rename, scm_rename},
  {s_access, scm_access},
#ifndef MCH_AMIGA
  {s_dup, scm_dup},
  {s_dup2, scm_dup2},
#ifndef THINK_C
  {s_chmod, scm_chmod},
#endif
#endif
  {0, 0}};

static scm_iproc subr2os[] =
{
  {s_read_line1, scm_read_line1},
  {s_write_line, scm_write_line},
  {s_mkdir, scm_mkdir},
  {0, 0}
};


static scm_iproc subr3s[] =
{
  {s_fseek, scm_fseek},
  {s_freopen, scm_freopen},
  {0, 0}
};

void 
scm_init_ioext ()
{
  scm_init_iprocs (subr0s, tc7_subr_0);
  scm_init_iprocs (subr1os, tc7_subr_1o);
  scm_init_iprocs (subr1s, tc7_subr_1);
  scm_init_iprocs (subr2os, tc7_subr_2o);
  scm_init_iprocs (subr2s, tc7_subr_2);
  scm_init_iprocs (subr3s, tc7_subr_3);
  scm_make_gsubr (s_utime, 1, 2, 0, scm_utime);

  /* fseek() symbols.  */
  scm_sysintern ("SEEK_SET", MAKINUM (SEEK_SET));
  scm_sysintern ("SEEK_CUR", MAKINUM (SEEK_CUR));
  scm_sysintern ("SEEK_END", MAKINUM (SEEK_END));

  /* access() symbols.  */
  scm_sysintern ("R_OK", MAKINUM (R_OK));
  scm_sysintern ("W_OK", MAKINUM (W_OK));
  scm_sysintern ("X_OK", MAKINUM (X_OK));
  scm_sysintern ("F_OK", MAKINUM (F_OK));

  /* File type/permission bits.  */
#ifdef S_IRUSR
  scm_sysintern ("S_IRUSR", MAKINUM (S_IRUSR));
#endif
#ifdef S_IWUSR
  scm_sysintern ("S_IWUSR", MAKINUM (S_IWUSR));
#endif
#ifdef S_IXUSR
  scm_sysintern ("S_IXUSR", MAKINUM (S_IXUSR));
#endif
#ifdef S_IRWXU
  scm_sysintern ("S_IRWXU", MAKINUM (S_IRWXU));
#endif

#ifdef S_IRGRP
  scm_sysintern ("S_IRGRP", MAKINUM (S_IRGRP));
#endif
#ifdef S_IWGRP
  scm_sysintern ("S_IWGRP", MAKINUM (S_IWGRP));
#endif
#ifdef S_IXGRP
  scm_sysintern ("S_IXGRP", MAKINUM (S_IXGRP));
#endif
#ifdef S_IRWXG
  scm_sysintern ("S_IRWXG", MAKINUM (S_IRWXG));
#endif

#ifdef S_IROTH
  scm_sysintern ("S_IROTH", MAKINUM (S_IROTH));
#endif
#ifdef S_IWOTH
  scm_sysintern ("S_IWOTH", MAKINUM (S_IWOTH));
#endif
#ifdef S_IXOTH
  scm_sysintern ("S_IXOTH", MAKINUM (S_IXOTH));
#endif
#ifdef S_IRWXO
  scm_sysintern ("S_IRWXO", MAKINUM (S_IRWXO));
#endif

#ifdef S_ISUID
  scm_sysintern ("S_ISUID", MAKINUM (S_ISUID));
#endif
#ifdef S_ISGID
  scm_sysintern ("S_ISGID", MAKINUM (S_ISGID));
#endif
#ifdef S_ISVTX
  scm_sysintern ("S_ISVTX", MAKINUM (S_ISVTX));
#endif

#ifdef S_IFMT
  scm_sysintern ("S_IFMT", MAKINUM (S_IFMT));
#endif
#ifdef S_IFDIR
  scm_sysintern ("S_IFDIR", MAKINUM (S_IFDIR));
#endif
#ifdef S_IFCHR
  scm_sysintern ("S_IFCHR", MAKINUM (S_IFCHR));
#endif
#ifdef S_IFBLK
  scm_sysintern ("S_IFBLK", MAKINUM (S_IFBLK));
#endif
#ifdef S_IFREG
  scm_sysintern ("S_IFREG", MAKINUM (S_IFREG));
#endif
#ifdef S_IFLNK
  scm_sysintern ("S_IFLNK", MAKINUM (S_IFLNK));
#endif
#ifdef S_IFSOCK
  scm_sysintern ("S_IFSOCK", MAKINUM (S_IFSOCK));
#endif
#ifdef S_IFIFO
  scm_sysintern ("S_IFIFO", MAKINUM (S_IFIFO));
#endif

#ifndef THINK_C
#ifndef MCH_AMIGA
#ifndef vms
/*  scm_make_subr (s_utime, tc7_subr_3, scm_utime); */
  scm_tc16_dir = scm_newsmob (&dir_smob);
#endif
#endif
#endif
  scm_add_feature ("i/o-extensions");
  scm_add_feature ("line-i/o");
#ifdef HAVE_PIPE
/*
  scm_ptobs[0x0ff & (tc16_pipe >> 8)].fclose = pclose;
  scm_ptobs[0x0ff & (tc16_pipe >> 8)].free = pclose;
  scm_ptobs[0x0ff & (tc16_pipe >> 8)].print = prinpipe;
  scm_add_feature (s_pipe);
*/
#endif
}
