/* xlfio - xlisp file i/o */

#ifdef AZTEC
#include "a:stdio.h"
#else
#include <stdio.h>
#endif

#include "xlisp.h"

/* external variables */
extern struct node *xlstack;

/* local variables */
static char buf[STRMAX+1];

/* xlfopen - open a file */
LOCAL struct node *xlfopen(args)
  struct node *args;
{
    struct node *oldstk,arg,fname,mode,*val;
    FILE *fp;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&fname,&mode,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* get the file name */
    fname.n_ptr = xlevmatch(STR,&arg.n_ptr);

    /* get the mode */
    mode.n_ptr = xlevmatch(STR,&arg.n_ptr);

    /* make sure there aren't any more arguments */
    xllastarg(arg.n_ptr);

    /* try to open the file */
    if ((fp = fopen(fname.n_ptr->n_str,
                        mode.n_ptr->n_str)) != NULL) {
        val = newnode(FPTR);
        val->n_fp = fp;
    }
    else
        val = NULL;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the file pointer */
    return (val);
}

/* xlfclose - close a file */
LOCAL struct node *xlfclose(args)
  struct node *args;
{
    struct node *fptr;

    /* get file pointer */
    fptr = xlevmatch(FPTR,&args);

    /* make sure there aren't any more arguments */
    xllastarg(args);

    /* make sure the file exists */
    if (fptr->n_fp == NULL)
        xlfail("file not open");

    /* close the file */
    fclose(fptr->n_fp);
    fptr->n_fp = NULL;

    /* return nil */
    return (NULL);
}

/* xlgetcc - get a character from a file */
LOCAL struct node *xlgetcc(args)
  struct node *args;
{
    struct node *val;
    FILE *fp;
    int ch;

    /* get file pointer */
    if (args != NULL)
        fp = xlevmatch(FPTR,&args)->n_fp;
    else
        fp = stdin;

    /* make sure there aren't any more arguments */
    xllastarg(args);

    /* make sure the file exists */
    if (fp == NULL)
        xlfail("file not open");

    /* get character and check for eof */
    if ((ch = getc(fp)) != EOF) {

        /* create return node */
        val = newnode(INT);
        val->n_int = ch;
    }
    else
        val = NULL;

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

/* xlputc - put a character to a file */
LOCAL struct node *xlputc(args)
  struct node *args;
{
    struct node *oldstk,arg,chr;
    FILE *fp;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&chr,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* get the character */
    chr.n_ptr = xlevmatch(INT,&arg.n_ptr);

    /* get file pointer */
    if (arg.n_ptr != NULL)
        fp = xlevmatch(FPTR,&arg.n_ptr)->n_fp;
    else
        fp = stdout;

    /* make sure there aren't any more arguments */
    xllastarg(arg.n_ptr);

    /* make sure the file exists */
    if (fp == NULL)
        xlfail("file not open");

    /* put character to the file */
    putc(chr.n_ptr->n_int,fp);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the character */
    return (chr.n_ptr);
}

/* xlfgets - get a string from a file */
LOCAL struct node *xlfgets(args)
  struct node *args;
{
    struct node *str;
    char *sptr;
    FILE *fp;

    /* get file pointer */
    if (args != NULL)
        fp = xlevmatch(FPTR,&args)->n_fp;
    else
        fp = stdin;

    /* make sure there aren't any more arguments */
    xllastarg(args);

    /* make sure the file exists */
    if (fp == NULL)
        xlfail("file not open");

    /* get character and check for eof */
    if (fgets(buf,STRMAX,fp) != NULL) {

        /* create return node */
        str = newnode(STR);
        str->n_str = strsave(buf);

        /* make sure we got the whole string */
        while (buf[strlen(buf)-1] != '\n') {
            if (fgets(buf,STRMAX,fp) == NULL)
                break;
            sptr = str->n_str;
            str->n_str = stralloc(strlen(sptr) + strlen(buf));
            strcpy(str->n_str,sptr);
            strcat(buf);
            strfree(sptr);
        }
    }
    else
        str = NULL;

    /* return the string */
    return (str);
}

/* xlfputs - put a string to a file */
LOCAL struct node *xlfputs(args)
  struct node *args;
{
    struct node *oldstk,arg,str;
    FILE *fp;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&str,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* get the string */
    str.n_ptr = xlevmatch(STR,&arg.n_ptr);

    /* get file pointer */
    if (arg.n_ptr != NULL)
        fp = xlevmatch(FPTR,&arg.n_ptr)->n_fp;
    else
        fp = stdout;

    /* make sure there aren't any more arguments */
    xllastarg(arg.n_ptr);

    /* make sure the file exists */
    if (fp == NULL)
        xlfail("file not open");

    /* put string to the file */
    fputs(str.n_ptr->n_str,fp);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the string */
    return (str.n_ptr);
}

/* xlfinit - initialize file stuff */
xlfinit()
{
    xlsubr("fopen",xlfopen);
    xlsubr("fclose",xlfclose);
    xlsubr("getc",xlgetcc);
    xlsubr("putc",xlputc);
    xlsubr("fgets",xlfgets);
    xlsubr("fputs",xlfputs);
}

l equal f