/* Copyright (C) 2001-2021 Artifex Software, Inc.

   All Rights Reserved.

   This software is provided AS-IS with no warranty, either express or

   implied.

   This software is distributed under license and may not be copied,

   modified or distributed except as expressly authorized under the terms

   of the license contained in the file LICENSE in this distribution.

   Refer to licensing information at http://www.artifex.com or contact

   Artifex Software, Inc.,  1305 Grant Avenue - Suite 200, Novato,

   CA 94945, U.S.A., +1(415)492-9861, for further information.

*/

/* File I/O operators */

#include "memory_.h"

#include "ghost.h"

#include "gp.h"

#include "oper.h"

#include "stream.h"

#include "files.h"

#include "store.h"

#include "strimpl.h"    /* for ifilter.h */

#include "ifilter.h"    /* for procedure streams */

#include "interp.h"   /* for gs_errorinfo_put_string */

#include "gsmatrix.h"   /* for gxdevice.h */

#include "gxdevice.h"

#include "gxdevmem.h"

#include "estack.h"

#include "gsstate.h"

/* Forward references */

static int write_string(ref *, stream *);

static int handle_read_status(i_ctx_t *, int, const ref *, const uint *,

                               op_proc_t);

static int handle_write_status(i_ctx_t *, int, const ref *, const uint *,

                                op_proc_t);

/* ------ Operators ------ */

/* <file> closefile - */

int

zclosefile(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    check_type(*op, t_file);

    if (file_is_valid(s, op)) { /* closing a closed file is a no-op */

        int status = sclose(s);

        if (status != 0 && status != EOFC) {

            if (s_is_writing(s))

                return handle_write_status(i_ctx_p, status, op, NULL,

                                           zclosefile);

            else

                return handle_read_status(i_ctx_p, status, op, NULL,

                                          zclosefile);

        }

    }

    pop(1);

    return 0;

}

/* <file> read <int> -true- */

/* <file> read -false- */

static int

zread(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    int ch;

    check_read_file(i_ctx_p, s, op);

    /* We 'push' first in case of ostack block overflow and the */

    /* usual case is we will need to push anyway. If we get EOF */

    /* we will need to 'pop' and decrement the 'op' pointer.    */

    /* This is required since the 'push' macro might return with*/

    /* stackoverflow which will result in another stack block   */

    /* added on, then the operator being retried. We can't read */

    /* (sgetc) prior to having a place on the ostack to return  */

    /* the character.           */

    push(1);

    ch = sgetc(s);

    if (ch >= 0) {

        make_int(op - 1, ch);

        make_bool(op, 1);

    } else {

        pop(1);    /* Adjust ostack back from preparatory 'pop' */

        op--;

        if (ch == EOFC)

        make_bool(op, 0);

    else

        return handle_read_status(i_ctx_p, ch, op, NULL, zread);

    }

    return 0;

}

/* <file> <int> write - */

int

zwrite(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    byte ch;

    int status;

    check_write_file(s, op - 1);

    check_type(*op, t_integer);

    ch = (byte) op->value.intval;

    status = sputc(s, (byte) ch);

    if (status >= 0) {

        pop(2);

        return 0;

    }

    return handle_write_status(i_ctx_p, status, op - 1, NULL, zwrite);

}

/* <file> <string> readhexstring <substring> <filled_bool> */

static int zreadhexstring_continue(i_ctx_t *);

/* We pack the odd digit above the the current position for the  */

/* convenience of reusing procedures that take 1 state parameter */

static int

zreadhexstring_at(i_ctx_t *i_ctx_p, os_ptr op, uint start, int odd)

