/*FUNCTION*/ LVAL c_newnode(tpLspObject pLSP, unsigned char type ){ /*noverbatim CUT*/ LVAL p; if( null((p = getnode())) ) return NIL; settype(p,type); switch( type ) { case NTYPE_CON: return NULL; case NTYPE_FLO: setfloat(p,0.0); break; case NTYPE_INT: setint(p,0); break; case NTYPE_STR: setstring(p,NULL); break; case NTYPE_SYM: setsymbol(p,NULL); break; case NTYPE_CHR: setchar(p,(char)0); break; default: return NULL; } return p; }
NODE *make_floatnode(FLONUM f) { NODE *nd = newnode(FLOAT); setfloat(nd, f); return (nd); }
NODE *cnv_node_to_numnode(NODE *ndi) { NODE *val; int dr; char s2[MAX_NUMBER], *s = s2; if (is_number(ndi)) return (ndi); ndi = cnv_node_to_strnode(ndi); if (ndi == UNBOUND) return (UNBOUND); if (((getstrlen(ndi)) < MAX_NUMBER) && (dr = numberp(ndi))) { if (backslashed(ndi)) noparity_strnzcpy(s, getstrptr(ndi), getstrlen(ndi)); else strnzcpy(s, getstrptr(ndi), getstrlen(ndi)); if (*s == '+') ++s; if (s2[getstrlen(ndi) - 1] == '.') s2[getstrlen(ndi) - 1] = 0; if (/*TRUE || */ dr - 1 || getstrlen(ndi) > 9) { val = newnode(FLOAT); setfloat(val, atof(s)); } else { val = newnode(INT); setint(val, atol(s)); } gcref(ndi); return (val); } else { gcref(ndi); return (UNBOUND); } }
/* * local function to read an expression */ static LVAL _readexpr(tpLspObject pLSP,FILE *f) { int ch,ch1,ch2,i; LVAL p; char *s; double dval; long lval; spaceat(ch,f); if( ch == EOF ) { return NIL; } if( ch == pLSP->cClose ) { return NIL; } if( ch == pLSP->cOpen )/* Read a cons node. */ return readcons(pLSP,f); /**** Note: XLISP allows 1E++10 as a symbol. This is dangerous. We do not change XLISP (so far), but here I exclude all symbol names starting with numeral. */ if( const_p1(ch) )/* Read a symbol. */ { for( i = 0 ; const_p(ch) ; i++ ){ if( storech(pLSP,i,ch) )return NIL; ch = getC(pLSP,f); } UNGETC(ch); /* Recognize NIL and nil symbols. */ if( !strcmp(BUFFER,"NIL") || !strcmp(BUFFER,"nil") ) return NIL; p = newsymbol(); s = StrDup( BUFFER ); if( null(p) || s == NULL )return NIL; setsymbol(p,s); return p; } if( ch == '\"' ){ ch = GETC(f); storech(pLSP,0,0); /* inititalize the buffer */ if( ch != '\"' )goto SimpleString; ch = GETC(f); if( ch != '\"' ){ UNGETC(ch); ch = '\"';/* ch should hold the first character of the string that is " now */ goto SimpleString; } ch = GETC(f); /* multi line string */ for( i = 0 ; ch != EOF ; i++ ){ if( ch == '\"' ){ ch1 = GETC(f); ch2 = GETC(f); if( ch1 == '\"' && ch2 == '\"' )break; UNGETC(ch2); UNGETC(ch1); } if( ch == '\\' ){ ch = GETC(f); s = escapers; while( *s ){ if( *s++ == ch ){ ch = *s; break; } if( *s )s++; } } if( storech(pLSP,i,ch) )return NIL; ch = GETC(f); } p = newstring(); s = StrDup( BUFFER ); if( null(p) || s == NULL )return NIL; setstring(p,s); return p; } if( ch == '\"' ){/* Read a string. */ ch = GETC(f);/* Eat the " character. */ SimpleString: for( i = 0 ; ch != '\"' && ch != EOF ; i++ ){ if( ch == '\\' ){ ch = GETC(f); s = escapers; while( *s ){ if( *s++ == ch ){ ch = *s; break; } if( *s )s++; } } if( ch == '\n' )return NIL; if( storech(pLSP,i,ch) )return NIL; ch = GETC(f); } p = newstring(); s = StrDup( BUFFER ); if( null(p) || s == NULL ) { return NIL; } setstring(p,s); return p; } if( numeral1(ch) ) { for( i = 0 ; isinset(ch,"0123456789+-eE.") ; i++ ) { if( storech(pLSP,i,ch) )return NIL; ch = getC(pLSP,f); } UNGETC(ch); cnumeric(BUFFER,&i,&dval,&lval); switch( i ) { case 0: return NIL; case 1: /* A float number is coming. */ p = newfloat(); if( null(p) ) { return NIL; } setfloat(p,dval); return p; case 2: /* An integer is coming. */ p = newint(); if( null(p) ) { return NIL; } setint(p,lval); return p; default: return NIL; } } return NIL; }