token.c

Go to the documentation of this file.

/* Copyright 1991 Digital Equipment Corporation.
** All Rights Reserved.
*****************************************************************/

#include "defs.h"

long trace_input=FALSE;

/****************************************************************************/

/* Abstract Data Type for the Input File State */

/* FILE *last_eof_read; */

/* Global input file state information */
/* Note: all characters should be stored in longs.  This ensures
   that noncharacters (i.e., EOF) can also be stored. */
/* Psi-term containing global input file state */

/***********************************************/
/* Utilities */
/* All psi-terms created here are on the HEAP. */
/* Many utilities exist in two versions that allocate on the heap */
/* or the stack. */
/* All these routines are NON-backtrackable. */

void TOKEN_ERROR(ptr_psi_term p)    /*  RM: Feb  1 1993  */
{
  if(p->type==error_psi_term->type) {
    Syntaxerrorline("Module violation (%E).\n");
  }
}

void stdin_cleareof()
{
  if (eof_flag && stdin_terminal) {
    clearerr(stdin);
    start_of_line=TRUE;
    saved_psi_term=NULL;
    old_saved_psi_term=NULL;
    saved_char=0;
    old_saved_char=0;
    eof_flag=FALSE;
  }
}

void heap_add_int_attr(ptr_psi_term t, char *attrname, long value)
{
  ptr_psi_term t1;

  t1=heap_psi_term(4);
  t1->type=integer;
  t1->value_3=heap_alloc(sizeof(REAL));
  *(REAL *)t1->value_3 = (REAL) value;

  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)t1);
}

void stack_add_int_attr(ptr_psi_term t, char *attrname, long value)
{
  ptr_psi_term t1;

  t1=stack_psi_term(4);
  t1->type=integer;
  t1->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
  *(REAL *)t1->value_3 = (REAL) value;

  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
}

void heap_mod_int_attr(ptr_psi_term t, char *attrname, long value)
{
  ptr_node n;
  ptr_psi_term t1;

  n=find(FEATCMP,attrname,t->attr_list);
  t1=(ptr_psi_term)n->data;
  *(REAL *)t1->value_3 = (REAL) value;
}

/*
void stack_mod_int_attr(t, attrname, value)
ptr_psi_term t;
char *attrname;
long value;
{
  ptr_node n;
  ptr_psi_term t1;

  n=find(FEATCMP,attrname,t->attr_list);
  t1=(ptr_psi_term)n->data;
  *(REAL *)t1->value_3 = (REAL) value;
}
*/

void heap_add_str_attr(ptr_psi_term t, char *attrname, char *str)
{
  ptr_psi_term t1;

  t1=heap_psi_term(4);
  t1->type=quoted_string;
  t1->value_3=(GENERIC)heap_copy_string(str);

  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
}

void stack_add_str_attr(ptr_psi_term t, char *attrname, char *str)
{
  ptr_psi_term t1;

  t1=stack_psi_term(4);
  t1->type=quoted_string;
  t1->value_3=(GENERIC)stack_copy_string(str);

  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
}

void heap_mod_str_attr(ptr_psi_term t, char *attrname, char *str)
{
  ptr_node n;
  ptr_psi_term t1;

  n=find(FEATCMP,attrname,t->attr_list);
  t1=(ptr_psi_term)n->data;
  t1->value_3=(GENERIC)heap_copy_string(str);
}

/*
ATTENTION - This should be made backtrackable if used
void stack_mod_str_attr(t, attrname, str)
ptr_psi_term t;
char *attrname;
char *str;
{
  ptr_node n;
  ptr_psi_term t1;

  n=find(FEATCMP,attrname,t->attr_list);
  t1=(ptr_psi_term)n->data;
  t1->value_3=(GENERIC)stack_copy_string(str);
}
*/

void heap_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
{
  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
}

void stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
{
  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
}

void bk_stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
{
  (void)bk_stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)g);
}