{

    stream *s;

    uint len, nread;

    byte *str;

    int odd_byte = odd;

    stream_cursor_write cw;

    int status;

    check_read_file(i_ctx_p, s, op - 1);

    /*check_write_type(*op, t_string); *//* done by caller */

    str = op->value.bytes;

    len = r_size(op);

    cw.ptr = str + start - 1;

    cw.limit = str + len - 1;

    for (;;) {

        status = s_hex_process(&s->cursor.r, &cw, &odd_byte,

                               hex_ignore_garbage);

        if (status == 1) { /* filled the string */

            ref_assign_inline(op - 1, op);

            make_true(op);

            return 0;

        } else if (status != 0)  /* error or EOF */

            break;

        /* Didn't fill, keep going. */

        status = spgetc(s);

        if (status < 0)

            break;

        sputback(s);

    }

    nread = cw.ptr + 1 - str;

    if (status != EOFC) { /* Error */

        nread |= ((uchar)odd_byte) << 24;

        return handle_read_status(i_ctx_p, status, op - 1, &nread,

                                  zreadhexstring_continue);

    }

    /* Reached end-of-file before filling the string. */

    /* Return an appropriate substring. */

    ref_assign_inline(op - 1, op);

    r_set_size(op - 1, nread);

    make_false(op);

    return 0;

}

static int

zreadhexstring(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    check_write_type(*op, t_string);

    return zreadhexstring_at(i_ctx_p, op, 0, -1);

}

/* Continue a readhexstring operation after a callout. */

/* *op contains the index within the string and the odd flag. */

static int

zreadhexstring_continue(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    int code, length, odd;

    check_type(*op, t_integer);

    length = op->value.intval & 0xFFFFFF;

    odd = (schar)(op->value.intval >> 24);

    if (length > r_size(op - 1) || odd < -1 || odd > 0xF)

        return_error(gs_error_rangecheck);

    check_write_type(op[-1], t_string);

    code = zreadhexstring_at(i_ctx_p, op - 1, (uint)length, odd);

    if (code >= 0)

        pop(1);

    return code;

}

/* <file> <string> writehexstring - */

static int zwritehexstring_continue(i_ctx_t *);

static int

zwritehexstring_at(i_ctx_t *i_ctx_p, os_ptr op, uint odd)

{

    register stream *s;

    register byte ch;

    register const byte *p;

    register const char *const hex_digits = "0123456789abcdef";

    register uint len;

    int status;

#define MAX_HEX 128

    byte buf[MAX_HEX];

    check_write_file(s, op - 1);

    check_read_type(*op, t_string);

    p = op->value.bytes;

    len = r_size(op);

    while (len) {

        uint len1 = min(len, MAX_HEX / 2);

        register byte *q = buf;

        uint count = len1;

        ref rbuf;

        do {

            ch = *p++;

            *q++ = hex_digits[ch >> 4];

            *q++ = hex_digits[ch & 0xf];

        }

        while (--count);

        r_set_size(&rbuf, (len1 << 1) - odd);

        rbuf.value.bytes = buf + odd;

        status = write_string(&rbuf, s);

        switch (status) {

            default:

                return_error(gs_error_ioerror);

            case 0:

                len -= len1;

                odd = 0;

                continue;

            case INTC:

            case CALLC:

                count = rbuf.value.bytes - buf;

                op->value.bytes += count >> 1;

                r_set_size(op, len - (count >> 1));

                count &= 1;

                return handle_write_status(i_ctx_p, status, op - 1, &count,

                                           zwritehexstring_continue);

        }

    }

    pop(2);

    return 0;

#undef MAX_HEX

}

static int

zwritehexstring(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    return zwritehexstring_at(i_ctx_p, op, 0);

}

/* Continue a writehexstring operation after a callout. */

/* *op is the odd/even hex digit flag for the first byte. */

static int

zwritehexstring_continue(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    int code;

    check_type(*op, t_integer);

    if ((op->value.intval & ~1) != 0)

        return_error(gs_error_rangecheck);

    code = zwritehexstring_at(i_ctx_p, op - 1, (uint) op->value.intval);

    if (code >= 0)

        pop(1);

    return code;

}

/* <file> <string> readstring <substring> <filled_bool> */

static int zreadstring_continue(i_ctx_t *);

static int

zreadstring_at(i_ctx_t *i_ctx_p, os_ptr op, uint start)

{

    stream *s;

    uint len, rlen;

    int status;

    check_write_type(*op, t_string);

    check_read_file(i_ctx_p, s, op - 1);

    len = r_size(op);

    status = sgets(s, op->value.bytes + start, len - start, &rlen);

    rlen += start;

    switch (status) {

        case EOFC:

        case 0:

            break;

        default:

            return handle_read_status(i_ctx_p, status, op - 1, &rlen,

                                      zreadstring_continue);

    }

    /*

     * The most recent Adobe specification says that readstring

     * must signal a rangecheck if the string length is zero.

     * I can't imagine the motivation for this, but we emulate it.

     * It's safe to check it here, rather than earlier, because if

     * len is zero, sgets will return 0 immediately with rlen = 0.

     */

    if (len == 0)

        return_error(gs_error_rangecheck);

    r_set_size(op, rlen);

    op[-1] = *op;

    make_bool(op, (rlen == len ? 1 : 0));

    return 0;

}

