Wild Life  2.29
 All Data Structures Files Functions Variables Typedefs Macros
token.c
Go to the documentation of this file.
1 /* Copyright 1991 Digital Equipment Corporation.
2 ** All Rights Reserved.
3 *****************************************************************/
4 /* $Id: token.c,v 1.4 1995/07/27 19:22:17 duchier Exp $ */
5 
6 #include "defs.h"
7 
9 
10 /****************************************************************************/
11 
12 /* Abstract Data Type for the Input File State */
13 
14 /* FILE *last_eof_read; */
15 
16 /* Global input file state information */
17 /* Note: all characters should be stored in longs. This ensures
18  that noncharacters (i.e., EOF) can also be stored. */
19 /* Psi-term containing global input file state */
20 
21 /***********************************************/
22 /* Utilities */
23 /* All psi-terms created here are on the HEAP. */
24 /* Many utilities exist in two versions that allocate on the heap */
25 /* or the stack. */
26 /* All these routines are NON-backtrackable. */
27 
28 
29 
30 void TOKEN_ERROR(p) /* RM: Feb 1 1993 */
31 
32  ptr_psi_term p;
33 {
34  if(p->type==error_psi_term->type) {
35  Syntaxerrorline("Module violation (%E).\n");
36  }
37 }
38 
39 
40 
41 /* Clear EOF if necessary for stdin */
43 {
44  if (eof_flag && stdin_terminal) {
45  clearerr(stdin);
49  saved_char=0;
52  }
53 }
54 
55 
56 /* Add an attribute whose value is an integer to a psi-term */
57 /* that does not yet contains this attribute. */
58 void heap_add_int_attr(t, attrname, value)
59 ptr_psi_term t;
60 char * attrname;
61 long value;
62 {
63  ptr_psi_term t1;
64 
65  t1=heap_psi_term(4);
66  t1->type=integer;
67  t1->value_3=heap_alloc(sizeof(REAL));
68  *(REAL *)t1->value_3 = (REAL) value;
69 
70  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)t1);
71 }
72 
73 void stack_add_int_attr(t, attrname, value)
74 ptr_psi_term t;
75 char *attrname;
76 long value;
77 {
78  ptr_psi_term t1;
79 
80  t1=stack_psi_term(4);
81  t1->type=integer;
82  t1->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
83  *(REAL *)t1->value_3 = (REAL) value;
84 
85  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
86 }
87 
88 
89 /* Modify an attribute whose value is an integer to a psi-term */
90 /* that already contains this attribute with another integer value. */
91 void heap_mod_int_attr(t, attrname, value)
92 ptr_psi_term t;
93 char *attrname;
94 long value;
95 {
96  ptr_node n;
97  ptr_psi_term t1;
98 
99  n=find(FEATCMP,attrname,t->attr_list);
100  t1=(ptr_psi_term)n->data;
101  *(REAL *)t1->value_3 = (REAL) value;
102 }
103 
104 /*
105 void stack_mod_int_attr(t, attrname, value)
106 ptr_psi_term t;
107 char *attrname;
108 long value;
109 {
110  ptr_node n;
111  ptr_psi_term t1;
112 
113  n=find(FEATCMP,attrname,t->attr_list);
114  t1=(ptr_psi_term)n->data;
115  *(REAL *)t1->value_3 = (REAL) value;
116 }
117 */
118 
119 
120 /* Add an attribute whose value is a string to a psi-term */
121 /* that does not yet contains this attribute. */
122 void heap_add_str_attr(t, attrname, str)
123 ptr_psi_term t;
124 char *attrname;
125 char *str;
126 {
127  ptr_psi_term t1;
128 
129  t1=heap_psi_term(4);
130  t1->type=quoted_string;
131  t1->value_3=(GENERIC)heap_copy_string(str);
132 
133  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
134 }
135 
136 void stack_add_str_attr(t, attrname, str)
137 ptr_psi_term t;
138 char *attrname;
139 char *str;
140 {
141  ptr_psi_term t1;
142 
143  t1=stack_psi_term(4);
144  t1->type=quoted_string;
146 
147  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
148 }
149 
150 
151 /* Modify an attribute whose value is a string to a psi-term */
152 /* that already contains this attribute with another integer value. */
153 void heap_mod_str_attr(t, attrname, str)
154 ptr_psi_term t;
155 char *attrname;
156 char *str;
157 {
158  ptr_node n;
159  ptr_psi_term t1;
160 
161  n=find(FEATCMP,attrname,t->attr_list);
162  t1=(ptr_psi_term)n->data;
163  t1->value_3=(GENERIC)heap_copy_string(str);
164 }
165 
166 /*
167 ATTENTION - This should be made backtrackable if used
168 void stack_mod_str_attr(t, attrname, str)
169 ptr_psi_term t;
170 char *attrname;
171 char *str;
172 {
173  ptr_node n;
174  ptr_psi_term t1;
175 
176  n=find(FEATCMP,attrname,t->attr_list);
177  t1=(ptr_psi_term)n->data;
178  t1->value_3=(GENERIC)stack_copy_string(str);
179 }
180 */
181 
182 
183 /* Attach a psi-term to another as an attribute. */
184 void heap_add_psi_attr(t, attrname, g)
185 ptr_psi_term t;
186 char *attrname;
187 ptr_psi_term g;
188 {
189  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
190 }
191 
192 void stack_add_psi_attr(t, attrname, g)
193 ptr_psi_term t;
194 char *attrname;
195 ptr_psi_term g;
196 {
197  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
198 }
199 
200 void bk_stack_add_psi_attr(t, attrname, g)
201 ptr_psi_term t;
202 char *attrname;
203 ptr_psi_term g;
204 {
205  (void)bk_stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)g);
206 }
207 
208 
209 /* Get the GENERIC value of a psi-term's attribute */
210 GENERIC get_attr(t, attrname)
211 ptr_psi_term t;
212 char *attrname;
213 {
214  ptr_node n=find(FEATCMP,attrname,t->attr_list);
215  return n->data;
216 }
217 
218 /* Get the psi-term's STREAM attribute */
219 FILE *get_stream(t)
220 ptr_psi_term t;
221 {
222  return (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
223 }
224 
225 /***********************************************/
226 /* Main routines for saving & restoring state */
227 
228 
229 /* Save global state into an existing file state psi-term t */
230 void save_state(t)
231 ptr_psi_term t;
232 {
233  ptr_node n;
234  ptr_psi_term t1;
235 
236  n=find(FEATCMP,STREAM,t->attr_list);
237  t1=(ptr_psi_term)n->data;
239 
240  /* RM: Jan 27 1993
241  heap_mod_str_attr(t,CURRENT_MODULE,current_module->module_name);
242  */
243 
248 
251 
254 
255  t1=heap_psi_term(4);
258 
259  t1=heap_psi_term(4);
262 }
263 
264 
265 
266 /* Restore global state from an existing file state psi-term t */
268 ptr_psi_term t;
269 {
270  // long i;
271  char *str;
272 
273 
274  input_stream = (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
275  str = (char*) ((ptr_psi_term)get_attr(t,INPUT_FILE_NAME))->value_3;
276  strcpy(input_file_name,str);
277  /* for (i=0;i++;i<=strlen(str)) input_file_name[i]=str[i]; */
278  line_count = *(REAL *) ((ptr_psi_term)get_attr(t,LINE_COUNT))->value_3;
279  saved_char = *(REAL *) ((ptr_psi_term)get_attr(t,SAVED_CHAR))->value_3;
281 
284 
287 
290 
291 
292  /* RM: Jan 27 1993
293  set_current_module(
294  find_module(((ptr_psi_term)get_attr(input_state,
295  CURRENT_MODULE))->value_3));
296  */
297 }
298 
299 
300 /* Create a new file state psi-term that reflects the current global state */
301 void new_state(t)
302 ptr_psi_term *t;
303 {
304  ptr_psi_term t1;
305 
306  *t=heap_psi_term(4);
307  (*t)->type=inputfilesym;
308 
309  t1=heap_psi_term(4);
310  t1->type=stream;
312  heap_add_psi_attr(*t,STREAM,t1);
313 
314  /* RM: Jan 27 1993 */
316 
317  /*
318  printf("Creating new state for file '%s', module '%s'\n",
319  input_file_name,
320  current_module->module_name);
321  */
322 
327 
330 
333 
334  t1=heap_psi_term(4);
337 
338  t1=heap_psi_term(4);
341 }
342 
343 
344 
345 /****************************************************************************/
346 
347 
348 /* Parser/tokenizer state handling */
349 
351 ptr_parse_block pb;
352 {
353  if (pb) {
354  pb->lc = line_count;
355  pb->sol = start_of_line;
356  pb->sc = saved_char;
357  pb->osc = old_saved_char;
358  pb->spt = saved_psi_term;
359  pb->ospt = old_saved_psi_term;
360  pb->ef = eof_flag;
361  }
362 }
363 
364 
366 ptr_parse_block pb;
367 {
368  if (pb) {
369  line_count = pb->lc;
370  start_of_line = pb->sol;
371  saved_char = pb->sc;
372  old_saved_char = pb->osc;
373  saved_psi_term = pb->spt;
374  old_saved_psi_term = pb->ospt;
375  eof_flag = pb->ef;
376  }
377 }
378 
379 
380 /* Initialize the parser/tokenizer state variables. */
382 {
383  line_count=0;
385  saved_char=0;
386  old_saved_char=0;
389  eof_flag=FALSE;
391 }
392 
393 
394 /****************************************************************************/
395 
396 
397 static long inchange, outchange;
398 static FILE *out;
399 ptr_psi_term old_state=NULL; /* RM: Feb 17 1993 */
400 
401 
402 
403 /******** BEGIN_TERMINAL_IO()
404  These two routines must bracket any I/O directed to the terminal.
405  This is to avoid mix-ups between terminal and file I/O since the
406  program's input and output streams may be different from stdin stdout.
407  See the routine what_next_aim(), which uses them to isolate the
408  user interface I/O from the program's own I/O.
409 */
411 {
412  inchange = (input_stream!=stdin);
413  outchange = (output_stream!=stdout);
414 
415  if (outchange) {
417  output_stream=stdout;
418  }
419 
420  if (inchange) {
421  old_state=input_state;
422  (void)open_input_file("stdin");
423  }
424 }
425 
426 
427 
428 /******** END_TERMINAL_IO()
429  End of terminal I/O bracketing.
430 */
432 {
433  if (inchange) {
435  restore_state(old_state);
436  old_state=NULL; /* RM: Feb 17 1993 */
437  }
438  if (outchange)
440 }
441 
442 
443 
444 /******** EXPAND_FILE_NAME(str)
445  Return the expansion of file name STR.
446  For the time being all this does is replace '~' by the HOME directory
447  if no user is given, or tries to find the user.
448 */
450 char *s;
451 {
452  char *r;
453  char *home; // *getenv();
454  struct passwd *pw;
455  /* char *user="eight character name"; 18.5 */
456  char userbuf[STRLEN];
457  char *user=userbuf;
458  char *t1,*t2;
459 
460  r=s;
461  if (s[0]=='~') {
462  t1=s+1;
463  t2=user;
464  while (*t1!=0 && *t1!='/') {
465  *t2= *t1;
466  *t2++;
467  *t1++;
468  }
469  *t2=0;
470  if ((int)strlen(user)>0) {
471  pw = getpwnam(user);
472  if (pw) {
473  user=pw->pw_dir;
474  r=(char *)malloc(strlen(user)+strlen(t1)+1);
475  sprintf(r,"%s%s",user,t1);
476  }
477  else
478  /* if (warning()) printf("couldn't find user '%s'.\n",user) */;
479  }
480  else {
481  home=getenv("HOME");
482  if (home) {
483  r=(char *)malloc(strlen(home)+strlen(s)+1);
484  sprintf(r,"%s%s",home,s+1);
485  }
486  else
487  /* if (warning()) printf("no HOME directory.\n") */;
488  }
489  }
490 
491  /* printf("*** Using file name: '%s'\n",r); */
492 
493  return r;
494 }
495 
496 
497 
498 /******** OPEN_INPUT_FILE(file)
499  Open the input file specified by the string FILE. If the file is "stdin",
500  restore the stdin state. Otherwise, open the file and create a new global
501  state for it.
502  If the file can't be opened, print an error and open "stdin" instead.
503 */
504 long open_input_file(file)
505 char *file;
506 {
507  long ok=TRUE;
508  long stdin_flag;
509 
510  /* Save global input file state */
512 
513  file=expand_file_name(file);
514 
515  if ((stdin_flag=(!strcmp(file,"stdin")))) {
516  input_stream=stdin;
517  noisy=TRUE;
518  }
519  else {
520  input_stream=fopen(file,"r");
521  noisy=FALSE;
522  }
523 
524  if (input_stream==NULL) {
525  Errorline("file '%s' does not exist.\n",file);
526  file="stdin";
527  input_stream=stdin;
528  noisy=TRUE;
529  ok=FALSE;
530  }
531 
532  if (!stdin_flag || stdin_state==NULL) {
533  /* Initialize a new global input file state */
534  strcpy(input_file_name,file);
536  /* Create a new state containing the new global values */
538  if (stdin_flag) stdin_state=input_state;
539  }
540  else {
543  }
544 
545  return ok;
546 }
547 
548 
549 
550 /******** OPEN_OUTPUT_FILE(file)
551  Same thing as OPEN_INPUT_FILE, only for output. If FILE="stdout" then
552  output_stream=stdout.
553 */
555 string file;
556 {
557  long ok=TRUE;
558 
559 
560  file=expand_file_name(file);
561 
562  if (!strcmp(file,"stdout"))
563  output_stream=stdout;
564  else
565  if (!strcmp(file,"stderr"))
566  output_stream=stderr;
567  else
568  output_stream=fopen(file,"w");
569 
570  if (output_stream==NULL) {
571  Errorline("file '%s' could not be opened for output.\n",file);
572  ok=FALSE;
573  output_stream=stdout;
574  }
575 
576  return ok;
577 }
578 
579 
580 
581 /******** READ_CHAR
582  Return the char read from the input stream, if end of file reached
583  then return EOF.
584  If stringparse==TRUE then read characters from the input string
585  instead of from a file.
586 */
587 long read_char()
588 {
589  int c=0;
590 
591  if ((c=saved_char)) {
593  old_saved_char=0;
594  }
595  else if (stringparse) {
596  if ((c=(*stringinput)))
597  stringinput++;
598  else
599  c=EOF;
600  }
601  else if (input_stream == NULL || feof(input_stream))
602  c=EOF;
603  else {
604  if (start_of_line) {
606  line_count++;
607  if (input_stream==stdin) infoline("%s",prompt); /* 21.1 */
608  }
609 
610  c=fgetc(input_stream);
611 
612  if(trace_input) /* RM: Jan 13 1993 */
613  if(c!=EOF)
614  printf("%c",c);
615  else
616  printf(" <EOF>\n");
617 
618  if (c==EOLN)
620  }
621 
622  /* printf("%c\n",c); RM: Jan 5 1993 Just to trace the parser */
623 
624  return c;
625 }
626 
627 
628 
629 /******** PUT_BACK_CHAR
630  Put back one character, if there already are 2 saved characters then report
631  an error (= bug).
632 */
634 long c;
635 {
636  if (old_saved_char)
637  Errorline("in tokenizer, put_back_char three times (last=%d).\n",c);
639  saved_char=c;
640 }
641 
642 
643 /******** PUT_BACK_TOKEN
644  Put back a psi_term, if there already are two saved then report an
645  error (= bug).
646 */
648 psi_term t;
649 {
651  Errorline("in parser, put_back_token three times (last=%P).\n",t);
654 }
655 
656 
657 
658 /******** PSI_TERM_ERROR
659  Print the line number at which the current psi_term started.
660 */
662 {
663  perr_i("near line %ld",psi_term_line_number);
664  if (strcmp(input_file_name,"stdin")) {
665  perr_s(" in file \042%s\042",input_file_name);
666  }
667  /* prompt="error>"; 20.8 */
668  parse_ok=FALSE;
669 }
670 
671 
672 
673 /******** READ_COMMENT
674  Read a comment starting with '%' to the end of the line.
675 */
676 void read_comment(tok)
677 ptr_psi_term tok;
678 {
679  long c;
680 
681  do {
682  c=read_char();
683  } while (c!=EOF && c!=EOLN);
684 
685  tok->type=comment;
686 }
687 
688 void
690  int n;
691 {
693  else
694  switch (n) {
695  case 0:
696  Syntaxerrorline("end of file reached before end of string (%E).\n");
697  break;
698  case 1:
699  Syntaxerrorline("Hexadecimal digit expected (%E).\n");
700  break;
701  }
702 }
703 
704 int
706  int n;
707 {
708  switch (n) {
709  case '0': return 0;
710  case '1': return 1;
711  case '2': return 2;
712  case '3': return 3;
713  case '4': return 4;
714  case '5': return 5;
715  case '6': return 6;
716  case '7': return 7;
717  case '8': return 8;
718  case '9': return 9;
719  case 'a':
720  case 'A': return 10;
721  case 'b':
722  case 'B': return 11;
723  case 'c':
724  case 'C': return 12;
725  case 'd':
726  case 'D': return 13;
727  case 'e':
728  case 'E': return 14;
729  case 'f':
730  case 'F': return 15;
731  default:
732  fprintf(stderr,"base2int('%c'): illegal argument\n",n);
733  exit(EXIT_FAILURE);
734  }
735 }
736 
737 #define isoctal(c) (c=='0'||c=='1'||c=='2'||c=='3'||c=='4'||c=='5'||c=='6'||c=='7')
738 
739 /******** READ_STRING(e)
740  Read a string ending with character E, where E=" or '. Transform a double
741  occurrence into a single one so that 'ab""cd' is the string 'ab"cd'.
742 */
743 void read_string(tok,e)
744 ptr_psi_term tok;
745 long e;
746 {
747  long c;
748  string str;
749  long len=0;
750  long store=TRUE;
751  long flag=TRUE;
752 
753  str[len]=0;
754 
755  do {
756  c=read_char();
757  if (c==EOF) {
758  store=FALSE;
759  flag=FALSE;
761  }
762  else if (e=='"' && c=='\\') {
763  c=read_char();
764  if (c==EOF) {
765  store=FALSE;
766  flag=FALSE;
767  put_back_char('\\');
769  }
770  else {
771  switch (c) {
772  case 'a': c='\a'; break;
773  case 'b': c='\b'; break;
774  case 'f': c='\f'; break;
775  case 'n': c='\n'; break;
776  case 'r': c='\r'; break;
777  case 't': c='\t'; break;
778  case 'v': c='\v'; break;
779  /* missing \ooo and \xhh */
780  case 'x':
781  {
782  int n;
783  c=read_char();
784  if (c==EOF) {
785  store=flag=FALSE;
787  break;
788  }
789  else if (!isxdigit(c)) {
790  store=flag=FALSE;
792  break;
793  }
794  else {
795  n = base2int(c);
796  }
797  c=read_char();
798  if (isxdigit(c)) n = 16*n+base2int(c);
799  else put_back_char(c);
800  c=n;
801  break;
802  }
803  default:
804  if (isoctal(c)) {
805  int n,i;
806  for(i=n=0;i<3&&isoctal(c);i++,c=read_char())
807  n = n*8 + base2int(c);
808  if (c!=EOF) put_back_char(c);
809  c=n;
810  break;
811  }
812  else break;
813  }
814  }
815  }
816  else
817  if (c==e) {
818  c=read_char();
819  if (c!=e) {
820  store=FALSE;
821  flag=FALSE;
822  put_back_char(c);
823  }
824  }
825  if (store)
826  if (len==STRLEN) {
827  warningline("string too long, extra ignored (%E).\n");
828  store=FALSE;
829  }
830  else {
831  str[len++]=c;
832  str[len]=0;
833  }
834  } while(flag);
835 
836  if (e=='"')
837  tok->value_3=(GENERIC)heap_copy_string(str);
838  else {
839  tok->type=update_symbol(NULL,str); /* Maybe no_module would be better */
840  tok->value_3=NULL;
841  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
842  }
843 }
844 
845 
846 
847 /******** SYMBOLIC(character)
848  Tests if character is a symbol (see macro).
849 */
850 long symbolic(c)
851 long c;
852 {
853  return SYMBOL(c);
854 }
855 
856 
857 
858 /******** LEGAL_IN_NAME(character)
859  Tests if character is legal in a name or a variable (see macros).
860 */
862 long c;
863 {
864  return
865  UPPER(c) ||
866  LOWER(c) ||
867  DIGIT(c);
868 
869  /* || c=='\'' RM: Dec 16 1992 */ ;
870 }
871 
872 
873 
874 /******** READ_NAME(C,F,TYP)
875  Read in the name starting with character C followed by character of whose
876  type function is F. The result is a psi_term of symbol type TYP.
877 */
878 void read_name(tok,ch,f,typ)
879 ptr_psi_term tok;
880 long ch;
881 long (*f)(long);
882 ptr_definition typ;
883 {
884  char c;
885  string str;
886  long len=1;
887  long store=TRUE;
888  long flag=TRUE;
889  ptr_module module=NULL;
890  ptr_node n; /* RM: Feb 9 1993 */
891 
892  tok->coref=NULL;
893  tok->resid=NULL;
894  tok->attr_list=NULL;
895 
896  str[0]=ch;
897 
898  do {
899  c=read_char();
900  flag=(*f)(c);
901 
902  if(c=='#' && /* RM: Feb 3 1993 */
903  (long)f==(long)legal_in_name &&
904  len>0 &&
905  len<STRLEN &&
906  !module) {
907  str[len]=0;
908  module=create_module(str);
909  len=0;
910  flag=TRUE;
911 
912  /* RM: Sep 21 1993 */
913  /* Change the type function if required */
914  c=read_char();
915  if SYMBOL(c)
916  f=symbolic;
917  put_back_char(c);
918  }
919  else
920  if (flag) {
921  if (store)
922  if (len==STRLEN) {
923  warningline("name too long, extra ignored (%E).\n");
924  store=FALSE;
925  }
926  else
927  str[len++]=c;
928  }
929  else
930  put_back_char(c);
931  } while(flag);
932 
933  if(module && len==0) { /* RM: Feb 3 1993 */
934  strcpy(str,module->module_name);
935  len=strlen(str);
936  put_back_char('#');
937  module=NULL;
938  }
939 
940  str[len]=0;
941 
942  tok->type=typ;
943 
944  if(typ==constant) {
945  /* printf("module=%s\n",module->module_name); */
946  tok->type=update_symbol(module,str); /* RM: Feb 3 1993 */
947  tok->value_3=NULL;
948 
949  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
950 
951  /* PVR 4.2.94 for correct level incrementing */
952  if (tok->type->type_def==(def_type)global) {
954  }
955  if (FALSE /*tok->type->type==global && tok->type->global_value*/) {
956  /* RM: Nov 10 1993 */
957 
958  /* Remove this for Bruno who didn't like it, and doesn't like
959  to use "print_depth" */
960 
961  /* RM: Feb 9 1993 */
962  /* Add into the variable tree */
964  n=find(STRCMP,tok->type->keyword->symbol,var_tree);
965  if (n==NULL) {
966  /* The change is always trailed. */
967  (void)bk2_stack_insert(STRCMP,
968  tok->type->keyword->symbol,
969  &var_tree,
970  (GENERIC)tok->type->global_value);
971  }
972  }
973 
974  }
975  else
976  tok->value_3=(GENERIC)heap_copy_string(str);
977 }
978 
979 
980 
981 /******** READ_NUMBER(c)
982  Read in the number whose first character is c.
983  Accepted syntax: digit+ [ . digit+ ] [ {e|E} {+|-|empty} digit* ]
984  Negative numbers are dealt with in the parser.
985 */
986 void read_number(tok,c)
987 ptr_psi_term tok;
988 long c;
989 {
990  long c2;
991  REAL f,p;
992  long /* sgn, */ pwr,posflag;
993 
994  /* if (sgn=(c=='-')) c=read_char(); */
995 
996  /* tok->type=integer; RM: Mar 8 1993 */
997 
998  f=0.0;
999  do { f=f*10.0+(c-'0'); c=read_char(); } while (DIGIT(c));
1000 
1001  if (c=='.') {
1002  c2=read_char();
1003  if DIGIT(c2) {
1004  /* tok->type=real; RM: Mar 8 1993 */
1005  p=10.0;
1006  while (DIGIT(c2)) { f=f+(c2-'0')/p; p=p*10.0; c2=read_char(); }
1007  put_back_char(c2);
1008  }
1009  else {
1010  put_back_char(c2);
1011  put_back_char(c);
1012  }
1013  }
1014  else
1015  put_back_char(c);
1016 
1017  c=read_char();
1018  if (c=='e' || c=='E') {
1019  c2=read_char();
1020  if (c2=='+' || c2=='-' || DIGIT(c2)) {
1021  tok->type=real;
1022  posflag = (c2=='+' || DIGIT(c2));
1023  if (!DIGIT(c2)) c2=read_char();
1024  pwr=0;
1025  while (DIGIT(c2)) { pwr=pwr*10+(c2-'0'); c2=read_char(); }
1026  put_back_char(c2);
1027  p=1.0;
1028  while (pwr>=100) { pwr-=100; if (posflag) p*=1e100; else p/=1e100; }
1029  while (pwr>=10 ) { pwr-=10; if (posflag) p*=1e10; else p/=1e10; }
1030  while (pwr>0 ) { pwr-=1; if (posflag) p*=1e1; else p/=1e1; }
1031  f*=p;
1032  }
1033  else {
1034  put_back_char(c2);
1035  put_back_char(c);
1036  }
1037  }
1038  else
1039  put_back_char(c);
1040 
1041  /* if (sgn) f = -f; */
1042  tok->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
1043  *(REAL *)tok->value_3=f;
1044 
1045  /* RM: Mar 8 1993 */
1046  if(f==floor(f))
1047  tok->type=integer;
1048  else
1049  tok->type=real;
1050 }
1051 
1052 
1053 
1054 /******** READ_TOKEN
1055  Read in one token from the input stream, represented as a psi_term.
1056  Return the psi_term 'end_of_file' if that is the case.
1057 */
1058 
1059 void read_token_main(ptr_psi_term,long); /* Forward declaration */
1060 
1061 /* Used in the parser */
1062 /* Set prompt to the 'partial input' prompt */
1063 void read_token(tok)
1064 ptr_psi_term tok;
1065 { read_token_main(tok, TRUE); }
1066 
1067 /* Used as a built-in */
1068 /* Prompt is unchanged */
1069 void read_token_b(tok)
1070 ptr_psi_term tok;
1071 { read_token_main(tok, FALSE); }
1072 
1073 void read_token_main(tok, for_parser)
1074 ptr_psi_term tok;
1075 long for_parser;
1076 {
1077  long c, c2;
1078  ptr_node n;
1079  char p[2];
1080 
1081  if (for_parser && (saved_psi_term!=NULL)) {
1082  *tok= *saved_psi_term;
1085  }
1086  else {
1087  tok->type=nothing;
1088 
1089  do {
1090  c=read_char();
1091  } while(c!=EOF && (c<=32));
1092 
1093  if (for_parser) psi_term_line_number=line_count;
1094 
1095  switch(c) {
1096  case EOF:
1097  tok->type=eof;
1098  tok->value_3=NULL;
1099  break;
1100  case '%':
1101  read_comment(tok);
1102  break;
1103  case '"':
1104  read_string(tok,c);
1105  tok->type=quoted_string;
1106  break;
1107  case 39: /* The quote symbol "'" */
1108  read_string(tok,c);
1109  break;
1110 
1111  default:
1112 
1113  /* Adding this results in problems with terms like (N-1) */
1114  /* if (c=='-' && (c2=read_char()) && DIGIT(c2)) {
1115  put_back_char(c2);
1116  read_number(tok,c);
1117  }
1118  else */
1119 
1120  if(c=='.' || c=='?') { /* RM: Jul 7 1993 */
1121  c2=read_char();
1122  put_back_char(c2);
1123  /*printf("c2=%d\n",c2);*/
1124  if(c2<=' ' || c2==EOF) {
1125  if(c=='.')
1126  tok->type=final_dot;
1127  else
1128  tok->type=final_question;
1129 
1130  tok->value_3=NULL;
1131  }
1132  else
1133  read_name(tok,c,symbolic,constant);
1134  }
1135  else
1136  if DIGIT(c)
1137  read_number(tok,c);
1138  else
1139  if UPPER(c) {
1141  }
1142  else
1143  if LOWER(c) {
1145  }
1146  else
1147  if SYMBOL(c) {
1148  read_name(tok,c,symbolic,constant);
1149  }
1150  else /* RM: Jul 7 1993 Moved this */
1151  if SINGLE(c) {
1152  p[0]=c; p[1]=0;
1153  tok->type=update_symbol(current_module,p);
1154  tok->value_3=NULL;
1155  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1156  }
1157  else {
1158  Errorline("illegal character %d in input (%E).\n",c);
1159  }
1160  }
1161 
1162  if (tok->type==variable) {
1163  if (tok->value_3) {
1164  /* If the variable read in has name "_", then it becomes 'top' */
1165  /* and is no longer a variable whose name must be remembered. */
1166  /* As a result, '@' and '_' are synonyms in the program input. */
1167  if (!strcmp((char *)tok->value_3,"_")) {
1168  p[0]='@'; p[1]=0;
1169  tok->type=update_symbol(current_module,p);
1170  tok->value_3=NULL;
1171  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1172  }
1173  else {
1174  /* Insert into variable tree, create 'top' value if need be. */
1176  n=find(STRCMP,(char *)tok->value_3,var_tree);
1177  if (n==NULL) {
1179  /* The change is always trailed. */
1180  (void)bk2_stack_insert(STRCMP,(char *)tok->value_3,&var_tree,(GENERIC)t); /* 17.8 */
1181  tok->coref=t;
1182  }
1183  else
1184  tok->coref=(ptr_psi_term)n->data;
1185  }
1186  }
1187  /* else do nothing */
1188  }
1189  }
1190 
1191  if (tok->type==comment)
1192  read_token(tok);
1193 
1194  if (tok->type!=variable)
1195  tok->coref=NULL;
1196 
1197  tok->attr_list=NULL;
1198  tok->status=0;
1199  tok->flags=FALSE; /* 14.9 */
1200  tok->resid=NULL;
1201 
1202  if (tok->type==cut) /* 12.7 */
1203  tok->value_3=(GENERIC)choice_stack;
1204 
1205  do {
1206  c=read_char();
1207  if (c==EOLN) {
1208  if (for_parser) put_back_char(c);
1209  c=0;
1210  }
1211  else if (c<0 || c>32) {
1212  put_back_char(c);
1213  c=0;
1214  }
1215  } while(c && c!=EOF);
1216 
1217  if (for_parser) prompt="| ";
1218 }
1219 
1220 /****************************************************************************/
void begin_terminal_io()
Definition: token.c:410
void psi_term_error()
Definition: token.c:661
long open_output_file(string file)
Definition: token.c:554
void init_parse_state()
Definition: token.c:381
void read_token_main(ptr_psi_term, long)
Definition: token.c:1073
#define FEATCMP
Definition: def_const.h:257
#define LINE_COUNT
Definition: def_const.h:227
ptr_psi_term stdin_state
Definition: def_glob.h:200
long stdin_terminal
Definition: def_glob.h:188
void read_token_b(ptr_psi_term tok)
Definition: token.c:1069
ptr_module current_module
Definition: def_glob.h:161
#define UPPER(C)
Definition: def_macro.h:39
ptr_definition comment
Definition: def_glob.h:80
void bk_stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
Definition: token.c:200
ptr_module create_module(char *module)
Definition: modules.c:67
long eof_flag
Definition: def_glob.h:196
ptr_node bk_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:309
ptr_definition stream
Definition: def_glob.h:103
long psi_term_line_number
Definition: def_glob.h:268
char * stack_copy_string(char *s)
Definition: trees.c:155
long start_of_line
Definition: def_glob.h:191
void heap_mod_int_attr(ptr_psi_term t, char *attrname, long value)
Definition: token.c:91
int base2int(int n)
Definition: token.c:705
#define global
Definition: def_const.h:364
string input_file_name
Definition: def_glob.h:40
#define SAVED_PSI_TERM
Definition: def_const.h:231
ptr_psi_term heap_psi_term(long stat)
heap_psi_term
Definition: lefun.c:75
#define OLD_SAVED_CHAR
Definition: def_const.h:230
ptr_psi_term null_psi_term
Definition: def_glob.h:140
void save_state(ptr_psi_term t)
Definition: token.c:230
void save_parse_state(ptr_parse_block pb)
Definition: token.c:350
void put_back_token(psi_term t)
Definition: token.c:647
char string[STRLEN]
Definition: def_struct.h:27
void stdin_cleareof()
Definition: token.c:42
#define CURRENT_MODULE
Definition: def_const.h:234
#define DIGIT(C)
Definition: def_macro.h:37
ptr_definition constant
Definition: def_glob.h:82
void perr_s(char *s1, char *s2)
Definition: error.c:665
GENERIC data
Definition: def_struct.h:185
long old_saved_char
Definition: def_glob.h:193
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
ptr_node bk2_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:327
void read_name(ptr_psi_term tok, long ch, long(*f)(long), ptr_definition typ)
Definition: token.c:878
ptr_psi_term input_state
Definition: def_glob.h:199
void end_terminal_io()
Definition: token.c:431
void read_string(ptr_psi_term tok, long e)
Definition: token.c:743
long saved_char
Definition: def_glob.h:192
ptr_psi_term old_state
Definition: token.c:399
#define REAL
Definition: def_const.h:72
long noisy
Definition: def_glob.h:35
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
#define LOWER(C)
Definition: def_macro.h:41
#define SYMBOL(C)
Definition: def_macro.h:52
static long outchange
Definition: token.c:397
long trace_input
Definition: token.c:8
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:276
long line_count
Definition: def_glob.h:39
void read_string_error(int n)
Definition: token.c:689
void Errorline(char *format,...)
Definition: error.c:414
char * heap_copy_string(char *s)
Definition: trees.c:147
#define EOLN
Definition: def_const.h:140
void stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
Definition: token.c:192
ptr_definition real
Definition: def_glob.h:102
void read_number(ptr_psi_term tok, long c)
Definition: token.c:986
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
void infoline(char *format,...)
Definition: error.c:245
void restore_state(ptr_psi_term t)
Definition: token.c:267
ptr_definition eof
Definition: def_glob.h:86
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define TRUE
Definition: def_const.h:127
#define STREAM
Definition: def_const.h:225
#define START_OF_LINE
Definition: def_const.h:228
void heap_add_str_attr(ptr_psi_term t, char *attrname, char *str)
Definition: token.c:122
#define STRCMP
Definition: def_const.h:255
ptr_psi_term error_psi_term
Definition: def_glob.h:23
ptr_definition integer
Definition: def_glob.h:93
void heap_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
Definition: token.c:184
ptr_definition lf_true
Definition: def_glob.h:107
ptr_definition final_dot
Definition: def_glob.h:137
#define FALSE
Definition: def_const.h:128
long var_occurred
Definition: def_glob.h:189
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
FILE * input_stream
Definition: def_glob.h:38
ptr_definition lf_false
Definition: def_glob.h:89
GENERIC value_3
Definition: def_struct.h:170
#define INPUT_FILE_NAME
Definition: def_const.h:226
char * module_name
Definition: def_struct.h:75
ptr_psi_term coref
Definition: def_struct.h:172
#define OLD_SAVED_PSI_TERM
Definition: def_const.h:232
void heap_add_int_attr(ptr_psi_term t, char *attrname, long value)
Definition: token.c:58
char * expand_file_name(char *s)
Definition: token.c:449
static long inchange
Definition: token.c:397
#define isoctal(c)
Definition: token.c:737
void new_state(ptr_psi_term *t)
Definition: token.c:301
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
long legal_in_name(long c)
Definition: token.c:861
GENERIC get_attr(ptr_psi_term t, char *attrname)
Definition: token.c:210
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
static FILE * out
Definition: token.c:398
void stack_add_str_attr(ptr_psi_term t, char *attrname, char *str)
Definition: token.c:136
ptr_definition final_question
Definition: def_glob.h:138
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
void read_comment(ptr_psi_term tok)
Definition: token.c:676
#define EOF_FLAG
Definition: def_const.h:233
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
char * prompt
Definition: def_glob.h:42
long symbolic(long c)
Definition: token.c:850
ptr_definition cut
Definition: def_glob.h:83
#define SINGLE(C)
Definition: def_macro.h:47
void restore_parse_state(ptr_parse_block pb)
Definition: token.c:365
void stack_add_int_attr(ptr_psi_term t, char *attrname, long value)
Definition: token.c:73
void heap_mod_str_attr(ptr_psi_term t, char *attrname, char *str)
Definition: token.c:153
FILE * output_stream
Definition: def_glob.h:41
ptr_definition nothing
Definition: def_glob.h:98
#define STRLEN
Definition: def_const.h:86
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
void TOKEN_ERROR(ptr_psi_term p)
Definition: token.c:30
void warningline(char *format,...)
Definition: error.c:327
FILE * get_stream(ptr_psi_term t)
Definition: token.c:219
char * stringinput
Definition: def_glob.h:203
ptr_definition type
Definition: def_struct.h:165
#define SAVED_CHAR
Definition: def_const.h:229
long open_input_file(char *file)
Definition: token.c:504
unsigned long * GENERIC
Definition: def_struct.h:17
long read_char()
Definition: token.c:587
ptr_definition inputfilesym
Definition: def_glob.h:120
ptr_definition variable
Definition: def_glob.h:111
void perr_i(char *str, long i)
Definition: error.c:677
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
ptr_choice_point choice_stack
Definition: def_glob.h:51
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
void read_token(ptr_psi_term tok)
Definition: token.c:1063
void put_back_char(long c)
Definition: token.c:633