token.c File Reference

token More...

Go to the source code of this file.

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

Functions
void	TOKEN_ERROR (ptr_psi_term p)
	TOKEN_ERROR. More...
void	stdin_cleareof ()
	stdin_cleareof More...
void	heap_add_int_attr (ptr_psi_term t, char *attrname, long value)
	heap_add_int_attr More...
void	stack_add_int_attr (ptr_psi_term t, char *attrname, long value)
	stack_add_int_attr More...
void	heap_mod_int_attr (ptr_psi_term t, char *attrname, long value)
	heap_mod_int_attr More...
void	heap_add_str_attr (ptr_psi_term t, char *attrname, char *str)
	heap_add_str_attr More...
void	stack_add_str_attr (ptr_psi_term t, char *attrname, char *str)
	stack_add_str_attr More...
void	heap_mod_str_attr (ptr_psi_term t, char *attrname, char *str)
	heap_mod_str_attr More...
void	heap_add_psi_attr (ptr_psi_term t, char *attrname, ptr_psi_term g)
	heap_add_psi_attr More...
void	stack_add_psi_attr (ptr_psi_term t, char *attrname, ptr_psi_term g)
	stack_add_psi_attr More...
void	bk_stack_add_psi_attr (ptr_psi_term t, char *attrname, ptr_psi_term g)
	bk_stack_add_psi_attr More...
GENERIC	get_attr (ptr_psi_term t, char *attrname)
	get_attr More...
FILE *	get_stream (ptr_psi_term t)
	get_stream More...
void	save_state (ptr_psi_term t)
	save_state More...
void	restore_state (ptr_psi_term t)
	restore_state More...
void	new_state (ptr_psi_term *t)
	new_state More...
void	save_parse_state (ptr_parse_block pb)
	save_parse_state More...
void	restore_parse_state (ptr_parse_block pb)
	restore_parse_state More...
void	init_parse_state ()
	init_parse_state More...
void	begin_terminal_io ()
	begin_terminal_io More...
void	end_terminal_io ()
	end_terminal_io More...
char *	expand_file_name (char *s)
	expand_file_name More...
long	open_input_file (char *file)
	open_input_file More...
long	open_output_file (string file)
	open_output_file More...
long	read_char ()
	read_char More...
void	put_back_char (long c)
	put_back_char More...
void	put_back_token (psi_term t)
	put_back_token More...
void	psi_term_error ()
	psi_term_error More...
void	read_comment (ptr_psi_term tok)
	read_comment More...
void	read_string_error (int n)
	read_string_error More...
int	base2int (int n)
	base2int More...
void	read_string (ptr_psi_term tok, long e)
	read_string More...
long	symbolic (long c)
	symbolic More...
long	legal_in_name (long c)
	legal_in_name More...
void	read_name (ptr_psi_term tok, long ch, long(*f)(long), ptr_definition typ)
	read_name More...
void	read_number (ptr_psi_term tok, long c)
	read_number More...
void	read_token (ptr_psi_term tok)
	read_token More...
void	read_token_b (ptr_psi_term tok)
	read_token_b More...
void	read_token_main (ptr_psi_term tok, long for_parser)
	read_token_main More...

Variables
long	trace_input =FALSE
static long	inchange
static long	outchange
static FILE *	out
ptr_psi_term	old_state =NULL

Detailed Description

token

Definition in file token.c.

Macro Definition Documentation

#define isoctal

(

c

)

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

Definition at line 847 of file token.c.

Function Documentation

int base2int

(

int

n

)

base2int

Parameters

n

- int n

Definition at line 816 of file token.c.

{
  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);
  }
}

void begin_terminal_io

(

)

begin_terminal_io

BEGIN_TERMINAL_IO() These two routines must bracket any I/O directed to the terminal. This is to avoid mix-ups between terminal and file I/O since the program's input and output streams may be different from stdin stdout. See the routine what_next_aim(), which uses them to isolate the user interface I/O from the program's own I/O.

Definition at line 493 of file token.c.

References inchange, input_state, input_stream, open_input_file(), out, outchange, and output_stream.