static int

zreadstring(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    return zreadstring_at(i_ctx_p, op, 0);

}

/* Continue a readstring operation after a callout. */

/* *op is the index within the string. */

static int

zreadstring_continue(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    int code;

    check_type(*op, t_integer);

    if (op->value.intval < 0 || op->value.intval > r_size(op - 1))

        return_error(gs_error_rangecheck);

    code = zreadstring_at(i_ctx_p, op - 1, (uint) op->value.intval);

    if (code >= 0)

        pop(1);

    return code;

}

/* <file> <string> writestring - */

static int

zwritestring(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    int status;

    check_write_file(s, op - 1);

    check_read_type(*op, t_string);

    status = write_string(op, s);

    if (status >= 0) {

        pop(2);

        return 0;

    }

    return handle_write_status(i_ctx_p, status, op - 1, NULL, zwritestring);

}

/* <file> <string> readline <substring> <bool> */

static int zreadline(i_ctx_t *);

static int zreadline_continue(i_ctx_t *);

/*

 * We could handle readline the same way as readstring,

 * except for the anomalous situation where we get interrupted

 * between the CR and the LF of an end-of-line marker.

 * We hack around this in the following way: if we get interrupted

 * before we've read any characters, we just restart the readline;

 * if we get interrupted at any other time, we use readline_continue;

 * we use start=0 (which we have just ruled out as a possible start value

 * for readline_continue) to indicate interruption after the CR.

 */

static int

zreadline_at(i_ctx_t *i_ctx_p, os_ptr op, uint count, bool in_eol)

{

    stream *s;

    int status;

    gs_string str;

    check_write_type(*op, t_string);

    check_read_file(i_ctx_p, s, op - 1);

    str.data = op->value.bytes;

    str.size = r_size(op);

    status = zreadline_from(s, &str, NULL, &count, &in_eol);

    switch (status) {

        case 0:

        case EOFC:

            break;

        case 1:

            return_error(gs_error_rangecheck);

        default:

            if (count == 0 && !in_eol)

                return handle_read_status(i_ctx_p, status, op - 1, NULL,

                                          zreadline);

            else {

                if (in_eol) {

                    r_set_size(op, count);

                    count = 0;

                }

                return handle_read_status(i_ctx_p, status, op - 1, &count,

                                          zreadline_continue);

            }

    }

    r_set_size(op, count);

    op[-1] = *op;

    make_bool(op, status == 0);

    return 0;

}

static int

zreadline(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    return zreadline_at(i_ctx_p, op, 0, false);

}

/* Continue a readline operation after a callout. */

/* *op is the index within the string, or 0 for an interrupt after a CR. */

static int

zreadline_continue(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    uint size = r_size(op - 1);

    uint start;

    int code;

    check_type(*op, t_integer);

    if (op->value.intval < 0 || op->value.intval > size)

        return_error(gs_error_rangecheck);

    start = (uint) op->value.intval;

    code = (start == 0 ? zreadline_at(i_ctx_p, op - 1, size, true) :

            zreadline_at(i_ctx_p, op - 1, start, false));

    if (code >= 0)

        pop(1);

    return code;

}

/* Internal readline routine. */

/* Returns a stream status value, or 1 if we overflowed the string. */

/* This is exported for %lineedit. */

int

zreadline_from(stream *s, gs_string *buf, gs_memory_t *bufmem,

               uint *pcount, bool *pin_eol)

{

    sreadline_proc((*readline));

    if (zis_stdin(s))

        readline = gp_readline;

    else

        readline = sreadline;

    return readline(s, NULL, NULL /*WRONG*/, NULL, buf, bufmem,

                    pcount, pin_eol, zis_stdin);

}

/* <file> bytesavailable <int> */

static int

