Wild Life: token.c Source File

Wild Life 2.29

- Main Page
- Data Structures
- Files

- File List
- Globals

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
8 long trace_input=FALSE;
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 */
42 void stdin_cleareof()
43 {
44 if (eof_flag && stdin_terminal) {
45 clearerr(stdin);
46 start_of_line=TRUE;
47 saved_psi_term=NULL;
48 old_saved_psi_term=NULL;
49 saved_char=0;
50 old_saved_char=0;
51 eof_flag=FALSE;
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;
145 t1->value_3=(GENERIC)stack_copy_string(str);
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;
238 t1->value_3=(GENERIC)input_stream;
239
240 /* RM: Jan 27 1993
241 heap_mod_str_attr(t,CURRENT_MODULE,current_module->module_name);
242 */
243
244 heap_mod_str_attr(t,INPUT_FILE_NAME,input_file_name);
245 heap_mod_int_attr(t,LINE_COUNT,line_count);
246 heap_mod_int_attr(t,SAVED_CHAR,saved_char);
247 heap_mod_int_attr(t,OLD_SAVED_CHAR,old_saved_char);
248
249 t1=saved_psi_term?saved_psi_term:null_psi_term;
250 heap_add_psi_attr(t,SAVED_PSI_TERM,t1);
251
252 t1=old_saved_psi_term?old_saved_psi_term:null_psi_term;
253 heap_add_psi_attr(t,OLD_SAVED_PSI_TERM,t1);
254
255 t1=heap_psi_term(4);
256 t1->type=(eof_flag?lf_true:lf_false);
257 heap_add_psi_attr(t,EOF_FLAG,t1);
258
259 t1=heap_psi_term(4);
260 t1->type=(start_of_line?lf_true:lf_false);
261 heap_add_psi_attr(t,START_OF_LINE,t1);
262 }
263
264
265
266 /* Restore global state from an existing file state psi-term t */
267 void restore_state(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;
280 old_saved_char= *(REAL *)((ptr_psi_term)get_attr(t,OLD_SAVED_CHAR))->value_3;
281
282 saved_psi_term=(ptr_psi_term)get_attr(t,SAVED_PSI_TERM);
283 if (saved_psi_term==null_psi_term) saved_psi_term=NULL;
284
285 old_saved_psi_term=(ptr_psi_term)get_attr(t,OLD_SAVED_PSI_TERM);
286 if (old_saved_psi_term==null_psi_term) old_saved_psi_term=NULL;
287
288 eof_flag = ((ptr_psi_term)get_attr(t,EOF_FLAG))->type==lf_true;
289 start_of_line = ((ptr_psi_term)get_attr(t,START_OF_LINE))->type==lf_true;
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;
311 t1->value_3=(GENERIC)input_stream;
312 heap_add_psi_attr(*t,STREAM,t1);
313
314 /* RM: Jan 27 1993 */
315 heap_add_str_attr(*t,CURRENT_MODULE,current_module->module_name);
316
317 /*
318 printf("Creating new state for file '%s', module '%s'\n",
319 input_file_name,
320 current_module->module_name);
321 */
322
323 heap_add_str_attr(*t,INPUT_FILE_NAME,input_file_name);
324 heap_add_int_attr(*t,LINE_COUNT,line_count);
325 heap_add_int_attr(*t,SAVED_CHAR,saved_char);
326 heap_add_int_attr(*t,OLD_SAVED_CHAR,old_saved_char);
327
328 t1=saved_psi_term?saved_psi_term:null_psi_term;
329 heap_add_psi_attr(*t,SAVED_PSI_TERM,t1);
330
331 t1=old_saved_psi_term?old_saved_psi_term:null_psi_term;
332 heap_add_psi_attr(*t,OLD_SAVED_PSI_TERM,t1);
333
334 t1=heap_psi_term(4);
335 t1->type=(eof_flag?lf_true:lf_false);
336 heap_add_psi_attr(*t,EOF_FLAG,t1);
337
338 t1=heap_psi_term(4);
339 t1->type=(start_of_line?lf_true:lf_false);
340 heap_add_psi_attr(*t,START_OF_LINE,t1);
341 }
342
343
344
345 /****************************************************************************/
346
347
348 /* Parser/tokenizer state handling */
349
350 void save_parse_state(pb)
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
365 void restore_parse_state(pb)
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. */
381 void init_parse_state()
382 {
383 line_count=0;
384 start_of_line=TRUE;
385 saved_char=0;
386 old_saved_char=0;
387 saved_psi_term=NULL;
388 old_saved_psi_term=NULL;
389 eof_flag=FALSE;
390 stringparse=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 */
410 void begin_terminal_io()
411 {
412 inchange = (input_stream!=stdin);
413 outchange = (output_stream!=stdout);
414
415 if (outchange) {
416 out=output_stream;
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 */
431 void end_terminal_io()
432 {
433 if (inchange) {
434 input_state=old_state;
435 restore_state(old_state);
436 old_state=NULL; /* RM: Feb 17 1993 */
437 }
438 if (outchange)
439 output_stream=out;
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 */
449 char *expand_file_name(s)
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 */
511 if (input_state!=NULL) save_state(input_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);
535 init_parse_state();
536 /* Create a new state containing the new global values */
537 new_state(&input_state);
538 if (stdin_flag) stdin_state=input_state;
539 }
540 else {
541 input_state=stdin_state;
542 restore_state(input_state);
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 */
554 long open_output_file(file)
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)) {
592 saved_char=old_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) {
605 start_of_line=FALSE;
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)
619 start_of_line=TRUE;
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 */
633 void put_back_char(c)
634 long c;
635 {
636 if (old_saved_char)
637 Errorline("in tokenizer, put_back_char three times (last=%d).\n",c);
638 old_saved_char=saved_char;
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 */
647 void put_back_token(t)
648 psi_term t;
649 {
650 if (old_saved_psi_term!=NULL)
651 Errorline("in parser, put_back_token three times (last=%P).\n",t);
652 old_saved_psi_term=saved_psi_term;
653 saved_psi_term=stack_copy_psi_term(t);
654 }
655
656
657
658 /******** PSI_TERM_ERROR
659 Print the line number at which the current psi_term started.
660 */
661 void psi_term_error()
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
689 read_string_error(n)
690 int n;
691 {
692 if (stringparse) parse_ok=FALSE;
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
705 base2int(n)
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;
760 read_string_error(0);
761 }
762 else if (e=='"' && c=='\\') {
763 c=read_char();
764 if (c==EOF) {
765 store=FALSE;
766 flag=FALSE;
767 put_back_char('\\');
768 read_string_error(0);
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;
786 read_string_error(0);
787 break;
788 }
789 else if (!isxdigit(c)) {
790 store=flag=FALSE;
791 read_string_error(1);
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 */
861 long legal_in_name(c)
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) {
953 var_occurred=TRUE;
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 */
963 var_occurred=TRUE;
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;
1083 saved_psi_term=old_saved_psi_term;
1084 old_saved_psi_term=NULL;
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) {
1140 read_name(tok,c,legal_in_name,variable);
1141 }
1142 else
1143 if LOWER(c) {
1144 read_name(tok,c,legal_in_name,constant);
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. */
1175 var_occurred=TRUE;
1176 n=find(STRCMP,(char *)tok->value_3,var_tree);
1177 if (n==NULL) {
1178 ptr_psi_term t=stack_psi_term(0);
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 /****************************************************************************/
begin_terminal_io
void begin_terminal_io()
Definition: token.c:410
psi_term_error
void psi_term_error()
Definition: token.c:661
open_output_file
long open_output_file(string file)
Definition: token.c:554
init_parse_state
void init_parse_state()
Definition: token.c:381
read_token_main
void read_token_main(ptr_psi_term, long)
Definition: token.c:1073
FEATCMP
#define FEATCMP
Definition: def_const.h:257
LINE_COUNT
#define LINE_COUNT
Definition: def_const.h:227
stdin_state
ptr_psi_term stdin_state
Definition: def_glob.h:200
stdin_terminal
long stdin_terminal
Definition: def_glob.h:188
read_token_b
void read_token_b(ptr_psi_term tok)
Definition: token.c:1069
current_module
ptr_module current_module
Definition: def_glob.h:161
UPPER
#define UPPER(C)
Definition: def_macro.h:39
comment
ptr_definition comment
Definition: def_glob.h:80
bk_stack_add_psi_attr
void bk_stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
Definition: token.c:200
create_module
ptr_module create_module(char *module)
Definition: modules.c:67
eof_flag
long eof_flag
Definition: def_glob.h:196
bk_stack_insert
ptr_node bk_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:309
stream
ptr_definition stream
Definition: def_glob.h:103
psi_term_line_number
long psi_term_line_number
Definition: def_glob.h:268
stack_copy_string
char * stack_copy_string(char *s)
Definition: trees.c:155
start_of_line
long start_of_line
Definition: def_glob.h:191
heap_mod_int_attr
void heap_mod_int_attr(ptr_psi_term t, char *attrname, long value)
Definition: token.c:91
base2int
int base2int(int n)
Definition: token.c:705
global
#define global
Definition: def_const.h:364
input_file_name
string input_file_name
Definition: def_glob.h:40
SAVED_PSI_TERM
#define SAVED_PSI_TERM
Definition: def_const.h:231
heap_psi_term
ptr_psi_term heap_psi_term(long stat)
Definition: lefun.c:63
OLD_SAVED_CHAR
#define OLD_SAVED_CHAR
Definition: def_const.h:230
wl_module
Definition: def_struct.h:74
null_psi_term
ptr_psi_term null_psi_term
Definition: def_glob.h:140
save_state
void save_state(ptr_psi_term t)
Definition: token.c:230
defs.h
wl_psi_term
Definition: def_struct.h:161
save_parse_state
void save_parse_state(ptr_parse_block pb)
Definition: token.c:350
put_back_token
void put_back_token(psi_term t)
Definition: token.c:647
string
char string[STRLEN]
Definition: def_struct.h:27
stdin_cleareof
void stdin_cleareof()
Definition: token.c:42
CURRENT_MODULE
#define CURRENT_MODULE
Definition: def_const.h:234
DIGIT
#define DIGIT(C)
Definition: def_macro.h:37
constant
ptr_definition constant
Definition: def_glob.h:82
perr_s
void perr_s(char *s1, char *s2)
Definition: error.c:665
wl_node::data
GENERIC data
Definition: def_struct.h:185
old_saved_char
long old_saved_char
Definition: def_glob.h:193
NULL
#define NULL
Definition: def_const.h:203
var_tree
ptr_node var_tree
Definition: def_glob.h:26
bk2_stack_insert
ptr_node bk2_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:327
read_name
void read_name(ptr_psi_term tok, long ch, long(*f)(long), ptr_definition typ)
Definition: token.c:878
input_state
ptr_psi_term input_state
Definition: def_glob.h:199
end_terminal_io
void end_terminal_io()
Definition: token.c:431
read_string
void read_string(ptr_psi_term tok, long e)
Definition: token.c:743
saved_char
long saved_char
Definition: def_glob.h:192
old_state
ptr_psi_term old_state
Definition: token.c:399
REAL
#define REAL
Definition: def_const.h:72
noisy
long noisy
Definition: def_glob.h:35
update_symbol
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
LOWER
#define LOWER(C)
Definition: def_macro.h:41
SYMBOL
#define SYMBOL(C)
Definition: def_macro.h:52
outchange
static long outchange
Definition: token.c:397
trace_input
long trace_input
Definition: token.c:8
heap_insert
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:276
line_count
long line_count
Definition: def_glob.h:39
read_string_error
void read_string_error(int n)
Definition: token.c:689
Errorline
void Errorline(char *format,...)
Definition: error.c:414
heap_copy_string
char * heap_copy_string(char *s)
Definition: trees.c:147
wl_parse_block::lc
long lc
Definition: def_struct.h:372
EOLN
#define EOLN
Definition: def_const.h:140
stack_add_psi_attr
void stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
Definition: token.c:192
real
ptr_definition real
Definition: def_glob.h:102
read_number
void read_number(ptr_psi_term tok, long c)
Definition: token.c:986
stack_insert
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
infoline
void infoline(char *format,...)
Definition: error.c:245
restore_state
void restore_state(ptr_psi_term t)
Definition: token.c:267
eof
ptr_definition eof
Definition: def_glob.h:86
Syntaxerrorline
void Syntaxerrorline(char *format,...)
Definition: error.c:498
wl_parse_block
Definition: def_struct.h:371
TRUE
#define TRUE
Definition: def_const.h:127
STREAM
#define STREAM
Definition: def_const.h:225
START_OF_LINE
#define START_OF_LINE
Definition: def_const.h:228
heap_add_str_attr
void heap_add_str_attr(ptr_psi_term t, char *attrname, char *str)
Definition: token.c:122
STRCMP
#define STRCMP
Definition: def_const.h:255
error_psi_term
ptr_psi_term error_psi_term
Definition: def_glob.h:23
integer
ptr_definition integer
Definition: def_glob.h:93
heap_add_psi_attr
void heap_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
Definition: token.c:184
lf_true
ptr_definition lf_true
Definition: def_glob.h:107
final_dot
ptr_definition final_dot
Definition: def_glob.h:137
FALSE
#define FALSE
Definition: def_const.h:128
var_occurred
long var_occurred
Definition: def_glob.h:189
quoted_string
ptr_definition quoted_string
Definition: def_glob.h:101
stack_psi_term
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
input_stream
FILE * input_stream
Definition: def_glob.h:38
lf_false
ptr_definition lf_false
Definition: def_glob.h:89
wl_psi_term::value_3
GENERIC value_3
Definition: def_struct.h:170
INPUT_FILE_NAME
#define INPUT_FILE_NAME
Definition: def_const.h:226
wl_module::module_name
char * module_name
Definition: def_struct.h:75
wl_psi_term::coref
ptr_psi_term coref
Definition: def_struct.h:172
OLD_SAVED_PSI_TERM
#define OLD_SAVED_PSI_TERM
Definition: def_const.h:232
heap_add_int_attr
void heap_add_int_attr(ptr_psi_term t, char *attrname, long value)
Definition: token.c:58
expand_file_name
char * expand_file_name(char *s)
Definition: token.c:449
inchange
static long inchange
Definition: token.c:397
isoctal
#define isoctal(c)
Definition: token.c:737
new_state
void new_state(ptr_psi_term *t)
Definition: token.c:301
find
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
legal_in_name
long legal_in_name(long c)
Definition: token.c:861
get_attr
GENERIC get_attr(ptr_psi_term t, char *attrname)
Definition: token.c:210
stack_copy_psi_term
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
out
static FILE * out
Definition: token.c:398
wl_definition
Definition: def_struct.h:121
stack_add_str_attr
void stack_add_str_attr(ptr_psi_term t, char *attrname, char *str)
Definition: token.c:136
final_question
ptr_definition final_question
Definition: def_glob.h:138
saved_psi_term
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
read_comment
void read_comment(ptr_psi_term tok)
Definition: token.c:676
EOF_FLAG
#define EOF_FLAG
Definition: def_const.h:233
ptr_psi_term
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
prompt
char * prompt
Definition: def_glob.h:42
symbolic
long symbolic(long c)
Definition: token.c:850
cut
ptr_definition cut
Definition: def_glob.h:83
SINGLE
#define SINGLE(C)
Definition: def_macro.h:47
restore_parse_state
void restore_parse_state(ptr_parse_block pb)
Definition: token.c:365
stack_add_int_attr
void stack_add_int_attr(ptr_psi_term t, char *attrname, long value)
Definition: token.c:73
heap_mod_str_attr
void heap_mod_str_attr(ptr_psi_term t, char *attrname, char *str)
Definition: token.c:153
output_stream
FILE * output_stream
Definition: def_glob.h:41
nothing
ptr_definition nothing
Definition: def_glob.h:98
STRLEN
#define STRLEN
Definition: def_const.h:86
stringparse
long stringparse
Definition: def_glob.h:202
parse_ok
long parse_ok
Definition: def_glob.h:171
TOKEN_ERROR
void TOKEN_ERROR(ptr_psi_term p)
Definition: token.c:30
warningline
void warningline(char *format,...)
Definition: error.c:327
get_stream
FILE * get_stream(ptr_psi_term t)
Definition: token.c:219
stringinput
char * stringinput
Definition: def_glob.h:203
wl_node
Definition: def_struct.h:181
wl_psi_term::type
ptr_definition type
Definition: def_struct.h:165
SAVED_CHAR
#define SAVED_CHAR
Definition: def_const.h:229
open_input_file
long open_input_file(char *file)
Definition: token.c:504
GENERIC
unsigned long * GENERIC
Definition: def_struct.h:17
read_char
long read_char()
Definition: token.c:587
inputfilesym
ptr_definition inputfilesym
Definition: def_glob.h:120
variable
ptr_definition variable
Definition: def_glob.h:111
perr_i
void perr_i(char *str, long i)
Definition: error.c:677
heap_alloc
GENERIC heap_alloc(long s)
Definition: memory.c:1518
choice_stack
ptr_choice_point choice_stack
Definition: def_glob.h:51
old_saved_psi_term
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
read_token
void read_token(ptr_psi_term tok)
Definition: token.c:1063
put_back_char
void put_back_char(long c)
Definition: token.c:633