/*
** io.ops
*/

VERSION = PARROT_VERSION;

=head1 NAME

io.ops

=cut

=head1 DESCRIPTION

Parrot's IO API

=cut


###############################################################################

=head2 Parrot IO API Operations


=over 4

=cut


########################################

=item B<close>(in PMC)

Close IO object $1

=cut

inline op close(in PMC) {
  PIO_close(interpreter, $1);
  goto NEXT();
}

########################################

=item B<fdopen>(out PMC, in INT, in STR)

Create ParrotIO object as $1 as a copy of file descriptor $2.

XXX: integral file descriptors may not exist outside of the UNIX
     platform.  This op needs work.

=cut

inline op fdopen(out PMC, in INT, in STR) {
  /* These char * need to go away soon */
  const char * mode;
  mode = string_to_cstring(interpreter, $3);

  $1 = PIO_fdopen(interpreter, $2, mode);
  if (!$1) {
    $1 = pmc_new(interpreter, enum_class_PerlUndef);
  }
  /* string_cstring_free(mode); */
  /* TODO all results from string_to_cstring() need freeing
     but this generates ugly warnings WRT discarding the const
     qualifier -lt
   */
  goto NEXT();
}

=item B<getfd>(out INT, in PMC)

Get the file descriptor out of the ParrotIO object $2 and store it in $1

XXX: integral file descriptors may not exist outside of the UNIX
     platform.

=cut

inline op getfd(out INT, in PMC) {
  $1 = (INTVAL)PIO_getfd(interpreter, $2);
  goto NEXT();
}

=item B<getstdin>(out PMC)

Create a new ParrotIO object for the stdin file descriptor and
store it in $1

=item B<getstdout>(out PMC)

Create a new ParrotIO object for the stdout file descriptor and
store it in $1

=item B<getstderr>(out PMC)

Create a new ParrotIO object for the stderr file descriptor and
store it in $1

=cut

inline op getstdin(out PMC) {
  $1 = PIO_STDIN(interpreter);
  goto NEXT();
}

inline op getstdout(out PMC) {
  $1 = PIO_STDOUT(interpreter);
  goto NEXT();
}

inline op getstderr(out PMC) {
  $1 = PIO_STDERR(interpreter);
  goto NEXT();
}

#########################################

=item B<open>(out PMC, in STR, in STR)

Open URL (file, address, database, in core image) named $2 with
Perl style mode string in $3 and create an IO object in $1.

=item B<open>(out PMC, in STR)

Open URL (file, address, database, in core image) named $2 with
read/write mode and create an IO object in $1.

=cut

inline op open(out PMC, in STR, in STR) {
  /* These char * need to go away soon */
  const char * path, * mode;

  path = string_to_cstring(interpreter, $2);
  mode = string_to_cstring(interpreter, $3);

  $1 = PIO_open(interpreter, path, mode);
  /* string_cstring_free(mode); */
  /* string_cstring_free(path); */
  if(!$1) {
    $1 = pmc_new(interpreter, enum_class_PerlUndef);
  }
  goto NEXT();
}

inline op open(out PMC, in STR) {
  /* These char * need to go away soon */
  const char * path;

  path = string_to_cstring(interpreter, $2);

  $1 = PIO_open(interpreter, path, "+<");
  /* string_cstring_free(path); */
  if(!$1) {
    $1 = pmc_new(interpreter, enum_class_PerlUndef);
  }
  goto NEXT();
}

########################################

=item B<print>(in INT)

=item B<print>(in NUM)

=item B<print>(in PMC)

=item B<print>(in STR)

Print $1 to standard output.

=cut

inline op print(in INT) {
  PIO_printf(interpreter, INTVAL_FMT, (INTVAL)$1);
  goto NEXT();
}

inline op print(in NUM) {
  PIO_printf(interpreter, "%f", (double)$1);
  goto NEXT();
}

op print(in STR) {
  STRING *s = $1;
  if (s && string_length(s)) {
    PIO_putps(interpreter, PIO_STDOUT(interpreter), s);
  }
  goto NEXT();
}

op print(in PMC) {
  PMC *p = $1;
  STRING *s = (VTABLE_get_string(interpreter, p));
  if (s) {
    PIO_putps(interpreter, PIO_STDOUT(interpreter), s);
  }
  goto NEXT();
}

op write(in PMC) {
  PMC *p = $1;
  STRING *s = (VTABLE_get_string(interpreter, p));
  if (s) {
    PIO_write(interpreter, PIO_STDOUT(interpreter), s->strstart, s->bufused);
  }
  goto NEXT();
}
##########################################

=item B<printerr>(in INT)

=item B<printerr>(in NUM)

=item B<printerr>(in STR)

=item B<printerr>(in PMC)

Print $1 to standard error.

=cut

op printerr(in INT) {
  PIO_eprintf(interpreter, INTVAL_FMT, $1);
  goto NEXT();
}

op printerr(in NUM) {
  PIO_eprintf(interpreter, "%f", (double)$1);
  goto NEXT();
}

op printerr(in STR) {
  STRING *s = $1;
  if (s && string_length(s)) {
    PIO_putps(interpreter, PIO_STDERR(interpreter), s);
  }
  goto NEXT();
}

op printerr(in PMC) {
  PMC *p = $1;
  STRING *s = (VTABLE_get_string(interpreter, p));
  if (s) {
    PIO_putps(interpreter, PIO_STDOUT(interpreter), s);
  }
  goto NEXT();
}

##########################################

=item B<print>(in PMC, in INT)

=item B<print>(in PMC, in NUM)

=item B<print>(in PMC, in STR)

=item B<print>(in PMC, in PMC)