zbytesavailable(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    gs_offset_t avail;

    check_read_file(i_ctx_p, s, op);

    switch (savailable(s, &avail)) {

        default:

            return_error(gs_error_ioerror);

        case EOFC:

            avail = -1;

        case 0:

            ;

    }

    if (gs_currentcpsimode(imemory)) {

        avail = (ps_int32)avail;

    }

    make_int(op, avail);

    return 0;

}

/* - flush - */

int

zflush(i_ctx_t *i_ctx_p)

{

    stream *s;

    int status;

    ref rstdout;

    int code = zget_stdout(i_ctx_p, &s);

    if (code < 0)

        return code;

    make_stream_file(&rstdout, s, "w");

    status = sflush(s);

    if (status == 0 || status == EOFC) {

        return 0;

    }

    return

        (s_is_writing(s) ?

         handle_write_status(i_ctx_p, status, &rstdout, NULL, zflush) :

         handle_read_status(i_ctx_p, status, &rstdout, NULL, zflush));

}

/* <file> flushfile - */

static int

zflushfile(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    int status;

    check_type(*op, t_file);

    /*

     * We think flushfile is a no-op on closed input files, but causes an

     * error on closed output files.

     */

    if (file_is_invalid(s, op)) {

        if (r_has_attr(op, a_write))

            return_error(gs_error_invalidaccess);

        pop(1);

        return 0;

    }

    status = sflush(s);

    if (status == 0 || status == EOFC) {

        pop(1);

        return 0;

    }

    return

        (s_is_writing(s) ?

         handle_write_status(i_ctx_p, status, op, NULL, zflushfile) :

         handle_read_status(i_ctx_p, status, op, NULL, zflushfile));

}

/* <file> resetfile - */

static int

zresetfile(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    /* According to Adobe, resetfile is a no-op on closed files. */

    check_type(*op, t_file);

    if (file_is_valid(s, op))

        sreset(s);

    pop(1);

    return 0;

}

/* <string> print - */

static int

zprint(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    int status;

    ref rstdout;

    int code;

    check_read_type(*op, t_string);

    code = zget_stdout(i_ctx_p, &s);

    if (code < 0)

        return code;

    status = write_string(op, s);

    if (status >= 0) {

        pop(1);

        return 0;

    }

    /* Convert print to writestring on the fly. */

    make_stream_file(&rstdout, s, "w");

    code = handle_write_status(i_ctx_p, status, &rstdout, NULL,

                               zwritestring);

    if (code != o_push_estack)

        return code;

    push(1);

    *op = op[-1];

    op[-1] = rstdout;

    return code;

}

/* <bool> echo - */

static int

zecho(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    check_type(*op, t_boolean);

    /****** NOT IMPLEMENTED YET ******/

    pop(1);

    return 0;

}

/* ------ Level 2 extensions ------ */

/* <file> fileposition <int> */

static int

zfileposition(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    check_file(s, op);

    /*

     * The PLRM says fileposition must give an error for non-seekable

     * streams.

     */

    if (!s_can_seek(s))

        return_error(gs_error_ioerror);

    make_int(op, stell(s));

    return 0;

}

/* <file> .fileposition <int> */

static int

zxfileposition(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    check_file(s, op);

    /*

     * This version of fileposition doesn't give the error, so we can

     * use it to get the position of string or procedure streams.

     */

    make_int(op, stell(s));

    return 0;

}

/* <file> <int> setfileposition - */

static int

zsetfileposition(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    check_type(*op, t_integer);

    check_file(s, op - 1);

    if (sseek(s, (gs_offset_t)op->value.intval) < 0)

        return_error(gs_error_ioerror);

    pop(2);

    return 0;

}

/* ------ Non-standard extensions ------ */

/* <file> .filename <string> true */

/* <file> .filename false */

static int

zfilename(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    gs_const_string fname;

    byte *str;

    check_file(s, op);

    if (sfilename(s, &fname) < 0) {

        make_false(op);

        return 0;

    }

    check_ostack(1);

    str = ialloc_string(fname.size, "filename");

    if (str == 0)

        return_error(gs_error_VMerror);

    memcpy(str, fname.data, fname.size);

    push(1);      /* can't fail */

    make_const_string( op - 1 ,

                      a_all | imemory_space((const struct gs_ref_memory_s*) imemory),

                      fname.size,

                      str);

    make_true(op);

    return 0;

}

