2.2 read

�����������������������������������D

/* xlread - read an xlisp expression */
int xlread(fptr,pval,rflag)
  LVAL fptr,*pval; int rflag;
{
    int sts;

    /* read an expression */
    while ((sts = readone(fptr,pval)) == FALSE) ;

    /* return status */
    return (sts == EOF ? FALSE : TRUE);
}

/* readone - attempt to read a single expression */
int readone(fptr,pval)
  LVAL fptr,*pval;
{
    LVAL val,type;
    int ch;

    /* get a character and check for EOF */
    if ((ch = xlgetc(fptr)) == EOF)
        return (EOF);

    /* handle white space */
    if ((type = tentry(ch)) == k_wspace)
        return (FALSE);

    /* handle symbol constituents */
    else if (type == k_const) {
        xlungetc(fptr,ch);
        *pval = psymbol(fptr);
        return (TRUE);      
    }

    /* handle single and multiple escapes */
    else if (type == k_sescape || type == k_mescape) {
        xlungetc(fptr,ch);
        *pval = psymbol(fptr);
        return (TRUE);
    }
    
    /* handle read macros */
    else if (consp(type)) {
        if ((val = callmacro(fptr,ch)) && consp(val)) {
            *pval = car(val);
            return (TRUE);
        }
        else
            return (FALSE);
    }

    /* handle illegal characters */
    else
        xlerror("illegal character",cvfixnum((FIXTYPE)ch));
}

/* psymbol - parse a symbol name */
LOCAL LVAL psymbol(fptr)
  LVAL fptr;
{
    int escflag;
    LVAL val;
    pname(fptr,&escflag);
    return (escflag || !isnumber(buf,&val) ? xlenter(buf) : val);
}

���������������������V���{�����������������V���{���\�� �o�^���������D�V���{���\���������o��������������obarry�����D

/* xlenter - enter a symbol into the obarray */
LVAL xlenter(name)
  char *name;
{
    LVAL sym,array;
    int i;

    /* check for nil */
    if (strcmp(name,"NIL") == 0)
        return (NIL);

    /* check for symbol already in table */
    array = getvalue(obarray);
    i = hash(name,HSIZE);
    for (sym = getelement(array,i);
                               sym; sym = cdr(sym))
        if (strcmp(name,
                getstring(getpname(car(sym)))) == 0)
            return (car(sym));

/* make a new symbol node and link it into the list */
    xlsave1(sym);
    sym = consd(getelement(array,i));
    rplaca(sym,xlmakesym(name));
    setelement(array,i,sym);
    xlpop();

    /* return the new symbol */
    return (car(sym));
}

/* xlmakesym - make a new symbol node */
LVAL xlmakesym(name)
  char *name;
{
    LVAL sym;
    sym = cvsymbol(name);
    if (*name == ':')
        setvalue(sym,sym);
    return (sym);
}