Wild Life: token.c Source File

Wild Life 2.30

- 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
6 /* Copyright 1991 Digital Equipment Corporation.
7 ** All Rights Reserved.
8 *****************************************************************/
9
10 #include "defs.h"
11
12 long trace_input=FALSE;
13
14 /****************************************************************************/
15
16 /* Abstract Data Type for the Input File State */
17
18 /* FILE *last_eof_read; */
19
20 /* Global input file state information */
21 /* Note: all characters should be stored in longs. This ensures
22 that noncharacters (i.e., EOF) can also be stored. */
23 /* Psi-term containing global input file state */
24
25 /***********************************************/
26 /* Utilities */
27 /* All psi-terms created here are on the HEAP. */
28 /* Many utilities exist in two versions that allocate on the heap */
29 /* or the stack. */
30 /* All these routines are NON-backtrackable. */
31
38 void TOKEN_ERROR(ptr_psi_term p) /* RM: Feb 1 1993 */
39 {
40 if(p->type==error_psi_term->type) {
41 Syntaxerrorline("Module violation (%E).\n");
42 }
43 }
44
51 void stdin_cleareof()
52 {
53 if (eof_flag && stdin_terminal) {
54 clearerr(stdin);
55 start_of_line=TRUE;
56 saved_psi_term=NULL;
57 old_saved_psi_term=NULL;
58 saved_char=0;
59 old_saved_char=0;
60 eof_flag=FALSE;
61 }
62 }
63
74 void heap_add_int_attr(ptr_psi_term t, char *attrname, long value)
75 {
76 ptr_psi_term t1;
77
78 t1=heap_psi_term(4);
79 t1->type=integer;
80 t1->value_3=heap_alloc(sizeof(REAL));
81 *(REAL *)t1->value_3 = (REAL) value;
82
83 (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)t1);
84 }
85
94 void stack_add_int_attr(ptr_psi_term t, char *attrname, long value)
95 {
96 ptr_psi_term t1;
97
98 t1=stack_psi_term(4);
99 t1->type=integer;
100 t1->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
101 *(REAL *)t1->value_3 = (REAL) value;
102
103 (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
104 }
105
116 void heap_mod_int_attr(ptr_psi_term t, char *attrname, long value)
117 {
118 ptr_node n;
119 ptr_psi_term t1;
120
121 n=find(FEATCMP,attrname,t->attr_list);
122 t1=(ptr_psi_term)n->data;
123 *(REAL *)t1->value_3 = (REAL) value;
124 }
125
126 /*
127 void stack_mod_int_attr(t, attrname, value)
128 ptr_psi_term t;
129 char *attrname;
130 long value;
131 {
132 ptr_node n;
133 ptr_psi_term t1;
134
135 n=find(FEATCMP,attrname,t->attr_list);
136 t1=(ptr_psi_term)n->data;
137 *(REAL *)t1->value_3 = (REAL) value;
138 }
139 */
140
151 void heap_add_str_attr(ptr_psi_term t, char *attrname, char *str)
152 {
153 ptr_psi_term t1;
154
155 t1=heap_psi_term(4);
156 t1->type=quoted_string;
157 t1->value_3=(GENERIC)heap_copy_string(str);
158
159 (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
160 }
161
170 void stack_add_str_attr(ptr_psi_term t, char *attrname, char *str)
171 {
172 ptr_psi_term t1;
173
174 t1=stack_psi_term(4);
175 t1->type=quoted_string;
176 t1->value_3=(GENERIC)stack_copy_string(str);
177
178 (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
179 }
180
191 void heap_mod_str_attr(ptr_psi_term t, char *attrname, char *str)
192 {
193 ptr_node n;
194 ptr_psi_term t1;
195
196 n=find(FEATCMP,attrname,t->attr_list);
197 t1=(ptr_psi_term)n->data;
198 t1->value_3=(GENERIC)heap_copy_string(str);
199 }
200
201 /*
202 ATTENTION - This should be made backtrackable if used
203 void stack_mod_str_attr(t, attrname, str)
204 ptr_psi_term t;
205 char *attrname;
206 char *str;
207 {
208 ptr_node n;
209 ptr_psi_term t1;
210
211 n=find(FEATCMP,attrname,t->attr_list);
212 t1=(ptr_psi_term)n->data;
213 t1->value_3=(GENERIC)stack_copy_string(str);
214 }
215 */
216
226 void heap_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
227 {
228 (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
229 }
230
239 void stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
240 {
241 (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
242 }
243
252 void bk_stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
253 {
254 (void)bk_stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)g);
255 }
256
265 GENERIC get_attr(ptr_psi_term t, char *attrname)
266 {
267 ptr_node n=find(FEATCMP,attrname,t->attr_list);
268 return n->data;
269 }
270
278 FILE *get_stream(ptr_psi_term t)
279 {
280 return (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
281 }
282
283 /***********************************************/
284 /* Main routines for saving & restoring state */
285
293 void save_state(ptr_psi_term t)
294 {
295 ptr_node n;
296 ptr_psi_term t1;
297
298 n=find(FEATCMP,STREAM,t->attr_list);
299 t1=(ptr_psi_term)n->data;
300 t1->value_3=(GENERIC)input_stream;
301
302 /* RM: Jan 27 1993
303 heap_mod_str_attr(t,CURRENT_MODULE,current_module->module_name);
304 */
305
306 heap_mod_str_attr(t,INPUT_FILE_NAME,input_file_name);
307 heap_mod_int_attr(t,LINE_COUNT,line_count);
308 heap_mod_int_attr(t,SAVED_CHAR,saved_char);
309 heap_mod_int_attr(t,OLD_SAVED_CHAR,old_saved_char);
310
311 t1=saved_psi_term?saved_psi_term:null_psi_term;
312 heap_add_psi_attr(t,SAVED_PSI_TERM,t1);
313
314 t1=old_saved_psi_term?old_saved_psi_term:null_psi_term;
315 heap_add_psi_attr(t,OLD_SAVED_PSI_TERM,t1);
316
317 t1=heap_psi_term(4);
318 t1->type=(eof_flag?lf_true:lf_false);
319 heap_add_psi_attr(t,EOF_FLAG,t1);
320
321 t1=heap_psi_term(4);
322 t1->type=(start_of_line?lf_true:lf_false);
323 heap_add_psi_attr(t,START_OF_LINE,t1);
324 }
325
326
334 void restore_state(ptr_psi_term t)
335 {
336 // long i;
337 char *str;
338
339
340 input_stream = (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
341 str = (char*) ((ptr_psi_term)get_attr(t,INPUT_FILE_NAME))->value_3;
342 strcpy(input_file_name,str);
343 /* for (i=0;i++;i<=strlen(str)) input_file_name[i]=str[i]; */
344 line_count = *(REAL *) ((ptr_psi_term)get_attr(t,LINE_COUNT))->value_3;
345 saved_char = *(REAL *) ((ptr_psi_term)get_attr(t,SAVED_CHAR))->value_3;
346 old_saved_char= *(REAL *)((ptr_psi_term)get_attr(t,OLD_SAVED_CHAR))->value_3;
347
348 saved_psi_term=(ptr_psi_term)get_attr(t,SAVED_PSI_TERM);
349 if (saved_psi_term==null_psi_term) saved_psi_term=NULL;
350
351 old_saved_psi_term=(ptr_psi_term)get_attr(t,OLD_SAVED_PSI_TERM);
352 if (old_saved_psi_term==null_psi_term) old_saved_psi_term=NULL;
353
354 eof_flag = ((ptr_psi_term)get_attr(t,EOF_FLAG))->type==lf_true;
355 start_of_line = ((ptr_psi_term)get_attr(t,START_OF_LINE))->type==lf_true;
356
357
358 /* RM: Jan 27 1993
359 set_current_module(
360 find_module(((ptr_psi_term)get_attr(input_state,
361 CURRENT_MODULE))->value_3));
362 */
363 }
364
372 void new_state(ptr_psi_term *t)
373 {
374 ptr_psi_term t1;
375
376 *t=heap_psi_term(4);
377 (*t)->type=inputfilesym;
378
379 t1=heap_psi_term(4);
380 t1->type=stream;
381 t1->value_3=(GENERIC)input_stream;
382 heap_add_psi_attr(*t,STREAM,t1);
383
384 /* RM: Jan 27 1993 */
385 heap_add_str_attr(*t,CURRENT_MODULE,current_module->module_name);
386
387 /*
388 printf("Creating new state for file '%s', module '%s'\n",
389 input_file_name,
390 current_module->module_name);
391 */
392
393 heap_add_str_attr(*t,INPUT_FILE_NAME,input_file_name);
394 heap_add_int_attr(*t,LINE_COUNT,line_count);
395 heap_add_int_attr(*t,SAVED_CHAR,saved_char);
396 heap_add_int_attr(*t,OLD_SAVED_CHAR,old_saved_char);
397
398 t1=saved_psi_term?saved_psi_term:null_psi_term;
399 heap_add_psi_attr(*t,SAVED_PSI_TERM,t1);
400
401 t1=old_saved_psi_term?old_saved_psi_term:null_psi_term;
402 heap_add_psi_attr(*t,OLD_SAVED_PSI_TERM,t1);
403
404 t1=heap_psi_term(4);
405 t1->type=(eof_flag?lf_true:lf_false);
406 heap_add_psi_attr(*t,EOF_FLAG,t1);
407
408 t1=heap_psi_term(4);
409 t1->type=(start_of_line?lf_true:lf_false);
410 heap_add_psi_attr(*t,START_OF_LINE,t1);
411 }
412
413 /****************************************************************************/
414
415
416
417 /* Parser/tokenizer state handling */
418
425 void save_parse_state(ptr_parse_block pb)
426 {
427 if (pb) {
428 pb->lc = line_count;
429 pb->sol = start_of_line;
430 pb->sc = saved_char;
431 pb->osc = old_saved_char;
432 pb->spt = saved_psi_term;
433 pb->ospt = old_saved_psi_term;
434 pb->ef = eof_flag;
435 }
436 }
437
444 void restore_parse_state(ptr_parse_block pb)
445 {
446 if (pb) {
447 line_count = pb->lc;
448 start_of_line = pb->sol;
449 saved_char = pb->sc;
450 old_saved_char = pb->osc;
451 saved_psi_term = pb->spt;
452 old_saved_psi_term = pb->ospt;
453 eof_flag = pb->ef;
454 }
455 }
456
457
464 void init_parse_state()
465 {
466 line_count=0;
467 start_of_line=TRUE;
468 saved_char=0;
469 old_saved_char=0;
470 saved_psi_term=NULL;
471 old_saved_psi_term=NULL;
472 eof_flag=FALSE;
473 stringparse=FALSE;
474 }
475
476 /****************************************************************************/
477
478 static long inchange, outchange;
479 static FILE *out;
480 ptr_psi_term old_state=NULL; /* RM: Feb 17 1993 */
481
493 void begin_terminal_io()
494 {
495 inchange = (input_stream!=stdin);
496 outchange = (output_stream!=stdout);
497
498 if (outchange) {
499 out=output_stream;
500 output_stream=stdout;
501 }
502
503 if (inchange) {
504 old_state=input_state;
505 (void)open_input_file("stdin");
506 }
507 }
508
516 void end_terminal_io()
517 {
518 if (inchange) {
519 input_state=old_state;
520 restore_state(old_state);
521 old_state=NULL; /* RM: Feb 17 1993 */
522 }
523 if (outchange)
524 output_stream=out;
525 }
526
537 char *expand_file_name(char *s)
538 {
539 char *r;
540 char *home; // *getenv();
541 struct passwd *pw;
542 /* char *user="eight character name"; 18.5 */
543 char userbuf[STRLEN];
544 char *user=userbuf;
545 char *t1,*t2;
546
547 r=s;
548 if (s[0]=='~') {
549 t1=s+1;
550 t2=user;
551 while (*t1!=0 && *t1!='/') {
552 *t2= *t1;
553 *t2++;
554 *t1++;
555 }
556 *t2=0;
557 if ((int)strlen(user)>0) {
558 pw = getpwnam(user);
559 if (pw) {
560 user=pw->pw_dir;
561 r=(char *)malloc(strlen(user)+strlen(t1)+1);
562 sprintf(r,"%s%s",user,t1);
563 }
564 else
565 /* if (warning()) printf("couldn't find user '%s'.\n",user) */;
566 }
567 else {
568 home=getenv("HOME");
569 if (home) {
570 r=(char *)malloc(strlen(home)+strlen(s)+1);
571 sprintf(r,"%s%s",home,s+1);
572 }
573 else
574 /* if (warning()) printf("no HOME directory.\n") */;
575 }
576 }
577
578 /* printf("*** Using file name: '%s'\n",r); */
579
580 return r;
581 }
582
594 long open_input_file(char *file)
595 {
596 long ok=TRUE;
597 long stdin_flag;
598
599 /* Save global input file state */
600 if (input_state!=NULL) save_state(input_state);
601
602 file=expand_file_name(file);
603
604 if ((stdin_flag=(!strcmp(file,"stdin")))) {
605 input_stream=stdin;
606 noisy=TRUE;
607 }
608 else {
609 input_stream=fopen(file,"r");
610 noisy=FALSE;
611 }
612
613 if (input_stream==NULL) {
614 Errorline("file '%s' does not exist.\n",file);
615 file="stdin";
616 input_stream=stdin;
617 noisy=TRUE;
618 ok=FALSE;
619 }
620
621 if (!stdin_flag || stdin_state==NULL) {
622 /* Initialize a new global input file state */
623 strcpy(input_file_name,file);
624 init_parse_state();
625 /* Create a new state containing the new global values */
626 new_state(&input_state);
627 if (stdin_flag) stdin_state=input_state;
628 }
629 else {
630 input_state=stdin_state;
631 restore_state(input_state);
632 }
633
634 return ok;
635 }
636
646 long open_output_file(string file)
647 {
648 long ok=TRUE;
649
650
651 file=expand_file_name(file);
652
653 if (!strcmp(file,"stdout"))
654 output_stream=stdout;
655 else
656 if (!strcmp(file,"stderr"))
657 output_stream=stderr;
658 else
659 output_stream=fopen(file,"w");
660
661 if (output_stream==NULL) {
662 Errorline("file '%s' could not be opened for output.\n",file);
663 ok=FALSE;
664 output_stream=stdout;
665 }
666
667 return ok;
668 }
669
680 long read_char()
681 {
682 int c=0;
683
684 if ((c=saved_char)) {
685 saved_char=old_saved_char;
686 old_saved_char=0;
687 }
688 else if (stringparse) {
689 if ((c=(*stringinput)))
690 stringinput++;
691 else
692 c=EOF;
693 }
694 else if (input_stream == NULL || feof(input_stream))
695 c=EOF;
696 else {
697 if (start_of_line) {
698 start_of_line=FALSE;
699 line_count++;
700 if (input_stream==stdin) infoline("%s",prompt); /* 21.1 */
701 }
702
703 c=fgetc(input_stream);
704
705 if(trace_input) /* RM: Jan 13 1993 */
706 if(c!=EOF)
707 printf("%c",c);
708 else
709 printf(" <EOF>\n");
710
711 if (c==EOLN)
712 start_of_line=TRUE;
713 }
714
715 /* printf("%c\n",c); RM: Jan 5 1993 Just to trace the parser */
716
717 return c;
718 }
719
729 void put_back_char(long c)
730 {
731 if (old_saved_char)
732 Errorline("in tokenizer, put_back_char three times (last=%d).\n",c);
733 old_saved_char=saved_char;
734 saved_char=c;
735 }
736
746 void put_back_token(psi_term t)
747 {
748 if (old_saved_psi_term!=NULL)
749 Errorline("in parser, put_back_token three times (last=%P).\n",t);
750 old_saved_psi_term=saved_psi_term;
751 saved_psi_term=stack_copy_psi_term(t);
752 }
753
761 void psi_term_error()
762 {
763 perr_i("near line %ld",psi_term_line_number);
764 if (strcmp(input_file_name,"stdin")) {
765 perr_s(" in file \042%s\042",input_file_name);
766 }
767 /* prompt="error>"; 20.8 */
768 parse_ok=FALSE;
769 }
770
779 void read_comment(ptr_psi_term tok)
780 {
781 long c;
782
783 do {
784 c=read_char();
785 } while (c!=EOF && c!=EOLN);
786
787 tok->type=comment;
788 }
789
796 void read_string_error(int n)
797 {
798 if (stringparse) parse_ok=FALSE;
799 else
800 switch (n) {
801 case 0:
802 Syntaxerrorline("end of file reached before end of string (%E).\n");
803 break;
804 case 1:
805 Syntaxerrorline("Hexadecimal digit expected (%E).\n");
806 break;
807 }
808 }
809
816 int base2int(int n)
817 {
818 switch (n) {
819 case '0': return 0;
820 case '1': return 1;
821 case '2': return 2;
822 case '3': return 3;
823 case '4': return 4;
824 case '5': return 5;
825 case '6': return 6;
826 case '7': return 7;
827 case '8': return 8;
828 case '9': return 9;
829 case 'a':
830 case 'A': return 10;
831 case 'b':
832 case 'B': return 11;
833 case 'c':
834 case 'C': return 12;
835 case 'd':
836 case 'D': return 13;
837 case 'e':
838 case 'E': return 14;
839 case 'f':
840 case 'F': return 15;
841 default:
842 fprintf(stderr,"base2int('%c'): illegal argument\n",n);
843 exit(EXIT_FAILURE);
844 }
845 }
846
847 #define isoctal(c) (c=='0'||c=='1'||c=='2'||c=='3'||c=='4'||c=='5'||c=='6'||c=='7')
848
859 void read_string(ptr_psi_term tok,long e)
860 {
861 long c;
862 string str;
863 long len=0;
864 long store=TRUE;
865 long flag=TRUE;
866
867 str[len]=0;
868
869 do {
870 c=read_char();
871 if (c==EOF) {
872 store=FALSE;
873 flag=FALSE;
874 read_string_error(0);
875 }
876 else if (e=='"' && c=='\\') {
877 c=read_char();
878 if (c==EOF) {
879 store=FALSE;
880 flag=FALSE;
881 put_back_char('\\');
882 read_string_error(0);
883 }
884 else {
885 switch (c) {
886 case 'a': c='\a'; break;
887 case 'b': c='\b'; break;
888 case 'f': c='\f'; break;
889 case 'n': c='\n'; break;
890 case 'r': c='\r'; break;
891 case 't': c='\t'; break;
892 case 'v': c='\v'; break;
893 /* missing \ooo and \xhh */
894 case 'x':
895 {
896 int n;
897 c=read_char();
898 if (c==EOF) {
899 store=flag=FALSE;
900 read_string_error(0);
901 break;
902 }
903 else if (!isxdigit(c)) {
904 store=flag=FALSE;
905 read_string_error(1);
906 break;
907 }
908 else {
909 n = base2int(c);
910 }
911 c=read_char();
912 if (isxdigit(c)) n = 16*n+base2int(c);
913 else put_back_char(c);
914 c=n;
915 break;
916 }
917 default:
918 if (isoctal(c)) {
919 int n,i;
920 for(i=n=0;i<3&&isoctal(c);i++,c=read_char())
921 n = n*8 + base2int(c);
922 if (c!=EOF) put_back_char(c);
923 c=n;
924 break;
925 }
926 else break;
927 }
928 }
929 }
930 else
931 if (c==e) {
932 c=read_char();
933 if (c!=e) {
934 store=FALSE;
935 flag=FALSE;
936 put_back_char(c);
937 }
938 }
939 if (store)
940 if (len==STRLEN) {
941 warningline("string too long, extra ignored (%E).\n");
942 store=FALSE;
943 }
944 else {
945 str[len++]=c;
946 str[len]=0;
947 }
948 } while(flag);
949
950 if (e=='"')
951 tok->value_3=(GENERIC)heap_copy_string(str);
952 else {
953 tok->type=update_symbol(NULL,str); /* Maybe no_module would be better */
954 tok->value_3=NULL;
955 TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
956 }
957 }
958
967 long symbolic(long c)
968 {
969 return SYMBOL(c);
970 }
971
980 long legal_in_name(long c)
981 {
982 return
983 UPPER(c) ||
984 LOWER(c) ||
985 DIGIT(c);
986
987 /* || c=='\'' RM: Dec 16 1992 */ ;
988 }
989
1002 void read_name(ptr_psi_term tok,long ch,long (*f)(long),ptr_definition typ)
1003 {
1004 char c;
1005 string str;
1006 long len=1;
1007 long store=TRUE;
1008 long flag=TRUE;
1009 ptr_module module=NULL;
1010 ptr_node n; /* RM: Feb 9 1993 */
1011
1012 tok->coref=NULL;
1013 tok->resid=NULL;
1014 tok->attr_list=NULL;
1015
1016 str[0]=ch;
1017
1018 do {
1019 c=read_char();
1020 flag=(*f)(c);
1021
1022 if(c=='#' && /* RM: Feb 3 1993 */
1023 (long)f==(long)legal_in_name &&
1024 len>0 &&
1025 len<STRLEN &&
1026 !module) {
1027 str[len]=0;
1028 module=create_module(str);
1029 len=0;
1030 flag=TRUE;
1031
1032 /* RM: Sep 21 1993 */
1033 /* Change the type function if required */
1034 c=read_char();
1035 if SYMBOL(c)
1036 f=symbolic;
1037 put_back_char(c);
1038 }
1039 else
1040 if (flag) {
1041 if (store)
1042 if (len==STRLEN) {
1043 warningline("name too long, extra ignored (%E).\n");
1044 store=FALSE;
1045 }
1046 else
1047 str[len++]=c;
1048 }
1049 else
1050 put_back_char(c);
1051 } while(flag);
1052
1053 if(module && len==0) { /* RM: Feb 3 1993 */
1054 strcpy(str,module->module_name);
1055 len=strlen(str);
1056 put_back_char('#');
1057 module=NULL;
1058 }
1059
1060 str[len]=0;
1061
1062 tok->type=typ;
1063
1064 if(typ==constant) {
1065 /* printf("module=%s\n",module->module_name); */
1066 tok->type=update_symbol(module,str); /* RM: Feb 3 1993 */
1067 tok->value_3=NULL;
1068
1069 TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1070
1071 /* PVR 4.2.94 for correct level incrementing */
1072 if (tok->type->type_def==(def_type)global_it) {
1073 var_occurred=TRUE;
1074 }
1075 if (FALSE /*tok->type->type==global_it && tok->type->global_value*/) {
1076 /* RM: Nov 10 1993 */
1077
1078 /* Remove this for Bruno who didn't like it, and doesn't like
1079 to use "print_depth" */
1080
1081 /* RM: Feb 9 1993 */
1082 /* Add into the variable tree */
1083 var_occurred=TRUE;
1084 n=find(STRCMP,tok->type->keyword->symbol,var_tree);
1085 if (n==NULL) {
1086 /* The change is always trailed. */
1087 (void)bk2_stack_insert(STRCMP,
1088 tok->type->keyword->symbol,
1089 &var_tree,
1090 (GENERIC)tok->type->global_value);
1091 }
1092 }
1093
1094 }
1095 else
1096 tok->value_3=(GENERIC)heap_copy_string(str);
1097 }
1098
1110 void read_number(ptr_psi_term tok,long c)
1111 {
1112 long c2;
1113 REAL f,p;
1114 long /* sgn, */ pwr,posflag;
1115
1116 /* if (sgn=(c=='-')) c=read_char(); */
1117
1118 /* tok->type=integer; RM: Mar 8 1993 */
1119
1120 f=0.0;
1121 do { f=f*10.0+(c-'0'); c=read_char(); } while (DIGIT(c));
1122
1123 if (c=='.') {
1124 c2=read_char();
1125 if DIGIT(c2) {
1126 /* tok->type=real; RM: Mar 8 1993 */
1127 p=10.0;
1128 while (DIGIT(c2)) { f=f+(c2-'0')/p; p=p*10.0; c2=read_char(); }
1129 put_back_char(c2);
1130 }
1131 else {
1132 put_back_char(c2);
1133 put_back_char(c);
1134 }
1135 }
1136 else
1137 put_back_char(c);
1138
1139 c=read_char();
1140 if (c=='e' || c=='E') {
1141 c2=read_char();
1142 if (c2=='+' || c2=='-' || DIGIT(c2)) {
1143 tok->type=real;
1144 posflag = (c2=='+' || DIGIT(c2));
1145 if (!DIGIT(c2)) c2=read_char();
1146 pwr=0;
1147 while (DIGIT(c2)) { pwr=pwr*10+(c2-'0'); c2=read_char(); }
1148 put_back_char(c2);
1149 p=1.0;
1150 while (pwr>=100) { pwr-=100; if (posflag) p*=1e100; else p/=1e100; }
1151 while (pwr>=10 ) { pwr-=10; if (posflag) p*=1e10; else p/=1e10; }
1152 while (pwr>0 ) { pwr-=1; if (posflag) p*=1e1; else p/=1e1; }
1153 f*=p;
1154 }
1155 else {
1156 put_back_char(c2);
1157 put_back_char(c);
1158 }
1159 }
1160 else
1161 put_back_char(c);
1162
1163 /* if (sgn) f = -f; */
1164 tok->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
1165 *(REAL *)tok->value_3=f;
1166
1167 /* RM: Mar 8 1993 */
1168 if(f==floor(f))
1169 tok->type=integer;
1170 else
1171 tok->type=real;
1172 }
1173
1186 void read_token(ptr_psi_term tok)
1187 { read_token_main(tok, TRUE); }
1188
1197 void read_token_b(ptr_psi_term tok)
1198 { read_token_main(tok, FALSE); }
1199
1207 void read_token_main(ptr_psi_term tok, long for_parser)
1208 {
1209 long c, c2;
1210 ptr_node n;
1211 char p[2];
1212
1213 if (for_parser && (saved_psi_term!=NULL)) {
1214 *tok= *saved_psi_term;
1215 saved_psi_term=old_saved_psi_term;
1216 old_saved_psi_term=NULL;
1217 }
1218 else {
1219 tok->type=nothing;
1220
1221 do {
1222 c=read_char();
1223 } while(c!=EOF && (c<=32));
1224
1225 if (for_parser) psi_term_line_number=line_count;
1226
1227 switch(c) {
1228 case EOF:
1229 tok->type=eof;
1230 tok->value_3=NULL;
1231 break;
1232 case '%':
1233 read_comment(tok);
1234 break;
1235 case '"':
1236 read_string(tok,c);
1237 tok->type=quoted_string;
1238 break;
1239 case 39: /* The quote symbol "'" */
1240 read_string(tok,c);
1241 break;
1242
1243 default:
1244
1245 /* Adding this results in problems with terms like (N-1) */
1246 /* if (c=='-' && (c2=read_char()) && DIGIT(c2)) {
1247 put_back_char(c2);
1248 read_number(tok,c);
1249 }
1250 else */
1251
1252 if(c=='.' || c=='?') { /* RM: Jul 7 1993 */
1253 c2=read_char();
1254 put_back_char(c2);
1255 /*printf("c2=%d\n",c2);*/
1256 if(c2<=' ' || c2==EOF) {
1257 if(c=='.')
1258 tok->type=final_dot;
1259 else
1260 tok->type=final_question;
1261
1262 tok->value_3=NULL;
1263 }
1264 else
1265 read_name(tok,c,symbolic,constant);
1266 }
1267 else
1268 if DIGIT(c)
1269 read_number(tok,c);
1270 else
1271 if UPPER(c) {
1272 read_name(tok,c,legal_in_name,variable);
1273 }
1274 else
1275 if LOWER(c) {
1276 read_name(tok,c,legal_in_name,constant);
1277 }
1278 else
1279 if SYMBOL(c) {
1280 read_name(tok,c,symbolic,constant);
1281 }
1282 else /* RM: Jul 7 1993 Moved this */
1283 if SINGLE(c) {
1284 p[0]=c; p[1]=0;
1285 tok->type=update_symbol(current_module,p);
1286 tok->value_3=NULL;
1287 TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1288 }
1289 else {
1290 Errorline("illegal character %d in input (%E).\n",c);
1291 }
1292 }
1293
1294 if (tok->type==variable) {
1295 if (tok->value_3) {
1296 /* If the variable read in has name "_", then it becomes 'top' */
1297 /* and is no longer a variable whose name must be remembered. */
1298 /* As a result, '@' and '_' are synonyms in the program input. */
1299 if (!strcmp((char *)tok->value_3,"_")) {
1300 p[0]='@'; p[1]=0;
1301 tok->type=update_symbol(current_module,p);
1302 tok->value_3=NULL;
1303 TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1304 }
1305 else {
1306 /* Insert into variable tree, create 'top' value if need be. */
1307 var_occurred=TRUE;
1308 n=find(STRCMP,(char *)tok->value_3,var_tree);
1309 if (n==NULL) {
1310 ptr_psi_term t=stack_psi_term(0);
1311 /* The change is always trailed. */
1312 (void)bk2_stack_insert(STRCMP,(char *)tok->value_3,&var_tree,(GENERIC)t); /* 17.8 */
1313 tok->coref=t;
1314 }
1315 else
1316 tok->coref=(ptr_psi_term)n->data;
1317 }
1318 }
1319 /* else do nothing */
1320 }
1321 }
1322
1323 if (tok->type==comment)
1324 read_token(tok);
1325
1326 if (tok->type!=variable)
1327 tok->coref=NULL;
1328
1329 tok->attr_list=NULL;
1330 tok->status=0;
1331 tok->flags=FALSE; /* 14.9 */
1332 tok->resid=NULL;
1333
1334 if (tok->type==cut) /* 12.7 */
1335 tok->value_3=(GENERIC)choice_stack;
1336
1337 do {
1338 c=read_char();
1339 if (c==EOLN) {
1340 if (for_parser) put_back_char(c);
1341 c=0;
1342 }
1343 else if (c<0 || c>32) {
1344 put_back_char(c);
1345 c=0;
1346 }
1347 } while(c && c!=EOF);
1348
1349 if (for_parser) prompt="| ";
1350 }
1351
1352 /****************************************************************************/
begin_terminal_io
void begin_terminal_io()
begin_terminal_io
Definition: token.c:493
psi_term_error
void psi_term_error()
psi_term_error
Definition: token.c:761
wl_psi_term::resid
ptr_residuation resid
Definition: def_struct.h:189
open_output_file
long open_output_file(string file)
open_output_file
Definition: token.c:646
init_parse_state
void init_parse_state()
init_parse_state
Definition: token.c:464
FEATCMP
#define FEATCMP
indicates to use featcmp for comparison (in trees.c)
Definition: def_const.h:979
wl_parse_block::ospt
ptr_psi_term ospt
Definition: def_struct.h:377
LINE_COUNT
#define LINE_COUNT
feature name
Definition: def_const.h:890
stdin_state
ptr_psi_term stdin_state
Definition: def_glob.h:857
lf_false
ptr_definition lf_false
symbol in bi module
Definition: def_glob.h:284
nothing
ptr_definition nothing
symbol in bi module
Definition: def_glob.h:347
integer
ptr_definition integer
symbol in bi module
Definition: def_glob.h:312
final_question
ptr_definition final_question
symbol in syntax module
Definition: def_glob.h:615
read_token_b
void read_token_b(ptr_psi_term tok)
read_token_b
Definition: token.c:1197
UPPER
#define UPPER(C)
Definition: def_macro.h:44
bk_stack_add_psi_attr
void bk_stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
bk_stack_add_psi_attr
Definition: token.c:252
create_module
ptr_module create_module(char *module)
ptr_module create_module(char *module)
Definition: modules.c:72
eof_flag
long eof_flag
Definition: def_glob.h:853
wl_parse_block::sol
long sol
Definition: def_struct.h:373
bk_stack_insert
ptr_node bk_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
bk_stack_insert
Definition: trees.c:357
psi_term_line_number
long psi_term_line_number
Definition: def_glob.h:909
heap_mod_int_attr
void heap_mod_int_attr(ptr_psi_term t, char *attrname, long value)
heap_mod_int_attr
Definition: token.c:116
base2int
int base2int(int n)
base2int
Definition: token.c:816
input_file_name
string input_file_name
Definition: def_glob.h:1016
current_module
ptr_module current_module
The current module for the tokenizer.
Definition: def_glob.h:729
cut
ptr_definition cut
symbol in syntax module
Definition: def_glob.h:242
SAVED_PSI_TERM
#define SAVED_PSI_TERM
feature name
Definition: def_const.h:918
heap_psi_term
ptr_psi_term heap_psi_term(long stat)
heap_psi_term
Definition: lefun.c:75
OLD_SAVED_CHAR
#define OLD_SAVED_CHAR
feature name
Definition: def_const.h:911
wl_module
Definition: def_struct.h:105
save_state
void save_state(ptr_psi_term t)
save_state
Definition: token.c:293
comment
ptr_definition comment
symbol in bi module
Definition: def_glob.h:227
wl_definition::type_def
def_type type_def
Definition: def_struct.h:153
defs.h
includes
wl_psi_term
Definition: def_struct.h:177
save_parse_state
void save_parse_state(ptr_parse_block pb)
save_parse_state
Definition: token.c:425
put_back_token
void put_back_token(psi_term t)
put_back_token
Definition: token.c:746
stdin_cleareof
void stdin_cleareof()
stdin_cleareof
Definition: token.c:51
CURRENT_MODULE
#define CURRENT_MODULE
feature name
Definition: def_const.h:939
DIGIT
#define DIGIT(C)
Definition: def_macro.h:42
stream
ptr_definition stream
symbol in bi module
Definition: def_glob.h:382
wl_parse_block::osc
long osc
Definition: def_struct.h:375
wl_definition::keyword
ptr_keyword keyword
Definition: def_struct.h:147
perr_s
void perr_s(char *s1, char *s2)
perr_s
Definition: error.c:775
ptr_psi_term
struct wl_psi_term * ptr_psi_term
quotedStackCopy
Definition: def_struct.h:62
global_it
#define global_it
was enum (def_type) in extern.h now there is typedef ptr_definition
Definition: def_const.h:1422
wl_node::data
GENERIC data
Definition: def_struct.h:201
old_saved_char
long old_saved_char
Definition: def_glob.h:850
NULL
#define NULL
Definition: def_const.h:533
var_tree
ptr_node var_tree
Definition: def_glob.h:1005
bk2_stack_insert
ptr_node bk2_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
bk2_stack_insert
Definition: trees.c:377
read_name
void read_name(ptr_psi_term tok, long ch, long(*f)(long), ptr_definition typ)
read_name
Definition: token.c:1002
input_state
ptr_psi_term input_state
Definition: def_glob.h:856
end_terminal_io
void end_terminal_io()
end_terminal_io
Definition: token.c:516
REAL
#define REAL
Which C type to use to represent reals and integers in Wild_Life.
Definition: def_const.h:132
read_string
void read_string(ptr_psi_term tok, long e)
read_string
Definition: token.c:859
parse_ok
long parse_ok
indicates whether there was a syntax error
Definition: def_glob.h:765
wl_keyword::symbol
char * symbol
Definition: def_struct.h:118
saved_char
long saved_char
Definition: def_glob.h:849
old_state
ptr_psi_term old_state
Definition: token.c:480
noisy
long noisy
Definition: def_glob.h:1011
update_symbol
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
LOWER
#define LOWER(C)
Definition: def_macro.h:46
SYMBOL
#define SYMBOL(C)
Definition: def_macro.h:57
outchange
static long outchange
Definition: token.c:478
trace_input
long trace_input
Definition: token.c:12
heap_insert
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
null_psi_term
ptr_psi_term null_psi_term
Used to represent an empty parse token.
Definition: def_glob.h:656
real
ptr_definition real
symbol in bi module
Definition: def_glob.h:375
inputfilesym
ptr_definition inputfilesym
symbol in bi module
Definition: def_glob.h:501
line_count
long line_count
Definition: def_glob.h:1015
read_string_error
void read_string_error(int n)
read_string_error
Definition: token.c:796
Errorline
void Errorline(char *format,...)
Errorline.
Definition: error.c:465
GENERIC
unsigned long * GENERIC
unsigned long *GENERIC
Definition: def_struct.h:35
wl_parse_block::lc
long lc
Definition: def_struct.h:372
EOLN
#define EOLN
End of line.
Definition: def_const.h:309
variable
ptr_definition variable
symbol in bi module
Definition: def_glob.h:438
stack_add_psi_attr
void stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
stack_add_psi_attr
Definition: token.c:239
read_token_main
void read_token_main(ptr_psi_term tok, long for_parser)
read_token_main
Definition: token.c:1207
read_number
void read_number(ptr_psi_term tok, long c)
read_number
Definition: token.c:1110
wl_parse_block::ef
long ef
Definition: def_struct.h:378
stack_insert
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
infoline
void infoline(char *format,...)
infoline
Definition: error.c:281
heap_copy_string
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
final_dot
ptr_definition final_dot
symbol in syntax module
Definition: def_glob.h:608
restore_state
void restore_state(ptr_psi_term t)
restore_state
Definition: token.c:334
Syntaxerrorline
void Syntaxerrorline(char *format,...)
Syntaxerrorline.
Definition: error.c:557
wl_parse_block
Definition: def_struct.h:371
TRUE
#define TRUE
Standard boolean.
Definition: def_const.h:268
STREAM
#define STREAM
feature name
Definition: def_const.h:876
wl_parse_block::sc
long sc
Definition: def_struct.h:374
START_OF_LINE
#define START_OF_LINE
feature name
Definition: def_const.h:897
heap_add_str_attr
void heap_add_str_attr(ptr_psi_term t, char *attrname, char *str)
heap_add_str_attr
Definition: token.c:151
STRCMP
#define STRCMP
indicates to use strcmp for comparison (c function)
Definition: def_const.h:963
eof
ptr_definition eof
symbol in syntax module
Definition: def_glob.h:263
heap_add_psi_attr
void heap_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
heap_add_psi_attr
Definition: token.c:226
constant
ptr_definition constant
symbol in bi module
Definition: def_glob.h:235
wl_definition::global_value
ptr_psi_term global_value
Definition: def_struct.h:159
FALSE
#define FALSE
Standard boolean.
Definition: def_const.h:275
stack_psi_term
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
input_stream
FILE * input_stream
Definition: def_glob.h:1014
wl_psi_term::value_3
GENERIC value_3
Definition: def_struct.h:186
start_of_line
long start_of_line
???
Definition: def_glob.h:846
INPUT_FILE_NAME
#define INPUT_FILE_NAME
feature name
Definition: def_const.h:883
wl_module::module_name
char * module_name
Definition: def_struct.h:106
wl_psi_term::coref
ptr_psi_term coref
Definition: def_struct.h:188
OLD_SAVED_PSI_TERM
#define OLD_SAVED_PSI_TERM
feature name
Definition: def_const.h:925
heap_add_int_attr
void heap_add_int_attr(ptr_psi_term t, char *attrname, long value)
heap_add_int_attr
Definition: token.c:74
expand_file_name
char * expand_file_name(char *s)
expand_file_name
Definition: token.c:537
inchange
static long inchange
Definition: token.c:478
isoctal
#define isoctal(c)
Definition: token.c:847
new_state
void new_state(ptr_psi_term *t)
new_state
Definition: token.c:372
find
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
legal_in_name
long legal_in_name(long c)
legal_in_name
Definition: token.c:980
get_attr
GENERIC get_attr(ptr_psi_term t, char *attrname)
get_attr
Definition: token.c:265
stack_copy_psi_term
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
out
static FILE * out
Definition: token.c:479
wl_psi_term::status
long status
Definition: def_struct.h:182
wl_psi_term::flags
long flags
Definition: def_struct.h:185
wl_definition
Definition: def_struct.h:145
stack_add_str_attr
void stack_add_str_attr(ptr_psi_term t, char *attrname, char *str)
stack_add_str_attr
Definition: token.c:170
saved_psi_term
ptr_psi_term saved_psi_term
Definition: def_glob.h:851
error_psi_term
ptr_psi_term error_psi_term
symbol in bi module
Definition: def_glob.h:118
read_comment
void read_comment(ptr_psi_term tok)
read_comment
Definition: token.c:779
stdin_terminal
long stdin_terminal
set in init_io in lib.c to true - never changed - used in token.c
Definition: def_glob.h:832
EOF_FLAG
#define EOF_FLAG
feature name
Definition: def_const.h:932
prompt
char * prompt
Definition: def_glob.h:1018
symbolic
long symbolic(long c)
symbolic
Definition: token.c:967
SINGLE
#define SINGLE(C)
Definition: def_macro.h:52
restore_parse_state
void restore_parse_state(ptr_parse_block pb)
restore_parse_state
Definition: token.c:444
stack_add_int_attr
void stack_add_int_attr(ptr_psi_term t, char *attrname, long value)
stack_add_int_attr
Definition: token.c:94
heap_mod_str_attr
void heap_mod_str_attr(ptr_psi_term t, char *attrname, char *str)
heap_mod_str_attr
Definition: token.c:191
output_stream
FILE * output_stream
Definition: def_glob.h:1017
STRLEN
#define STRLEN
Maximum size of file names and input tokens (which includes input strings) (Note: calculated tokens c...
Definition: def_const.h:162
wl_parse_block::spt
ptr_psi_term spt
Definition: def_struct.h:376
stringparse
long stringparse
Definition: def_glob.h:859
TOKEN_ERROR
void TOKEN_ERROR(ptr_psi_term p)
TOKEN_ERROR.
Definition: token.c:38
warningline
void warningline(char *format,...)
warningline
Definition: error.c:371
get_stream
FILE * get_stream(ptr_psi_term t)
get_stream
Definition: token.c:278
stringinput
char * stringinput
Definition: def_glob.h:860
lf_true
ptr_definition lf_true
symbol in bi module
Definition: def_glob.h:410
wl_node
Definition: def_struct.h:197
wl_psi_term::type
ptr_definition type
Definition: def_struct.h:181
SAVED_CHAR
#define SAVED_CHAR
feature name
Definition: def_const.h:904
open_input_file
long open_input_file(char *file)
open_input_file
Definition: token.c:594
read_char
long read_char()
read_char
Definition: token.c:680
var_occurred
long var_occurred
???
Definition: def_glob.h:839
wl_psi_term::attr_list
ptr_node attr_list
Definition: def_struct.h:187
quoted_string
ptr_definition quoted_string
symbol in bi module
Definition: def_glob.h:368
perr_i
void perr_i(char *str, long i)
perr_i
Definition: error.c:800
heap_alloc
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
choice_stack
ptr_choice_point choice_stack
Definition: def_glob.h:1026
old_saved_psi_term
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:852
read_token
void read_token(ptr_psi_term tok)
read_token
Definition: token.c:1186
stack_copy_string
char * stack_copy_string(char *s)
stack_copy_string
Definition: trees.c:184
put_back_char
void put_back_char(long c)
put_back_char
Definition: token.c:729