/* <file> .isprocfilter <bool> */

static int

zisprocfilter(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    check_file(s, op);

    while (s->strm != 0)

        s = s->strm;

    make_bool(op, s_is_proc(s));

    return 0;

}

/* <file> <string> .peekstring <substring> <filled_bool> */

static int

zpeekstring(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    uint len, rlen;

    check_read_file(i_ctx_p, s, op - 1);

    check_write_type(*op, t_string);

    len = r_size(op);

    while ((rlen = sbufavailable(s)) < len) {

        int status = s->end_status;

        switch (status) {

        case EOFC:

            break;

        case 0:

            /*

             * The following is a HACK.  It should reallocate the buffer to hold

             * at least len bytes.  However, this raises messy problems about

             * which allocator to use and how it should interact with restore.

             */

            if (len >= s->bsize)

                return_error(gs_error_rangecheck);

            s_process_read_buf(s);

            continue;

        default:

            return handle_read_status(i_ctx_p, status, op - 1, NULL,

                                      zpeekstring);

        }

        break;

    }

    if (rlen > len)

        rlen = len;

    /* Don't remove the data from the buffer. */

    memcpy(op->value.bytes, sbufptr(s), rlen);

    r_set_size(op, rlen);

    op[-1] = *op;

    make_bool(op, (rlen == len ? 1 : 0));

    return 0;

}

/* <file> <int> .unread - */

static int

zunread(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    stream *s;

    ulong ch;

    check_read_file(i_ctx_p, s, op - 1);

    check_type(*op, t_integer);

    ch = op->value.intval;

    if (ch > 0xff)

        return_error(gs_error_rangecheck);

    if (sungetc(s, (byte) ch) < 0)

        return_error(gs_error_ioerror);

    pop(2);

    return 0;

}

/* <file> <obj> <==flag> .writecvp - */

static int zwritecvp_continue(i_ctx_t *);

static int

zwritecvp_at(i_ctx_t *i_ctx_p, os_ptr op, uint start, bool first)

{

    stream *s;

    byte str[100];    /* arbitrary */

    ref rstr;

    const byte *data = str;

    uint len;

    int code, status;

    check_write_file(s, op - 2);

    check_type(*op, t_integer);

    code = obj_cvp(op - 1, str, sizeof(str), &len, (int)op->value.intval,

                   start, imemory, true);

    if (code == gs_error_rangecheck) {

        code = obj_string_data(imemory, op - 1, &data, &len);

        if (len < start)

            return_error(gs_error_rangecheck);

        data += start;

        len -= start;

    }

    if (code < 0)

        return code;

    r_set_size(&rstr, len);

    rstr.value.const_bytes = data;

    status = write_string(&rstr, s);

    switch (status) {

        default:

            return_error(gs_error_ioerror);

        case 0:

            break;

        case INTC:

        case CALLC:

            len = start + len - r_size(&rstr);

            if (!first)

                --osp;   /* pop(1) without affecting op */

            return handle_write_status(i_ctx_p, status, op - 2, &len,

                                       zwritecvp_continue);

    }

    if (code == 1) {

        if (first)

            check_ostack(1);

        push_op_estack(zwritecvp_continue);

        if (first)

            push(1);

        make_int(osp, start + len);

        return o_push_estack;

    }

    if (first)      /* zwritecvp */

        pop(3);

    else      /* zwritecvp_continue */

        pop(4);

    return 0;

}

static int

zwritecvp(i_ctx_t *i_ctx_p)

{

    return zwritecvp_at(i_ctx_p, osp, 0, true);

}

/* Continue a .writecvp after a callout. */

/* *op is the index within the string. */

static int

zwritecvp_continue(i_ctx_t *i_ctx_p)

{

    os_ptr op = osp;

    check_type(*op, t_integer);

    if (op->value.intval != (uint) op->value.intval)

        return_error(gs_error_rangecheck);

    return zwritecvp_at(i_ctx_p, op - 1, (uint) op->value.intval, false);

}

/* ------ Initialization procedure ------ */

/* We need to split the table because of the 16-element limit. */

