1 /* $Id: $ */
2
3 /* Copyright (C) 1998 Sverre Hvammen Johansen,
4 * Department of Informatics, University of Oslo.
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; version 2.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
18
19 #include <stdio.h>
20 #include "const.h"
21 #include "mellbuilder.h"
22 #include "builder.h"
23 #include "checker.h"
24 #include "expmacros.h"
25
26 static struct DECL *absfunction;
27 static struct DECL *absfunctionr;
28 static struct DECL *absfunctioni;
29 static struct DECL *minfunction;
30 static struct DECL *minfunctiont;
31 static struct DECL *minfunctionc;
32 static struct DECL *minfunctionr;
33 static struct DECL *minfunctioni;
34 static struct DECL *maxfunction;
35 static struct DECL *maxfunctiont;
36 static struct DECL *maxfunctionc;
37 static struct DECL *maxfunctionr;
38 static struct DECL *maxfunctioni;
39 static struct DECL *signfunction;
40 static struct DECL *signfunctionr;
41 static struct DECL *signfunctioni;
42 static struct DECL *sourcelinefunction;
43
44 static struct DECL *varargsint;
45 static struct DECL *varargsreal;
46 static struct DECL *varargschar;
47 static struct DECL *varargstext;
48 static struct DECL *varargsintvar;
49 static struct DECL *varargsrealvar;
50 static struct DECL *varargscharvar;
51 static struct DECL *varargstextvalue;
52 static struct DECL *varargs;
53
expCheckerInit()54 void expCheckerInit ()
55 {
56 absfunction = findGlobal (tag ("ABS"), TRUE);
57 minfunction = findGlobal (tag ("MIN"), TRUE);
58 maxfunction = findGlobal (tag ("MAX"), TRUE);
59 absfunctionr = findGlobal (tag ("ABS*R"), TRUE);
60 absfunctioni = findGlobal (tag ("ABS*I"), TRUE);
61 minfunctiont = findGlobal (tag ("MIN*T"), TRUE);
62 minfunctionc = findGlobal (tag ("MIN*C"), TRUE);
63 minfunctionr = findGlobal (tag ("MIN*R"), TRUE);
64 minfunctioni = findGlobal (tag ("MIN*I"), TRUE);
65 maxfunctiont = findGlobal (tag ("MAX*T"), TRUE);
66 maxfunctionc = findGlobal (tag ("MAX*C"), TRUE);
67 maxfunctionr = findGlobal (tag ("MAX*R"), TRUE);
68 maxfunctioni = findGlobal (tag ("MAX*I"), TRUE);
69 signfunction = findGlobal (tag ("SIGN"), TRUE);
70 signfunctionr = findGlobal (tag ("SIGN*R"), TRUE);
71 signfunctioni = findGlobal (tag ("SIGN*I"), TRUE);
72 sourcelinefunction = findGlobal (tag ("SOURCELINE"), TRUE);
73
74 varargsint = newDecl ();
75 varargsint->type = TINTG;
76 varargsint->kind = KSIMPLE;
77 varargsint->categ = CDEFLT;
78
79 varargsreal = newDecl ();
80 varargsreal->type = TREAL;
81 varargsreal->kind = KSIMPLE;
82 varargsreal->categ = CDEFLT;
83
84 varargschar = newDecl ();
85 varargschar->type = TCHAR;
86 varargschar->kind = KSIMPLE;
87 varargschar->categ = CDEFLT;
88
89 varargstext = newDecl ();
90 varargstext->type = TTEXT;
91 varargstext->kind = KSIMPLE;
92 varargstext->categ = CDEFLT;
93
94 varargsintvar = newDecl ();
95 varargsintvar->type = TINTG;
96 varargsintvar->kind = KSIMPLE;
97 varargsintvar->categ = CVAR;
98
99 varargsrealvar = newDecl ();
100 varargsrealvar->type = TREAL;
101 varargsrealvar->kind = KSIMPLE;
102 varargsrealvar->categ = CVAR;
103
104 varargscharvar = newDecl ();
105 varargscharvar->type = TCHAR;
106 varargscharvar->kind = KSIMPLE;
107 varargscharvar->categ = CVAR;
108
109 varargstextvalue = newDecl ();
110 varargstextvalue->type = TTEXT;
111 varargstextvalue->kind = KSIMPLE;
112 varargstextvalue->categ = CVALUE;
113
114 varargs = newDecl ();
115 varargs->type = TNOTY;
116 varargs->kind = KSIMPLE;
117 varargs->categ = CDEFLT;
118
119 }
120
121 /******************************************************************************
122 SERROR */
123
124 #define SERROR(melding) sserror(melding,re)
125
sserror(melding,re)126 static sserror (melding, re)
127 int melding;
128 struct EXP *re;
129 {
130 if (RD && RD->categ == CNEW)
131 {
132 serror (melding, RD->ident);
133 RD->categ = CERROR;
134 }
135 else if (LEFT && LEFTRD && LEFTRD->categ == CNEW)
136 {
137 serror (melding, LEFTRD->ident);
138 LEFTRD->categ = CERROR;
139 }
140 else if (RIGHT && RIGHTRD && RIGHTRD->categ == CNEW)
141 {
142 serror (melding, RIGHTRD->ident);
143 RIGHTRD->categ = CERROR;
144 }
145 else if (QUAL && QUAL->categ == CNEW)
146 {
147 serror (melding, QUAL->ident);
148 QUAL->categ = CERROR;
149 }
150 else if ((LEFT ? LEFTTYPE != TERROR : TRUE)
151 && (RIGHT ? RIGHTTYPE != TERROR : TRUE) &&
152 (UP ? UPTYPE != TERROR : TRUE) && (RD ? RD->type != TERROR : TRUE) &&
153 (QUAL ? QUAL->type != TERROR : TRUE)
154 && (UPRD ? UPRD->type != TERROR : TRUE) &&
155 (TYPE != TERROR))
156 serror (melding, RD ? RD->ident : 0);
157 TYPE = TERROR;
158 }
159
160
161 /******************************************************************************
162 KONVTYPE */
163
164 /*VARARGS2 */
165 static konvtype (re, type, qual)
166 struct EXP **re;
167 char type;
168 struct DECL *qual;
169 {
170 struct EXP *rex;
171 struct DECL *rd;
172 if (((*re)->type == TINTG && type == TREAL)
173 || ((*re)->type == TREAL && type == TINTG))
174 {
175 rex = newexp();
176 rex->left = (*re);
177 rex->right = NULL;
178 rex->up = (*re)->up;
179 rex->rd = NULL;
180 rex->qual = NULL;
181 rex->value.rval = 0.0;
182 if (type == TREAL)
183 rex->token = MREAINT;
184 else
185 rex->token = MINTREA;
186 rex->type = type;
187 *re = (*re)->up = rex;
188 }
189 else if ((*re)->type == TREF && type == TREF)
190 {
191 if ((*re)->qual == NULL) /* OK */ ;
192 else if (qual == NULL)
193 {
194 if (((*re)->up->left == NULL || (*re)->up->left->type != TERROR)
195 && ((*re)->up->right == NULL || (*re)->up->right->type != TERROR))
196 serror (85, (*re)->up->token);
197 (*re)->type = (*re)->up->type = TERROR;
198 }
199 else if ((rd = commonqual ((*re)->qual, qual)) == qual) /* OK */ ;
200 else if (rd == (*re)->qual && (*re)->token != MNEWARG)
201 {
202 rex = newexp();
203 rex->left = (*re);
204 rex->right = NULL;
205 rex->up = (*re)->up;
206 rex->rd = qual;
207 rex->value.ident = qual->ident;
208 rex->qual = qual;
209 rex->token = MQUANONEAND;
210 rex->type = type;
211 *re = (*re)->up = rex;
212 }
213 else
214 {
215 if (((*re)->token == MNEWARG) ||
216 (((*re)->up->left == NULL || (*re)->up->left->type != TERROR)
217 && ((*re)->up->right == NULL || (*re)->up->right->type != TERROR)))
218 serror (85, (*re)->up->token);
219 (*re)->type = (*re)->up->type = TERROR;
220 }
221 }
222 }
223
224 /******************************************************************************
225 SAMETYPE */
226
227 static sametype (rel, rer)
228 struct EXP **rel,
229 **rer;
230 {
231 if ((*rel)->type == TINTG && (*rer)->type == TREAL)
232 konvtype (rel, TREAL);
233 else if ((*rel)->type == TREAL && (*rer)->type == TINTG)
234 konvtype (rer, TREAL);
235 }
236
237 /******************************************************************************
238 ARGUMENTERROR */
239
240 void
argumenterror(melding,re)241 static argumenterror (melding, re)
242 int melding;
243 struct EXP *re;
244 {
245 int i = 1;
246 if (TYPE == TERROR)
247 return;
248 TYPE = TERROR;
249 if (UPTYPE == TERROR || (LEFT != NULL && LEFTTYPE == TERROR))
250 return;
251 for (re = UP; TOKEN == MARGUMENTSEP; re = UP)
252 i++;
253 if (re->type == TERROR)
254 return;
255 serror (melding, re->value.ident, i);
256
257 }
258
259 /******************************************************************************
260 SET_PARAM */
261
262 static set_param (re)
263 struct EXP *re;
264 {
265 re->right->rd = firstParam (re->rd);
266 {
267 struct EXP *rex;
268 for (rex = re->right; rex->token != MENDSEP; rex = rex->right)
269 {
270 if (moreParam (rex->rd) == FALSE)
271 argumenterror (102, rex);
272 rex->right->rd = nextParam (rex->rd);
273 }
274 if (moreParam (rex->rd) == TRUE)
275 argumenterror (102, rex);
276 }
277 }
278
279 /******************************************************************************
280 EXPCHECK */
281
282 static expCheck (re)
283 struct EXP *re;
284 {
285
286 /* Sjekker f�rst at nodene har riktige typer */
287 switch (TOKEN)
288 {
289 case MFOR:
290 case MFORR:
291 expCheck (LEFT);
292 TYPE = LEFTTYPE;
293 QUAL = LEFTQUAL;
294 expCheck (RIGHT);
295 if (TYPE != RIGHTTYPE)
296 SERROR (86);
297 else if (TOKEN == MFOR && TYPE == TREF)
298 SERROR (86);
299 else if (TOKEN == MFORR && (TYPE == TINTG
300 || TYPE == TREAL || TYPE == TCHAR || TYPE == TBOOL))
301 SERROR (86);
302 if (LEFTTOKEN != MIDENTIFIER)
303 SERROR (87);
304 else if (LEFTRD->categ == CNAME || LEFTRD->categ == CVAR)
305 SERROR (87);
306 else if (LEFTRD->kind != KSIMPLE)
307 SERROR (87);
308 break;
309 case MLISTSEP:
310 case MFORWHILE:
311 case MSTEP:
312 case MUNTIL:
313 case MSWITCHSEP:
314 case MBOUNDPARSEP:
315 case MBOUNDSEP:
316 TYPE = UPTYPE;
317 QUAL = UPQUAL;
318 expCheck (LEFT);
319 expCheck (RIGHT);
320 konvtype (&LEFT, TYPE, QUAL);
321 TYPE = LEFTTYPE;
322 if(TOKEN==MUNTIL && TYPE==TINTG && RIGHTTYPE==TREAL)
323 {
324
325 }
326 else
327 {
328 konvtype (&RIGHT, TYPE, QUAL);
329 if (TOKEN == MFORWHILE)
330 {
331 if (RIGHTTYPE != TBOOL)
332 SERROR (77);
333 }
334 else if (LEFTTYPE != RIGHTTYPE)
335 SERROR (88);
336 }
337 break;
338 case MSWITCH:
339 TYPE = TLABEL;
340 expCheck (LEFT);
341 TYPE = LEFTTYPE;
342 expCheck (RIGHT);
343 TYPE = RIGHTTYPE;
344 break;
345 case MARRAY:
346 expCheck (LEFT);
347 localused = 0;
348 TYPE = TINTG;
349 expCheck (RIGHT);
350 if (localused)
351 SERROR (89);
352 break;
353 case MARRAYSEP:
354 /* Forutsetter at venstre node er en identifier */
355 expCheck (RIGHT);
356 LEFTRD = findGlobal (LEFTVALUE.ident, FALSE);
357 if (LEFTRD->categ == CNEW)
358 SERROR (75);
359 LEFTTYPE = LEFTRD->type;
360 break;
361 case MASSIGN:
362 case MASSIGNR:
363 expCheck (LEFT);
364 expCheck (RIGHT);
365 TYPE = LEFTTYPE;
366 if (UPTOKEN != MASSIGN && UPTOKEN != MASSIGNR
367 && UPTOKEN != MENDASSIGN && UPTOKEN != MCONST)
368 SERROR (118);
369 else if (TYPE != TTEXT && LEFTTOKEN != MIDENTIFIER
370 && LEFTTOKEN != MPROCASSIGN
371 && LEFTTOKEN != MARRAYARG && LEFTTOKEN != MDOT)
372 SERROR (90);
373 else if (LEFTTOKEN == MIFE)
374 SERROR (90);
375 konvtype (&RIGHT, LEFTTYPE, LEFTQUAL);
376 if (LEFTTYPE != RIGHTTYPE)
377 SERROR (91);
378 else if (TOKEN == MASSIGNR)
379 {
380 if (TYPE != TTEXT && TYPE != TREF)
381 SERROR (91);
382 if (TYPE == TTEXT)
383 TOKEN = MREFASSIGNT;
384 }
385 else
386 {
387 if (TYPE != TINTG && TYPE != TREAL
388 && TYPE != TCHAR && TYPE != TBOOL && TYPE != TTEXT)
389 SERROR (91);
390 if (TYPE == TTEXT)
391 TOKEN = MVALASSIGNT;
392 }
393 break;
394 case MLABEL:
395 RD = findGlobal (VALUE.ident, TRUE);
396 break;
397 case MIFE:
398 expCheck (LEFT);
399 expCheck (RIGHT);
400 if (LEFTTYPE != TBOOL)
401 SERROR (77);
402 else
403 TYPE = RIGHTTYPE;
404 QUAL = RIGHTQUAL;
405 break;
406 case MELSEE:
407 expCheck (LEFT);
408 expCheck (RIGHT);
409 sametype (&LEFT, &RIGHT);
410 if (LEFTTYPE != RIGHTTYPE)
411 SERROR (92);
412 else if (LEFTTOKEN == MIFE)
413 SERROR (93);
414 else if ((TYPE = LEFTTYPE) == TREF && (QUAL
415 = commonqual (LEFTQUAL, RIGHTQUAL)) == NULL)
416 SERROR (94);
417
418 break;
419 case MCONC:
420 expCheck (LEFT);
421 expCheck (RIGHT);
422 if (LEFTTYPE != TTEXT || RIGHTTYPE != TTEXT)
423 SERROR (109);
424 else
425 TYPE = TTEXT;
426 break;
427 case MORELSEE:
428 case MANDTHENE:
429 case MEQV:
430 case MIMP:
431 case MOR:
432 case MAND:
433 expCheck (LEFT);
434 expCheck (RIGHT);
435 if (LEFTTYPE != TBOOL || RIGHTTYPE != TBOOL)
436 SERROR (95);
437 else
438 TYPE = TBOOL;
439 break;
440 case MNOT:
441 expCheck (LEFT);
442 if (LEFTTYPE != TBOOL)
443 SERROR (95);
444 else
445 TYPE = TBOOL;
446 break;
447 case MEQ:
448 case MNE:
449 case MLT:
450 case MLE:
451 case MGT:
452 case MGE:
453 expCheck (LEFT);
454 expCheck (RIGHT);
455 sametype (&LEFT, &RIGHT);
456 if (LEFTTYPE != RIGHTTYPE)
457 SERROR (96);
458 else if (LEFTTYPE != TINTG && LEFTTYPE != TREAL
459 && LEFTTYPE != TCHAR && LEFTTYPE != TTEXT)
460 SERROR (96);
461 else
462 TYPE = TBOOL;
463 if (LEFTTYPE == TTEXT)
464 TOKEN = TOKEN - MEQ + MEQT;
465 break;
466 case MNER:
467 case MEQR:
468 expCheck (LEFT);
469 expCheck (RIGHT);
470 if (LEFTTYPE != RIGHTTYPE)
471 SERROR (96);
472 else if (LEFTTYPE != TREF && LEFTTYPE != TTEXT)
473 SERROR (96);
474 else
475 TYPE = TBOOL;
476 if (LEFTTYPE == TTEXT)
477 TOKEN = TOKEN - MNER + MNERT;
478 break;
479 case MIS:
480 case MINS:
481 VALUE = RIGHTVALUE;
482 expCheck (LEFT);
483 RIGHTRD = RD = findGlobal (VALUE.ident, FALSE);
484 if (RIGHTRD->categ == CNEW)
485 SERROR (75);
486 if (LEFTTYPE != TREF)
487 SERROR (96);
488 else if (LEFTQUAL == NULL)
489 SERROR (96);
490 else if (RD->categ == CNEW)
491 SERROR (96);
492 else if (RD->kind != KCLASS)
493 SERROR (96);
494 else if (!commonqual (LEFTQUAL, RD))
495 SERROR (85);
496 TYPE = TBOOL;
497 break;
498 case MUADD:
499 case MUSUB:
500 expCheck (LEFT);
501 if (LEFTTYPE != TREAL && LEFTTYPE != TINTG)
502 SERROR (97);
503 else if (LEFTTOKEN == MUADD || LEFTTOKEN == MUSUB)
504 SERROR (98);
505 else
506 TYPE = LEFTTYPE;
507 if (TYPE == TINTG)
508 TOKEN = TOKEN - MUADD + MUADDI;
509 break;
510 case MADD:
511 case MSUB:
512 case MMUL:
513 expCheck (LEFT);
514 expCheck (RIGHT);
515 sametype (&LEFT, &RIGHT);
516 TYPE = LEFTTYPE;
517 if (LEFTTYPE != RIGHTTYPE ||
518 (LEFTTYPE != TINTG && LEFTTYPE != TREAL))
519 SERROR (97);
520 if (TYPE == TINTG)
521 TOKEN = TOKEN - MADD + MADDI;
522 break;
523 case MINTDIV:
524 if (TRUE)
525 TYPE = TINTG;
526 else
527 case MDIV:
528 TYPE = TREAL;
529 expCheck (LEFT);
530 expCheck (RIGHT);
531 konvtype (&LEFT, TYPE);
532 konvtype (&RIGHT, TYPE);
533 if (LEFTTYPE != TYPE || RIGHTTYPE != TYPE)
534 SERROR (97);
535 break;
536 case MPRIMARY:
537 expCheck (LEFT);
538 expCheck (RIGHT);
539 TYPE = TREAL;
540 if ((LEFTTYPE == TINTG || LEFTTYPE == TREAL) &&
541 RIGHTTYPE == TREAL)
542 konvtype (&LEFT, TREAL);
543 else if (LEFTTYPE == TREAL && RIGHTTYPE == TINTG)
544 TOKEN = MPRIMARYRI;
545 else if (LEFTTYPE == TINTG && RIGHTTYPE == TINTG)
546 {
547 TYPE = TINTG;
548 TOKEN = MPRIMARYII;
549 }
550 else
551 SERROR (97);
552 break;
553 case MNOOP:
554 expCheck (LEFT);
555 TYPE = LEFTTYPE;
556 QUAL = LEFTQUAL;
557 break;
558 case MTEXTKONST:
559 TYPE = TTEXT;
560 break;
561 case MCHARACTERKONST:
562 TYPE = TCHAR;
563 break;
564 case MREALKONST:
565 TYPE = TREAL;
566 break;
567 case MINTEGERKONST:
568 TYPE = TINTG;
569 break;
570 case MBOOLEANKONST:
571 TYPE = TBOOL;
572 break;
573 case MNONE:
574 TYPE = TREF;
575 QUAL = commonprefiks;
576 break;
577 case MIDENTIFIER:
578 if (UPTOKEN == MDOT && ISRIGHT)
579 RD = findLocal (VALUE.ident, UPQUAL, TRUE);
580 else if (ISLEFT && (UPTOKEN == MASSIGN | UPTOKEN == MASSIGNR))
581 RD = findGlobal (VALUE.ident, FALSE); /* Tilordning av
582 * funksjons proc. */
583 else if (UPTOKEN == MWHEN)
584 RD = findGlobal (VALUE.ident, FALSE);
585 else
586 RD = findGlobal (VALUE.ident, TRUE);
587 if (RD->categ == CNEW)
588 SERROR (75);
589 SEENTHROUGH = seenthrough;
590 TYPE = RD->type;
591 QUAL = RD->prefqual;
592 if (RD->type == TERROR)
593 SERROR (106);
594 if (TYPE == TLABEL && seenthrough != NULL)
595 SERROR (8);
596 if (UPTOKEN == MWHEN)
597 {
598 if (RD->kind != KCLASS)
599 {
600 if (RD->kind != KERROR)
601 serror (84);
602 }
603 } else
604 if (RD == sourcelinefunction)
605 {
606 TOKEN = MINTEGERKONST;
607 TYPE = TINTG;
608 VALUE.ival = re->line;
609 RD = NULL;
610 SEENTHROUGH = NULL;
611 }
612 else if (RD->kind == KARRAY)
613 {
614 if (ISLEFT)
615 {
616 if ((UPTOKEN != MARGUMENTSEP || UPRD->kind != KARRAY) &&
617 UPTOKEN != MSWITCH)
618 SERROR (119);
619 }
620 else
621 {
622 if (UPTOKEN != MDOT || UPUPTOKEN != MARGUMENTSEP ||
623 UPUPRD->kind != KARRAY)
624 SERROR (119);
625 }
626 }
627 else if (RD->kind == KPROC || RD->kind == KCLASS)
628 {
629 if (ISLEFT && (UPTOKEN == MASSIGN | UPTOKEN == MASSIGNR))
630 if (body (RD))
631 TOKEN = MPROCASSIGN;
632 else
633 SERROR (90);
634 else if (moreParam (firstParam (RD)) == TRUE)
635 SERROR (107);
636 else if (RD->kind == KPROC)
637 TOKEN = MPROCARG;
638 else
639 TOKEN = MARGUMENT;
640 RIGHT = newexp();
641 RIGHTTOKEN = MENDSEP;
642 RIGHTVALUE.rval = 0.0;
643 RIGHTRIGHT = NULL;
644 RIGHTLEFT = NULL;
645 RIGHTRD = NULL;
646 RIGHTQUAL = NULL;
647 }
648 else if (RD->categ == CCONST)
649 {
650 if (TYPE == TREAL)
651 TOKEN = MREALKONST;
652 else if (TYPE == TINTG)
653 TOKEN = MINTEGERKONST;
654 else if (TYPE == TTEXT)
655 TOKEN = MTEXTKONST;
656 else if (TYPE == TCHAR)
657 TOKEN = MCHARACTERKONST;
658 else if (TYPE == TBOOL)
659 TOKEN = MBOOLEANKONST;
660 VALUE = RD->value;
661 if (UPTOKEN == MDOT)
662 UPTOKEN = MDOTCONST;
663 }
664 else if (RD->categ == CCONSTU)
665 {
666 if ((ISLEFT && (UPTOKEN == MASSIGN | UPTOKEN == MASSIGNR)) |
667 (ISRIGHT && UPTOKEN == MDOT && UPISLEFT &&
668 (UPUPTOKEN == MASSIGN | UPUPTOKEN == MASSIGNR)))
669 {
670 if (RD->encl->blev != cblev)
671 SERROR (90);
672 }
673 else
674 SERROR (7);
675 }
676 break;
677 case MTHIS:
678 RD = regThis (VALUE.ident);
679 if (RD->categ == CNEW)
680 SERROR (75);
681 TYPE = TREF;
682 QUAL = RD;
683 SEENTHROUGH = seenthrough;
684 if (RD->kind != KCLASS)
685 SERROR (99);
686 break;
687 case MDOT:
688 expCheck (LEFT);
689 TYPE = LEFTTYPE;
690 QUAL = LEFTQUAL;
691 VALUE = LEFTVALUE;
692 SEENTHROUGH = LEFTSEENTHROUGH;
693 if (TYPE == TTEXT)
694 {
695 QUAL = classtext;
696 }
697 if (LEFTTOKEN == MNONE)
698 SERROR (9);
699 if (TYPE == TREF)
700 VALUE.ival = QUAL->descr->blev;
701 if (TYPE != TTEXT && TYPE != TREF)
702 SERROR (100);
703 if (RIGHTTOKEN != MIDENTIFIER && RIGHTTOKEN != MARGUMENT
704 && RIGHTTOKEN != MARRAYARG && RIGHTTOKEN != MPROCARG)
705 SERROR (116);
706 expCheck (RIGHT);
707 if (LEFTTYPE == TREF && RIGHTTYPE == TREF &&
708 LEFTQUAL->descr->blev < RIGHTQUAL->descr->blev)
709 SERROR (117);
710 TYPE = RIGHTTYPE;
711 QUAL = RIGHTQUAL;
712 RD = RIGHTRD;
713 VALUE = RIGHTVALUE;
714 if (TYPE == TLABEL)
715 SERROR (8);
716 break;
717 case MNEWARG:
718 RD = findGlobal (VALUE.ident, FALSE);
719 if (RD->categ == CNEW)
720 SERROR (75);
721 SEENTHROUGH = seenthrough;
722 TYPE = TREF;
723 QUAL = RD;
724 if (RD->kind != KCLASS)
725 SERROR (99);
726 set_param (re);
727 expCheck (RIGHT);
728 if (RIGHTTYPE == TERROR)
729 TYPE = TERROR;
730 break;
731 case MQUA:
732 expCheck (LEFT);
733 QUAL = findGlobal (VALUE.ident, FALSE);
734 if (QUAL->categ == CNEW)
735 SERROR (75);
736 TYPE = LEFTTYPE;
737 if (LEFTTOKEN == MNONE)
738 SERROR (9);
739 if (TYPE != TREF)
740 SERROR (100);
741 else if (QUAL->kind != KCLASS)
742 SERROR (99);
743 else if ((RD = commonqual (LEFTQUAL, QUAL)) == NULL)
744 SERROR (85);
745 else if (QUAL == RD)
746 TOKEN = MQUANOTNONE;
747 else if (RD != LEFTQUAL)
748 SERROR (85);
749 break;
750 case MARGUMENT:
751 if (UPTOKEN == MDOT && ISRIGHT)
752 RD = findLocal (VALUE.ident, UPQUAL, TRUE);
753 else
754 RD = findGlobal (VALUE.ident, TRUE);
755 if (RD->categ == CNEW)
756 SERROR (75);
757 SEENTHROUGH = seenthrough;
758 TYPE = RD->type;
759 QUAL = RD->prefqual;
760 if (RD->kind == KARRAY)
761 TOKEN = MARRAYARG;
762 else if (RD->kind == KPROC)
763 TOKEN = MPROCARG;
764 else if (RD->kind == KCLASS && UPTOKEN == MPRBLOCK);
765 else
766 SERROR (101);
767 set_param (re);
768 expCheck (RIGHT);
769 if (RIGHTTYPE == TERROR)
770 TYPE = TERROR;
771 if (RD == absfunction)
772 {
773 if (RIGHTLEFTTYPE == TINTG)
774 RD = absfunctioni;
775 else
776 RD = absfunctionr;
777 TYPE = RD->type;
778 set_param (re);
779 expCheck (RIGHT);
780 if (RIGHTTYPE == TERROR)
781 TYPE = TERROR;
782 }
783 else if (RD == signfunction)
784 {
785 if (RIGHTLEFTTYPE == TINTG)
786 RD = signfunctioni;
787 else
788 RD = signfunctionr;
789 TYPE = RD->type;
790 set_param (re);
791 expCheck (RIGHT);
792 if (RIGHTTYPE == TERROR)
793 TYPE = TERROR;
794 }
795 else if (RD == minfunction && RIGHTRIGHTLEFT != NULL)
796 {
797 if (RIGHTLEFTTYPE == TTEXT)
798 RD = minfunctiont;
799 else if (RIGHTLEFTTYPE == TCHAR)
800 RD = minfunctionc;
801 else if (RIGHTLEFTTYPE == TINTG && RIGHTRIGHTLEFTTYPE == TINTG)
802 RD = minfunctioni;
803 else
804 RD = minfunctionr;
805 TYPE = RD->type;
806 set_param (re);
807 expCheck (RIGHT);
808 if (RIGHTTYPE == TERROR)
809 TYPE = TERROR;
810 }
811 else if (RD == maxfunction && RIGHTRIGHTLEFT != NULL)
812 {
813 if (RIGHTLEFTTYPE == TTEXT)
814 RD = maxfunctiont;
815 else if (RIGHTLEFTTYPE == TCHAR)
816 RD = maxfunctionc;
817 else if (RIGHTLEFTTYPE == TINTG && RIGHTRIGHTLEFTTYPE == TINTG)
818 RD = maxfunctioni;
819 else
820 RD = maxfunctionr;
821 TYPE = RD->type;
822 set_param (re);
823 expCheck (RIGHT);
824 if (RIGHTTYPE == TERROR)
825 TYPE = TERROR;
826 }
827 break;
828 case MARGUMENTSEP:
829 TYPE = RD->type;
830 QUAL = RD->prefqual;
831 if (RD->type == TVARARGS)
832 {
833 struct DECL *rdx;
834 expCheck (LEFT);
835 rdx = RD;
836 if (RD->categ == CNAME || RD->categ == CVAR)
837 {
838 if (LEFTTYPE == TINTG)
839 RD = varargsintvar;
840 else if (LEFTTYPE == TREAL)
841 RD = varargsrealvar;
842 else if (LEFTTYPE == TCHAR)
843 RD = varargscharvar;
844 else if (LEFTTYPE == TTEXT)
845 RD = varargstext;
846 else
847 argumenterror (104, re);
848 if (LEFTTOKEN != MDOT && LEFTTOKEN != MIDENTIFIER
849 && LEFTTOKEN != MARRAYARG)
850 argumenterror (110, re);
851 }
852 else if (RD->categ == CVALUE || RD->categ == CDEFLT)
853 {
854 if (LEFTTYPE == TINTG)
855 RD = varargsint;
856 else if (LEFTTYPE == TREAL)
857 RD = varargsreal;
858 else if (LEFTTYPE == TCHAR)
859 RD = varargschar;
860 else if (LEFTTYPE == TTEXT && RD->categ == CDEFLT)
861 RD = varargstext;
862 else if (LEFTTYPE == TTEXT && RD->categ == CVALUE)
863 RD = varargstextvalue;
864 else
865 argumenterror (104, re);
866 }
867 RD->encl = rdx->encl;
868 RD->next = rdx;
869 }
870 else if (RD->kind == KARRAY || RD->kind == KPROC)
871 { /* Parameteren skal v{re ett array eller en
872 * prosedyre */
873 if (LEFTTOKEN == MDOT)
874 {
875 expCheck (LEFT->left);
876 LEFTRIGHTQUAL = LEFTQUAL = LEFTLEFTQUAL;
877 LEFTSEENTHROUGH = LEFTLEFTSEENTHROUGH;
878 LEFTRIGHTRD = LEFTRD =
879 findLocal (LEFTRIGHTVALUE.ident, LEFTQUAL, TRUE);
880 if (LEFTRD->categ == CNEW)
881 SERROR (75);
882 if (LEFTRD->kind != RD->kind)
883 argumenterror (111, re);
884 LEFTTYPE = LEFTRD->type;
885 if (TYPE != LEFTTYPE && TYPE != TNOTY && TYPE != TALLTY)
886 {
887 if (RD->categ != CNAME & RD->categ != CVAR
888 || TYPE != TINTG & TYPE != TREAL
889 || LEFTTYPE != TINTG & LEFTTYPE != TREAL)
890 argumenterror (104, re);
891 }
892 if (RD->kind == KPROC)
893 {
894 if (RD->encl->quant.categ == CCPROC &&
895 LEFTRD->categ != CCPROC)
896 argumenterror (111, re);
897 if (RD->encl->quant.categ != CCPROC &&
898 LEFTRD->categ == CCPROC)
899 argumenterror (111, re);
900 if (!subordinate (LEFTRD, RD)) argumenterror (112, re);
901 if (!sameParam (RD->descr, LEFTRD->descr))
902 argumenterror (112, re);
903 }
904 }
905 else if (LEFTTOKEN != MIDENTIFIER)
906 {
907 argumenterror (103, re);
908 expCheck (LEFT);
909 }
910 else
911 {
912 LEFTRD = findGlobal (LEFTVALUE.ident, TRUE);
913 LEFTSEENTHROUGH = seenthrough;
914 LEFTQUAL = LEFTRD->prefqual;
915 if (LEFTRD->categ == CNEW)
916 SERROR (75);
917 if (LEFTRD->kind != RD->kind)
918 argumenterror (111, re);
919 LEFTTYPE = LEFTRD->type;
920 if (TYPE != LEFTTYPE && TYPE != TNOTY && TYPE != TALLTY)
921 {
922 if (RD->categ != CNAME & RD->categ != CVAR
923 || TYPE != TINTG & TYPE != TREAL
924 || LEFTTYPE != TINTG & LEFTTYPE != TREAL)
925 argumenterror (104, re);
926 }
927 if (RD->kind == KPROC)
928 {
929 if (RD->encl->quant.categ == CCPROC &&
930 LEFTRD->categ != CCPROC)
931 argumenterror (111, re);
932 if (RD->encl->quant.categ != CCPROC &&
933 LEFTRD->categ == CCPROC)
934 argumenterror (111, re);
935 if (!subordinate (LEFTRD, RD)) argumenterror (112, re);
936 if (!sameParam (RD->descr, LEFTRD->descr))
937 argumenterror (112, re);
938 }
939 }
940 }
941 else if (RD->kind == KSIMPLE)
942 { /* Parameteren skal v{re simple */
943 expCheck (LEFT);
944 if (RD->categ == CNAME)
945 {
946 if (TYPE != LEFTTYPE && (TYPE != TINTG & TYPE != TREAL
947 || LEFTTYPE != TINTG & LEFTTYPE != TREAL))
948 argumenterror (104, re);
949 }
950 else if (RD->categ == CVAR)
951 {
952 if (TYPE != LEFTTYPE && (TYPE != TINTG & TYPE != TREAL
953 || LEFTTYPE != TINTG & LEFTTYPE != TREAL))
954 argumenterror (104, re);
955 if (LEFTTOKEN != MDOT && LEFTTOKEN != MIDENTIFIER
956 && LEFTTOKEN != MARRAYARG && LEFTTYPE != TLABEL)
957 argumenterror (110, re);
958 }
959 else
960 {
961 konvtype (&LEFT, TYPE, QUAL);
962 if (TYPE != LEFTTYPE)
963 argumenterror (104, re);
964 }
965 }
966 else
967 {
968 argumenterror (105, re);
969 expCheck (LEFT);
970 }
971 expCheck (RIGHT);
972 if (RIGHTTYPE == TERROR)
973 TYPE = TERROR;
974 break;
975 case MENDSEP:
976 switch (UPTOKEN)
977 {
978 case MSWITCHSEP:
979 TYPE = TLABEL;
980 break;
981 case MLISTSEP:
982 TYPE = UPTYPE;
983 break;
984 case MARGUMENT:
985 case MARGUMENTSEP:
986 case MPROCARG:
987 case MNEWARG:
988 case MARRAYARG:
989 case MARRAYSEP:
990 TYPE = TNOTY;
991 break;
992 case MBOUNDSEP:
993 TYPE = TINTG;
994 break;
995 default:
996 TYPE = TERROR;
997 break;
998 }
999 break;
1000 }
1001 }
1002
1003 /******************************************************************************
1004 mainExpCheck */
1005
mainExpCheck(re)1006 void mainExpCheck (re) struct EXP *re;
1007 {
1008 expCheck (re);
1009 computeconst (re);
1010 setdanger_const (re);
1011 }
1012
1013