{
  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 bk_stack_add_psi_attr	(	ptr_psi_term	t,
		char *	attrname,
		ptr_psi_term	g
	)

bk_stack_add_psi_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
g	- ptr_psi_term g

Definition at line 252 of file token.c.

References wl_psi_term::attr_list, bk_stack_insert(), FEATCMP, and heap_copy_string().

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

void end_terminal_io

(

)

end_terminal_io

END_TERMINAL_IO() End of terminal I/O bracketing.

Definition at line 516 of file token.c.

References inchange, input_state, NULL, old_state, out, outchange, output_stream, and restore_state().

{
  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

)

expand_file_name

Parameters

s

- char *s

EXPAND_FILE_NAME(str) Return the expansion of file name STR. For the time being all this does is replace '~' by the HOME directory if no user is given, or tries to find the user.

Definition at line 537 of file token.c.

References STRLEN.

{
  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;
}

GENERIC get_attr	(	ptr_psi_term	t,
		char *	attrname
	)

get_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname

Get the GENERIC value of a psi-term's attribute

Definition at line 265 of file token.c.

References wl_psi_term::attr_list, wl_node::data, FEATCMP, and find().

{
  ptr_node n=find(FEATCMP,attrname,t->attr_list);
  return n->data;
}

FILE* get_stream

(

ptr_psi_term

t

)

get_stream

Parameters

t	- ptr_psi_term t

Get the psi-term's STREAM attribute

Definition at line 278 of file token.c.

References get_attr(), and STREAM.

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

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

heap_add_int_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
value	- long value

Add an attribute whose value is an integer to a psi-term that does not yet contains this attribute.

Definition at line 74 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_alloc(), heap_copy_string(), heap_insert(), heap_psi_term(), integer, REAL, wl_psi_term::type, and wl_psi_term::value_3.

{
  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 heap_add_psi_attr	(	ptr_psi_term	t,
		char *	attrname,
		ptr_psi_term	g
	)

heap_add_psi_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
g	- ptr_psi_term g

Attach a psi-term to another as an attribute.

Definition at line 226 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_copy_string(), and heap_insert().

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

void heap_add_str_attr	(	ptr_psi_term	t,
		char *	attrname,
		char *	str
	)

heap_add_str_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
str	- char *str

Add an attribute whose value is a string to a psi-term that does not yet contains this attribute.

Definition at line 151 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_copy_string(), heap_insert(), heap_psi_term(), quoted_string, wl_psi_term::type, and wl_psi_term::value_3.

{
  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 heap_mod_int_attr	(	ptr_psi_term	t,
		char *	attrname,
		long	value
	)

heap_mod_int_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
value	- long value

Modify an attribute whose value is an integer to a psi-term that already contains this attribute with another integer value.

Definition at line 116 of file token.c.

References wl_psi_term::attr_list, wl_node::data, FEATCMP, find(), REAL, and wl_psi_term::value_3.

{
  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_mod_str_attr	(	ptr_psi_term	t,
		char *	attrname,
		char *	str
	)

heap_mod_str_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
str	- char *str

Modify an attribute whose value is a string to a psi-term that already contains this attribute with another integer value.

Definition at line 191 of file token.c.

References wl_psi_term::attr_list, wl_node::data, FEATCMP, find(), heap_copy_string(), and wl_psi_term::value_3.

{
  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);
}

void init_parse_state

(

)

init_parse_state

Initialize the parser/tokenizer state variables.

Definition at line 464 of file token.c.

References eof_flag, FALSE, line_count, NULL, old_saved_char, old_saved_psi_term, saved_char, saved_psi_term, start_of_line, stringparse, and TRUE.

{
  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;
}

long legal_in_name

(

long

c

)

legal_in_name

Parameters

c

- long c

LEGAL_IN_NAME(character) Tests if character is legal in a name or a variable (see macros).

Definition at line 980 of file token.c.

References DIGIT, LOWER, and UPPER.

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

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

void new_state

(

ptr_psi_term *

t

)

new_state

Parameters

t	- ptr_psi_term *t

Create a new file state psi-term that reflects the current global state

Definition at line 372 of file token.c.

References current_module, CURRENT_MODULE, eof_flag, EOF_FLAG, heap_add_int_attr(), heap_add_psi_attr(), heap_add_str_attr(), heap_psi_term(), INPUT_FILE_NAME, input_file_name, input_stream, inputfilesym, lf_false, lf_true, LINE_COUNT, line_count, wl_module::module_name, null_psi_term, old_saved_char, OLD_SAVED_CHAR, old_saved_psi_term, OLD_SAVED_PSI_TERM, saved_char, SAVED_CHAR, saved_psi_term, SAVED_PSI_TERM, start_of_line, START_OF_LINE, stream, STREAM, wl_psi_term::type, and wl_psi_term::value_3.

{
  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);
}

long open_input_file

(

char *

file

)

open_input_file

Parameters

file	- char *file

OPEN_INPUT_FILE(file) Open the input file specified by the string FILE. If the file is "stdin", restore the stdin state. Otherwise, open the file and create a new global state for it. If the file can't be opened, print an error and open "stdin" instead.

Definition at line 594 of file token.c.

References Errorline(), expand_file_name(), FALSE, init_parse_state(), input_file_name, input_state, input_stream, new_state(), noisy, NULL, restore_state(), save_state(), stdin_state, and TRUE.

{
  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

)

open_output_file

Parameters

file	- string file

OPEN_OUTPUT_FILE(file) Same thing as OPEN_INPUT_FILE, only for output. If FILE="stdout" then output_stream=stdout.

Definition at line 646 of file token.c.

References Errorline(), expand_file_name(), FALSE, NULL, output_stream, and TRUE.

{
  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;
}

void psi_term_error

(

)

psi_term_error

PSI_TERM_ERROR Print the line number at which the current psi_term started.

Definition at line 761 of file token.c.

References FALSE, input_file_name, parse_ok, perr_i(), perr_s(), and psi_term_line_number.

{
  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 put_back_char

(

long

c

)

put_back_char

Parameters

c

- long c

PUT_BACK_CHAR Put back one character, if there already are 2 saved characters then report an error (= bug).

Definition at line 729 of file token.c.

References Errorline(), old_saved_char, and saved_char.

{
  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

)

put_back_token

Parameters

t	- psi_term t

PUT_BACK_TOKEN Put back a psi_term, if there already are two saved then report an error (= bug).

Definition at line 746 of file token.c.

References Errorline(), NULL, old_saved_psi_term, saved_psi_term, and stack_copy_psi_term().

{  
  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);
}

long read_char

(

)

read_char

READ_CHAR Return the char read from the input stream, if end of file reached then return EOF. If stringparse==TRUE then read characters from the input string instead of from a file.

Definition at line 680 of file token.c.

References EOLN, FALSE, infoline(), input_stream, line_count, NULL, old_saved_char, prompt, saved_char, start_of_line, stringinput, stringparse, trace_input, and TRUE.

{
  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 read_comment

(

ptr_psi_term

tok

)

read_comment

Parameters

tok	- ptr_psi_term tok

READ_COMMENT Read a comment starting with '' to the end of the line.

Definition at line 779 of file token.c.

References comment, EOLN, read_char(), and wl_psi_term::type.

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

void read_name	(	ptr_psi_term	tok,
		long	ch,
		long(*)(long)	f,
		ptr_definition	typ
	)

read_name

Parameters

tok	- ptr_psi_term tok
ch	- long ch
f	- long (*f)(long)
typ	- ptr_definition typ

READ_NAME(C,F,TYP) Read in the name starting with character C followed by character of whose type function is F. The result is a psi_term of symbol type TYP.

Definition at line 1002 of file token.c.

References wl_psi_term::attr_list, bk2_stack_insert(), constant, wl_psi_term::coref, create_module(), FALSE, find(), global_it, wl_definition::global_value, heap_copy_string(), wl_definition::keyword, legal_in_name(), wl_module::module_name, NULL, put_back_char(), read_char(), wl_psi_term::resid, STRCMP, STRLEN, SYMBOL, wl_keyword::symbol, symbolic(), TOKEN_ERROR(), TRUE, wl_psi_term::type, wl_definition::type_def, update_symbol(), wl_psi_term::value_3, var_occurred, var_tree, and warningline().

{
  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
	)

read_number

Parameters

tok	- ptr_psi_term tok
c	- long c

READ_NUMBER(c) Read in the number whose first character is c. Accepted syntax: digit+ [ . digit+ ] [ {e|E} {+|-|empty} digit* ] Negative numbers are dealt with in the parser.

Definition at line 1110 of file token.c.

References DIGIT, heap_alloc(), integer, put_back_char(), read_char(), REAL, real, wl_psi_term::type, and wl_psi_term::value_3.

{
  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_string	(	ptr_psi_term	tok,
		long	e
	)

read_string

Parameters

tok	- ptr_psi_term tok
e	- long e

READ_STRING(e) Read a string ending with character E, where E=" or '. Transform a double occurrence into a single one so that 'ab""cd' is the string 'ab"cd'.

Definition at line 859 of file token.c.

References base2int(), FALSE, heap_copy_string(), isoctal, NULL, put_back_char(), read_char(), read_string_error(), STRLEN, TOKEN_ERROR(), TRUE, wl_psi_term::type, update_symbol(), wl_psi_term::value_3, and warningline().

{
  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  */
  }
}

void read_string_error

(

int

n

)

read_string_error

Parameters

n

- int n

Definition at line 796 of file token.c.

References FALSE, parse_ok, stringparse, and Syntaxerrorline().

{
  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;
    }
}

void read_token

(

ptr_psi_term

tok

)

read_token

Parameters

tok	- ptr_psi_term tok

READ_TOKEN Read in one token from the input stream, represented as a psi_term. Return the psi_term 'end_of_file' if that is the case.

Used in the parser Set prompt to the 'partial input' prompt

Definition at line 1186 of file token.c.

References read_token_main(), and TRUE.

{ read_token_main(tok, TRUE); }

void read_token_b

(

ptr_psi_term

tok

)

read_token_b

Parameters

tok	- ptr_psi_term tok

Used as a built-in Prompt is unchanged

Definition at line 1197 of file token.c.

References FALSE, and read_token_main().

{ read_token_main(tok, FALSE); }

void read_token_main	(	ptr_psi_term	tok,
		long	for_parser
	)

read_token_main

Parameters

tok	- ptr_psi_term tok
for_parser	- long for_parser

Definition at line 1207 of file token.c.

References wl_psi_term::attr_list, bk2_stack_insert(), choice_stack, comment, constant, wl_psi_term::coref, current_module, cut, wl_node::data, DIGIT, eof, EOLN, Errorline(), FALSE, final_dot, final_question, find(), wl_psi_term::flags, legal_in_name(), line_count, LOWER, nothing, NULL, old_saved_psi_term, prompt, psi_term_line_number, put_back_char(), quoted_string, read_char(), read_comment(), read_name(), read_number(), read_string(), read_token(), wl_psi_term::resid, saved_psi_term, SINGLE, stack_psi_term(), wl_psi_term::status, STRCMP, SYMBOL, symbolic(), TOKEN_ERROR(), TRUE, wl_psi_term::type, update_symbol(), UPPER, wl_psi_term::value_3, var_occurred, var_tree, and variable.

{
  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="|    ";
}

void restore_parse_state

(

ptr_parse_block

pb

)

restore_parse_state

Parameters

pb	- ptr_parse_block pb

Definition at line 444 of file token.c.

References wl_parse_block::ef, eof_flag, wl_parse_block::lc, line_count, old_saved_char, old_saved_psi_term, wl_parse_block::osc, wl_parse_block::ospt, saved_char, saved_psi_term, wl_parse_block::sc, wl_parse_block::sol, wl_parse_block::spt, and start_of_line.

{
   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 restore_state

(

ptr_psi_term

t

)

restore_state

Parameters

t	- ptr_psi_term t

Restore global state from an existing file state psi-term t

Definition at line 334 of file token.c.

References eof_flag, EOF_FLAG, get_attr(), INPUT_FILE_NAME, input_file_name, input_stream, lf_true, LINE_COUNT, line_count, NULL, null_psi_term, old_saved_char, OLD_SAVED_CHAR, old_saved_psi_term, OLD_SAVED_PSI_TERM, REAL, saved_char, SAVED_CHAR, saved_psi_term, SAVED_PSI_TERM, start_of_line, START_OF_LINE, and STREAM.

{
  //  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 save_parse_state

(

ptr_parse_block

pb

)

save_parse_state

Parameters

pb	- ptr_parse_block pb

Definition at line 425 of file token.c.

References wl_parse_block::ef, eof_flag, wl_parse_block::lc, line_count, old_saved_char, old_saved_psi_term, wl_parse_block::osc, wl_parse_block::ospt, saved_char, saved_psi_term, wl_parse_block::sc, wl_parse_block::sol, wl_parse_block::spt, and start_of_line.

{
   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 save_state

(

ptr_psi_term

t

)

save_state

Parameters

t	- ptr_psi_term t

Save global state into an existing file state psi-term t

Definition at line 293 of file token.c.

References wl_psi_term::attr_list, wl_node::data, eof_flag, EOF_FLAG, FEATCMP, find(), heap_add_psi_attr(), heap_mod_int_attr(), heap_mod_str_attr(), heap_psi_term(), INPUT_FILE_NAME, input_file_name, input_stream, lf_false, lf_true, LINE_COUNT, line_count, null_psi_term, old_saved_char, OLD_SAVED_CHAR, old_saved_psi_term, OLD_SAVED_PSI_TERM, saved_char, SAVED_CHAR, saved_psi_term, SAVED_PSI_TERM, start_of_line, START_OF_LINE, STREAM, wl_psi_term::type, and wl_psi_term::value_3.

{
  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 stack_add_int_attr	(	ptr_psi_term	t,
		char *	attrname,
		long	value
	)

stack_add_int_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
value	- long value

Definition at line 94 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_alloc(), heap_copy_string(), integer, REAL, stack_insert(), stack_psi_term(), wl_psi_term::type, and wl_psi_term::value_3.

{
  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 stack_add_psi_attr	(	ptr_psi_term	t,
		char *	attrname,
		ptr_psi_term	g
	)

stack_add_psi_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
g	- ptr_psi_term g

Definition at line 239 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_copy_string(), and stack_insert().

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

void stack_add_str_attr	(	ptr_psi_term	t,
		char *	attrname,
		char *	str
	)

stack_add_str_attr

Parameters

t	- ptr_psi_term t
attrname	- char *attrname
str	- char *str

Definition at line 170 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_copy_string(), quoted_string, stack_copy_string(), stack_insert(), stack_psi_term(), wl_psi_term::type, and wl_psi_term::value_3.

{
  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 stdin_cleareof

(

)

stdin_cleareof

Clear EOF if necessary for stdin

Definition at line 51 of file token.c.

References eof_flag, FALSE, NULL, old_saved_char, old_saved_psi_term, saved_char, saved_psi_term, start_of_line, stdin_terminal, and TRUE.

{
  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;
  }
}

long symbolic

(

long

c

)

symbolic

Parameters

c

- long c

SYMBOLIC(character) Tests if character is a symbol (see macro).

Definition at line 967 of file token.c.

References SYMBOL.

{
  return SYMBOL(c);
}

void TOKEN_ERROR

(

ptr_psi_term

p

)

TOKEN_ERROR.

Parameters

p	- ptr_psi_term p

Definition at line 38 of file token.c.

References error_psi_term, Syntaxerrorline(), and wl_psi_term::type.

{
  if(p->type==error_psi_term->type) {
    Syntaxerrorline("Module violation (%E).\n");
  }
}

Variable Documentation

long inchange

static

Definition at line 478 of file token.c.

ptr_psi_term old_state =NULL

Definition at line 480 of file token.c.

FILE* out

static

Definition at line 479 of file token.c.

long outchange

static

Definition at line 478 of file token.c.

long trace_input =FALSE

Definition at line 12 of file token.c.