/* libsizzle/iofun.c - input/output functions
 
  Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This 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 software 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 package; see the file COPYING.  If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#include <stdio.h>
#include <string.h>

#if HAVE_UNISTD_H
# include <unistd.h>
#endif
#include <fcntl.h>

#ifdef __MINGW32__
# include <io.h>
#endif

#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "alloc.h"
#include "node.h"
#include "validate.h"
#include "fdport.h"
#include "sport.h"
#include "port.h"
#include "read.h"
#include "capi.h"
#include "iofun.h"

#ifndef O_BINARY
# define O_BINARY 0
#endif

/* Predefined exceptions. */
zzz_scm_t zzz_file_not_found_exception;
zzz_scm_t zzz_file_creation_exception;

/*:doc
  write
  (write obj [port]) => *unspecified*
  Print @var{obj} to @var{port}, or to the current output port if not
  specified. @code{write} prints the object in the read syntax of the
  object, so that it can be read in again using @code{read}.
  doc:*/
#define FUNC_NAME "write"
static result_t
write_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (undefined_p (port))
    port = zzz_current_out_port;
  else
    CHECK_TYPE (2, port_p (port), zzz_port_type_name);
  *result = zzz_unspecified;
  return zzz_port_print (port, obj, &zzz_state.print_state, result);
}
#undef FUNC_NAME

/*:doc
  write-char
  (write-char char [port]) => *unspecified*
  Print the character @var{char} to @var{port}, or to the current output 
  port if not given.  @var{char} is not quoted when printing.
  doc:*/
#define FUNC_NAME "write-char"
static result_t
write_char_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t port,
		 zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  if (undefined_p (port))
    port = zzz_current_out_port;
  else
    CHECK_TYPE (2, port_p (port), zzz_port_type_name);
  *result = zzz_unspecified;
  return zzz_port_putc (char_val (ch), port, result);
}
#undef FUNC_NAME

/*:doc
  display
  (display obj [port]) => *unspecified*
  Print @var{obj} to @var{port}, or to the current output port if not
  specified. @code{display} prints the object without quoting.
  doc:*/
#define FUNC_NAME "display"
static result_t
display_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  struct zzz_print_state display_print_state = {/*  0,  */0};

  if (undefined_p (port))
    port = zzz_current_out_port;
  else
    CHECK_TYPE (2, port_p (port), zzz_port_type_name);
  *result = zzz_unspecified;
  return zzz_port_print (port, obj, &display_print_state, result);
}
#undef FUNC_NAME

/*:doc
  newline
  (newline [port]) => *unspecified*
  Print a newline character to @var{port}, or to the current output port if 
  not given.
  doc:*/
#define FUNC_NAME "newline"
static result_t
newline_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (undefined_p (port))
    port = zzz_current_out_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  *result = zzz_unspecified;
  return zzz_port_putc ('\n', port, result);
}
#undef FUNC_NAME

/*:doc
  read
  (read [port]) => object
  Read a Scheme object from @var{port}, or from the current input port if not
  specified.
  doc:*/
#define FUNC_NAME "read"
static result_t
read_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  return zzz_read_cell (port, result);
}
#undef FUNC_NAME

/*:doc
  read-char
  (read-char [port]) => char
  Read a character from @var{port}, or from the current input port if not 
  specified.
  doc:*/
#define FUNC_NAME "read-char"
static result_t
read_char_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;
  int ch;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  if ((err = zzz_port_getc (port, &ch, result)) != RESULT_SUCCESS)
    return err;
  if (ch == EOF)
    *result = zzz_eof_object;
  else
    *result = zzz_make_char (ch);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  unread-char
  (unread-char char [port]) => char
  Put the character @var{char} back onto the port @var{port}, or the
  current input port if not specifed, so that it will be read by the
  next call to @code{read-char}.  Return the given character
  @var{char}.
  doc:*/
#define FUNC_NAME "unread-char"
static result_t
unread_char_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t port,
		  zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  if ((err = zzz_port_ungetc (char_val (ch), port, result)) != RESULT_SUCCESS)
    return err;
  *result = ch;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  peek-char
  (peek-char [port]) => char
  Like @code{read-char}, but do not remove the character from the
  input port @var{port}, so that it can be read again using
  @code{read-char}.  @var{port} defaults to the current input port.
  doc:*/
#define FUNC_NAME "peek-char"
static result_t
peek_char_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;
  int ch;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  if ((err = zzz_port_getc (port, &ch, result)) != RESULT_SUCCESS)
    return err;
  if (ch == EOF)
    *result = zzz_eof_object;
  else
    {
      if ((err = zzz_port_ungetc (ch, port, result)) != RESULT_SUCCESS)
	return err;
      *result = zzz_make_char (ch);
    }
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-ready?
  (char-ready? [port]) => boolean
  Return @code{#t} if a character is available for reading from @var{port} 
  or the current input port, if @var{port} is not given.
  doc:*/
#define FUNC_NAME "char-ready?"
static result_t
char_ready_p_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;
  int ready;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);

  if ((err = zzz_port_char_ready_p (port, &ready, result)) != RESULT_SUCCESS)
    return err;
  if (ready)
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  %read-line
  (%read-line [port]) => string
  Read a newline-terminated line from @var{port}, or the current input port 
  if not specified.  Return the end-of-file object when reaching the end of
  file.
  doc:*/