const op_def zfileio1_op_defs[] = {

    {"1bytesavailable", zbytesavailable},

    {"1closefile", zclosefile},

                /* currentfile is in zcontrol.c */

    {"1echo", zecho},

    {"1.filename", zfilename},

    {"1.fileposition", zxfileposition},

    {"1fileposition", zfileposition},

    {"0flush", zflush},

    {"1flushfile", zflushfile},

    {"1.isprocfilter", zisprocfilter},

    {"2.peekstring", zpeekstring},

    {"1print", zprint},

    {"1read", zread},

    {"2readhexstring", zreadhexstring},

    {"2readline", zreadline},

    {"2readstring", zreadstring},

    op_def_end(0)

};

const op_def zfileio2_op_defs[] = {

    {"1resetfile", zresetfile},

    {"2setfileposition", zsetfileposition},

    {"2.unread", zunread},

    {"2write", zwrite},

    {"3.writecvp", zwritecvp},

    {"2writehexstring", zwritehexstring},

    {"2writestring", zwritestring},

                /* Internal operators */

    {"3%zreadhexstring_continue", zreadhexstring_continue},

    {"3%zreadline_continue", zreadline_continue},

    {"3%zreadstring_continue", zreadstring_continue},

    {"4%zwritecvp_continue", zwritecvp_continue},

    {"3%zwritehexstring_continue", zwritehexstring_continue},

    op_def_end(0)

};

/* ------ Non-operator routines ------ */

/* Switch a file open for read/write access but currently in write mode */

/* to read mode. */

int

file_switch_to_read(const ref * op)

{

    stream *s = fptr(op);

    if (s->write_id != r_size(op) || s->file == 0)  /* not valid */

        return_error(gs_error_invalidaccess);

    if (sswitch(s, false) < 0)

        return_error(gs_error_ioerror);

    s->read_id = s->write_id; /* enable reading */

    s->write_id = 0;    /* disable writing */

    return 0;

}

/* Switch a file open for read/write access but currently in read mode */

/* to write mode. */

int

file_switch_to_write(const ref * op)

{

    stream *s = fptr(op);

    if (s->read_id != r_size(op) || s->file == 0) /* not valid */

        return_error(gs_error_invalidaccess);

    if (sswitch(s, true) < 0)

        return_error(gs_error_ioerror);

    s->write_id = s->read_id; /* enable writing */

    s->read_id = 0;   /* disable reading */

    return 0;

}

/* ------ Internal routines ------ */

/* Write a string on a file.  The file and string have been validated. */

/* If the status is INTC or CALLC, updates the string on the o-stack. */

static int

write_string(ref * op, stream * s)

{

    const byte *data = op->value.const_bytes;

    uint len = r_size(op);

    uint wlen;

    int status = sputs(s, data, len, &wlen);

    switch (status) {

        case INTC:

        case CALLC:

            op->value.const_bytes = data + wlen;

            r_set_size(op, len - wlen);

            /* falls through */

        default:    /* 0, EOFC, ERRC */

            return status;

    }

}

/*

 * Look for a stream error message that needs to be copied to

 * $error.errorinfo, if any.

 */

static int

copy_error_string(i_ctx_t *i_ctx_p, const ref *fop)

{

    stream *s;

    for (s = fptr(fop); s->strm != 0 && s->state->error_string[0] == 0;)

        s = s->strm;

    if (s->state->error_string[0]) {

        int code = gs_errorinfo_put_string(i_ctx_p, s->state->error_string);

        if (code < 0)

            return code;

        s->state->error_string[0] = 0; /* just do it once */

    }

    return_error(gs_error_ioerror);

}

/* Handle an exceptional status return from a read stream. */

/* fop points to the ref for the stream. */

/* ch may be any stream exceptional value. */

/* Return 0, 1 (EOF), o_push_estack, or an error. */

static int

handle_read_status(i_ctx_t *i_ctx_p, int ch, const ref * fop,

                   const uint * pindex, op_proc_t cont)

{

    switch (ch) {

        default:    /* error */

            return copy_error_string(i_ctx_p, fop);

        case EOFC:

            return 1;

        case INTC:

        case CALLC:

            if (pindex) {

                ref index;

                make_int(&index, *pindex);

                return s_handle_read_exception(i_ctx_p, ch, fop, &index, 1,

                                               cont);