Fish 'n' More 2/fishmore-publicdomainlibraryvol.ii1991xetec.iso/fish/applications/xlispstat/xlisp/xlio.c

C/C++ Source or Header | 1990-10-03 | 5KB | 224 lines

/* xlio - xlisp i/o routines */
/* Copyright (c) 1989, by David Michael Betz.                            */
/* You may give out copies of this software; for conditions see the file */
/* COPYING included with this distribution.                              */

#include "xlisp.h"
#include "osdef.h"
#ifdef ANSI
#include "xlproto.h"
#include "osproto.h"
#else
#include "xlfun.h"
#include "osfun.h"
#endif ANSI
#include "xlvar.h"

/* xlgetc - get a character from a file or stream */
int xlgetc(fptr)
  LVAL fptr;
{
    LVAL lptr,cptr;
    FILE *fp;
    int ch;

    /* check for input from nil */
    if (fptr == NIL)
    ch = EOF;

    /* otherwise, check for input from a stream */
    else if (ustreamp(fptr)) {
    if ((lptr = gethead(fptr)) == NIL)
        ch = EOF;
    else {
        if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr)){
          if (!consp(lptr)) xlerror("not a cons in stream", lptr);
          if (cptr == NIL) xlfail("character is nil in stream");
          if (!charp(cptr)) xlerror("not a character in stream", cptr);
        xlfail("bad stream");
        }
        sethead(fptr,lptr = cdr(lptr));
        if (lptr == NIL)
        settail(fptr,NIL);
        ch = getchcode(cptr);
    }
    }

    /* otherwise, check for a buffered character */
    else if (ch = getsavech(fptr))
    setsavech(fptr,'\0');

    /* otherwise, check for terminal input or file input */
    else {
    fp = getfile(fptr);
    if (fp == stdin || fp == stderr)
        ch = ostgetc();
    else
        ch = osagetc(fp);
    }

    /* return the character */
    return (ch);
}

/* xlungetc - unget a character */
void xlungetc(fptr,ch)
  LVAL fptr; int ch;
{
    LVAL lptr;

    /* check for ungetc from nil */
    if (fptr == NIL)
    ;

    /* otherwise, check for ungetc to a stream */
    if (ustreamp(fptr)) {
    if (ch != EOF) {
        lptr = cons(cvchar(ch),gethead(fptr));
        if (gethead(fptr) == NIL)
        settail(fptr,lptr);
        sethead(fptr,lptr);
    }
    }

    /* otherwise, it must be a file */
    else
    setsavech(fptr,ch);
}

/* xlpeek - peek at a character from a file or stream */
int xlpeek(fptr)
  LVAL fptr;
{
    LVAL lptr,cptr;
    int ch;

    /* check for input from nil */
    if (fptr == NIL)
    ch = EOF;

    /* otherwise, check for input from a stream */
    else if (ustreamp(fptr)) {
    if ((lptr = gethead(fptr)) == NIL)
        ch = EOF;
    else {
        if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
        xlfail("bad stream");
        ch = getchcode(cptr);
    }
    }

    /* otherwise, get the next file character and save it */
    else {
    ch = xlgetc(fptr);
    setsavech(fptr,ch);
    }

    /* return the character */
    return (ch);
}

/* xlputc - put a character to a file or stream */
void xlputc(fptr,ch)
  LVAL fptr; int ch;
{
    LVAL lptr;
    FILE *fp;

    /* count the character */
    ++xlfsize;

    /* check for output to nil */
    if (fptr == NIL)
    ;

    /* otherwise, check for output to an unnamed stream */
    else if (ustreamp(fptr)) {
        LVAL chp;
        xlsave1(chp);
        chp = cvchar(ch);
    lptr = consa(chp);
    if (gettail(fptr))
        rplacd(gettail(fptr),lptr);
    else
        sethead(fptr,lptr);
    settail(fptr,lptr);
    xlpop();
    }

    /* otherwise, check for terminal output or file output */
    else {
    fp = getfile(fptr);
    if (fp == stdout || fp == stderr)
        ostputc(ch);
    else
        osaputc(ch,fp);
    }
}

/* xlflush - flush the input buffer */
int xlflush()
{
    osflush();
    return(0);  /* to keep compilers happy - L. Tierney */
}

/* stdprint - print to *standard-output* */
void stdprint(expr)
  LVAL expr;
{
    xlprint(getvalue(s_stdout),expr,TRUE);
    xlterpri(getvalue(s_stdout));
}

/* stdputstr - print a string to *standard-output* */
void stdputstr(str)
  char *str;
{
    xlputstr(getvalue(s_stdout),str);
}

/* errprint - print to *error-output* */
void errprint(expr)
  LVAL expr;
{
    xlprint(getvalue(s_stderr),expr,TRUE);
    xlterpri(getvalue(s_stderr));
}

/* errputstr - print a string to *error-output* */
void errputstr(str)
  char *str;
{
    xlputstr(getvalue(s_stderr),str);
}

/* dbgprint - print to *debug-io* */
void dbgprint(expr)
  LVAL expr;
{
    xlprint(getvalue(s_debugio),expr,TRUE);
    xlterpri(getvalue(s_debugio));
}

/* dbgputstr - print a string to *debug-io* */
void dbgputstr(str)
  char *str;
{
    xlputstr(getvalue(s_debugio),str);
}

/* trcprin1 - print to *trace-output* */
void trcprin1(expr)
  LVAL expr;
{
    xlprint(getvalue(s_traceout),expr,TRUE);
}

/* trcputstr - print a string to *trace-output* */
void trcputstr(str)
  char *str;
{
    xlputstr(getvalue(s_traceout),str);
}