#define FUNC_NAME "%read-line"
static result_t
sys_read_line_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;
  zzz_scm_t exp = NULL;
  int ch;
  char * buf = NULL;
  int buf_size = 0, buf_len = 0;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  for (;;)
    {
      if (buf_len >= buf_size)
	{
	  buf = zzz_realloc (buf, buf_size + 64, buf_size);
	  buf_size += 64;
	}
      if ((err = zzz_port_getc (port, &ch, result)) != RESULT_SUCCESS)
	{
	  zzz_free (buf, buf_size);
	  return err;
	}
      if (ch == EOF)
	{
	  if (buf_len == 0)
	    *result = zzz_cons (zzz_eof_object, zzz_eof_object);
	  else
	    *result = zzz_cons (zzz_make_string (buf, buf_len),
				zzz_eof_object);
	  zzz_free (buf, buf_size);
	  return RESULT_SUCCESS;
	} 
      else if (ch == '\n')
	{
	  *result = zzz_cons (zzz_make_string (buf, buf_len),
			      zzz_make_char (ch));
	  zzz_free (buf, buf_size);
	  return RESULT_SUCCESS;
	}
      else
	buf[buf_len++] = ch;
    }
  /* Not reached.  */
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  write-line
  (write-line obj [port]) => *unspecified*
  Write the object @var{obj} to the output port @var{port}, or the current
  output port if not specified.  Then terminate the current output line 
  with a newline character.
  doc:*/
#define FUNC_NAME "write-line"
static result_t
write_line_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t port,
		 zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  struct zzz_print_state display_print_state = {/*  0,  */0};
  result_t err;

  if (undefined_p (port))
    port = zzz_current_out_port;
  else
    CHECK_TYPE (2, port_p (port), zzz_port_type_name);
  if ((err = zzz_port_print (port, obj, &display_print_state, result)) !=
      RESULT_SUCCESS)
    return err;
  if ((err = zzz_port_putc ('\n', port, result)) != RESULT_SUCCESS)
    return err;
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  %read-delimited!
  (%read-delimited! delims buf gobble? [port start end]) => pair
  Read a delimited string into @var{buf} from @var{port}, using the
  current input port if not specified.  The string read is stored into
  @var{buf} from positions START to END, which default to 0 and the
  length of @var{buf}, respecively. Characters are read until any of
  the characters in the string @var{delims} is read.  When
  @var{gobble?}  is true, the terminating character is discarded,
  otherwise it is stored at the end of @var{buf}.  Returns a pair of
  the terminating character (or the end-of- file object) and the
  number of characters read and stored into @var{buf}.
  doc:*/
