1
2 #include <stdio.h> /* main etc */
3 #include <stdlib.h> /* exit */
4 #include <string.h> /* memmove */
5 #include "header.h"
6
7 /* recursive usage: */
8
9 static void read_program_(struct analyser * a, int terminator);
10 static struct node * read_C(struct analyser * a);
11 static struct node * C_style(struct analyser * a, char * s, int token);
12
13
fault(int n)14 static void fault(int n) { fprintf(stderr, "fault %d\n", n); exit(1); }
15
print_node_(struct node * p,int n,char * s)16 static void print_node_(struct node * p, int n, char * s) {
17
18 int i;
19 for (i = 0; i < n; i++) fputs(i == n - 1 ? s : " ", stdout);
20 printf("%s ", name_of_token(p->type));
21 unless (p->name == 0) report_b(stdout, p->name->b);
22 unless (p->literalstring == 0) {
23 printf("'");
24 report_b(stdout, p->literalstring);
25 printf("'");
26 }
27 printf("\n");
28 unless (p->AE == 0) print_node_(p->AE, n+1, "# ");
29 unless (p->left == 0) print_node_(p->left, n+1, " ");
30 unless (p->right == 0) print_node_(p->right, n, " ");
31 if (p->aux != 0) print_node_(p->aux, n+1, "@ ");
32 }
33
print_program(struct analyser * a)34 extern void print_program(struct analyser * a) {
35 print_node_(a->program, 0, " ");
36 }
37
new_node(struct analyser * a,int type)38 static struct node * new_node(struct analyser * a, int type) {
39 NEW(node, p);
40 p->next = a->nodes; a->nodes = p;
41 p->left = 0;
42 p->right = 0;
43 p->aux = 0;
44 p->AE = 0;
45 p->name = 0;
46 p->literalstring = 0;
47 p->mode = a->mode;
48 p->line_number = a->tokeniser->line_number;
49 p->type = type;
50 return p;
51 }
52
name_of_mode(int n)53 static char * name_of_mode(int n) {
54 switch (n) {
55 default: fault(0);
56 case m_backward: return "string backward";
57 case m_forward: return "string forward";
58 /* case m_integer: return "integer"; */
59 }
60 }
61
name_of_type(int n)62 static char * name_of_type(int n) {
63 switch (n) {
64 default: fault(1);
65 case 's': return "string";
66 case 'i': return "integer";
67 case 'r': return "routine";
68 case 'R': return "routine or grouping";
69 case 'g': return "grouping";
70 }
71 }
72
count_error(struct analyser * a)73 static void count_error(struct analyser * a) {
74 struct tokeniser * t = a->tokeniser;
75 if (t->error_count >= 20) { fprintf(stderr, "... etc\n"); exit(1); }
76 t->error_count++;
77 }
78
error2(struct analyser * a,int n,int x)79 static void error2(struct analyser * a, int n, int x) {
80 struct tokeniser * t = a->tokeniser;
81 count_error(a);
82 fprintf(stderr, "Line %d", t->line_number);
83 if (t->get_depth > 0) fprintf(stderr, " (of included file)");
84 fprintf(stderr, ": ");
85 if (n >= 30) report_b(stderr, t->b);
86 switch (n) {
87 case 0:
88 fprintf(stderr, "%s omitted", name_of_token(t->omission)); break;
89 case 3:
90 fprintf(stderr, "in among(...), ");
91 case 1:
92 fprintf(stderr, "unexpected %s", name_of_token(t->token));
93 if (t->token == c_number) fprintf(stderr, " %d", t->number);
94 if (t->token == c_name) {
95 fprintf(stderr, " ");
96 report_b(stderr, t->b);
97 } break;
98 case 2:
99 fprintf(stderr, "string omitted"); break;
100
101 case 14:
102 fprintf(stderr, "unresolved substring on line %d", x); break;
103 case 15:
104 fprintf(stderr, "%s not allowed inside reverse(...)", name_of_token(t->token)); break;
105 case 16:
106 fprintf(stderr, "empty grouping"); break;
107 case 17:
108 fprintf(stderr, "backwards used when already in this mode"); break;
109 case 18:
110 fprintf(stderr, "empty among(...)"); break;
111 case 19:
112 fprintf(stderr, "two adjacent bracketed expressions in among(...)"); break;
113 case 20:
114 fprintf(stderr, "substring preceded by another substring on line %d", x); break;
115
116 case 30:
117 fprintf(stderr, " re-declared"); break;
118 case 31:
119 fprintf(stderr, " undeclared"); break;
120 case 32:
121 fprintf(stderr, " declared as %s mode; used as %s mode",
122 name_of_mode(a->mode), name_of_mode(x)); break;
123 case 33:
124 fprintf(stderr, " not of type %s", name_of_type(x)); break;
125 case 34:
126 fprintf(stderr, " not of type string or integer"); break;
127 case 35:
128 fprintf(stderr, " misplaced"); break;
129 case 36:
130 fprintf(stderr, " redefined"); break;
131 case 37:
132 fprintf(stderr, " mis-used as %s mode",
133 name_of_mode(x)); break;
134 default:
135 fprintf(stderr, " error %d", n); break;
136
137 }
138 if (n <= 13 && t->previous_token > 0)
139 fprintf(stderr, " after %s", name_of_token(t->previous_token));
140 fprintf(stderr, "\n");
141 }
142
error(struct analyser * a,int n)143 static void error(struct analyser * a, int n) { error2(a, n, 0); }
144
error3(struct analyser * a,struct node * p,symbol * b)145 static void error3(struct analyser * a, struct node * p, symbol * b) {
146 count_error(a);
147 fprintf(stderr, "among(...) on line %d has repeated string '", p->line_number);
148 report_b(stderr, b);
149 fprintf(stderr, "'\n");
150 }
151
error4(struct analyser * a,struct name * q)152 static void error4(struct analyser * a, struct name * q) {
153 count_error(a);
154 report_b(stderr, q->b);
155 fprintf(stderr, " undefined\n");
156 }
157
omission_error(struct analyser * a,int n)158 static void omission_error(struct analyser * a, int n) {
159 a->tokeniser->omission = n;
160 error(a, 0);
161 }
162
check_token(struct analyser * a,int code)163 static int check_token(struct analyser * a, int code) {
164 struct tokeniser * t = a->tokeniser;
165 if (t->token != code) { omission_error(a, code); return false; }
166 return true;
167 }
168
get_token(struct analyser * a,int code)169 static int get_token(struct analyser * a, int code) {
170 struct tokeniser * t = a->tokeniser;
171 read_token(t);
172 {
173 int x = check_token(a, code);
174 unless (x) t->token_held = true;
175 return x;
176 }
177 }
178
look_for_name(struct analyser * a)179 static struct name * look_for_name(struct analyser * a) {
180 struct name * p = a->names;
181 symbol * q = a->tokeniser->b;
182 repeat {
183 if (p == 0) return 0;
184 { symbol * b = p->b;
185 int n = SIZE(b);
186 if (n == SIZE(q) && memcmp(q, b, n * sizeof(symbol)) == 0) {
187 p->referenced = true;
188 return p;
189 }
190 }
191 p = p->next;
192 }
193 }
194
find_name(struct analyser * a)195 static struct name * find_name(struct analyser * a) {
196 struct name * p = look_for_name(a);
197 if (p == 0) error(a, 31);
198 return p;
199 }
200
check_routine_mode(struct analyser * a,struct name * p,int mode)201 static void check_routine_mode(struct analyser * a, struct name * p, int mode) {
202 if (p->mode < 0) p->mode = mode; else
203 unless (p->mode == mode) error2(a, 37, mode);
204 }
205
check_name_type(struct analyser * a,struct name * p,int type)206 static void check_name_type(struct analyser * a, struct name * p, int type) {
207 switch (type) {
208 case 's': if (p->type == t_string) return; break;
209 case 'i': if (p->type == t_integer) return; break;
210 case 'b': if (p->type == t_boolean) return; break;
211 case 'R': if (p->type == t_grouping) return;
212 case 'r': if (p->type == t_routine ||
213 p->type == t_external) return; break;
214 case 'g': if (p->type == t_grouping) return; break;
215 }
216 error2(a, 33, type);
217 }
218
read_names(struct analyser * a,int type)219 static void read_names(struct analyser * a, int type) {
220 struct tokeniser * t = a->tokeniser;
221 unless (get_token(a, c_bra)) return;
222 repeat {
223 if (read_token(t) != c_name) break;
224 if (look_for_name(a) != 0) error(a, 30); else {
225 NEW(name, p);
226 p->b = copy_b(t->b);
227 p->type = type;
228 p->mode = -1; /* routines, externals */
229 p->count = a->name_count[type];
230 p->referenced = false;
231 p->used = false;
232 p->grouping = 0;
233 p->definition = 0;
234 p->routine_called_from_among = false;
235 a->name_count[type] ++;
236 p->next = a->names;
237 a->names = p;
238 }
239 }
240 unless (check_token(a, c_ket)) t->token_held = true;
241 }
242
new_literalstring(struct analyser * a)243 static symbol * new_literalstring(struct analyser * a) {
244 NEW(literalstring, p);
245 p->b = copy_b(a->tokeniser->b);
246 p->next = a->literalstrings;
247 a->literalstrings = p;
248 return p->b;
249 }
250
read_AE_test(struct analyser * a)251 static int read_AE_test(struct analyser * a) {
252
253 struct tokeniser * t = a->tokeniser;
254 switch (read_token(t)) {
255 case c_assign: return c_mathassign;
256 case c_plusassign:
257 case c_minusassign:
258 case c_multiplyassign:
259 case c_divideassign:
260 case c_eq:
261 case c_ne:
262 case c_gr:
263 case c_ge:
264 case c_ls:
265 case c_le: return t->token;
266 default: error(a, 1); t->token_held = true; return c_eq;
267 }
268 }
269
binding(int t)270 static int binding(int t) {
271 switch (t) {
272 case c_plus: case c_minus: return 1;
273 case c_multiply: case c_divide: return 2;
274 default: return -2;
275 }
276 }
277
name_to_node(struct analyser * a,struct node * p,int type)278 static void name_to_node(struct analyser * a, struct node * p, int type) {
279 struct name * q = find_name(a);
280 unless (q == 0) {
281 check_name_type(a, q, type);
282 q->used = true;
283 }
284 p->name = q;
285 }
286
read_AE(struct analyser * a,int B)287 static struct node * read_AE(struct analyser * a, int B) {
288 struct tokeniser * t = a->tokeniser;
289 struct node * p;
290 struct node * q;
291 switch (read_token(t)) {
292 case c_minus: /* monadic */
293 p = new_node(a, c_neg);
294 p->right = read_AE(a, 100);
295 break;
296 case c_bra:
297 p = read_AE(a, 0);
298 get_token(a, c_ket);
299 break;
300 case c_name:
301 p = new_node(a, c_name);
302 name_to_node(a, p, 'i');
303 break;
304 case c_maxint:
305 case c_minint:
306 case c_cursor:
307 case c_limit:
308 case c_size:
309 p = new_node(a, t->token);
310 break;
311 case c_number:
312 p = new_node(a, c_number);
313 p->number = t->number;
314 break;
315 case c_sizeof:
316 p = C_style(a, "s", c_sizeof);
317 break;
318 default:
319 error(a, 1);
320 t->token_held = true;
321 return 0;
322 }
323 repeat {
324 int token = read_token(t);
325 int b = binding(token);
326 unless (binding(token) > B) {
327 t->token_held = true;
328 return p;
329 }
330 q = new_node(a, token);
331 q->left = p;
332 q->right = read_AE(a, b);
333 p = q;
334 }
335 }
336
read_C_connection(struct analyser * a,struct node * q,int op)337 static struct node * read_C_connection(struct analyser * a, struct node * q, int op) {
338 struct tokeniser * t = a->tokeniser;
339 struct node * p = new_node(a, op);
340 struct node * p_end = q;
341 p->left = q;
342 repeat {
343 q = read_C(a);
344 p_end->right = q; p_end = q;
345 if (read_token(t) != op) {
346 t->token_held = true;
347 break;
348 }
349 }
350 return p;
351 }
352
read_C_list(struct analyser * a)353 static struct node * read_C_list(struct analyser * a) {
354 struct tokeniser * t = a->tokeniser;
355 struct node * p = new_node(a, c_bra);
356 struct node * p_end = 0;
357 repeat {
358 int token = read_token(t);
359 if (token == c_ket) return p;
360 if (token < 0) { omission_error(a, c_ket); return p; }
361 t->token_held = true;
362 {
363 struct node * q = read_C(a);
364 repeat {
365 token = read_token(t);
366 if (token != c_and && token != c_or) {
367 t->token_held = true;
368 break;
369 }
370 q = read_C_connection(a, q, token);
371 }
372 if (p_end == 0) p->left = q; else p_end->right = q;
373 p_end = q;
374 }
375 }
376 }
377
C_style(struct analyser * a,char * s,int token)378 static struct node * C_style(struct analyser * a, char * s, int token) {
379 int i;
380 struct node * p = new_node(a, token);
381 for (i = 0; s[i] != 0; i++) switch(s[i]) {
382 case 'C':
383 p->left = read_C(a); continue;
384 case 'D':
385 p->aux = read_C(a); continue;
386 case 'A':
387 p->AE = read_AE(a, 0); continue;
388 case 'f':
389 get_token(a, c_for); continue;
390 case 'S':
391 {
392 int str_token = read_token(a->tokeniser);
393 if (str_token == c_name) name_to_node(a, p, 's'); else
394 if (str_token == c_literalstring) p->literalstring = new_literalstring(a);
395 else error(a, 2);
396 }
397 continue;
398 case 'b':
399 case 's':
400 case 'i':
401 if (get_token(a, c_name)) name_to_node(a, p, s[i]);
402 continue;
403 }
404 return p;
405 }
406
read_literalstring(struct analyser * a)407 static struct node * read_literalstring(struct analyser * a) {
408 struct node * p = new_node(a, c_literalstring);
409 p->literalstring = new_literalstring(a);
410 return p;
411 }
412
reverse_b(symbol * b)413 static void reverse_b(symbol * b) {
414 int i = 0; int j = SIZE(b) - 1;
415 until (i >= j) {
416 int ch1 = b[i]; int ch2 = b[j];
417 b[i++] = ch2; b[j--] = ch1;
418 }
419 }
420
compare_amongvec(const void * pv,const void * qv)421 static int compare_amongvec(const void *pv, const void *qv) {
422 const struct amongvec * p = (const struct amongvec*)pv;
423 const struct amongvec * q = (const struct amongvec*)qv;
424 symbol * b_p = p->b; int p_size = p->size;
425 symbol * b_q = q->b; int q_size = q->size;
426 int smaller_size = p_size < q_size ? p_size : q_size;
427 int i;
428 for (i = 0; i < smaller_size; i++)
429 if (b_p[i] != b_q[i]) return b_p[i] - b_q[i];
430 return p_size - q_size;
431 }
432
make_among(struct analyser * a,struct node * p,struct node * substring)433 static void make_among(struct analyser * a, struct node * p, struct node * substring) {
434
435 NEW(among, x);
436 NEWVEC(amongvec, v, p->number);
437 struct node * q = p->left;
438 struct amongvec * w0 = v;
439 struct amongvec * w1 = v;
440 int result = 1;
441
442 int direction = substring != 0 ? substring->mode : p->mode;
443 int backward = direction == m_backward;
444
445 if (a->amongs == 0) a->amongs = x; else a->amongs_end->next = x;
446 a->amongs_end = x;
447 x->next = 0;
448 x->b = v;
449 x->number = a->among_count++;
450 x->starter = 0;
451
452 if (q->type == c_bra) { x->starter = q; q = q->right; }
453
454 until (q == 0) {
455 if (q->type == c_literalstring) {
456 symbol * b = q->literalstring;
457 w1->b = b; /* pointer to case string */
458 w1->p = 0; /* pointer to corresponding case expression */
459 w1->size = SIZE(b); /* number of characters in string */
460 w1->i = -1; /* index of longest substring */
461 w1->result = -1; /* number of corresponding case expression */
462 w1->function = q->left == 0 ? 0 : q->left->name;
463 unless (w1->function == 0) {
464 check_routine_mode(a, w1->function, direction);
465 w1->function->routine_called_from_among = true;
466 }
467 w1++;
468 }
469 else
470 if (q->left == 0) /* empty command: () */
471 w0 = w1;
472 else {
473 until (w0 == w1) {
474 w0->p = q;
475 w0->result = result;
476 w0++;
477 }
478 result++;
479 }
480 q = q->right;
481 }
482 unless (w1-v == p->number) { fprintf(stderr, "oh! %d %d\n", (int)(w1-v), p->number); exit(1); }
483 if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
484 qsort(v, w1 - v, sizeof(struct amongvec), compare_amongvec);
485
486 /* the following loop is O(n squared) */
487 for (w0 = w1 - 1; w0 >= v; w0--) {
488 symbol * b = w0->b;
489 int size = w0->size;
490 struct amongvec * w;
491
492 for (w = w0 - 1; w >= v; w--) {
493 if (w->size < size && memcmp(w->b, b, w->size * sizeof(symbol)) == 0) {
494 w0->i = w - v; /* fill in index of longest substring */
495 break;
496 }
497 }
498 }
499 if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
500
501 for (w0 = v; w0 < w1 - 1; w0++)
502 if (w0->size == (w0 + 1)->size &&
503 memcmp(w0->b, (w0 + 1)->b, w0->size * sizeof(symbol)) == 0) error3(a, p, w0->b);
504
505 x->literalstring_count = p->number;
506 x->command_count = result - 1;
507 p->among = x;
508
509 x->substring = substring;
510 if (substring != 0) substring->among = x;
511 unless (x->command_count == 0 && x->starter == 0) a->amongvar_needed = true;
512 }
513
read_among(struct analyser * a)514 static struct node * read_among(struct analyser * a) {
515 struct tokeniser * t = a->tokeniser;
516 struct node * p = new_node(a, c_among);
517 struct node * p_end = 0;
518 int previous_token = -1;
519 struct node * substring = a->substring;
520
521 a->substring = 0;
522 p->number = 0; /* counts the number of literals */
523 unless (get_token(a, c_bra)) return p;
524 repeat {
525 struct node * q;
526 int token = read_token(t);
527 switch (token) {
528 case c_literalstring:
529 q = read_literalstring(a);
530 if (read_token(t) == c_name) {
531 struct node * r = new_node(a, c_name);
532 name_to_node(a, r, 'r');
533 q->left = r;
534 }
535 else t->token_held = true;
536 p->number++; break;
537 case c_bra:
538 if (previous_token == c_bra) error(a, 19);
539 q = read_C_list(a); break;
540 default:
541 error(a, 3);
542 case c_ket:
543 if (p->number == 0) error(a, 18);
544 if (t->error_count == 0) make_among(a, p, substring);
545 return p;
546 }
547 previous_token = token;
548 if (p_end == 0) p->left = q; else p_end->right = q;
549 p_end = q;
550 }
551 }
552
read_substring(struct analyser * a)553 static struct node * read_substring(struct analyser * a) {
554
555 struct node * p = new_node(a, c_substring);
556 if (a->substring != 0) error2(a, 20, a->substring->line_number);
557 a->substring = p;
558 return p;
559 }
560
check_modifyable(struct analyser * a)561 static void check_modifyable(struct analyser * a) {
562 unless (a->modifyable) error(a, 15);
563 }
564
read_C(struct analyser * a)565 static struct node * read_C(struct analyser * a) {
566 struct tokeniser * t = a->tokeniser;
567 int token = read_token(t);
568 switch (token) {
569 case c_bra:
570 return read_C_list(a);
571 case c_backwards:
572 {
573 int mode = a->mode;
574 if (a->mode == m_backward) error(a, 17); else a->mode = m_backward;
575 { struct node * p = C_style(a, "C", token);
576 a->mode = mode;
577 return p;
578 }
579 }
580 case c_reverse:
581 {
582 int mode = a->mode;
583 int modifyable = a->modifyable;
584 a->modifyable = false;
585 a->mode = mode == m_forward ? m_backward : m_forward;
586 {
587 struct node * p = C_style(a, "C", token);
588 a->mode = mode;
589 a->modifyable = modifyable;
590 return p;
591 }
592 }
593 case c_not:
594 case c_try:
595 case c_fail:
596 case c_test:
597 case c_do:
598 case c_goto:
599 case c_gopast:
600 case c_repeat:
601 return C_style(a, "C", token);
602 case c_loop:
603 case c_atleast:
604 return C_style(a, "AC", token);
605 case c_setmark:
606 return C_style(a, "i", token);
607 case c_tomark:
608 case c_atmark:
609 case c_hop:
610 return C_style(a, "A", token);
611 case c_delete:
612 check_modifyable(a);
613 case c_next:
614 case c_tolimit:
615 case c_atlimit:
616 case c_leftslice:
617 case c_rightslice:
618 case c_true:
619 case c_false:
620 case c_debug:
621 return C_style(a, "", token);
622 case c_assignto:
623 case c_sliceto:
624 check_modifyable(a);
625 return C_style(a, "s", token);
626 case c_assign:
627 case c_insert:
628 case c_attach:
629 case c_slicefrom:
630 check_modifyable(a);
631 return C_style(a, "S", token);
632 case c_setlimit:
633 return C_style(a, "CfD", token);
634 case c_set:
635 case c_unset:
636 return C_style(a, "b", token);
637 case c_dollar:
638 get_token(a, c_name);
639 {
640 struct node * p;
641 struct name * q = find_name(a);
642 int mode = a->mode;
643 int modifyable = a->modifyable;
644 switch (q ? q->type : t_string)
645 /* above line was: switch (q->type) - bug #1 fix 7/2/2003 */
646 {
647 default: error(a, 34);
648 case t_string:
649 a->mode = m_forward;
650 a->modifyable = true;
651 p = new_node(a, c_dollar);
652 p->left = read_C(a); break;
653 case t_integer:
654 /* a->mode = m_integer; */
655 p = new_node(a, read_AE_test(a));
656 p->AE = read_AE(a, 0); break;
657 }
658 p->name = q;
659 a->mode = mode;
660 a->modifyable = modifyable;
661 return p;
662 }
663 case c_name:
664 {
665 struct name * q = find_name(a);
666 struct node * p = new_node(a, c_name);
667 unless (q == 0) {
668 q->used = true;
669 switch (q->type) {
670 case t_boolean:
671 p->type = c_booltest; break;
672 case t_integer:
673 error(a, 35); /* integer name misplaced */
674 case t_string:
675 break;
676 case t_routine:
677 case t_external:
678 p->type = c_call;
679 check_routine_mode(a, q, a->mode);
680 break;
681 case t_grouping:
682 p->type = c_grouping; break;
683 }
684 }
685 p->name = q;
686 return p;
687 }
688 case c_non:
689 {
690 struct node * p = new_node(a, token);
691 read_token(t);
692 if (t->token == c_minus) read_token(t);
693 unless (check_token(a, c_name)) { omission_error(a, c_name); return p; }
694 name_to_node(a, p, 'g');
695 return p;
696 }
697 case c_literalstring:
698 return read_literalstring(a);
699 case c_among: return read_among(a);
700 case c_substring: return read_substring(a);
701 default: error(a, 1); return 0;
702 }
703 }
704
next_symbol(symbol * p,symbol * W,int utf8)705 static int next_symbol(symbol * p, symbol * W, int utf8) {
706 if (utf8) {
707 int ch;
708 int j = get_utf8(p, & ch);
709 W[0] = ch; return j;
710 } else {
711 W[0] = p[0]; return 1;
712 }
713 }
714
alter_grouping(symbol * p,symbol * q,int style,int utf8)715 static symbol * alter_grouping(symbol * p, symbol * q, int style, int utf8) {
716 int j = 0;
717 symbol W[1];
718 int width;
719 if (style == c_plus) {
720 while (j < SIZE(q)) {
721 width = next_symbol(q + j, W, utf8);
722 p = add_to_b(p, 1, W);
723 j += width;
724 }
725 } else {
726 while (j < SIZE(q)) {
727 int i;
728 width = next_symbol(q + j, W, utf8);
729 for (i = 0; i < SIZE(p); i++) {
730 if (p[i] == W[0]) {
731 memmove(p + i, p + i + 1, (SIZE(p) - i - 1) * sizeof(symbol));
732 SIZE(p)--;
733 }
734 }
735 j += width;
736 }
737 }
738 return p;
739 }
740
read_define_grouping(struct analyser * a,struct name * q)741 static void read_define_grouping(struct analyser * a, struct name * q) {
742 struct tokeniser * t = a->tokeniser;
743 int style = c_plus;
744 {
745 NEW(grouping, p);
746 if (a->groupings == 0) a->groupings = p; else a->groupings_end->next = p;
747 a->groupings_end = p;
748 q->grouping = p;
749 p->next = 0;
750 p->name = q;
751 p->number = q->count;
752 p->b = create_b(0);
753 repeat {
754 switch (read_token(t)) {
755 case c_name:
756 {
757 struct name * r = find_name(a);
758 unless (r == 0) {
759 check_name_type(a, r, 'g');
760 p->b = alter_grouping(p->b, r->grouping->b, style, false);
761 }
762 }
763 break;
764 case c_literalstring:
765 p->b = alter_grouping(p->b, t->b, style, a->utf8);
766 break;
767 default: error(a, 1); return;
768 }
769 switch (read_token(t)) {
770 case c_plus:
771 case c_minus: style = t->token; break;
772 default: goto label0;
773 }
774 }
775 label0:
776 {
777 int i;
778 int max = 0;
779 int min = 1<<16;
780 for (i = 0; i < SIZE(p->b); i++) {
781 if (p->b[i] > max) max = p->b[i];
782 if (p->b[i] < min) min = p->b[i];
783 }
784 p->largest_ch = max;
785 p->smallest_ch = min;
786 if (min == 1<<16) error(a, 16);
787 }
788 t->token_held = true; return;
789 }
790 }
791
read_define_routine(struct analyser * a,struct name * q)792 static void read_define_routine(struct analyser * a, struct name * q) {
793 struct node * p = new_node(a, c_define);
794 a->amongvar_needed = false;
795 unless (q == 0) {
796 check_name_type(a, q, 'R');
797 if (q->definition != 0) error(a, 36);
798 if (q->mode < 0) q->mode = a->mode; else
799 if (q->mode != a->mode) error2(a, 32, q->mode);
800 }
801 p->name = q;
802 if (a->program == 0) a->program = p; else a->program_end->right = p;
803 a->program_end = p;
804 get_token(a, c_as);
805 p->left = read_C(a);
806 unless (q == 0) q->definition = p->left;
807
808 if (a->substring != 0) {
809 error2(a, 14, a->substring->line_number);
810 a->substring = 0;
811 }
812 p->amongvar_needed = a->amongvar_needed;
813 }
814
read_define(struct analyser * a)815 static void read_define(struct analyser * a) {
816 unless (get_token(a, c_name)) return;
817 {
818 struct name * q = find_name(a);
819 if (q != 0 && q->type == t_grouping) read_define_grouping(a, q);
820 else read_define_routine(a, q);
821 }
822 }
823
read_backwardmode(struct analyser * a)824 static void read_backwardmode(struct analyser * a) {
825 int mode = a->mode;
826 a->mode = m_backward;
827 if (get_token(a, c_bra)) {
828 read_program_(a, c_ket);
829 check_token(a, c_ket);
830 }
831 a->mode = mode;
832 }
833
read_program_(struct analyser * a,int terminator)834 static void read_program_(struct analyser * a, int terminator) {
835 struct tokeniser * t = a->tokeniser;
836 repeat {
837 switch (read_token(t)) {
838 case c_strings: read_names(a, t_string); break;
839 case c_booleans: read_names(a, t_boolean); break;
840 case c_integers: read_names(a, t_integer); break;
841 case c_routines: read_names(a, t_routine); break;
842 case c_externals: read_names(a, t_external); break;
843 case c_groupings: read_names(a, t_grouping); break;
844 case c_define: read_define(a); break;
845 case c_backwardmode:read_backwardmode(a); break;
846 case c_ket:
847 if (terminator == c_ket) return;
848 default:
849 error(a, 1); break;
850 case -1:
851 unless (terminator < 0) omission_error(a, c_ket);
852 return;
853 }
854 }
855 }
856
read_program(struct analyser * a)857 extern void read_program(struct analyser * a) {
858 read_program_(a, -1);
859 {
860 struct name * q = a->names;
861 until (q == 0) {
862 switch(q->type) {
863 case t_external: case t_routine:
864 if (q->used && q->definition == 0) error4(a, q); break;
865 case t_grouping:
866 if (q->used && q->grouping == 0) error4(a, q); break;
867 }
868 q = q->next;
869 }
870 }
871
872 if (a->tokeniser->error_count == 0) {
873 struct name * q = a->names;
874 int warned = false;
875 until (q == 0) {
876 unless (q->referenced) {
877 unless (warned) {
878 fprintf(stderr, "Declared but not used:");
879 warned = true;
880 }
881 fprintf(stderr, " "); report_b(stderr, q->b);
882 }
883 q = q->next;
884 }
885 if (warned) fprintf(stderr, "\n");
886
887 q = a->names;
888 warned = false;
889 until (q == 0) {
890 if (! q->used && (q->type == t_routine ||
891 q->type == t_grouping)) {
892 unless (warned) {
893 fprintf(stderr, "Declared and defined but not used:");
894 warned = true;
895 }
896 fprintf(stderr, " "); report_b(stderr, q->b);
897 }
898 q = q->next;
899 }
900 if (warned) fprintf(stderr, "\n");
901 }
902 }
903
create_analyser(struct tokeniser * t)904 extern struct analyser * create_analyser(struct tokeniser * t) {
905 NEW(analyser, a);
906 a->tokeniser = t;
907 a->nodes = 0;
908 a->names = 0;
909 a->literalstrings = 0;
910 a->program = 0;
911 a->amongs = 0;
912 a->among_count = 0;
913 a->groupings = 0;
914 a->mode = m_forward;
915 a->modifyable = true;
916 { int i; for (i = 0; i < t_size; i++) a->name_count[i] = 0; }
917 a->substring = 0;
918 return a;
919 }
920
close_analyser(struct analyser * a)921 extern void close_analyser(struct analyser * a) {
922 {
923 struct node * q = a->nodes;
924 until (q == 0) {
925 struct node * q_next = q->next;
926 FREE(q);
927 q = q_next;
928 }
929 }
930 {
931 struct name * q = a->names;
932 until (q == 0) {
933 struct name * q_next = q->next;
934 lose_b(q->b); FREE(q);
935 q = q_next;
936 }
937 }
938 {
939 struct literalstring * q = a->literalstrings;
940 until (q == 0) {
941 struct literalstring * q_next = q->next;
942 lose_b(q->b); FREE(q);
943 q = q_next;
944 }
945 }
946 {
947 struct among * q = a->amongs;
948 until (q == 0) {
949 struct among * q_next = q->next;
950 FREE(q->b); FREE(q);
951 q = q_next;
952 }
953 }
954 {
955 struct grouping * q = a->groupings;
956 until (q == 0) {
957 struct grouping * q_next = q->next;
958 lose_b(q->b); FREE(q);
959 q = q_next;
960 }
961 }
962 FREE(a);
963 }
964
965