GENERIC get_attr(ptr_psi_term t, char *attrname)
{
  ptr_node n=find(FEATCMP,attrname,t->attr_list);
  return n->data;
}

FILE *get_stream(ptr_psi_term t)
{
  return (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
}

/***********************************************/
/* Main routines for saving & restoring state */

void save_state(ptr_psi_term t)
{
  ptr_node n;
  ptr_psi_term t1;

  n=find(FEATCMP,STREAM,t->attr_list);
  t1=(ptr_psi_term)n->data;
  t1->value_3=(GENERIC)input_stream;

  /*  RM: Jan 27 1993
  heap_mod_str_attr(t,CURRENT_MODULE,current_module->module_name);
  */
  
  heap_mod_str_attr(t,INPUT_FILE_NAME,input_file_name);
  heap_mod_int_attr(t,LINE_COUNT,line_count);
  heap_mod_int_attr(t,SAVED_CHAR,saved_char);
  heap_mod_int_attr(t,OLD_SAVED_CHAR,old_saved_char);

  t1=saved_psi_term?saved_psi_term:null_psi_term;
  heap_add_psi_attr(t,SAVED_PSI_TERM,t1);

  t1=old_saved_psi_term?old_saved_psi_term:null_psi_term;
  heap_add_psi_attr(t,OLD_SAVED_PSI_TERM,t1);

  t1=heap_psi_term(4);
  t1->type=(eof_flag?lf_true:lf_false);
  heap_add_psi_attr(t,EOF_FLAG,t1);

  t1=heap_psi_term(4);
  t1->type=(start_of_line?lf_true:lf_false);
  heap_add_psi_attr(t,START_OF_LINE,t1);
}


void restore_state(ptr_psi_term t)
{
  //  long i;
  char *str;

  
  input_stream = (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
  str = (char*) ((ptr_psi_term)get_attr(t,INPUT_FILE_NAME))->value_3;
  strcpy(input_file_name,str);
  /* for (i=0;i++;i<=strlen(str)) input_file_name[i]=str[i]; */
  line_count = *(REAL *) ((ptr_psi_term)get_attr(t,LINE_COUNT))->value_3;
  saved_char = *(REAL *) ((ptr_psi_term)get_attr(t,SAVED_CHAR))->value_3;
  old_saved_char= *(REAL *)((ptr_psi_term)get_attr(t,OLD_SAVED_CHAR))->value_3;

  saved_psi_term=(ptr_psi_term)get_attr(t,SAVED_PSI_TERM);
  if (saved_psi_term==null_psi_term) saved_psi_term=NULL;

  old_saved_psi_term=(ptr_psi_term)get_attr(t,OLD_SAVED_PSI_TERM);
  if (old_saved_psi_term==null_psi_term) old_saved_psi_term=NULL;

  eof_flag = ((ptr_psi_term)get_attr(t,EOF_FLAG))->type==lf_true;
  start_of_line = ((ptr_psi_term)get_attr(t,START_OF_LINE))->type==lf_true;

  
  /*  RM: Jan 27 1993
      set_current_module(
      find_module(((ptr_psi_term)get_attr(input_state,
      CURRENT_MODULE))->value_3));
      */
}

void new_state(ptr_psi_term *t)
{
  ptr_psi_term t1;

  *t=heap_psi_term(4);
  (*t)->type=inputfilesym;

  t1=heap_psi_term(4);
  t1->type=stream;
  t1->value_3=(GENERIC)input_stream;
  heap_add_psi_attr(*t,STREAM,t1);

  /*  RM: Jan 27 1993  */
  heap_add_str_attr(*t,CURRENT_MODULE,current_module->module_name);
  
  /*
    printf("Creating new state for file '%s', module '%s'\n",
    input_file_name,
    current_module->module_name);
    */
  
  heap_add_str_attr(*t,INPUT_FILE_NAME,input_file_name);
  heap_add_int_attr(*t,LINE_COUNT,line_count);
  heap_add_int_attr(*t,SAVED_CHAR,saved_char);
  heap_add_int_attr(*t,OLD_SAVED_CHAR,old_saved_char);

  t1=saved_psi_term?saved_psi_term:null_psi_term;
  heap_add_psi_attr(*t,SAVED_PSI_TERM,t1);

  t1=old_saved_psi_term?old_saved_psi_term:null_psi_term;
  heap_add_psi_attr(*t,OLD_SAVED_PSI_TERM,t1);

  t1=heap_psi_term(4);
  t1->type=(eof_flag?lf_true:lf_false);
  heap_add_psi_attr(*t,EOF_FLAG,t1);

  t1=heap_psi_term(4);
  t1->type=(start_of_line?lf_true:lf_false);
  heap_add_psi_attr(*t,START_OF_LINE,t1);
}

/****************************************************************************/



/* Parser/tokenizer state handling */

void save_parse_state(ptr_parse_block pb)
{
   if (pb) {
     pb->lc   = line_count;
     pb->sol  = start_of_line;
     pb->sc   = saved_char;
     pb->osc  = old_saved_char;
     pb->spt  = saved_psi_term;
     pb->ospt = old_saved_psi_term;
     pb->ef   = eof_flag;
   }
}

void restore_parse_state(ptr_parse_block pb)
{
   if (pb) {
     line_count         = pb->lc;
     start_of_line      = pb->sol;
     saved_char         = pb->sc;
     old_saved_char     = pb->osc;
     saved_psi_term     = pb->spt;
     old_saved_psi_term = pb->ospt;
     eof_flag           = pb->ef;
   }
}


void init_parse_state()
{
  line_count=0;
  start_of_line=TRUE;
  saved_char=0;
  old_saved_char=0;
  saved_psi_term=NULL;
  old_saved_psi_term=NULL;
  eof_flag=FALSE;
  stringparse=FALSE;
}

/****************************************************************************/

static long inchange, outchange;
static FILE *out;
ptr_psi_term old_state=NULL; /*  RM: Feb 17 1993  */

void begin_terminal_io()
{
  inchange = (input_stream!=stdin);
  outchange = (output_stream!=stdout);

  if (outchange) {
    out=output_stream;
    output_stream=stdout;
  }

  if (inchange) {
    old_state=input_state;
    (void)open_input_file("stdin");
  }
}

void end_terminal_io()
{
  if (inchange) {
    input_state=old_state;
    restore_state(old_state);
    old_state=NULL; /*  RM: Feb 17 1993  */
  }
  if (outchange)
    output_stream=out;
}

char *expand_file_name(char *s)
{
  char *r;
  char *home; // *getenv();
  struct passwd *pw;
  /* char *user="eight character name"; 18.5 */
  char userbuf[STRLEN];
  char *user=userbuf;
  char *t1,*t2;

  r=s;
  if (s[0]=='~') {
    t1=s+1;
    t2=user;
    while (*t1!=0 && *t1!='/') {
      *t2= *t1;
      *t2++;
      *t1++;
    }
    *t2=0;
    if ((int)strlen(user)>0) {
      pw = getpwnam(user);
      if (pw) {
    user=pw->pw_dir;
    r=(char *)malloc(strlen(user)+strlen(t1)+1);
    sprintf(r,"%s%s",user,t1);
      }
      else
    /* if (warning()) printf("couldn't find user '%s'.\n",user) */;
    }
    else {
      home=getenv("HOME");
      if (home) {
    r=(char *)malloc(strlen(home)+strlen(s)+1);
    sprintf(r,"%s%s",home,s+1);
      }
      else
    /* if (warning()) printf("no HOME directory.\n") */;
    }
  }

  /* printf("*** Using file name: '%s'\n",r); */
  
  return r;
}
  
long open_input_file(char *file)
{
  long ok=TRUE;
  long stdin_flag;

  /* Save global input file state */
  if (input_state!=NULL) save_state(input_state);

  file=expand_file_name(file);
  
  if ((stdin_flag=(!strcmp(file,"stdin")))) {
    input_stream=stdin;
    noisy=TRUE;
  }
  else {
    input_stream=fopen(file,"r");
    noisy=FALSE;
  }
  
  if (input_stream==NULL) {
    Errorline("file '%s' does not exist.\n",file);
    file="stdin";
    input_stream=stdin;
    noisy=TRUE;
    ok=FALSE;
  }

  if (!stdin_flag || stdin_state==NULL) {
    /* Initialize a new global input file state */
    strcpy(input_file_name,file);
    init_parse_state();
    /* Create a new state containing the new global values */
    new_state(&input_state);
    if (stdin_flag) stdin_state=input_state;
  }
  else {
    input_state=stdin_state;
    restore_state(input_state);
  }

  return ok;
}

long open_output_file(string file)
{
  long ok=TRUE;


  file=expand_file_name(file);
  
  if (!strcmp(file,"stdout"))
    output_stream=stdout;
  else
    if (!strcmp(file,"stderr"))
      output_stream=stderr;
    else
      output_stream=fopen(file,"w");
   
  if (output_stream==NULL) {
    Errorline("file '%s' could not be opened for output.\n",file);
    ok=FALSE;
    output_stream=stdout;
  }
  
  return ok;
}

long read_char()
{
  int c=0;
  
  if ((c=saved_char)) {
    saved_char=old_saved_char;
    old_saved_char=0;
  }
  else if (stringparse) {
    if ((c=(*stringinput)))
      stringinput++;
    else
      c=EOF;
  }
  else if (input_stream == NULL || feof(input_stream))
      c=EOF;
  else {
    if (start_of_line) {
      start_of_line=FALSE;
      line_count++;
      if (input_stream==stdin) infoline("%s",prompt); /* 21.1 */
    }
     
    c=fgetc(input_stream);
    
    if(trace_input)   /*  RM: Jan 13 1993  */
      if(c!=EOF)
    printf("%c",c);
      else
    printf(" <EOF>\n");
    
    if (c==EOLN)
      start_of_line=TRUE;
  }

  /* printf("%c\n",c); RM: Jan  5 1993  Just to trace the parser */
  
  return c;
}

void put_back_char(long c)
{
  if (old_saved_char)
    Errorline("in tokenizer, put_back_char three times (last=%d).\n",c);
  old_saved_char=saved_char;
  saved_char=c;
}

void put_back_token(psi_term t)
{  
  if (old_saved_psi_term!=NULL)
    Errorline("in parser, put_back_token three times (last=%P).\n",t);
  old_saved_psi_term=saved_psi_term;
  saved_psi_term=stack_copy_psi_term(t);
}

void psi_term_error()
{
  perr_i("near line %ld",psi_term_line_number);
  if (strcmp(input_file_name,"stdin")) {
    perr_s(" in file \042%s\042",input_file_name);
  }
  /* prompt="error>"; 20.8 */
  parse_ok=FALSE;
}

void read_comment(ptr_psi_term tok)
{
  long c;
  
  do {
    c=read_char();
  } while (c!=EOF && c!=EOLN);
  
  tok->type=comment;
}

void read_string_error(int n)
{
  if (stringparse) parse_ok=FALSE;
  else
    switch (n) {
    case 0:
      Syntaxerrorline("end of file reached before end of string (%E).\n");
      break;
    case 1:
      Syntaxerrorline("Hexadecimal digit expected (%E).\n");
      break;
    }
}

int base2int(int n)
{
  switch (n) {
  case '0': return 0;
  case '1': return 1;
  case '2': return 2;
  case '3': return 3;
  case '4': return 4;
  case '5': return 5;
  case '6': return 6;
  case '7': return 7;
  case '8': return 8;
  case '9': return 9;
  case 'a':
  case 'A': return 10;
  case 'b':
  case 'B': return 11;
  case 'c':
  case 'C': return 12;
  case 'd':
  case 'D': return 13;
  case 'e':
  case 'E': return 14;
  case 'f':
  case 'F': return 15;
  default:
    fprintf(stderr,"base2int('%c'): illegal argument\n",n);
    exit(EXIT_FAILURE);
  }
}

#define isoctal(c) (c=='0'||c=='1'||c=='2'||c=='3'||c=='4'||c=='5'||c=='6'||c=='7')

void read_string(ptr_psi_term tok,long e)
{
  long c;
  string str;
  long len=0;
  long store=TRUE;
  long flag=TRUE;
  
  str[len]=0;
  
  do {
    c=read_char();
    if (c==EOF) {
      store=FALSE;
      flag=FALSE;
      read_string_error(0);
    }
    else if (e=='"' && c=='\\') {
      c=read_char();
      if (c==EOF) {
    store=FALSE;
    flag=FALSE;
    put_back_char('\\');
    read_string_error(0);
      }
      else {
    switch (c) {
    case 'a': c='\a'; break;
    case 'b': c='\b'; break;
    case 'f': c='\f'; break;
    case 'n': c='\n'; break;
    case 'r': c='\r'; break;
    case 't': c='\t'; break;
    case 'v': c='\v'; break;
      /* missing \ooo and \xhh */
    case 'x':
      {
        int n;
        c=read_char();
        if (c==EOF) {
          store=flag=FALSE;
          read_string_error(0);
          break;
        }
        else if (!isxdigit(c)) {
          store=flag=FALSE;
          read_string_error(1);
          break;
        }
        else {
          n = base2int(c);
        }
        c=read_char();
        if (isxdigit(c)) n = 16*n+base2int(c);
        else put_back_char(c);
        c=n;
        break;
      }
    default: 
      if (isoctal(c)) {
        int n,i;
        for(i=n=0;i<3&&isoctal(c);i++,c=read_char())
          n = n*8 + base2int(c);
        if (c!=EOF) put_back_char(c);
        c=n;
        break;
      }
      else break;
    }
      }
    }
    else
      if (c==e) {
    c=read_char();
    if (c!=e) {
      store=FALSE;
      flag=FALSE;
      put_back_char(c);
    }
      }
    if (store)
      if (len==STRLEN) {
    warningline("string too long, extra ignored (%E).\n");
    store=FALSE;
      }
      else {
    str[len++]=c;
    str[len]=0;
      }
  } while(flag);
  
  if (e=='"')
    tok->value_3=(GENERIC)heap_copy_string(str);
  else {
    tok->type=update_symbol(NULL,str); /* Maybe no_module would be better */
    tok->value_3=NULL;
    TOKEN_ERROR(tok);       /*  RM: Feb  1 1993  */
  }
}

long symbolic(long c)
{
  return SYMBOL(c);
}

long legal_in_name(long c)
{
  return
    UPPER(c) ||
      LOWER(c) ||
    DIGIT(c);

  /* || c=='\'' RM: Dec 16 1992  */ ;
}

void read_name(ptr_psi_term tok,long ch,long (*f)(long),ptr_definition typ)
{
  char c;
  string str;
  long len=1;
  long store=TRUE;
  long flag=TRUE;
  ptr_module module=NULL;
  ptr_node n; /*  RM: Feb  9 1993  */

  tok->coref=NULL;
  tok->resid=NULL;
  tok->attr_list=NULL;

  str[0]=ch;
  
  do {
    c=read_char();
    flag=(*f)(c);
    
    if(c=='#' &&       /*  RM: Feb  3 1993  */
       (long)f==(long)legal_in_name &&
       len>0 &&
       len<STRLEN &&
       !module) {
      str[len]=0;
      module=create_module(str);
      len=0;
      flag=TRUE;

      /*  RM: Sep 21 1993  */
      /* Change the type function if required */
      c=read_char();
      if SYMBOL(c)
         f=symbolic;
      put_back_char(c);
    }
    else
      if (flag) {
    if (store)
      if (len==STRLEN) {
        warningline("name too long, extra ignored (%E).\n");
        store=FALSE;
      }
      else
        str[len++]=c;
      }
      else
    put_back_char(c);
  } while(flag);

  if(module && len==0) { /*  RM: Feb  3 1993  */
    strcpy(str,module->module_name);
    len=strlen(str);
    put_back_char('#');
    module=NULL;
  }
  
  str[len]=0;
  
  tok->type=typ;
  
  if(typ==constant) {
    /* printf("module=%s\n",module->module_name); */
    tok->type=update_symbol(module,str); /*  RM: Feb  3 1993  */
    tok->value_3=NULL;

    TOKEN_ERROR(tok); /*  RM: Feb  1 1993  */

    /* PVR 4.2.94 for correct level incrementing */
    if (tok->type->type_def==(def_type)global_it) {
      var_occurred=TRUE;
    }
    if (FALSE /*tok->type->type==global_it && tok->type->global_value*/) {
      /*  RM: Nov 10 1993  */
      
      /* Remove this for Bruno who didn't like it, and doesn't like
     to use "print_depth" */
      
      /*  RM: Feb  9 1993  */
      /* Add into the variable tree */
      var_occurred=TRUE;
      n=find(STRCMP,tok->type->keyword->symbol,var_tree);
      if (n==NULL) {
    /* The change is always trailed. */
    (void)bk2_stack_insert(STRCMP,
             tok->type->keyword->symbol,
             &var_tree,
             (GENERIC)tok->type->global_value);
      }
    }
    
  }
  else  
    tok->value_3=(GENERIC)heap_copy_string(str);
}

void read_number(ptr_psi_term tok,long c)
{
  long c2;
  REAL f,p;
  long /* sgn, */ pwr,posflag;

  /* if (sgn=(c=='-')) c=read_char(); */

  /* tok->type=integer;   RM: Mar  8 1993  */

  f=0.0;
  do { f=f*10.0+(c-'0'); c=read_char(); } while (DIGIT(c));

  if (c=='.') {
    c2=read_char();
    if DIGIT(c2) {
      /* tok->type=real;     RM: Mar  8 1993  */
      p=10.0;
      while (DIGIT(c2)) { f=f+(c2-'0')/p; p=p*10.0; c2=read_char(); }
      put_back_char(c2);
    }
    else {
      put_back_char(c2);
      put_back_char(c);
    }
  }
  else
    put_back_char(c);

  c=read_char();
  if (c=='e' || c=='E') {
    c2=read_char();
    if (c2=='+' || c2=='-' || DIGIT(c2)) {
      tok->type=real;
      posflag = (c2=='+' || DIGIT(c2));
      if (!DIGIT(c2)) c2=read_char();
      pwr=0;
      while (DIGIT(c2)) { pwr=pwr*10+(c2-'0'); c2=read_char(); }
      put_back_char(c2);
      p=1.0;
      while (pwr>=100) { pwr-=100; if (posflag) p*=1e100; else p/=1e100; }
      while (pwr>=10 ) { pwr-=10;  if (posflag) p*=1e10;  else p/=1e10;  }
      while (pwr>0   ) { pwr-=1;   if (posflag) p*=1e1;   else p/=1e1;   }
      f*=p;
    }
    else {
      put_back_char(c2);
      put_back_char(c);
    }
  }
  else
    put_back_char(c);

  /* if (sgn) f = -f; */
  tok->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
  *(REAL *)tok->value_3=f;

  /*  RM: Mar  8 1993  */
  if(f==floor(f))
    tok->type=integer;
  else
    tok->type=real;
}

void read_token(ptr_psi_term tok)
{ read_token_main(tok, TRUE); }

void read_token_b(ptr_psi_term tok)
{ read_token_main(tok, FALSE); }

void read_token_main(ptr_psi_term tok, long for_parser)
{
  long c, c2;
  ptr_node n;
  char p[2];

  if (for_parser && (saved_psi_term!=NULL)) {
    *tok= *saved_psi_term;
    saved_psi_term=old_saved_psi_term;
    old_saved_psi_term=NULL;
  }
  else {
    tok->type=nothing;
    
    do {
      c=read_char();
    } while(c!=EOF && (c<=32));
    
    if (for_parser) psi_term_line_number=line_count;
    
    switch(c) {
    case EOF:
      tok->type=eof;
      tok->value_3=NULL;
      break;
    case '%':
      read_comment(tok);
      break;
    case '"':
      read_string(tok,c);
      tok->type=quoted_string;
      break;
    case 39: /* The quote symbol "'" */
      read_string(tok,c);
      break;
      
    default:
      
      /* Adding this results in problems with terms like (N-1) */
      /* if (c=='-' && (c2=read_char()) && DIGIT(c2)) {
        put_back_char(c2);
        read_number(tok,c);
      }
      else */

      if(c=='.' || c=='?') { /*  RM: Jul  7 1993  */
    c2=read_char();
    put_back_char(c2);
    /*printf("c2=%d\n",c2);*/
    if(c2<=' ' || c2==EOF) {
      if(c=='.')
        tok->type=final_dot;
      else
        tok->type=final_question;
      
      tok->value_3=NULL;
    }
    else
      read_name(tok,c,symbolic,constant);
      }
      else
    if DIGIT(c)
      read_number(tok,c);
          else
            if UPPER(c) {
              read_name(tok,c,legal_in_name,variable);
            }
            else
              if LOWER(c) {
                read_name(tok,c,legal_in_name,constant);
              }
              else
                if SYMBOL(c) {
                  read_name(tok,c,symbolic,constant);
                }
        else /*  RM: Jul  7 1993  Moved this */
          if SINGLE(c) {
            p[0]=c; p[1]=0;
            tok->type=update_symbol(current_module,p);
            tok->value_3=NULL;
            TOKEN_ERROR(tok); /*  RM: Feb  1 1993  */
          }
          else {
            Errorline("illegal character %d in input (%E).\n",c);
          }
    }

    if (tok->type==variable) {
      if (tok->value_3) {
        /* If the variable read in has name "_", then it becomes 'top' */
        /* and is no longer a variable whose name must be remembered.  */
        /* As a result, '@' and '_' are synonyms in the program input. */
        if (!strcmp((char *)tok->value_3,"_")) {
      p[0]='@'; p[1]=0;
          tok->type=update_symbol(current_module,p);
          tok->value_3=NULL;
      TOKEN_ERROR(tok); /*  RM: Feb  1 1993  */
        }
        else {
          /* Insert into variable tree, create 'top' value if need be. */
          var_occurred=TRUE;
          n=find(STRCMP,(char *)tok->value_3,var_tree);
          if (n==NULL) {
            ptr_psi_term t=stack_psi_term(0);
            /* The change is always trailed. */
            (void)bk2_stack_insert(STRCMP,(char *)tok->value_3,&var_tree,(GENERIC)t); /* 17.8 */
            tok->coref=t;
          }
          else
        tok->coref=(ptr_psi_term)n->data;
        }
      }
      /* else do nothing */
    }
  }

  if (tok->type==comment)
    read_token(tok);

  if (tok->type!=variable)
    tok->coref=NULL;

  tok->attr_list=NULL;
  tok->status=0;
  tok->flags=FALSE; /* 14.9 */
  tok->resid=NULL;

  if (tok->type==cut) /* 12.7 */
    tok->value_3=(GENERIC)choice_stack;

  do {
    c=read_char();
    if (c==EOLN) {
      if (for_parser) put_back_char(c);
      c=0;
    }
    else if (c<0 || c>32) {
      put_back_char(c);
      c=0;
    }
  } while(c && c!=EOF);
  
  if (for_parser) prompt="|    ";
}

/****************************************************************************/