File contents

/* xlread - xlisp expression input routine */

#include <stdio.h>
#include <ctype.h>
#include "xlisp.h"

/* global variables */
struct node *oblist;

/* external variables */
extern struct node *xlstack;
extern int (*xlgetc)();

/* local variables */
static int savech;

/* forward declarations (the extern hack is for decusc) */
extern struct node *parse();
extern struct node *plist();
extern struct node *pstring();
extern struct node *pnumber();
extern struct node *pquote();
extern struct node *pname();

/* xlread - read an xlisp expression */
struct node *xlread()
{
    struct node *val;
    int ch;

    /* initialize */
    savech = -1;

    /* parse an expression */
    val = parse();

    /* skip to end of line */
    while ((ch = thisch()) > 0 && ch != '\n') {
	if (!isspace(ch))
	    xlfail("extra characters after expression");
	savech = -1;
    }

    /* return the result value */
    return (val);
}

/* parse - parse an xlisp expression */
static struct node *parse()
{
    int ch;

    /* keep looking for a node skipping comments */
    while (TRUE)

	/* check next character for type of node */
	switch (ch = nextch()) {
	case '\'':			/* a quoted expression */
		return (pquote());
	case '(':			/* a sublist */
		return (plist());
	case ')':			/* closing paren - shouldn't happen */
		xlfail("extra right paren");
	case ';':			/* a comment */
		pcomment();
		break;
	case '"':			/* a string */
		return (pstring());
	default:
		if (isdigit(ch))	/* a number */
		    return (pnumber());
		else			/* a name */
		    return (pname());
	}
}

/* pcomment - parse a comment */
static pcomment()
{
    int ch;

    /* skip to end of line */
    while ((ch = getch()) > 0)
	if (ch == '\n')
	    break;
}

/* plist - parse a list */
static struct node *plist()
{
    struct node *oldstk,val,*lastnptr,*nptr;
    int ch;

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

    /* skip the opening paren */
    savech = -1;

    /* keep appending nodes until a closing paren is found */
    for (lastnptr = NULL; (ch = nextch()) > 0 && ch != ')'; lastnptr = nptr) {

	/* allocate a new node and link it into the list */
	nptr = newnode(LIST);
	if (lastnptr == NULL)
	    val.n_ptr = nptr;
	else
	    lastnptr->n_listnext = nptr;

	/* initialize the new node */
	nptr->n_listvalue = parse();
    }

    /* skip the closing paren */
    savech = -1;

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

    /* return successfully */
    return (val.n_ptr);
}

/* pstring - parse a string */
static struct node *pstring()
{
    struct node *oldstk,val;
    char sbuf[STRMAX+1];
    int ch,i,d1,d2,d3;

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

    /* skip the opening quote */
    savech = -1;

    /* loop looking for a closing quote */
    for (i = 0; i < STRMAX && (ch = getch()) > 0 && ch != '"'; i++) {
	switch (ch) {
	case '\\':
		switch (ch = getch()) {
		case 'e':
			ch = '\033';
			break;
		case 'n':
			ch = '\n';
			break;
		case 'r':
			ch = '\r';
			break;
		case 't':
			ch = '\t';
			break;
		default:
			if (ch >= '0' && ch <= '7') {
			    d1 = ch - '0';
			    d2 = getch() - '0';
			    d3 = getch() - '0';
			    ch = (d1 << 6) + (d2 << 3) + d3;
			}
			break;
		}
	}
	sbuf[i] = ch;
    }
    sbuf[i] = 0;

    /* initialize the node */
    val.n_ptr = newnode(STR);
    val.n_ptr->n_str = strsave(sbuf);

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

    /* return the new string */
    return (val.n_ptr);
}

/* pnumber - parse a number */
static struct node *pnumber()
{
    struct node *val;
    int ch,ival;

    /* loop looking for a closing quote */
    for (ival = 0; (ch = thisch()) > 0 && isdigit(ch); savech = -1)
	ival = ival * 10 + ch - '0';

    /* initialize the node */
    val = newnode(INT);
    val->n_int = ival;

    /* return the new number */
    return (val);
}

/* xlenter - enter a symbol into the symbol table */
struct node *xlenter(sname)
  char *sname;
{
    struct node *sptr;

    /* check for nil */
    if (strcmp(sname,"nil") == 0)
	return (NULL);

    /* check for symbol already in table */
    for (sptr = oblist; sptr != NULL; sptr = sptr->n_listnext) 
	if (sptr->n_listvalue == NULL)
	    printf("bad oblist\n");
	else if (sptr->n_listvalue->n_symname == NULL)
	    printf("bad oblist symbol\n");
	else
	if (strcmp(sptr->n_listvalue->n_symname,sname) == 0)
	    return (sptr->n_listvalue);
    
    /* enter a new symbol and link it into the symbol list */
    sptr = newnode(LIST);
    sptr->n_listnext = oblist;
    oblist = sptr;
    sptr->n_listvalue = newnode(SYM);
    sptr->n_listvalue->n_symname = strsave(sname);

    /* return the new symbol */
    return (sptr->n_listvalue);
}

/* pquote - parse a quoted expression */
static struct node *pquote()
{
    struct node *oldstk,val;

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

    /* skip the quote character */
    savech = -1;

    /* allocate two nodes */
    val.n_ptr = newnode(LIST);
    val.n_ptr->n_listvalue = xlenter("quote");
    val.n_ptr->n_listnext = newnode(LIST);

    /* initialize the second to point to the quoted expression */
    val.n_ptr->n_listnext->n_listvalue = parse();

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

    /* return the quoted expression */
    return (val.n_ptr);
}

/* pname - parse a symbol name */
static struct node *pname()
{
    char sname[STRMAX+1];
    int ch,i;

    /* get symbol name */
    for (i = 0; i < STRMAX && (ch = thisch()) > 0 && issym(ch); i++)
	sname[i] = getch();
    sname[i] = 0;

    /* initialize value */
    return (xlenter(sname));
}

/* nextch - look at the next non-blank character */
static int nextch()
{
    int ch;

    /* look for a non-blank character */
    while ((ch = thisch()) > 0)
	if (isspace(ch))
	    savech = -1;
	else
	    break;

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

/* thisch - look at the current character */
static int thisch()
{
    /* return and save the current character */
    return (savech = getch());
}

/* getch - get the next character */
static int getch()
{
    int ch;

    /* check for a saved character */
    if ((ch = savech) >= 0)
	savech = -1;
    else
	ch = (*xlgetc)();

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

/* issym - check whether a character if valid in a symbol name */
static int issym(ch)
  int ch;
{
    if (isspace(ch) || ch == '(' || ch == ')' || ch == ';' || ch == '\'')
	return (FALSE);
    else
	return (TRUE);
}