Print $2 on the IO stream object $1.

=cut

op print(in PMC, in INT) {
  if ($1) {
    STRING *s = Parrot_sprintf_c(interpreter, INTVAL_FMT, $2);
    PIO_putps(interpreter, $1, s);
  }
  else {
    /* Handle error here */
  }
  goto NEXT();
}

op print(in PMC, in NUM) {
  if ($1) {
    STRING *s = Parrot_sprintf_c(interpreter, "%f", (double)$2);
    PIO_putps(interpreter, $1, s);
  }
  else {
    /* Handle error here */
  }
  goto NEXT();
}

op print(in PMC, in STR) {
  if ($2 && $1) {
    PIO_putps(interpreter, $1, $2);
  }
  else {
    /* Handle error here */
  }
  goto NEXT();
}

op print(in PMC, in PMC) {
  if ($2 && $1) {
    STRING *s = VTABLE_get_string(interpreter, $2);
    PIO_putps(interpreter, $1, s);
  }
  else {
    /* Handle error here */
  }
  goto NEXT();
}

##########################################

=item B<read>(out STR, in INT)

Read up to N bytes from standard input stream
If stream is linebuffered, will return at EOL, for
files it will read MIN(MAX(avail, N), 65535) bytes.
Warning: This is a quick hack.

=item B<read>(out STR, in PMC, in INT)

Read up to N bytes from IO PMC stream.
If stream is linebuffered, will return at EOL, for
files it will read MIN(MAX(avail, N), 65535) bytes.
Warning: This is a quick hack.

=cut

op read(out STR, in INT) {
  UINTVAL n;
  INTVAL nr;
  if($2 >= 65535)
    n = 65535;
  else
    n = $2;
  $1 = string_make(interpreter, NULL, n, NULL, 0, NULL);
  memset(($1)->strstart, 0, n);
  nr = PIO_read(interpreter, PIO_STDIN(interpreter),
                ($1)->strstart, (size_t)n);
  if(nr > 0)
    ($1)->strlen = ($1)->bufused = nr;
  else
    ($1)->strlen = ($1)->bufused = 0;
  goto NEXT();
}

op read(out STR, in PMC, in INT) {
  UINTVAL n;
  INTVAL nr;
  if($3 >= 65535)
    n = 65535;
  else
    n = $3;
  $1 = string_make(interpreter, NULL, n, NULL, 0, NULL);
  memset(($1)->strstart, 0, n);
  nr = PIO_read(interpreter, $2, ($1)->strstart, (size_t)n);
  if(nr > 0)
    ($1)->strlen = ($1)->bufused = nr;
  else
    ($1)->strlen = ($1)->bufused = 0;
  goto NEXT();
}

=item B<readline>(out STR, in PMC)

Read a line up to EOL from filehandle $2.
This switches the filehandle to linebuffer-mode.

If for some reason the line's longer than 64K you get only 64K

=cut

inline op readline(out STR, in PMC) {
  size_t len = 0;
  opcode_t * resume = expr NEXT();
  /* experimental error handling, mainly for t/pmc/io_5.pasm */
  int ok = VTABLE_get_bool(interpreter, $2);
  if (!ok)
      real_exception(interpreter, resume, PIO_ERROR,
          "File not found");
  $1 = string_make(interpreter, NULL, 65535, NULL, 0, NULL);
  memset(($1)->strstart, 0, 65535);

  if ($2) {
    PIO_setlinebuf(interpreter, $2);
    len = PIO_read(interpreter, $2, ($1)->strstart, 65534);
    ($1)->strlen = ($1)->bufused = len;
  }
  goto NEXT();
}

##########################################

=item B<seek>(in PMC, in INT, in INT)

seek:
Set file position to offset $2 on IO stream $1. 'whence' is
indicated by the value in $3.

=item B<seek>(in PMC, in INT, in INT, in INT)

64bit seek:
Set file position to offset ($2 << 32 | $3) on IO stream $1. 'whence' is
indicated by the value in $4. This allows 64-bit seeks with only 32-bit
INTVALS.

=cut

op seek(in PMC, in INT, in INT) {
  if ($1) {
    if (PIO_seek(interpreter, $1, PIO_make_offset($2), $3) < 0) {
      /* XXX: seek error */
    }
  }
  goto NEXT();
}

op seek(in PMC, in INT, in INT, in INT) {
  if ($1) {
    if (PIO_seek(interpreter, $1, PIO_make_offset32($2, $3), $4) < 0) {
      /* XXX: seek error */
    }
  }
  goto NEXT();
}

=item B<tell>(out INT, in PMC)

tell:
Get the current file position of stream $2 and store it in $1.
On systems where INTVAL is 32bit the result will be truncated if the
position is beyond 2 GiB

=item B<tell>(out INT, out INT, in PMC)

64bit tell:
Get the current file positon of stream $3 in two parts of 32-bit each
($1 = pos >> 32, $2 = pos & 0xffffffff).

=cut

op tell(out INT, in PMC) {
  if ($2) {
    $1 = (INTVAL)PIO_tell(interpreter, $2);
  }
  goto NEXT();
}

op tell(out INT, out INT, in PMC) {
  if ($3) {
    PIOOFF_T pos;
    pos = PIO_tell(interpreter, $3);
    $1 = (INTVAL)(pos >> 32);
    $2 = (INTVAL)(pos & 0xffffffff);
  }
  goto NEXT();
}

########################################

=back

=cut


###############################################################################

=head1 COPYRIGHT

Copyright (C) 2001-2003 The Perl Foundation.  All rights reserved.

=head1 LICENSE

This program is free software. It is subject to the same license
as the Parrot interpreter itself.

=cut