#define FUNC_NAME "%read-delimited!"
static result_t
sys_read_delimited_x_func (zzz_scm_t env, zzz_scm_t delims, zzz_scm_t buf,
			   zzz_scm_t gobble, zzz_scm_t port, zzz_scm_t start,
			   zzz_scm_t end, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  long j;
  char *cbuf;
  int c;
  char *cdelims;
  int num_delims;
  int start_idx;
  int end_idx;
  result_t err;

  CHECK_TYPE (1, string_p (delims), zzz_string_type_name);
  cdelims = string_val (delims);
  num_delims = string_len (delims);
  CHECK_TYPE (2, string_p (buf), zzz_string_type_name);
  if (ro_string_p (buf))
    {
      *result = zzz_make_wta_exception
	(zzz_make_list
	 (zzz_make_string (_("read-only string passed to `"), -1),
	  zzz_make_string (s_func_name, -1),
	  zzz_make_string ("'", -1),
	  NULL));
      return RESULT_EXCEPTION;
    }
  cbuf = string_val (buf);
  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (4, port_p (port), zzz_port_type_name);
  if (undefined_p (start))
    start_idx = 0;
  else
    {
      CHECK_TYPE (5, integer_val (start), zzz_integer_type_name);
      start_idx = integer_val (start);
      CHECK_RANGE (5, start_idx >= 0, _("integer greater than zero"));
    }
  if (undefined_p (end))
    end_idx = string_len (buf);
  else
    {
      CHECK_TYPE (6, integer_val (end), zzz_integer_type_name);
      end_idx = integer_val (end);
      CHECK_RANGE (6, end_idx <= (int) string_len (buf),
		   _("integer less or equal to buffer length"));
      CHECK_RANGE (6, start_idx <= end_idx,
		   _("integer greater or equal to start index"));
    }
  for (j = start_idx; j < end_idx; j++)
    {  
      int k;

      if ((err = zzz_port_getc (port, &c, result)) != RESULT_SUCCESS)
	return err;
      for (k = 0; k < num_delims; k++)
	{
	  if (cdelims[k] == c)
	    {
	      if (zzz_eq (gobble, zzz_false_value))
		{
		  if ((err = zzz_port_ungetc (c, port, result)) !=
		      RESULT_SUCCESS)
		    return err;
		}

	      *result = zzz_cons (zzz_make_char (c),
				  zzz_make_integer (j - start_idx));
	      return RESULT_SUCCESS;
	    }
	}
      if (c == EOF)
	{
	  *result = zzz_cons (zzz_eof_object, 
			      zzz_make_integer (j - start_idx));
	  return RESULT_SUCCESS;
	}
      cbuf[j] = c;
    }
  *result = zzz_cons (zzz_false_value, zzz_make_integer (j - start_idx));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  seek
  (seek port offset whence) => integer
  Move the file pointer of @var{port} to a new location, specified by
  @var{offset} and @var{whence}.  @var{whence} is any of
  @code{SEEK_CUR}, @code{SEEK_SET} or @code{SEEK_END}, like for the C
  library call fseek().
  doc:*/
#define FUNC_NAME "seek"
static result_t
seek_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t offset, zzz_scm_t whence,
	   zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;
  long ofs, whn;
  long rofs;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  CHECK_TYPE (2, integer_p (offset), zzz_integer_type_name);
  CHECK_TYPE (3, integer_p (whence), zzz_integer_type_name);
  ofs = integer_val (offset);
  whn = integer_val (whence);
  if ((err = zzz_port_seek (port, ofs, whn, &rofs, result)) != RESULT_SUCCESS)
    return err;
  *result = zzz_make_integer (rofs);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  ftell
  (ftell port) => integer
  Return the current file pointer position of @var{port}.
  doc:*/
#define FUNC_NAME "ftell"
static result_t
ftell_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;
  long rofs;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  if ((err = zzz_port_tell (port, &rofs, result)) != RESULT_SUCCESS)
    return err;
  *result = zzz_make_integer (rofs);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/* Open the file NAME with the mode given by MODE, and mark the
   returned port object for reading and/or writing, as indicated by
   READ and WRITE.  */
static zzz_scm_t
open_port (zzz_scm_t name, int flags, int mode, int read, int write)
{
  int file;
  zzz_scm_t res = NULL;

  if ((file = open (string_val (name), flags | O_BINARY, mode)) < 0)
    res = zzz_false_value;
  else
    res = zzz_make_fdport (file, read, write);
  return res;
}

/*:doc
  open-input-file
  (open-input-file filename) => port
  Open the file named @var{filename} for reading and return an input port for
  the file.  This may throw a @code{file-not-found} exception on error.
  doc:*/
#define FUNC_NAME "open-input-file"
static result_t
open_input_file_func (zzz_scm_t env, zzz_scm_t filename, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res;

  CHECK_TYPE (1, string_p (filename), zzz_string_type_name);
  CHECK_SAFE_FILENAME (1, filename, zzz_safe_filename_type_name);
  res = open_port (filename, O_RDONLY, 0, 1, 0);
  if (port_p (res))
    {
      *result = res;
      return RESULT_SUCCESS;
    }
  else
    {
      *result = zzz_make_exception (zzz_file_not_found_exception, filename);
      return RESULT_EXCEPTION;
    }
}
#undef FUNC_NAME

/*:doc
  open-output-file
  (open-output-file filename) => port
  Open the file named @var{filename} for writing and return an input port for
  the file.  This may throw a @code{file-creation} exception on error.
  doc:*/
#define FUNC_NAME "open-output-file"
static result_t
open_output_file_func (zzz_scm_t env, zzz_scm_t filename, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t res;

  CHECK_TYPE (1, string_p (filename), zzz_string_type_name);
  CHECK_SAFE_FILENAME (1, filename, zzz_safe_filename_type_name);
  res = open_port (filename, O_WRONLY | O_CREAT | O_TRUNC,
		   zzz_default_file_mode, 0, 1);
  if (port_p (res))
    {
      *result = res;
      return RESULT_SUCCESS;
    }
  else
    {
      *result = zzz_make_exception (zzz_file_creation_exception, filename);
      return RESULT_EXCEPTION;
    }
}
#undef FUNC_NAME

/*:doc
  close-port
  (close-port port) => *unspecified*
  Close the open port @var{port}.
  doc:*/
#define FUNC_NAME "close-port"
static result_t
close_port_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  if (port_open_p (port))
    {
      err = zzz_port_close (port, result);
      if (err == RESULT_SUCCESS)
	*result = zzz_unspecified;
      return err;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  close-input-port
  (close-input-port port) => *unspecified*
  Close the open input port @var{port}.
  doc:*/
#define FUNC_NAME "close-input-port"
static result_t
close_input_port_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  if (port_open_p (port))
    {
      err = zzz_port_close (port, result);
      if (err == RESULT_SUCCESS)
	*result = zzz_unspecified;
      return err;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  close-output-port
  (close-output-port port) => *unspecified*
  Close the open output port @var{port}.
  doc:*/
#define FUNC_NAME "close-output-port"
static result_t
close_output_port_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  if (port_open_p (port))
    {
      err = zzz_port_close (port, result);
      if (err == RESULT_SUCCESS)
	*result = zzz_unspecified;
      return err;
    }
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  port-closed?
  (port-closed? port) => boolean
  Return @code{#t} if @var{port} is a closed port, @code{#f} otherwise.
  doc:*/
#define FUNC_NAME "port-closed?"
static result_t
port_closed_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, port_p (obj), zzz_port_type_name);
  if (port_open_p (obj))
    *result = zzz_false_value;
  else
    *result = zzz_true_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  eof-object?
  (eof-object? obj) => boolean
  Return @code{#t} if @var{obj} is the end-of-file object.
  doc:*/
#define FUNC_NAME "eof-object?"
static result_t
eof_object_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (zzz_eq (obj, zzz_eof_object))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  input-port?
  (input-port? port) => boolean
  Return @code{#t} if @var{port} is open for input.
  doc:*/
#define FUNC_NAME "input-port?"
static result_t
input_port_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (port_p (obj))
    *result = port_read_p (obj) ? zzz_true_value : zzz_false_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  output-port?
  (output-port? port) => boolean
  Return @code{#t} if @var{port} is open for output.
  doc:*/
#define FUNC_NAME "output-port?"
static result_t
output_port_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (port_p (obj))
    *result = port_write_p (obj) ? zzz_true_value : zzz_false_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  force-output
  (force-output [port]) => *unspecified*
  Write all pending output of @var{port} to the underlying file descriptor.
  doc:*/
#define FUNC_NAME "force-output"
static result_t
force_output_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  result_t err;

  if (undefined_p (port))
    port = zzz_current_out_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  if ((err = zzz_port_flush (port, result)) != RESULT_SUCCESS)
    return err;
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  current-input-port
  (current-input-port) => port
  Return the current default port for input.
  doc:*/
#define FUNC_NAME "current-input-port"
static result_t
current_input_port_func (zzz_scm_t env, zzz_scm_t * result)
{
  *result = zzz_current_in_port;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  current-output-port
  (current-output-port) => port
  Return the current default port for output.
  doc:*/
#define FUNC_NAME "current-output-port"
static result_t
current_output_port_func (zzz_scm_t env, zzz_scm_t * result)
{
  *result = zzz_current_out_port;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  current-error-port
  (current-error-port) => port
  Return the current default port for error output.
  doc:*/
#define FUNC_NAME "current-error-port"
static result_t
current_error_port_func (zzz_scm_t env, zzz_scm_t * result)
{
  *result = zzz_current_err_port;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  set-current-input-port
  (set-current-input-port port) => *unspecified*
  Set the current input port to @var{port}.
  doc:*/
#define FUNC_NAME "set-current-input-port"
static result_t
set_current_input_port_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  zzz_current_in_port = port;
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  set-current-output-port
  (set-current-output-port port) => *unspecified*
  Set the current output port to @var{port}.
  doc:*/
#define FUNC_NAME "set-current-output-port"
static result_t
set_current_output_port_func (zzz_scm_t env, zzz_scm_t port,
			      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  zzz_current_out_port = port;
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  set-current-error-port
  (set-current-error-port port) => *unspecied*
  Set the error output port to @var{port}.
  doc:*/
#define FUNC_NAME "set-current-error-port"
static result_t
set_current_error_port_func (zzz_scm_t env, zzz_scm_t port,
			     zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  zzz_current_err_port = port;
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  call-with-input-file
  (call-with-input-file filename proc) => object
  Apply @var{proc} to an input port reading from @var{filename} and return
  the value returned by @var{proc}.
  doc:*/
#define FUNC_NAME "call-with-input-file"
static result_t
call_with_input_file_func (zzz_scm_t env, zzz_scm_t filename, zzz_scm_t proc,
			   zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t port, tmp;
  result_t err;

  CHECK_TYPE (1, string_p (filename), zzz_string_type_name);
  CHECK_SAFE_FILENAME (1, filename, zzz_safe_filename_type_name);
  CHECK_TYPE (2, procedure_p (proc), zzz_procedure_type_name);
  port = open_port (filename, O_RDONLY, 0, 1, 0);
  if (port_p (port))
    {
      err = zzz_apply (env, proc, zzz_cons (port, NULL), result);
      zzz_port_close (port, &tmp);
      return err;
    }
  else
    {
      *result = zzz_make_exception (zzz_file_not_found_exception, filename);
      return RESULT_EXCEPTION;
    }
}
#undef FUNC_NAME

/*:doc
  call-with-output-file
  (call-with-output-file filename proc) => object
  Apply @var{proc} to an output port writing to @var{filename} and return 
  the value returned by @var{proc}.
  doc:*/
#define FUNC_NAME "call-with-output-file"
static result_t
call_with_output_file_func (zzz_scm_t env, zzz_scm_t filename, zzz_scm_t proc,
			    zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t port, tmp;
  result_t err;

  CHECK_TYPE (1, string_p (filename), zzz_string_type_name);
  CHECK_SAFE_FILENAME (1, filename, zzz_safe_filename_type_name);
  CHECK_TYPE (2, procedure_p (proc), zzz_procedure_type_name);
  port = open_port (filename, O_WRONLY | O_CREAT | O_TRUNC,
		    zzz_default_file_mode, 0, 1);
  if (port_p (port))
    {
      err = zzz_apply (env, proc, zzz_cons (port, NULL), result);
      zzz_port_close (port, &tmp);
      return err;
    }
  else
    {
      *result = zzz_make_exception (zzz_file_creation_exception, filename);
      return RESULT_EXCEPTION;
    }
}
#undef FUNC_NAME

/*:doc
  with-input-from-file
  (with-input-from-file filename thunk)
  Call @var{thunk}, redirecting input ro read from the file called 
  @var{filename}. Return the value returned by @var{thunk}.
  doc:*/
#define FUNC_NAME "with-input-from-file"
static result_t
with_input_from_file_func (zzz_scm_t env, zzz_scm_t filename, zzz_scm_t thunk,
			   zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t port, tmp;
  zzz_scm_t old_in_port;
  result_t err;

  CHECK_TYPE (1, string_p (filename), zzz_string_type_name);
  CHECK_SAFE_FILENAME (1, filename, zzz_safe_filename_type_name);
  CHECK_TYPE (2, procedure_p (thunk), zzz_procedure_type_name);
  port = open_port (filename, O_RDONLY, 0, 1, 0);
  if (port_p (port))
    {
      old_in_port = zzz_current_in_port;
      zzz_current_in_port = port;
      err = zzz_apply (env, thunk, NULL, result);
      zzz_current_in_port = old_in_port;
      zzz_port_close (port, &tmp);
      return err;
    }
  else
    {
      *result = zzz_make_exception (zzz_file_not_found_exception, filename);
      return RESULT_EXCEPTION;
    }
}
#undef FUNC_NAME

/*:doc
  with-output-to-file
  (with-output-to-file filename thunk)
  Call @var{thunk}, redirecting output to the file called @var{filename}.  
  Return the value returned by @var{thunk}.
  doc:*/
#define FUNC_NAME "with-output-to-file"
static result_t
with_output_to_file_func (zzz_scm_t env, zzz_scm_t filename, zzz_scm_t thunk,
			  zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t port, tmp;
  zzz_scm_t old_out_port;
  result_t err;

  CHECK_TYPE (1, string_p (filename), zzz_string_type_name);
  CHECK_SAFE_FILENAME (1, filename, zzz_safe_filename_type_name);
  CHECK_TYPE (2, procedure_p (thunk), zzz_procedure_type_name);
  port = open_port (filename, O_WRONLY | O_CREAT | O_TRUNC,
		    zzz_default_file_mode, 0, 1);
  if (port_p (port))
    {
      old_out_port = zzz_current_out_port;
      zzz_current_out_port = port;
      err = zzz_apply (env, thunk, NULL, result);
      zzz_current_out_port = old_out_port;
      zzz_port_close (port, &tmp);
      return err;
    }
  else
    {
      *result = zzz_make_exception (zzz_file_creation_exception, filename);
      return RESULT_EXCEPTION;
    }
}
#undef FUNC_NAME

/*:doc
  with-error-to-file
  (with-error-to-file filename thunk)
  Call @var{thunk}, redirecting error output to the file called 
  @var{filename}. Return the value returned by @var{thunk}.
  doc:*/
#define FUNC_NAME "with-error-to-file"
static result_t
with_error_to_file_func (zzz_scm_t env, zzz_scm_t filename, zzz_scm_t thunk,
			 zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t port, tmp;
  zzz_scm_t old_err_port;
  result_t err;

  CHECK_TYPE (1, string_p (filename), zzz_string_type_name);
  CHECK_SAFE_FILENAME (1, filename, zzz_safe_filename_type_name);
  CHECK_TYPE (2, procedure_p (thunk), zzz_procedure_type_name);
  port = open_port (filename, O_WRONLY | O_CREAT | O_TRUNC,
		    zzz_default_file_mode, 0, 1);
  if (port_p (port))
    {
      old_err_port = zzz_current_err_port;
      zzz_current_err_port = port;
      err = zzz_apply (env, thunk, NULL, result);
      zzz_current_err_port = old_err_port;
      zzz_port_close (port, &tmp);
      return err;
    }
  else
    {
      *result = zzz_make_exception (zzz_file_creation_exception, filename);
      return RESULT_EXCEPTION;
    }
}
#undef FUNC_NAME

/*:doc
  call-with-input-string
  (call-with-input-string string proc) => object
  Apply @var{proc} to an input string port reading from @var{string} and
  return the value returned by @var{proc}.
  doc:*/
#define FUNC_NAME "call-with-input-string"
static result_t
call_with_input_string_func (zzz_scm_t env, zzz_scm_t string, zzz_scm_t proc,
			     zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t sport;

  CHECK_TYPE (1, string_p (string), zzz_string_type_name);
  CHECK_TYPE (1, procedure_p (proc), zzz_procedure_type_name);
  sport = zzz_make_sport_str_n (string_val (string), string_len (string));
  port_read_p (sport) = 1;
  return zzz_apply (env, proc, zzz_cons (sport, NULL), result);
}
#undef FUNC_NAME

/*:doc
  call-with-output-string
  (call-with-output-string string proc) => object
  Apply @var{proc} to an output string port and return the accumulated 
  string of output.
  doc:*/
#define FUNC_NAME "call-with-output-string"
static result_t
call_with_output_string_func (zzz_scm_t env, zzz_scm_t proc,
			      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t sport;
  result_t err;

  CHECK_TYPE (1, procedure_p (proc), zzz_procedure_type_name);
  sport = zzz_make_sport (32);
  if ((err = zzz_apply (env, proc, zzz_cons (sport, NULL), result)) !=
      RESULT_SUCCESS)
    return err;
  *result = zzz_make_string (sport_val (sport), sport_len (sport));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  with-input-from-string
  (with-input-from-string string thunk) => object
  Call @var{thunk}, redirecting input to read from a string port reading 
  from @var{string}. Return the value returned from @var{thunk}.
  doc:*/
#define FUNC_NAME "with-input-from-string"
static result_t
with_input_from_string_func (zzz_scm_t env, zzz_scm_t string, zzz_scm_t thunk,
			     zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t sport;
  zzz_scm_t old_in_port;
  result_t err;

  CHECK_TYPE (1, string_p (string), zzz_string_type_name);
  CHECK_TYPE (2, procedure_p (thunk), zzz_procedure_type_name);
  sport = zzz_make_sport_str_n (string_val (string), string_len (string));
  port_read_p (sport) = 1;
  old_in_port = zzz_current_in_port;
  zzz_current_in_port = sport;
  err = zzz_apply (env, thunk, NULL, result);
  zzz_current_in_port = old_in_port;
  return err;
}
#undef FUNC_NAME

/*:doc
  with-output-to-string
  (with-output-to-string thunk) => string
  Call @var{thunk}, redirecting output to a string port. Return the
  accumulated string.
  doc:*/
#define FUNC_NAME "with-output-to-string"
static result_t
with_output_to_string_func (zzz_scm_t env, zzz_scm_t thunk, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t sport;
  zzz_scm_t old_out_port;
  result_t err;

  CHECK_TYPE (1, procedure_p (thunk), zzz_procedure_type_name);
  sport = zzz_make_sport (32);
  old_out_port = zzz_current_out_port;
  zzz_current_out_port = sport;
  err = zzz_apply (env, thunk, NULL, result);
  zzz_current_out_port = old_out_port;
  if (err == RESULT_SUCCESS)
    *result = zzz_make_string (sport_val (sport), sport_len (sport));
  return err;
}
#undef FUNC_NAME

/*:doc
  with-error-to-string
  (with-error-to-string thunk) => string
  Call @var{thunk}, redirecting error output to a string port.  Return the 
  accumulated string.
  doc:*/
#define FUNC_NAME "with-error-to-string"
static result_t
with_error_to_string_func (zzz_scm_t env, zzz_scm_t thunk, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t sport;
  zzz_scm_t old_err_port;
  result_t err;

  CHECK_TYPE (1, procedure_p (thunk), zzz_procedure_type_name);
  sport = zzz_make_sport (32);
  old_err_port = zzz_current_err_port;
  zzz_current_err_port = sport;
  err = zzz_apply (env, thunk, NULL, result);
  zzz_current_err_port = old_err_port;
  if (err == RESULT_SUCCESS)
    *result = zzz_make_string (sport_val (sport), sport_len (sport));
  return err;
}
#undef FUNC_NAME

/*:doc
  with-input-from-port
  (with-input-from-port port thunk)
  Call @var{thunk}, redirecting input to read from @var{port}.  Return the 
  value returned by @var{thunk}.
  doc:*/
#define FUNC_NAME "with-input-from-port"
static result_t
with_input_from_port_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t thunk,
			   zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t old_in_port;
  result_t err;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  CHECK_TYPE (2, procedure_p (thunk), zzz_procedure_type_name);
  old_in_port = zzz_current_in_port;
  zzz_current_in_port = port;
  err = zzz_apply (env, thunk, NULL, result);
  zzz_current_in_port = old_in_port;
  return err;
}
#undef FUNC_NAME

/*:doc
  with-output-to-port
  (with-output-to-port port thunk)
  Call @var{thunk}, redirecting output to @var{port}.  Return the value 
  returned by @var{thunk}.
  doc:*/
#define FUNC_NAME "with-output-to-port"
static result_t
with_output_to_port_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t thunk,
			  zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t old_out_port;
  result_t err;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  CHECK_TYPE (2, procedure_p (thunk), zzz_procedure_type_name);
  old_out_port = zzz_current_out_port;
  zzz_current_out_port = port;
  err = zzz_apply (env, thunk, NULL, result);
  zzz_current_out_port = old_out_port;
  return err;
}
#undef FUNC_NAME

/*:doc
  with-error-to-port
  (with-error-to-port port thunk)
  Call @var{thunk}, redirecting error output to @var{port}.  Return the 
  value returned by @var{thunk}.
  doc:*/
#define FUNC_NAME "with-error-to-port"
static result_t
with_error_to_port_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t thunk,
			 zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t old_err_port;
  result_t err;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  CHECK_TYPE (2, procedure_p (thunk), zzz_procedure_type_name);
  old_err_port = zzz_current_err_port;
  zzz_current_err_port = port;
  err = zzz_apply (env, thunk, NULL, result);
  zzz_current_err_port = old_err_port;
  return err;
}
#undef FUNC_NAME

/*:doc
  port-line
  (port-line [port]) => integer
  Return the line number of @var{port}.  @var{port} defaults to the current 
  input port.
  doc:*/
#define FUNC_NAME "port-line"
static result_t
port_line_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  *result = zzz_make_integer (port_line_number (port));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  set-port-line!
  (set-port-line! port n) => *unspecified*
  Set the line number of @var{port} to @var{n}.
  doc:*/
#define FUNC_NAME "set-port-line!"
static result_t
set_port_line_x_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t n,
		      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  CHECK_TYPE (2, integer_p (n), zzz_integer_type_name);
  port_line_number (port) = integer_val (n);
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  port-column
  (port-column [port]) => integer
  Return the column number of @var{port}.  @var{port} defaults to the 
  current input port.
  doc:*/
#define FUNC_NAME "port-column"
static result_t
port_column_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  *result = zzz_make_integer (port_col_number (port));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  set-port-column!
  (set-port-column! port n) => *unspecified*
  Set the column number of @var{port} to @var{n}.
  doc:*/
#define FUNC_NAME "set-port-column!"
static result_t
set_port_column_x_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t n,
		      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  CHECK_TYPE (2, integer_p (n), zzz_integer_type_name);
  port_col_number (port) = integer_val (n);
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  port-filename
  (port-filename [port]) => string
  Return the filename of @var{port}.  @var{port} defaults to the current 
  input port.
  doc:*/
#define FUNC_NAME "port-filename"
static result_t
port_filename_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  *result = port_filename (port);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  set-port-filename!
  (set-port-filename! port filename) => *unspecified*
  Set the filename of @var{port} to @var{filename}.
  doc:*/
#define FUNC_NAME "set-port-filename!"
static result_t
set_port_filename_x_func (zzz_scm_t env, zzz_scm_t port, zzz_scm_t s,
		      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, port_p (port), zzz_port_type_name);
  CHECK_TYPE (2, string_p (s), zzz_string_type_name);
  port_filename (port) = s;
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  isatty?
  (isatty? [port]) => boolean
  Return @code{#t}, if @var{port} is a tty, @code{#f} otherwise.  @var{port}
  defaults to the current input port.
  doc:*/
#define FUNC_NAME "isatty?"
static result_t
isatty_p (zzz_scm_t env, zzz_scm_t port, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  if (undefined_p (port))
    port = zzz_current_in_port;
  else
    CHECK_TYPE (1, port_p (port), zzz_port_type_name);

  *result = zzz_make_bool (port_tty_p (port));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  object->string
  (object->string obj) => string
  Return a string with the characters @code{display} would produce
  when printing @var{obj}.
  doc:*/
#define FUNC_NAME "object->string"
static result_t
object_to_string (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t port;
  result_t err;

  port = zzz_make_sport (32);
  if ((err = display_func (env, obj, port, result)) != RESULT_SUCCESS)
    return err;
  *result = zzz_make_string (sport_val (port), sport_len (port));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

result_t
zzz_init_iofun (void)
{
  /*:doc
    SEEK_SET
    Constant
    To be used in calls to @code{seek}.  Moves the file pointer to an absolut 
    offset.
    doc:*/
  zzz_define_constant ("SEEK_SET", zzz_make_integer (SEEK_SET));
  /*:doc
    SEEK_CUR
    Constant
    To be used in calls to @code{seek}.  Moves the file pointer relatively to
    the current position.
    doc:*/
  zzz_define_constant ("SEEK_CUR", zzz_make_integer (SEEK_CUR));
  /*:doc
    SEEK_END
    Constant
    To be used in calls to @code{seek}.  Moves the file pointer relatively to
    the end offset of the file.
    doc:*/
  zzz_define_constant ("SEEK_END", zzz_make_integer (SEEK_END));

  /*:doc
    file-not-found
    Exception
    Thrown when a specified file name could not be found.
    doc:*/
  zzz_protect_global (&zzz_file_not_found_exception);
  zzz_file_not_found_exception = zzz_make_symbol ("file-not-found", -1);
  /*:doc
    file-creation
    Exception
    Thrown when a specified file could not be created.
    doc:*/
  zzz_protect_global (&zzz_file_creation_exception);
  zzz_file_creation_exception = zzz_make_symbol ("file-creation", -1);

  zzz_define_function ("display", (zzz_prim_t) display_func, argv_1_1_0);
  zzz_define_function ("write", (zzz_prim_t) write_func, argv_1_1_0);
  zzz_define_function ("write-char", (zzz_prim_t) write_char_func, argv_1_1_0);
  zzz_define_function ("newline", (zzz_prim_t) newline_func, argv_0_1_0);
  zzz_define_function ("read", (zzz_prim_t) read_func, argv_0_1_0);
  zzz_define_function ("read-char", (zzz_prim_t) read_char_func, argv_0_1_0);
  zzz_define_function ("unread-char", (zzz_prim_t) unread_char_func,
		       argv_1_1_0);
  zzz_define_function ("peek-char", (zzz_prim_t) peek_char_func, argv_0_1_0);
  zzz_define_function ("%read-line", (zzz_prim_t) sys_read_line_func,
		       argv_0_1_0);
  zzz_define_function ("seek", (zzz_prim_t) seek_func, argv_3_0_0);
  zzz_define_function ("ftell", (zzz_prim_t) ftell_func, argv_1_0_0);
  zzz_define_function ("open-input-file", (zzz_prim_t) open_input_file_func,
		       argv_1_0_0);
  zzz_define_function ("open-output-file", (zzz_prim_t) open_output_file_func,
		       argv_1_0_0);
  zzz_define_function ("close-port", (zzz_prim_t) close_port_func, argv_1_0_0);
  zzz_define_function ("close-input-port", (zzz_prim_t) close_input_port_func,
		       argv_1_0_0);
  zzz_define_function ("close-output-port",
		       (zzz_prim_t) close_output_port_func, argv_1_0_0);
  zzz_define_function ("force-output", (zzz_prim_t) force_output_func,
		       argv_0_1_0);
  zzz_define_function ("current-input-port",
		       (zzz_prim_t) current_input_port_func, argv_0_0_0);
  zzz_define_function ("current-output-port",
		       (zzz_prim_t) current_output_port_func, argv_0_0_0);
  zzz_define_function ("current-error-port",
		       (zzz_prim_t) current_error_port_func, argv_0_0_0);
  zzz_define_function ("set-current-input-port",
		       (zzz_prim_t) set_current_input_port_func, argv_1_0_0);
  zzz_define_function ("set-current-output-port",
		       (zzz_prim_t) set_current_output_port_func, argv_1_0_0);
  zzz_define_function ("set-current-error-port",
		       (zzz_prim_t) set_current_error_port_func, argv_1_0_0);
  zzz_define_function ("port-closed?", (zzz_prim_t) port_closed_p_func,
		       argv_1_0_0);
  zzz_define_function ("eof-object?", (zzz_prim_t) eof_object_p_func,
		       argv_1_0_0);
  zzz_define_function ("input-port?", (zzz_prim_t) input_port_p_func,
		       argv_1_0_0);
  zzz_define_function ("output-port?", (zzz_prim_t) output_port_p_func,
		       argv_1_0_0);
  zzz_define_function ("call-with-input-file",
		       (zzz_prim_t) call_with_input_file_func, argv_2_0_0);
  zzz_define_function ("call-with-output-file",
		       (zzz_prim_t) call_with_output_file_func, argv_2_0_0);
  zzz_define_function ("with-input-from-file",
		       (zzz_prim_t) with_input_from_file_func, argv_2_0_0);
  zzz_define_function ("with-output-to-file",
		       (zzz_prim_t) with_output_to_file_func, argv_2_0_0);
  zzz_define_function ("with-error-to-file",
		       (zzz_prim_t) with_error_to_file_func, argv_2_0_0);
  zzz_define_function ("call-with-input-string",
		       (zzz_prim_t) call_with_input_string_func, argv_2_0_0);
  zzz_define_function ("call-with-output-string",
		       (zzz_prim_t) call_with_output_string_func, argv_1_0_0);
  zzz_define_function ("with-input-from-string",
		       (zzz_prim_t) with_input_from_string_func, argv_2_0_0);
  zzz_define_function ("with-output-to-string",
		       (zzz_prim_t) with_output_to_string_func, argv_1_0_0);
  zzz_define_function ("with-error-to-string",
		       (zzz_prim_t) with_error_to_string_func, argv_1_0_0);
  zzz_define_function ("with-output-to-port",
		       (zzz_prim_t) with_output_to_port_func, argv_2_0_0);
  zzz_define_function ("with-error-to-port",
		       (zzz_prim_t) with_error_to_port_func, argv_2_0_0);
  zzz_define_function ("with-input-from-port",
		       (zzz_prim_t) with_input_from_port_func, argv_2_0_0);
  zzz_define_function ("char-ready?", (zzz_prim_t) char_ready_p_func,
		       argv_0_1_0);
  zzz_define_function ("port-line", (zzz_prim_t) port_line_func, argv_0_1_0);
  zzz_define_function ("set-port-line!",
		       (zzz_prim_t) set_port_line_x_func, argv_2_0_0);
  zzz_define_function ("port-column", (zzz_prim_t) port_column_func,
		       argv_0_1_0);
  zzz_define_function ("set-port-column!",
		       (zzz_prim_t) set_port_column_x_func, argv_2_0_0);
  zzz_define_function ("port-filename", (zzz_prim_t) port_filename_func,
		       argv_0_1_0);
  zzz_define_function ("set-port-filename!",
		       (zzz_prim_t) set_port_filename_x_func, argv_2_0_0);
  zzz_define_function ("%read-delimited!",
		       (zzz_prim_t) sys_read_delimited_x_func, argv_3_3_0);
  zzz_define_function ("write-line", (zzz_prim_t) write_line_func, argv_1_1_0);
  zzz_define_function ("isatty?", (zzz_prim_t) isatty_p, argv_0_1_0);
  zzz_define_function ("object->string", (zzz_prim_t) object_to_string,
		       argv_1_0_0);
  return RESULT_SUCCESS;
}
