/* xlfio.c - xlisp file i/o *//*	Copyright (c) 1985, by David Michael Betz        All Rights Reserved        Permission is granted for unrestricted non-commercial use	*//* CHANGE LOG * -------------------------------------------------------------------- * 28Apr03  dm  eliminate some compiler warnings */#include "switches.h"#include <string.h>#include "xlisp.h"/* do some sanity checking: */#ifndef XL_BIG_ENDIAN#ifndef XL_LITTLE_ENDIANconfiguration error -- either XL_BIG_ or XL_LITTLE_ENDIAN must be definedin xlisp.h#endif#endif#ifdef XL_BIG_ENDIAN#ifdef XL_LITTLE_ENDIANconfiguration error -- both XL_BIG_ and XL_LITTLE_ENDIAN are defined!#endif#endif/* forward declarations */FORWARD LOCAL LVAL getstroutput(LVAL stream);FORWARD LOCAL LVAL printit(int pflag, int tflag);FORWARD LOCAL LVAL flatsize(int pflag);/* xread - read an expression */LVAL xread(void){    LVAL fptr,eof,rflag,val;    /* get file pointer and eof value */    fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));    eof = (moreargs() ? xlgetarg() : NIL);    rflag = (moreargs() ? xlgetarg() : NIL);    xllastarg();    /* read an expression */    if (!xlread(fptr,&val,rflag != NIL))        val = eof;    /* return the expression */    return (val);}/* xprint - built-in function 'print' */LVAL xprint(void){    return (printit(TRUE,TRUE));}/* xprin1 - built-in function 'prin1' */LVAL xprin1(void){    return (printit(TRUE,FALSE));}/* xprinc - built-in function princ */LVAL xprinc(void){    return (printit(FALSE,FALSE));}/* xterpri - terminate the current print line */LVAL xterpri(void){    LVAL fptr;    /* get file pointer */    fptr = (moreargs() ? xlgetfile() : getvalue(s_stdout));    xllastarg();    /* terminate the print line and return nil */    xlterpri(fptr);    return (NIL);}/* printit - common print function */LOCAL LVAL printit(int pflag, int tflag){    LVAL fptr,val;    /* get expression to print and file pointer */    val = xlgetarg();    fptr = (moreargs() ? xlgetfile() : getvalue(s_stdout));    xllastarg();    /* print the value */    xlprint(fptr,val,pflag);    /* terminate the print line if necessary */    if (tflag)        xlterpri(fptr);    /* return the result */    return (val);}/* xflatsize - compute the size of a printed representation using prin1 */LVAL xflatsize(void){    return (flatsize(TRUE));}/* xflatc - compute the size of a printed representation using princ */LVAL xflatc(void){    return (flatsize(FALSE));}/* flatsize - compute the size of a printed expression */LOCAL LVAL flatsize(int pflag){    LVAL val;    /* get the expression */    val = xlgetarg();    xllastarg();    /* print the value to compute its size */    xlfsize = 0;    xlprint(NIL,val,pflag);    /* return the length of the expression */    return (cvfixnum((FIXTYPE)xlfsize));}/* xlopen - open a text or binary file */LVAL xlopen(int binaryflag){    char *name,*mode=NULL;    FILE *fp;    LVAL dir;    /* get the file name and direction */    name = (char *)getstring(xlgetfname());    if (!xlgetkeyarg(k_direction,&dir))        dir = k_input;    /* get the mode */    if (dir == k_input)        mode = "r";    else if (dir == k_output)        mode = "w";    else        xlerror("bad direction",dir);    /* try to open the file */    if (binaryflag) {        fp = osbopen(name,mode);    } else {        fp = osaopen(name,mode);    }    return (fp ? cvfile(fp) : NIL);}/* xopen - open a file */LVAL xopen(void){    return xlopen(FALSE);}/* xbopen - open a binary file */LVAL xbopen(void){        return xlopen(TRUE);}/* xclose - close a file */LVAL xclose(void){    LVAL fptr;    /* get file pointer */    fptr = xlgastream();    xllastarg();    /* make sure the file exists */    if (getfile(fptr) == NULL)        xlfail("file not open");    /* close the file */    osclose(getfile(fptr));    setfile(fptr,NULL);    /* return nil */    return (NIL);}/* xrdchar - read a character from a file */LVAL xrdchar(void){    LVAL fptr;    int ch;    /* get file pointer */    fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));    xllastarg();    /* get character and check for eof */    return ((ch = xlgetc(fptr)) == EOF ? NIL : cvchar(ch));}/* xrdint - read an integer from a file *//* positive byte count means big-endian, negative is little-endian */LVAL xrdint(void){    LVAL fptr;    unsigned char b[4];    long i;    int n = 4;    int index = 0; /* where to start in array */    int incr = 1;  /* how to step through array */    int rslt;    /* get file pointer */    fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));    /* get byte count */    if (moreargs()) {        LVAL count = typearg(fixp);        n = getfixnum(count);        if (n < 0) {            n = -n;            index = n - 1;            incr = -1;        }        if (n > 4) {            xlerror("4-byte limit", count);        }    }    xllastarg();    for (i = 0; i < n; i++) {        int ch = xlgetc(fptr);        if (ch == EOF) return NIL;        b[index] = ch;        index += incr;    }    /* build result, b is now big-endian */    /* extend sign bit for short integers */    rslt = ((b[0] & 0x80) ? -1 : 0);    for (i = 0; i < n; i++) {        rslt = (rslt << 8) + b[i];    }    /* return integer result */    return cvfixnum(rslt);}/* xrdfloat - read a float from a file */LVAL xrdfloat(void){    LVAL fptr;    union {        char b[8];        float f;        double d;    } rslt;    int n = 4;    int i;    int index = 3;  /* where to start in array */    int incr = -1;  /* how to step through array */    /* get file pointer */    fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));    /* get byte count */    if (moreargs()) {        LVAL count =  typearg(fixp);        n = getfixnum(count);        if (n < 0) {            n = -n;            index = 0;            incr = 1;        }        if (n != 4 && n != 8) {            xlerror("must be 4 or 8 bytes", count);        }    }    xllastarg();#ifdef XL_BIG_ENDIAN    /* flip the bytes */    index = n - 1 - index;    incr = -incr;#endif    for (i = 0; i < n; i++) {        int ch = xlgetc(fptr);        if (ch == EOF) return NIL;        rslt.b[index] = ch;        index += incr;    }    /* return result */    return cvflonum(n == 4 ? rslt.f : rslt.d);}/* xrdbyte - read a byte from a file */LVAL xrdbyte(void){    LVAL fptr;    int ch;    /* get file pointer */    fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));    xllastarg();    /* get character and check for eof */    return ((ch = xlgetc(fptr)) == EOF ? NIL : cvfixnum((FIXTYPE)ch));}/* xpkchar - peek at a character from a file */LVAL xpkchar(void){    LVAL flag,fptr;    int ch;    /* peek flag and get file pointer */    flag = (moreargs() ? xlgetarg() : NIL);    fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));    xllastarg();    /* skip leading white space and get a character */    if (flag)        while ((ch = xlpeek(fptr)) != EOF && isspace(ch))            xlgetc(fptr);    else        ch = xlpeek(fptr);    /* return the character */    return (ch == EOF ? NIL : cvchar(ch));}/* xwrchar - write a character to a file */LVAL xwrchar(void){    LVAL fptr,chr;    /* get the character and file pointer */    chr = xlgachar();