Line data Source code
1 : /* do not edit automatically generated by mc from M2Check. */
2 : /* M2Check.mod perform rigerous type checking for fully declared symbols.
3 :
4 : Copyright (C) 2020-2026 Free Software Foundation, Inc.
5 : Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 :
7 : This file is part of GNU Modula-2.
8 :
9 : GNU Modula-2 is free software; you can redistribute it and/or modify
10 : it under the terms of the GNU General Public License as published by
11 : the Free Software Foundation; either version 3, or (at your option)
12 : any later version.
13 :
14 : GNU Modula-2 is distributed in the hope that it will be useful, but
15 : WITHOUT ANY WARRANTY; without even the implied warranty of
16 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 : General Public License for more details.
18 :
19 : You should have received a copy of the GNU General Public License
20 : along with GNU Modula-2; see the file COPYING3. If not see
21 : <http://www.gnu.org/licenses/>. */
22 :
23 : #include "config.h"
24 : #include "system.h"
25 : #include "gcc-consolidation.h"
26 :
27 : #include <stdbool.h>
28 : # if !defined (PROC_D)
29 : # define PROC_D
30 : typedef void (*PROC_t) (void);
31 : typedef struct { PROC_t proc; } PROC;
32 : # endif
33 :
34 : # if !defined (TRUE)
35 : # define TRUE (1==1)
36 : # endif
37 :
38 : # if !defined (FALSE)
39 : # define FALSE (1==0)
40 : # endif
41 :
42 : # include "GStorage.h"
43 : # include "Gmcrts.h"
44 : #if defined(__cplusplus)
45 : # undef NULL
46 : # define NULL 0
47 : #endif
48 : #define _M2Check_C
49 :
50 : #include "GM2Check.h"
51 : # include "GM2System.h"
52 : # include "GM2Base.h"
53 : # include "GM2Bitset.h"
54 : # include "GIndexing.h"
55 : # include "GM2Error.h"
56 : # include "GM2MetaError.h"
57 : # include "GStrLib.h"
58 : # include "GM2Debug.h"
59 : # include "GSymbolTable.h"
60 : # include "GM2GCCDeclare.h"
61 : # include "GM2ALU.h"
62 : # include "GM2Options.h"
63 : # include "Gm2expr.h"
64 : # include "GSymbolConversion.h"
65 : # include "GDynamicStrings.h"
66 : # include "GM2LexBuf.h"
67 : # include "GStorage.h"
68 : # include "GSYSTEM.h"
69 : # include "Glibc.h"
70 :
71 : # define debugging false
72 : # define MaxEquvalence 20
73 : typedef struct M2Check_typeCheckFunction_p M2Check_typeCheckFunction;
74 :
75 : typedef struct M2Check_EquivalenceProcedure_p M2Check_EquivalenceProcedure;
76 :
77 : typedef struct M2Check__T1_r M2Check__T1;
78 :
79 : typedef M2Check__T1 *M2Check_errorSig;
80 :
81 : typedef struct M2Check__T2_r M2Check__T2;
82 :
83 : typedef M2Check__T2 *M2Check_pair;
84 :
85 : typedef struct M2Check__T3_r M2Check__T3;
86 :
87 : typedef M2Check__T3 *M2Check_tInfo;
88 :
89 : typedef struct M2Check__T4_a M2Check__T4;
90 :
91 : typedef enum {M2Check_parameter, M2Check_assignment, M2Check_expression} M2Check_checkType;
92 :
93 : typedef enum {M2Check_true, M2Check_false, M2Check_unknown, M2Check_visited, M2Check_unused} M2Check_status;
94 :
95 : typedef M2Check_status (*M2Check_typeCheckFunction_t) (M2Check_status, M2Check_tInfo, unsigned int, unsigned int);
96 : struct M2Check_typeCheckFunction_p { M2Check_typeCheckFunction_t proc; };
97 :
98 : typedef M2Check_status (*M2Check_EquivalenceProcedure_t) (M2Check_status, M2Check_tInfo, unsigned int, unsigned int);
99 : struct M2Check_EquivalenceProcedure_p { M2Check_EquivalenceProcedure_t proc; };
100 :
101 : struct M2Check__T1_r {
102 : unsigned int token;
103 : unsigned int left;
104 : unsigned int right;
105 : };
106 :
107 : struct M2Check__T2_r {
108 : unsigned int left;
109 : unsigned int right;
110 : M2Check_status pairStatus;
111 : M2Check_pair next;
112 : };
113 :
114 : struct M2Check__T3_r {
115 : bool reasonEnable;
116 : DynamicStrings_String reason;
117 : DynamicStrings_String format;
118 : M2Check_checkType kind;
119 : unsigned int token;
120 : unsigned int actual;
121 : unsigned int formal;
122 : unsigned int left;
123 : unsigned int right;
124 : unsigned int procedure;
125 : unsigned int nth;
126 : bool isvar;
127 : bool strict;
128 : bool isin;
129 : M2Error_Error error;
130 : M2Check_typeCheckFunction checkFunc;
131 : Indexing_Index visited;
132 : Indexing_Index resolved;
133 : Indexing_Index unresolved;
134 : M2Check_tInfo next;
135 : };
136 :
137 : struct M2Check__T4_a { M2Check_EquivalenceProcedure array[MaxEquvalence-1+1]; };
138 : static M2Check_pair pairFreeList;
139 : static M2Check_tInfo tinfoFreeList;
140 : static Indexing_Index errors;
141 : static unsigned int HighEquivalence;
142 : static M2Check__T4 Equivalence;
143 :
144 : /*
145 : ParameterTypeCompatible - returns TRUE if the nth procedure parameter formal
146 : is compatible with actual.
147 : */
148 :
149 : extern "C" bool M2Check_ParameterTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int procedure, unsigned int formal, unsigned int actual, unsigned int nth, bool isvar);
150 :
151 : /*
152 : AssignmentTypeCompatible - returns TRUE if the des and the expr are assignment compatible.
153 : */
154 :
155 : extern "C" bool M2Check_AssignmentTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int des, unsigned int expr, bool enableReason);
156 :
157 : /*
158 : ExpressionTypeCompatible - returns TRUE if the expressions, left and right,
159 : are expression compatible.
160 : */
161 :
162 : extern "C" bool M2Check_ExpressionTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int left, unsigned int right, bool strict, bool isin);
163 :
164 : /*
165 : dumpIndice -
166 : */
167 :
168 : static void dumpIndice (M2Check_pair ptr);
169 :
170 : /*
171 : dumpIndex -
172 : */
173 :
174 : static void dumpIndex (const char *name_, unsigned int _name_high, Indexing_Index index);
175 :
176 : /*
177 : dumptInfo -
178 : */
179 :
180 : static void dumptInfo (M2Check_tInfo t);
181 :
182 : /*
183 : falseReason2 - return false. It also stores the message as the
184 : reason for the false value.
185 : */
186 :
187 : static M2Check_status falseReason2 (const char *message_, unsigned int _message_high, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
188 :
189 : /*
190 : falseReason1 - return false. It also stores the message as the
191 : reason for the false value.
192 : */
193 :
194 : static M2Check_status falseReason1 (const char *message_, unsigned int _message_high, M2Check_tInfo tinfo, unsigned int operand);
195 :
196 : /*
197 : falseReason0 - return false. It also stores the message as the
198 : reason for the false value.
199 : */
200 :
201 : static M2Check_status falseReason0 (const char *message_, unsigned int _message_high, M2Check_tInfo tinfo);
202 :
203 : /*
204 : isKnown - returns BOOLEAN:TRUE if result is status:true or status:false.
205 : */
206 :
207 : static bool isKnown (M2Check_status result);
208 :
209 : /*
210 : isFalse - returns BOOLEAN:TRUE if result is status:false
211 : */
212 :
213 : static bool isFalse (M2Check_status result);
214 :
215 : /*
216 : checkTypeEquivalence - returns TRUE if left and right can be skipped and found to be equal.
217 : */
218 :
219 : static M2Check_status checkTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
220 :
221 : /*
222 : checkSubrange - check to see if subrange types left and right have the same limits.
223 : */
224 :
225 : static M2Check_status checkSubrange (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
226 :
227 : /*
228 : checkUnboundedArray - returns status if unbounded is parameter compatible with array.
229 : It checks all type equivalences of the static array for a
230 : match with the dynamic (unbounded) array.
231 : */
232 :
233 : static M2Check_status checkUnboundedArray (M2Check_status result, M2Check_tInfo tinfo, unsigned int unbounded, unsigned int array);
234 :
235 : /*
236 : checkUnboundedUnbounded - check to see if formal and actual are compatible.
237 : Both are unbounded parameters.
238 : */
239 :
240 : static M2Check_status checkUnboundedUnbounded (M2Check_status result, M2Check_tInfo tinfo, unsigned int formal, unsigned int actual);
241 :
242 : /*
243 : checkUnbounded - check to see if the unbounded is type compatible with right.
244 : This is only allowed during parameter passing.
245 : */
246 :
247 : static M2Check_status checkUnbounded (M2Check_status result, M2Check_tInfo tinfo, unsigned int unbounded, unsigned int right);
248 :
249 : /*
250 : checkGenericUnboundedTyped - return TRUE if we have a match for
251 : an unbounded generic type and a typed object
252 : which is not a Z, R or C type.
253 : */
254 :
255 : static bool checkGenericUnboundedTyped (unsigned int unbounded, unsigned int typed);
256 :
257 : /*
258 : checkArrayTypeEquivalence - check array and unbounded array type
259 : equivalence.
260 : */
261 :
262 : static M2Check_status checkArrayTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
263 :
264 : /*
265 : checkCharStringTypeEquivalence - check char and string constants for type equivalence.
266 : */
267 :
268 : static M2Check_status checkCharStringTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
269 :
270 : /*
271 : firstTime - returns TRUE if the triple (token, left, right) has not been seen before.
272 : */
273 :
274 : static bool firstTime (unsigned int token, unsigned int left, unsigned int right);
275 :
276 : /*
277 : buildError4 - generate a MetaString4 error. This is only used when checking
278 : parameter compatibility.
279 : */
280 :
281 : static void buildError4 (M2Check_tInfo tinfo, unsigned int left, unsigned int right);
282 :
283 : /*
284 : buildError2 - generate a MetaString2 error.
285 : */
286 :
287 : static void buildError2 (M2Check_tInfo tinfo, unsigned int left, unsigned int right);
288 :
289 : /*
290 : issueError -
291 : */
292 :
293 : static M2Check_status issueError (bool result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
294 :
295 : /*
296 : checkBaseEquivalence - the catch all check for types not specifically
297 : handled by this module.
298 : */
299 :
300 : static M2Check_status checkBaseEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
301 :
302 : /*
303 : checkPair - check whether left and right are type compatible.
304 : It will update the visited, unresolved list before
305 : calling the docheckPair for the cascaded type checking.
306 : Pre-condition: tinfo is initialized.
307 : left and right are modula2 symbols.
308 : Post-condition: tinfo visited, resolved, unresolved lists
309 : are updated and the result status is
310 : returned.
311 : */
312 :
313 : static M2Check_status checkPair (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
314 :
315 : /*
316 : useBaseCheck -
317 : */
318 :
319 : static bool useBaseCheck (unsigned int sym);
320 :
321 : /*
322 : checkBaseTypeEquivalence -
323 : */
324 :
325 : static M2Check_status checkBaseTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
326 :
327 : /*
328 : IsTyped - returns TRUE if sym will have a type.
329 : */
330 :
331 : static bool IsTyped (unsigned int sym);
332 :
333 : /*
334 : IsTypeEquivalence - returns TRUE if sym is a type equivalence symbol.
335 : */
336 :
337 : static bool IsTypeEquivalence (unsigned int sym);
338 :
339 : /*
340 : isLValue -
341 : */
342 :
343 : static bool isLValue (unsigned int sym);
344 :
345 : /*
346 : checkVarTypeEquivalence -
347 : */
348 :
349 : static M2Check_status checkVarTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
350 :
351 : /*
352 : checkVarEquivalence - this test must be done early as it checks the symbol mode.
353 : An LValue is treated as a pointer during assignment and the
354 : LValue is attached to a variable. This function skips the variable
355 : and checks the types - after it has considered a possible LValue.
356 : */
357 :
358 : static M2Check_status checkVarEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int des, unsigned int expr);
359 :
360 : /*
361 : checkConstMeta - performs a very course grained check against
362 : obviously incompatible type kinds.
363 : If left is a const string then it checks right against char.
364 : */
365 :
366 : static M2Check_status checkConstMeta (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
367 :
368 : /*
369 : checkEnumField -
370 : */
371 :
372 : static M2Check_status checkEnumField (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
373 :
374 : /*
375 : checkEnumFieldEquivalence -
376 : */
377 :
378 : static M2Check_status checkEnumFieldEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
379 :
380 : /*
381 : checkConstEquivalence - this check can be done first as it checks symbols which
382 : may have no type. Ie constant strings. These constants
383 : will likely have their type set during quadruple folding.
384 : But we can check the meta type for obvious mismatches
385 : early on. For example adding a string to an enum or set.
386 : */
387 :
388 : static M2Check_status checkConstEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
389 :
390 : /*
391 : checkSubrangeTypeEquivalence -
392 : */
393 :
394 : static M2Check_status checkSubrangeTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
395 :
396 : /*
397 : IsZRCType - return TRUE if type is a ZType, RType or a CType.
398 : */
399 :
400 : static bool IsZRCType (unsigned int type);
401 :
402 : /*
403 : isZRC - return TRUE if zrc is a ZType, RType or a CType
404 : and sym is either a complex type when zrc = CType
405 : or is not a composite type when zrc is a RType or ZType.
406 : */
407 :
408 : static bool isZRC (unsigned int zrc, unsigned int sym);
409 :
410 : /*
411 : isSameSizeConst -
412 :
413 : */
414 :
415 : static bool isSameSizeConst (unsigned int a, unsigned int b);
416 :
417 : /*
418 : isSameSize - should only be called if either a or b are WORD, BYTE, etc.
419 : */
420 :
421 : static bool isSameSize (unsigned int a, unsigned int b);
422 :
423 : /*
424 : checkSystemEquivalence - check whether left and right are system types and whether they have the same size.
425 : */
426 :
427 : static M2Check_status checkSystemEquivalence (M2Check_status result, M2Check_tInfo tinfo __attribute__((unused)), unsigned int left, unsigned int right);
428 :
429 : /*
430 : checkTypeKindViolation - returns false if one operand left or right is
431 : a set, record or array.
432 : */
433 :
434 : static M2Check_status checkTypeKindViolation (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
435 :
436 : /*
437 : doCheckPair - invoke a series of type checks checking compatibility
438 : between left and right modula2 symbols.
439 : Pre-condition: left and right are modula-2 symbols.
440 : tinfo is configured.
441 : Post-condition: status is returned determining the
442 : correctness of the type check.
443 : The tinfo resolved, unresolved, visited
444 : lists will be updated.
445 : */
446 :
447 : static M2Check_status doCheckPair (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
448 :
449 : /*
450 : InitEquivalenceArray - populate the Equivalence array with the
451 : checking procedures.
452 : */
453 :
454 : static void InitEquivalenceArray (void);
455 :
456 : /*
457 : addEquivalence - places proc into Equivalence array.
458 : */
459 :
460 : static void addEquivalence (M2Check_EquivalenceProcedure proc);
461 :
462 : /*
463 : checkProcType -
464 : */
465 :
466 : static M2Check_status checkProcType (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
467 :
468 : /*
469 : checkProcedureProcType -
470 : */
471 :
472 : static M2Check_status checkProcedureProcType (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
473 :
474 : /*
475 : checkProcedure -
476 : */
477 :
478 : static M2Check_status checkProcedure (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
479 :
480 : /*
481 : checkEnumerationEquivalence -
482 : */
483 :
484 : static M2Check_status checkEnumerationEquivalence (M2Check_status result, unsigned int left, unsigned int right);
485 :
486 : /*
487 : checkPointerType - check whether left and right are equal or are of type ADDRESS.
488 : */
489 :
490 : static M2Check_status checkPointerType (M2Check_status result, unsigned int left, unsigned int right);
491 :
492 : /*
493 : checkProcTypeEquivalence - allow proctype to be compared against another
494 : proctype or procedure. It is legal to be compared
495 : against an address.
496 : */
497 :
498 : static M2Check_status checkProcTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
499 :
500 : /*
501 : checkTypeKindEquivalence -
502 : */
503 :
504 : static M2Check_status checkTypeKindEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
505 :
506 : /*
507 : isSkipEquivalence -
508 : */
509 :
510 : static bool isSkipEquivalence (unsigned int left, unsigned int right);
511 :
512 : /*
513 : checkValueEquivalence - check to see if left and right values are the same.
514 : */
515 :
516 : static M2Check_status checkValueEquivalence (M2Check_status result, unsigned int left, unsigned int right);
517 :
518 : /*
519 : and -
520 : */
521 :
522 : static M2Check_status and_ (M2Check_status left, M2Check_status right);
523 :
524 : /*
525 : checkTypeRangeEquivalence -
526 : */
527 :
528 : static M2Check_status checkTypeRangeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
529 :
530 : /*
531 : include - include pair left:right into pairs with status, s.
532 : */
533 :
534 : static void include (Indexing_Index pairs, unsigned int left, unsigned int right, M2Check_status s);
535 :
536 : /*
537 : exclude - exclude pair left:right from pairs.
538 : */
539 :
540 : static void exclude (Indexing_Index pairs, unsigned int left, unsigned int right);
541 :
542 : /*
543 : getStatus -
544 : */
545 :
546 : static M2Check_status getStatus (Indexing_Index pairs, unsigned int left, unsigned int right);
547 :
548 : /*
549 : return -
550 : */
551 :
552 : static M2Check_status return_ (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
553 :
554 : /*
555 : checkSkipEquivalence - return true if left right are equivalent.
556 : */
557 :
558 : static M2Check_status checkSkipEquivalence (M2Check_status result, unsigned int left, unsigned int right);
559 :
560 : /*
561 : checkSetEquivalent - compares set types, left and right.
562 : */
563 :
564 : static M2Check_status checkSetEquivalent (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
565 :
566 : /*
567 : checkRecordEquivalence - compares record types, left and right.
568 : */
569 :
570 : static M2Check_status checkRecordEquivalence (M2Check_status result, unsigned int left, unsigned int right);
571 :
572 : /*
573 : getType - only returns the type of symbol providing it is not a procedure.
574 : */
575 :
576 : static unsigned int getType (unsigned int sym);
577 :
578 : /*
579 : getSType -
580 : */
581 :
582 : static unsigned int getSType (unsigned int sym);
583 :
584 : /*
585 : determineCompatible - check for compatibility by checking
586 : equivalence, array, generic and type kind.
587 : */
588 :
589 : static M2Check_status determineCompatible (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
590 :
591 : /*
592 : get -
593 : */
594 :
595 : static bool get (Indexing_Index pairs, unsigned int *left, unsigned int *right, M2Check_status s);
596 :
597 : /*
598 : isInternal - return TRUE if sym is a constant lit which was declared
599 : as internal.
600 : */
601 :
602 : static bool isInternal (unsigned int sym);
603 :
604 : /*
605 : doCheck - keep obtaining an unresolved pair and check for the
606 : type compatibility. This is the main check routine used by
607 : parameter, assignment and expression compatibility.
608 : It tests all unknown pairs and calls the appropriate
609 : check function
610 : */
611 :
612 : static bool doCheck (M2Check_tInfo tinfo);
613 :
614 : /*
615 : in - returns TRUE if the pair is in the list.
616 : */
617 :
618 : static bool in (Indexing_Index pairs, unsigned int left, unsigned int right);
619 :
620 : /*
621 : newPair -
622 : */
623 :
624 : static M2Check_pair newPair (void);
625 :
626 : /*
627 : disposePair - adds pair, p, to the free list.
628 : */
629 :
630 : static void disposePair (M2Check_pair p);
631 :
632 : /*
633 : deconstructIndex -
634 : */
635 :
636 : static Indexing_Index deconstructIndex (Indexing_Index pairs);
637 :
638 : /*
639 : deconstruct - deallocate the List data structure.
640 : */
641 :
642 : static void deconstruct (M2Check_tInfo tinfo);
643 :
644 : /*
645 : newtInfo -
646 : */
647 :
648 : static M2Check_tInfo newtInfo (void);
649 :
650 : /*
651 : collapseString - if the string, a, is "" then return NIL otherwise create
652 : and return a dynamic string.
653 : */
654 :
655 : static DynamicStrings_String collapseString (const char *a_, unsigned int _a_high);
656 :
657 : /*
658 : doExpressionTypeCompatible -
659 : */
660 :
661 : static bool doExpressionTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int left, unsigned int right, bool strict);
662 :
663 : /*
664 : init - initialise all global data structures for this module.
665 : */
666 :
667 : static void init (void);
668 :
669 :
670 : /*
671 : dumpIndice -
672 : */
673 :
674 0 : static void dumpIndice (M2Check_pair ptr)
675 : {
676 0 : libc_printf ((const char *) " left (%d), right (%d), status ", 31, ptr->left, ptr->right);
677 0 : switch (ptr->pairStatus)
678 : {
679 0 : case M2Check_true:
680 0 : libc_printf ((const char *) "true", 4);
681 0 : break;
682 :
683 0 : case M2Check_false:
684 0 : libc_printf ((const char *) "false", 5);
685 0 : break;
686 :
687 0 : case M2Check_unknown:
688 0 : libc_printf ((const char *) "unknown", 7);
689 0 : break;
690 :
691 0 : case M2Check_visited:
692 0 : libc_printf ((const char *) "visited", 7);
693 0 : break;
694 :
695 0 : case M2Check_unused:
696 0 : libc_printf ((const char *) "unused", 6);
697 0 : break;
698 :
699 :
700 0 : default:
701 0 : CaseException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Check.def", 20, 1);
702 0 : __builtin_unreachable ();
703 : }
704 0 : libc_printf ((const char *) "\\n", 2);
705 0 : }
706 :
707 :
708 : /*
709 : dumpIndex -
710 : */
711 :
712 0 : static void dumpIndex (const char *name_, unsigned int _name_high, Indexing_Index index)
713 : {
714 0 : char name[_name_high+1];
715 :
716 : /* make a local copy of each unbounded array. */
717 0 : memcpy (name, name_, _name_high+1);
718 :
719 0 : libc_printf ((const char *) "status: %s\\n", 12, const_cast<void*> (static_cast<const void*>(name)));
720 0 : Indexing_ForeachIndiceInIndexDo (index, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) dumpIndice});
721 0 : }
722 :
723 :
724 : /*
725 : dumptInfo -
726 : */
727 :
728 0 : static void dumptInfo (M2Check_tInfo t)
729 : {
730 0 : libc_printf ((const char *) "actual (%d), formal (%d), left (%d), right (%d), procedure (%d)\\n", 65, t->actual, t->formal, t->left, t->right, t->procedure);
731 0 : dumpIndex ((const char *) "visited", 7, t->visited);
732 0 : dumpIndex ((const char *) "resolved", 8, t->resolved);
733 0 : dumpIndex ((const char *) "unresolved", 10, t->unresolved);
734 0 : }
735 :
736 :
737 : /*
738 : falseReason2 - return false. It also stores the message as the
739 : reason for the false value.
740 : */
741 :
742 114 : static M2Check_status falseReason2 (const char *message_, unsigned int _message_high, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
743 : {
744 114 : char message[_message_high+1];
745 :
746 : /* make a local copy of each unbounded array. */
747 114 : memcpy (message, message_, _message_high+1);
748 :
749 102 : if (tinfo->reasonEnable && (tinfo->reason == NULL))
750 : {
751 102 : tinfo->reason = M2MetaError_MetaString2 (DynamicStrings_InitString ((const char *) message, _message_high), left, right);
752 : }
753 114 : return M2Check_false;
754 : /* static analysis guarentees a RETURN statement will be used before here. */
755 : __builtin_unreachable ();
756 114 : }
757 :
758 :
759 : /*
760 : falseReason1 - return false. It also stores the message as the
761 : reason for the false value.
762 : */
763 :
764 96 : static M2Check_status falseReason1 (const char *message_, unsigned int _message_high, M2Check_tInfo tinfo, unsigned int operand)
765 : {
766 96 : char message[_message_high+1];
767 :
768 : /* make a local copy of each unbounded array. */
769 96 : memcpy (message, message_, _message_high+1);
770 :
771 66 : if (tinfo->reasonEnable && (tinfo->reason == NULL))
772 : {
773 66 : tinfo->reason = M2MetaError_MetaString1 (DynamicStrings_InitString ((const char *) message, _message_high), operand);
774 : }
775 96 : return M2Check_false;
776 : /* static analysis guarentees a RETURN statement will be used before here. */
777 : __builtin_unreachable ();
778 96 : }
779 :
780 :
781 : /*
782 : falseReason0 - return false. It also stores the message as the
783 : reason for the false value.
784 : */
785 :
786 12 : static M2Check_status falseReason0 (const char *message_, unsigned int _message_high, M2Check_tInfo tinfo)
787 : {
788 12 : char message[_message_high+1];
789 :
790 : /* make a local copy of each unbounded array. */
791 12 : memcpy (message, message_, _message_high+1);
792 :
793 12 : if (tinfo->reasonEnable && (tinfo->reason == NULL))
794 : {
795 12 : tinfo->reason = M2MetaError_MetaString0 (DynamicStrings_InitString ((const char *) message, _message_high));
796 : }
797 12 : return M2Check_false;
798 : /* static analysis guarentees a RETURN statement will be used before here. */
799 : __builtin_unreachable ();
800 12 : }
801 :
802 :
803 : /*
804 : isKnown - returns BOOLEAN:TRUE if result is status:true or status:false.
805 : */
806 :
807 41734399 : static bool isKnown (M2Check_status result)
808 : {
809 41734399 : return ((result == M2Check_true) || (result == M2Check_false)) || (result == M2Check_visited);
810 : /* static analysis guarentees a RETURN statement will be used before here. */
811 : __builtin_unreachable ();
812 : }
813 :
814 :
815 : /*
816 : isFalse - returns BOOLEAN:TRUE if result is status:false
817 : */
818 :
819 0 : static bool isFalse (M2Check_status result)
820 : {
821 0 : return result == M2Check_false;
822 : /* static analysis guarentees a RETURN statement will be used before here. */
823 : __builtin_unreachable ();
824 : }
825 :
826 :
827 : /*
828 : checkTypeEquivalence - returns TRUE if left and right can be skipped and found to be equal.
829 : */
830 :
831 1114526 : static M2Check_status checkTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
832 : {
833 1114526 : if (left == right)
834 : {
835 : return M2Check_true;
836 : }
837 1107938 : else if ((SymbolTable_IsType (left)) && (SymbolTable_IsType (right)))
838 : {
839 : /* avoid dangling else. */
840 58 : if ((SymbolTable_IsHiddenType (left)) && (SymbolTable_IsHiddenType (right)))
841 : {
842 24 : return falseReason2 ((const char *) "opaque types {%1a} {%2a} differ", 31, tinfo, left, right);
843 : }
844 34 : else if (((SymbolTable_IsHiddenType (left)) && (right == M2System_Address)) || ((SymbolTable_IsHiddenType (right)) && (left == M2System_Address)))
845 : {
846 : /* avoid dangling else. */
847 0 : return M2Check_true;
848 : }
849 : }
850 1107880 : else if (IsTypeEquivalence (left))
851 : {
852 : /* avoid dangling else. */
853 968 : return checkPair (result, tinfo, SymbolTable_GetDType (left), right);
854 : }
855 1106912 : else if (IsTypeEquivalence (right))
856 : {
857 : /* avoid dangling else. */
858 96 : return checkPair (result, tinfo, left, SymbolTable_GetDType (right));
859 : }
860 : return result;
861 : /* static analysis guarentees a RETURN statement will be used before here. */
862 : __builtin_unreachable ();
863 : }
864 :
865 :
866 : /*
867 : checkSubrange - check to see if subrange types left and right have the same limits.
868 : */
869 :
870 216 : static M2Check_status checkSubrange (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
871 : {
872 216 : unsigned int lLow;
873 216 : unsigned int rLow;
874 216 : unsigned int lHigh;
875 216 : unsigned int rHigh;
876 :
877 : /* firstly check to see if we already have resolved this as false. */
878 216 : if (isFalse (result))
879 : {
880 : return result;
881 : }
882 : else
883 : {
884 216 : M2Debug_Assert (SymbolTable_IsSubrange (left));
885 216 : M2Debug_Assert (SymbolTable_IsSubrange (right));
886 216 : lLow = M2GCCDeclare_GetTypeMin (left);
887 216 : lHigh = M2GCCDeclare_GetTypeMax (left);
888 216 : rLow = M2GCCDeclare_GetTypeMin (right);
889 216 : rHigh = M2GCCDeclare_GetTypeMax (right);
890 216 : M2ALU_PushIntegerTree (SymbolConversion_Mod2Gcc (lLow));
891 216 : M2ALU_PushIntegerTree (SymbolConversion_Mod2Gcc (rLow));
892 216 : if (! (M2ALU_Equ (tinfo->token)))
893 : {
894 0 : return falseReason2 ((const char *) "low values of the subrange types {%1a} {%2a} differ", 51, tinfo, left, right);
895 : }
896 216 : M2ALU_PushIntegerTree (SymbolConversion_Mod2Gcc (lHigh));
897 216 : M2ALU_PushIntegerTree (SymbolConversion_Mod2Gcc (rHigh));
898 216 : if (! (M2ALU_Equ (tinfo->token)))
899 : {
900 12 : return falseReason2 ((const char *) "high values of the subrange types {%1a} {%2a} differ", 52, tinfo, left, right);
901 : }
902 : }
903 : return M2Check_true;
904 : /* static analysis guarentees a RETURN statement will be used before here. */
905 : __builtin_unreachable ();
906 : }
907 :
908 :
909 : /*
910 : checkUnboundedArray - returns status if unbounded is parameter compatible with array.
911 : It checks all type equivalences of the static array for a
912 : match with the dynamic (unbounded) array.
913 : */
914 :
915 6588 : static M2Check_status checkUnboundedArray (M2Check_status result, M2Check_tInfo tinfo, unsigned int unbounded, unsigned int array)
916 : {
917 6588 : unsigned int dim;
918 6588 : unsigned int ubtype;
919 6588 : unsigned int type;
920 :
921 : /* Firstly check to see if we have resolved this as false. */
922 6588 : if (isFalse (result))
923 : {
924 : return result;
925 : }
926 : else
927 : {
928 6588 : M2Debug_Assert (SymbolTable_IsUnbounded (unbounded));
929 6588 : M2Debug_Assert (SymbolTable_IsArray (array));
930 6588 : dim = SymbolTable_GetDimension (unbounded);
931 6588 : ubtype = SymbolTable_GetDType (unbounded);
932 6588 : type = array;
933 6738 : do {
934 6738 : type = SymbolTable_GetDType (type);
935 6738 : dim -= 1;
936 : /* Check type equivalences. */
937 6738 : if ((checkTypeEquivalence (result, tinfo, type, ubtype)) == M2Check_true)
938 : {
939 : return M2Check_true;
940 : }
941 162 : type = SymbolTable_SkipType (type);
942 : /* If we have run out of dimensions we conclude false. */
943 162 : if (dim == 0)
944 : {
945 12 : return falseReason0 ((const char *) "unbounded array has less dimensions than the array", 50, tinfo);
946 : }
947 150 : } while (! (! (SymbolTable_IsArray (type))));
948 : }
949 0 : return falseReason0 ((const char *) "array has less dimensions than the unbounded array", 50, tinfo);
950 : /* static analysis guarentees a RETURN statement will be used before here. */
951 : __builtin_unreachable ();
952 : }
953 :
954 :
955 : /*
956 : checkUnboundedUnbounded - check to see if formal and actual are compatible.
957 : Both are unbounded parameters.
958 : */
959 :
960 12 : static M2Check_status checkUnboundedUnbounded (M2Check_status result, M2Check_tInfo tinfo, unsigned int formal, unsigned int actual)
961 : {
962 : /* Firstly check to see if we have resolved this as false. */
963 12 : if (isFalse (result))
964 : {
965 : return result;
966 : }
967 : else
968 : {
969 12 : M2Debug_Assert (SymbolTable_IsUnbounded (formal));
970 12 : M2Debug_Assert (SymbolTable_IsUnbounded (actual));
971 : /* The actual parameter above might be a different symbol to the actual parameter
972 : symbol in the tinfo. So we must compare the original actual parameter against
973 : the formal.
974 : The actual above maybe a temporary which is created after derefencing an array.
975 : For example 'bar[10]' where bar is defined as ARRAY OF ARRAY OF CARDINAL.
976 : The GetDimension for 'bar[10]' is 1 indicating that one dimension has been
977 : referenced. We use GetDimension for 'bar' which is 2. */
978 12 : if ((SymbolTable_GetDimension (formal)) != (SymbolTable_GetDimension (tinfo->actual)))
979 : {
980 0 : return falseReason2 ((const char *) "the formal parameter unbounded array {%1a} has a different number of dimensions to the actual parameter unbounded array {%2a}", 126, tinfo, formal, actual);
981 : }
982 12 : if ((checkTypeEquivalence (result, tinfo, SymbolTable_GetType (formal), SymbolTable_GetType (actual))) == M2Check_true)
983 : {
984 : return M2Check_true;
985 : }
986 : }
987 0 : return falseReason2 ((const char *) "the formal unbounded array type {%1a} and the actual unbounded array type {%2a} differ", 86, tinfo, formal, actual);
988 : /* static analysis guarentees a RETURN statement will be used before here. */
989 : __builtin_unreachable ();
990 : }
991 :
992 :
993 : /*
994 : checkUnbounded - check to see if the unbounded is type compatible with right.
995 : This is only allowed during parameter passing.
996 : */
997 :
998 6618 : static M2Check_status checkUnbounded (M2Check_status result, M2Check_tInfo tinfo, unsigned int unbounded, unsigned int right)
999 : {
1000 : /* Firstly check to see if we have resolved this as false. */
1001 6618 : if (isFalse (result))
1002 : {
1003 : return result;
1004 : }
1005 : else
1006 : {
1007 6618 : M2Debug_Assert (SymbolTable_IsUnbounded (unbounded));
1008 6618 : if (tinfo->kind == M2Check_parameter)
1009 : {
1010 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
1011 : /* Check the unbounded data type against the type of right, SYSTEM types
1012 : are compared by the caller, so no need to test for them again. */
1013 6600 : if (isSkipEquivalence (SymbolTable_GetType (unbounded), right))
1014 : {
1015 : return M2Check_true;
1016 : }
1017 6600 : else if (SymbolTable_IsType (right))
1018 : {
1019 : /* avoid dangling else. */
1020 0 : if ((SymbolTable_GetType (right)) == SymbolTable_NulSym)
1021 : {
1022 : /* Base type check. */
1023 0 : return checkPair (result, tinfo, SymbolTable_GetType (unbounded), right);
1024 : }
1025 : else
1026 : {
1027 : /* It is safe to GetType (right) and we check the pair
1028 : [unbounded, GetType (right)]. */
1029 0 : return checkPair (result, tinfo, unbounded, SymbolTable_GetType (right));
1030 : }
1031 : }
1032 6600 : else if (SymbolTable_IsArray (right))
1033 : {
1034 : /* avoid dangling else. */
1035 6588 : return checkUnboundedArray (result, tinfo, unbounded, right);
1036 : }
1037 12 : else if (SymbolTable_IsUnbounded (right))
1038 : {
1039 : /* avoid dangling else. */
1040 12 : return checkUnboundedUnbounded (result, tinfo, unbounded, right);
1041 : }
1042 : else
1043 : {
1044 : /* avoid dangling else. */
1045 0 : return falseReason2 ((const char *) "the formal unbounded array type {%1a} and the actual unbounded array type {%2a} differ", 86, tinfo, unbounded, right);
1046 : }
1047 : }
1048 : }
1049 : return M2Check_false;
1050 : /* static analysis guarentees a RETURN statement will be used before here. */
1051 : __builtin_unreachable ();
1052 : }
1053 :
1054 :
1055 : /*
1056 : checkGenericUnboundedTyped - return TRUE if we have a match for
1057 : an unbounded generic type and a typed object
1058 : which is not a Z, R or C type.
1059 : */
1060 :
1061 2213016 : static bool checkGenericUnboundedTyped (unsigned int unbounded, unsigned int typed)
1062 : {
1063 2213022 : return ((SymbolTable_IsUnbounded (unbounded)) && (M2System_IsGenericSystemType (SymbolTable_GetDType (unbounded)))) && ((! (IsZRCType (typed))) || ((IsTyped (typed)) && (! (IsZRCType (SymbolTable_GetDType (typed))))));
1064 : /* static analysis guarentees a RETURN statement will be used before here. */
1065 : __builtin_unreachable ();
1066 : }
1067 :
1068 :
1069 : /*
1070 : checkArrayTypeEquivalence - check array and unbounded array type
1071 : equivalence.
1072 : */
1073 :
1074 1106724 : static M2Check_status checkArrayTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1075 : {
1076 1106724 : unsigned int lSub;
1077 1106724 : unsigned int rSub;
1078 :
1079 1106724 : if (isFalse (result))
1080 : {
1081 : return result;
1082 : }
1083 1106724 : else if ((SymbolTable_IsArray (left)) && (SymbolTable_IsArray (right)))
1084 : {
1085 : /* avoid dangling else. */
1086 216 : lSub = SymbolTable_GetArraySubscript (left);
1087 216 : rSub = SymbolTable_GetArraySubscript (right);
1088 216 : result = checkPair (result, tinfo, SymbolTable_GetDType (left), SymbolTable_GetDType (right));
1089 216 : if ((lSub != SymbolTable_NulSym) && (rSub != SymbolTable_NulSym))
1090 : {
1091 216 : result = checkSubrange (result, tinfo, getSType (lSub), getSType (rSub));
1092 : }
1093 : }
1094 1106508 : else if ((checkGenericUnboundedTyped (left, right)) || (checkGenericUnboundedTyped (right, left)))
1095 : {
1096 : /* avoid dangling else. */
1097 : /* ARRAY OF BYTE (or WORD or LOC etc will be compatible with any typed
1098 : non ZRC type. */
1099 948 : return M2Check_true;
1100 : }
1101 1105560 : else if ((SymbolTable_IsUnbounded (left)) && ((SymbolTable_IsArray (right)) || (SymbolTable_IsUnbounded (right))))
1102 : {
1103 : /* avoid dangling else. */
1104 30 : if ((M2System_IsGenericSystemType (getSType (left))) || (M2System_IsGenericSystemType (getSType (right))))
1105 : {
1106 0 : return M2Check_true;
1107 : }
1108 : else
1109 : {
1110 30 : result = checkUnbounded (result, tinfo, left, right);
1111 : }
1112 : }
1113 1105530 : else if ((SymbolTable_IsUnbounded (right)) && ((SymbolTable_IsArray (left)) || (SymbolTable_IsUnbounded (left))))
1114 : {
1115 : /* avoid dangling else. */
1116 6588 : if ((M2System_IsGenericSystemType (getSType (right))) || (M2System_IsGenericSystemType (getSType (left))))
1117 : {
1118 0 : return M2Check_true;
1119 : }
1120 : else
1121 : {
1122 6588 : result = checkUnbounded (result, tinfo, right, left);
1123 : }
1124 : }
1125 1098942 : else if ((SymbolTable_IsArray (left)) && (SymbolTable_IsConst (right)))
1126 : {
1127 : /* avoid dangling else. */
1128 25368 : result = checkPair (result, tinfo, SymbolTable_GetDType (left), SymbolTable_GetDType (right));
1129 : }
1130 1073574 : else if ((SymbolTable_IsArray (right)) && (SymbolTable_IsConst (left)))
1131 : {
1132 : /* avoid dangling else. */
1133 0 : result = checkPair (result, tinfo, SymbolTable_GetDType (left), SymbolTable_GetDType (right));
1134 : }
1135 : return result;
1136 : /* static analysis guarentees a RETURN statement will be used before here. */
1137 : __builtin_unreachable ();
1138 : }
1139 :
1140 :
1141 : /*
1142 : checkCharStringTypeEquivalence - check char and string constants for type equivalence.
1143 : */
1144 :
1145 1548652 : static M2Check_status checkCharStringTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1146 : {
1147 1555670 : if (isFalse (result))
1148 : {
1149 : return result;
1150 : }
1151 1555670 : else if (left == M2Base_Char)
1152 : {
1153 : /* avoid dangling else. */
1154 11820 : if (SymbolTable_IsConst (right))
1155 : {
1156 : /* We might not know the length of the string yet, in which case we return true. */
1157 200 : if ((SymbolTable_IsConstString (right)) && ((! (SymbolConversion_GccKnowsAbout (right))) || ((SymbolTable_GetStringLength (tinfo->token, right)) <= 1)))
1158 : {
1159 200 : return M2Check_true;
1160 : }
1161 : else
1162 : {
1163 0 : return falseReason2 ((const char *) "the string {%2a} does not fit into a {%1a}", 42, tinfo, left, right);
1164 : }
1165 : }
1166 11620 : else if (SymbolTable_IsParameter (right))
1167 : {
1168 : /* avoid dangling else. */
1169 0 : right = SymbolTable_GetDType (right);
1170 0 : if ((right == M2Base_Char) || ((SymbolTable_IsUnbounded (right)) && ((SymbolTable_SkipType (SymbolTable_GetDType (right))) == M2Base_Char)))
1171 : {
1172 0 : return M2Check_true;
1173 : }
1174 : }
1175 11620 : else if (SymbolTable_IsArray (right))
1176 : {
1177 : /* avoid dangling else. */
1178 5964 : if (M2Base_Char == (SymbolTable_SkipType (SymbolTable_GetDType (right))))
1179 : {
1180 : return M2Check_true;
1181 : }
1182 : }
1183 : }
1184 1543850 : else if (right == M2Base_Char)
1185 : {
1186 : /* avoid dangling else. */
1187 : return checkCharStringTypeEquivalence (result, tinfo, right, left);
1188 : }
1189 : return result;
1190 : /* static analysis guarentees a RETURN statement will be used before here. */
1191 : __builtin_unreachable ();
1192 : }
1193 :
1194 :
1195 : /*
1196 : firstTime - returns TRUE if the triple (token, left, right) has not been seen before.
1197 : */
1198 :
1199 414 : static bool firstTime (unsigned int token, unsigned int left, unsigned int right)
1200 : {
1201 414 : M2Check_errorSig p;
1202 414 : unsigned int i;
1203 414 : unsigned int n;
1204 :
1205 414 : i = 1;
1206 414 : n = Indexing_HighIndice (errors);
1207 894 : while (i <= n)
1208 : {
1209 126 : p = static_cast<M2Check_errorSig> (Indexing_GetIndice (errors, i));
1210 126 : if (((p->token == token) && (p->left == left)) && (p->right == right))
1211 : {
1212 : return false;
1213 : }
1214 66 : i += 1;
1215 : }
1216 354 : Storage_ALLOCATE ((void **) &p, sizeof (M2Check__T1));
1217 354 : p->token = token;
1218 354 : p->left = left;
1219 354 : p->right = right;
1220 354 : Indexing_IncludeIndiceIntoIndex (errors, reinterpret_cast <void *> (p));
1221 354 : return true;
1222 : /* static analysis guarentees a RETURN statement will be used before here. */
1223 : __builtin_unreachable ();
1224 : }
1225 :
1226 :
1227 : /*
1228 : buildError4 - generate a MetaString4 error. This is only used when checking
1229 : parameter compatibility.
1230 : */
1231 :
1232 168 : static void buildError4 (M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1233 : {
1234 168 : DynamicStrings_String s;
1235 :
1236 168 : if (firstTime (tinfo->token, left, right))
1237 : {
1238 108 : if (tinfo->error == NULL)
1239 : {
1240 : /* We need to create top level error message first. */
1241 108 : tinfo->error = M2Error_NewError (tinfo->token);
1242 : /* The parameters to MetaString4 in buildError4 must match the order
1243 : of parameters passed to ParameterTypeCompatible. */
1244 108 : s = M2MetaError_MetaString4 (tinfo->format, tinfo->procedure, tinfo->formal, tinfo->actual, tinfo->nth);
1245 : /* Append the overall reason for the failure. */
1246 108 : if (tinfo->reason != NULL)
1247 : {
1248 : /* The string tinfo^.reason is given to the error handler. */
1249 42 : s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " because ", 9)));
1250 42 : s = DynamicStrings_ConCat (s, tinfo->reason);
1251 42 : tinfo->reason = static_cast<DynamicStrings_String> (NULL); /* Hand over deconstructing to M2MetaError. */
1252 : }
1253 108 : M2Error_ErrorString (tinfo->error, s);
1254 : }
1255 : /* And now also generate a sub error containing detail. */
1256 108 : if ((left != tinfo->left) || (right != tinfo->right))
1257 : {
1258 108 : M2MetaError_MetaError1 ((const char *) "formal parameter {%1EDad}", 25, right);
1259 108 : M2MetaError_MetaError1 ((const char *) "actual parameter {%1EDad}", 25, left);
1260 : }
1261 : }
1262 168 : }
1263 :
1264 :
1265 : /*
1266 : buildError2 - generate a MetaString2 error.
1267 : */
1268 :
1269 246 : static void buildError2 (M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1270 : {
1271 246 : DynamicStrings_String s;
1272 :
1273 246 : if (firstTime (tinfo->token, left, right))
1274 : {
1275 246 : if (tinfo->error == NULL)
1276 : {
1277 : /* Need to create top level error message first. */
1278 246 : tinfo->error = M2Error_NewError (tinfo->token);
1279 246 : s = M2MetaError_MetaString2 (tinfo->format, tinfo->left, tinfo->right);
1280 246 : M2Error_ErrorString (tinfo->error, s);
1281 : }
1282 : /* Also generate a sub error containing detail. */
1283 246 : if ((left != tinfo->left) || (right != tinfo->right))
1284 : {
1285 228 : tinfo->error = M2Error_ChainError (tinfo->token, tinfo->error);
1286 228 : switch (tinfo->kind)
1287 : {
1288 0 : case M2Check_parameter:
1289 0 : s = M2MetaError_MetaString2 (DynamicStrings_InitString ((const char *) "{%1Ead} and {%2ad} are incompatible as formal and actual procedure parameters", 77), left, right);
1290 0 : break;
1291 :
1292 108 : case M2Check_assignment:
1293 108 : s = M2MetaError_MetaString2 (DynamicStrings_InitString ((const char *) "{%1Ead} and {%2ad} are assignment incompatible", 46), left, right);
1294 108 : break;
1295 :
1296 120 : case M2Check_expression:
1297 120 : s = M2MetaError_MetaString2 (DynamicStrings_InitString ((const char *) "{%1Ead} and {%2ad} are expression incompatible", 46), left, right);
1298 120 : break;
1299 :
1300 :
1301 0 : default:
1302 0 : CaseException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Check.def", 20, 1);
1303 0 : __builtin_unreachable ();
1304 : }
1305 : /* Lastly the overall reason for the failure. */
1306 228 : if (tinfo->reason != NULL)
1307 : {
1308 : /* The string tinfo^.reason is given to the error handler. */
1309 66 : s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " because ", 9)));
1310 66 : s = DynamicStrings_ConCat (s, tinfo->reason);
1311 66 : tinfo->reason = static_cast<DynamicStrings_String> (NULL); /* Hand over deconstructing to M2MetaError. */
1312 : }
1313 228 : M2Error_ErrorString (tinfo->error, s);
1314 : }
1315 : }
1316 246 : }
1317 :
1318 :
1319 : /*
1320 : issueError -
1321 : */
1322 :
1323 412368 : static M2Check_status issueError (bool result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1324 : {
1325 412368 : if (result)
1326 : {
1327 : return M2Check_true;
1328 : }
1329 : else
1330 : {
1331 : /* Check whether errors are required. */
1332 2310 : if (tinfo->format != NULL)
1333 : {
1334 414 : switch (tinfo->kind)
1335 : {
1336 168 : case M2Check_parameter:
1337 168 : buildError4 (tinfo, left, right);
1338 168 : break;
1339 :
1340 126 : case M2Check_assignment:
1341 126 : buildError2 (tinfo, left, right);
1342 126 : break;
1343 :
1344 120 : case M2Check_expression:
1345 120 : buildError2 (tinfo, left, right);
1346 120 : break;
1347 :
1348 :
1349 0 : default:
1350 0 : CaseException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Check.def", 20, 1);
1351 0 : __builtin_unreachable ();
1352 : }
1353 414 : tinfo->format = static_cast<DynamicStrings_String> (NULL); /* string is used by MetaError now. */
1354 : }
1355 2310 : return M2Check_false;
1356 : }
1357 : /* static analysis guarentees a RETURN statement will be used before here. */
1358 : __builtin_unreachable ();
1359 : }
1360 :
1361 :
1362 : /*
1363 : checkBaseEquivalence - the catch all check for types not specifically
1364 : handled by this module.
1365 : */
1366 :
1367 410334 : static M2Check_status checkBaseEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1368 : {
1369 410334 : if (isKnown (result))
1370 : {
1371 : return result;
1372 : }
1373 : else
1374 : {
1375 410334 : switch (tinfo->kind)
1376 : {
1377 84930 : case M2Check_parameter:
1378 84930 : if (tinfo->isvar)
1379 : {
1380 24 : return issueError (M2Base_IsExpressionCompatible (left, right), tinfo, left, right);
1381 : }
1382 : else
1383 : {
1384 84906 : return issueError (M2Base_IsAssignmentCompatible (left, right), tinfo, left, right);
1385 : }
1386 268984 : break;
1387 :
1388 268984 : case M2Check_assignment:
1389 268984 : return issueError (M2Base_IsAssignmentCompatible (left, right), tinfo, left, right);
1390 56420 : break;
1391 :
1392 56420 : case M2Check_expression:
1393 56420 : if (tinfo->isin)
1394 : {
1395 0 : if ((SymbolTable_IsVar (right)) || (SymbolTable_IsConst (right)))
1396 : {
1397 0 : right = getSType (right);
1398 : }
1399 : }
1400 56420 : if (tinfo->strict)
1401 : {
1402 43838 : return issueError (M2Base_IsComparisonCompatible (left, right), tinfo, left, right);
1403 : }
1404 : else
1405 : {
1406 12582 : return issueError (M2Base_IsExpressionCompatible (left, right), tinfo, left, right);
1407 : }
1408 0 : break;
1409 :
1410 :
1411 0 : default:
1412 0 : M2Error_InternalError ((const char *) "unexpected kind value", 21);
1413 : break;
1414 : }
1415 : }
1416 : /* should never reach here. */
1417 : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Check.def", 20, 1);
1418 : __builtin_unreachable ();
1419 : }
1420 :
1421 :
1422 : /*
1423 : checkPair - check whether left and right are type compatible.
1424 : It will update the visited, unresolved list before
1425 : calling the docheckPair for the cascaded type checking.
1426 : Pre-condition: tinfo is initialized.
1427 : left and right are modula2 symbols.
1428 : Post-condition: tinfo visited, resolved, unresolved lists
1429 : are updated and the result status is
1430 : returned.
1431 : */
1432 :
1433 4659398 : static M2Check_status checkPair (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1434 : {
1435 4659398 : if (isFalse (result))
1436 : {
1437 12 : exclude (tinfo->visited, left, right);
1438 12 : return result;
1439 : }
1440 : else
1441 : {
1442 4659386 : if (in (tinfo->resolved, left, right))
1443 : {
1444 58354 : exclude (tinfo->visited, left, right);
1445 58354 : return getStatus (tinfo->resolved, left, right);
1446 : }
1447 4601032 : else if (in (tinfo->visited, left, right))
1448 : {
1449 : /* avoid dangling else. */
1450 : return M2Check_visited;
1451 : }
1452 : else
1453 : {
1454 : /* avoid dangling else. */
1455 4300905 : if (debugging)
1456 : {
1457 : libc_printf ((const char *) " marked as visited (%d, %d)\\n", 31, left, right);
1458 : }
1459 4300905 : include (tinfo->visited, left, right, M2Check_unknown);
1460 4300905 : include (tinfo->unresolved, left, right, M2Check_unknown);
1461 : }
1462 4300905 : return doCheckPair (result, tinfo, left, right);
1463 : }
1464 : /* static analysis guarentees a RETURN statement will be used before here. */
1465 : __builtin_unreachable ();
1466 : }
1467 :
1468 :
1469 : /*
1470 : useBaseCheck -
1471 : */
1472 :
1473 2401917 : static bool useBaseCheck (unsigned int sym)
1474 : {
1475 2401917 : return (((M2Base_IsBaseType (sym)) || (M2System_IsSystemType (sym))) || (M2Base_IsMathType (sym))) || (M2Base_IsComplexType (sym));
1476 : /* static analysis guarentees a RETURN statement will be used before here. */
1477 : __builtin_unreachable ();
1478 : }
1479 :
1480 :
1481 : /*
1482 : checkBaseTypeEquivalence -
1483 : */
1484 :
1485 1518110 : static M2Check_status checkBaseTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1486 : {
1487 1518110 : if (isFalse (result))
1488 : {
1489 : return result;
1490 : }
1491 1518110 : else if ((useBaseCheck (left)) && (useBaseCheck (right)))
1492 : {
1493 : /* avoid dangling else. */
1494 410334 : return checkBaseEquivalence (result, tinfo, left, right);
1495 : }
1496 : else
1497 : {
1498 : /* avoid dangling else. */
1499 1107776 : return result;
1500 : }
1501 : /* static analysis guarentees a RETURN statement will be used before here. */
1502 : __builtin_unreachable ();
1503 : }
1504 :
1505 :
1506 : /*
1507 : IsTyped - returns TRUE if sym will have a type.
1508 : */
1509 :
1510 11106081 : static bool IsTyped (unsigned int sym)
1511 : {
1512 11106081 : return (((((SymbolTable_IsVar (sym)) || (SymbolTable_IsParameter (sym))) || (SymbolTable_IsConstructor (sym))) || ((SymbolTable_IsConst (sym)) && (SymbolTable_IsConstructor (sym)))) || (SymbolTable_IsParameter (sym))) || ((SymbolTable_IsConst (sym)) && ((SymbolTable_GetDType (sym)) != SymbolTable_NulSym));
1513 : /* static analysis guarentees a RETURN statement will be used before here. */
1514 : __builtin_unreachable ();
1515 : }
1516 :
1517 :
1518 : /*
1519 : IsTypeEquivalence - returns TRUE if sym is a type equivalence symbol.
1520 : */
1521 :
1522 2214792 : static bool IsTypeEquivalence (unsigned int sym)
1523 : {
1524 2214792 : return ((SymbolTable_IsType (sym)) && ((SymbolTable_GetDType (sym)) != SymbolTable_NulSym)) && ((SymbolTable_GetDType (sym)) != sym);
1525 : /* static analysis guarentees a RETURN statement will be used before here. */
1526 : __builtin_unreachable ();
1527 : }
1528 :
1529 :
1530 : /*
1531 : isLValue -
1532 : */
1533 :
1534 1529620 : static bool isLValue (unsigned int sym)
1535 : {
1536 1529620 : return (SymbolTable_IsVar (sym)) && ((SymbolTable_GetMode (sym)) == SymbolTable_LeftValue);
1537 : /* static analysis guarentees a RETURN statement will be used before here. */
1538 : __builtin_unreachable ();
1539 : }
1540 :
1541 :
1542 : /*
1543 : checkVarTypeEquivalence -
1544 : */
1545 :
1546 1548652 : static M2Check_status checkVarTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1547 : {
1548 1548652 : if (isFalse (result))
1549 : {
1550 : return result;
1551 : }
1552 1548652 : else if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
1553 : {
1554 : /* avoid dangling else. */
1555 : return M2Check_true;
1556 : }
1557 : else
1558 : {
1559 : /* avoid dangling else. */
1560 1548652 : if ((SymbolTable_IsVar (left)) || (SymbolTable_IsVar (right)))
1561 : {
1562 : /* Either left or right will change, so we can call doCheckPair. */
1563 230591 : if (SymbolTable_IsVar (left))
1564 : {
1565 230535 : left = getType (left);
1566 : }
1567 230591 : if (SymbolTable_IsVar (right))
1568 : {
1569 56 : right = getType (right);
1570 : }
1571 230591 : return doCheckPair (result, tinfo, left, right);
1572 : }
1573 : }
1574 : return result;
1575 : /* static analysis guarentees a RETURN statement will be used before here. */
1576 : __builtin_unreachable ();
1577 : }
1578 :
1579 :
1580 : /*
1581 : checkVarEquivalence - this test must be done early as it checks the symbol mode.
1582 : An LValue is treated as a pointer during assignment and the
1583 : LValue is attached to a variable. This function skips the variable
1584 : and checks the types - after it has considered a possible LValue.
1585 : */
1586 :
1587 5384300 : static M2Check_status checkVarEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int des, unsigned int expr)
1588 : {
1589 5384300 : if (isFalse (result))
1590 : {
1591 : return result;
1592 : }
1593 5384300 : else if ((IsTyped (des)) || (IsTyped (expr)))
1594 : {
1595 : /* avoid dangling else. */
1596 4143744 : if (tinfo->kind == M2Check_assignment)
1597 : {
1598 : /* avoid gcc warning by using compound statement even if not strictly necessary. */
1599 2808503 : if ((SymbolTable_GetDType (des)) == (SymbolTable_GetDType (expr)))
1600 : {
1601 : /* LValues are only relevant during assignment. */
1602 : return M2Check_true;
1603 : }
1604 763174 : else if ((isLValue (des)) && (! (isLValue (expr))))
1605 : {
1606 : /* avoid dangling else. */
1607 251210 : if ((SymbolTable_SkipType (getType (expr))) == M2System_Address)
1608 : {
1609 : return M2Check_true;
1610 : }
1611 249924 : else if (SymbolTable_IsPointer (SymbolTable_SkipType (getType (expr))))
1612 : {
1613 : /* avoid dangling else. */
1614 18834 : expr = SymbolTable_GetDType (SymbolTable_SkipType (getType (expr)));
1615 18834 : return doCheckPair (result, tinfo, getType (des), expr);
1616 : }
1617 : }
1618 511964 : else if ((isLValue (expr)) && (! (isLValue (des))))
1619 : {
1620 : /* avoid dangling else. */
1621 1392 : if ((SymbolTable_SkipType (getType (des))) == M2System_Address)
1622 : {
1623 : return M2Check_true;
1624 : }
1625 1392 : else if (SymbolTable_IsPointer (SymbolTable_SkipType (getType (des))))
1626 : {
1627 : /* avoid dangling else. */
1628 36 : des = SymbolTable_GetDType (SymbolTable_SkipType (getType (des)));
1629 36 : return doCheckPair (result, tinfo, des, getType (expr));
1630 : }
1631 : }
1632 : }
1633 2078259 : return doCheckPair (result, tinfo, getType (des), getType (expr));
1634 : }
1635 : return result;
1636 : /* static analysis guarentees a RETURN statement will be used before here. */
1637 : __builtin_unreachable ();
1638 : }
1639 :
1640 :
1641 : /*
1642 : checkConstMeta - performs a very course grained check against
1643 : obviously incompatible type kinds.
1644 : If left is a const string then it checks right against char.
1645 : */
1646 :
1647 109992 : static M2Check_status checkConstMeta (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1648 : {
1649 109992 : unsigned int typeLeft;
1650 109992 : unsigned int typeRight;
1651 :
1652 109992 : M2Debug_Assert (SymbolTable_IsConst (left));
1653 109992 : if (isFalse (result))
1654 : {
1655 : return result;
1656 : }
1657 109992 : else if (SymbolTable_IsConstString (left))
1658 : {
1659 : /* avoid dangling else. */
1660 95540 : if (SymbolTable_IsConstString (right))
1661 : {
1662 : return M2Check_true;
1663 : }
1664 93432 : else if (IsTyped (right))
1665 : {
1666 : /* avoid dangling else. */
1667 35030 : typeRight = SymbolTable_GetDType (right);
1668 35030 : if (typeRight == SymbolTable_NulSym)
1669 : {
1670 : return result;
1671 : }
1672 35030 : else if (((((SymbolTable_IsSet (typeRight)) || (SymbolTable_IsEnumeration (typeRight))) || (SymbolTable_IsProcedure (typeRight))) || (SymbolTable_IsRecord (typeRight))) || (SymbolTable_IsReallyPointer (typeRight)))
1673 : {
1674 : /* avoid dangling else. */
1675 96 : return falseReason1 ((const char *) "constant string is incompatible with {%1ad}", 43, tinfo, typeRight);
1676 : }
1677 34934 : else if (SymbolTable_IsArray (typeRight))
1678 : {
1679 : /* avoid dangling else. */
1680 0 : return doCheckPair (result, tinfo, M2Base_Char, SymbolTable_GetDType (typeRight));
1681 : }
1682 34934 : else if (! (SymbolConversion_GccKnowsAbout (left)))
1683 : {
1684 : /* avoid dangling else. */
1685 : /* We do not know the length of this string, so assume true. */
1686 : return M2Check_true;
1687 : }
1688 34934 : else if ((SymbolTable_GetStringLength (tinfo->token, left)) == 1)
1689 : {
1690 : /* avoid dangling else. */
1691 2080 : return doCheckPair (result, tinfo, M2Base_Char, typeRight);
1692 : }
1693 : }
1694 : }
1695 14452 : else if ((IsTyped (left)) && (IsTyped (right)))
1696 : {
1697 : /* avoid dangling else. */
1698 222 : typeRight = SymbolTable_GetDType (right);
1699 222 : typeLeft = SymbolTable_GetDType (left);
1700 6 : if ((IsZRCType (typeLeft)) && (SymbolTable_IsUnbounded (typeRight)))
1701 : {
1702 6 : return falseReason2 ((const char *) "the constant {%1a} is incompatible with an unbounded array of {%2a}", 67, tinfo, typeLeft, typeRight);
1703 : }
1704 : else
1705 : {
1706 216 : return doCheckPair (result, tinfo, typeLeft, typeRight);
1707 : }
1708 : }
1709 : return result;
1710 : /* static analysis guarentees a RETURN statement will be used before here. */
1711 : __builtin_unreachable ();
1712 : }
1713 :
1714 :
1715 : /*
1716 : checkEnumField -
1717 : */
1718 :
1719 204 : static M2Check_status checkEnumField (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1720 : {
1721 204 : unsigned int typeRight;
1722 :
1723 204 : M2Debug_Assert (SymbolTable_IsFieldEnumeration (left));
1724 204 : if (isFalse (result))
1725 : {
1726 : return result;
1727 : }
1728 204 : else if (IsTyped (right))
1729 : {
1730 : /* avoid dangling else. */
1731 204 : typeRight = SymbolTable_GetDType (right);
1732 204 : if (typeRight == SymbolTable_NulSym)
1733 : {
1734 : return result;
1735 : }
1736 : else
1737 : {
1738 204 : return doCheckPair (result, tinfo, SymbolTable_GetDType (left), typeRight);
1739 : }
1740 : }
1741 : return result;
1742 : /* static analysis guarentees a RETURN statement will be used before here. */
1743 : __builtin_unreachable ();
1744 : }
1745 :
1746 :
1747 : /*
1748 : checkEnumFieldEquivalence -
1749 : */
1750 :
1751 1540278 : static M2Check_status checkEnumFieldEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1752 : {
1753 1540278 : if (isFalse (result))
1754 : {
1755 : return result;
1756 : }
1757 1540278 : else if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
1758 : {
1759 : /* avoid dangling else. */
1760 : /* No option but to return true. */
1761 : return M2Check_true;
1762 : }
1763 1540278 : else if (SymbolTable_IsFieldEnumeration (left))
1764 : {
1765 : /* avoid dangling else. */
1766 204 : return checkEnumField (result, tinfo, left, right);
1767 : }
1768 1540074 : else if (SymbolTable_IsFieldEnumeration (right))
1769 : {
1770 : /* avoid dangling else. */
1771 0 : return checkEnumField (result, tinfo, right, left);
1772 : }
1773 : return result;
1774 : /* static analysis guarentees a RETURN statement will be used before here. */
1775 : __builtin_unreachable ();
1776 : }
1777 :
1778 :
1779 : /*
1780 : checkConstEquivalence - this check can be done first as it checks symbols which
1781 : may have no type. Ie constant strings. These constants
1782 : will likely have their type set during quadruple folding.
1783 : But we can check the meta type for obvious mismatches
1784 : early on. For example adding a string to an enum or set.
1785 : */
1786 :
1787 1542488 : static M2Check_status checkConstEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1788 : {
1789 1542488 : if (isFalse (result))
1790 : {
1791 : return result;
1792 : }
1793 1542488 : else if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
1794 : {
1795 : /* avoid dangling else. */
1796 : /* No option but to return true. */
1797 : return M2Check_true;
1798 : }
1799 1542488 : else if (SymbolTable_IsConst (left))
1800 : {
1801 : /* avoid dangling else. */
1802 81570 : return checkConstMeta (result, tinfo, left, right);
1803 : }
1804 1460918 : else if (SymbolTable_IsConst (right))
1805 : {
1806 : /* avoid dangling else. */
1807 28422 : return checkConstMeta (result, tinfo, right, left);
1808 : }
1809 : return result;
1810 : /* static analysis guarentees a RETURN statement will be used before here. */
1811 : __builtin_unreachable ();
1812 : }
1813 :
1814 :
1815 : /*
1816 : checkSubrangeTypeEquivalence -
1817 : */
1818 :
1819 1529536 : static M2Check_status checkSubrangeTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1820 : {
1821 1529536 : if (isFalse (result))
1822 : {
1823 : return result;
1824 : }
1825 : else
1826 : {
1827 1529536 : if (SymbolTable_IsSubrange (left))
1828 : {
1829 4964 : return doCheckPair (result, tinfo, SymbolTable_GetDType (left), right);
1830 : }
1831 1524572 : if (SymbolTable_IsSubrange (right))
1832 : {
1833 6556 : return doCheckPair (result, tinfo, left, SymbolTable_GetDType (right));
1834 : }
1835 : }
1836 : return result;
1837 : /* static analysis guarentees a RETURN statement will be used before here. */
1838 : __builtin_unreachable ();
1839 : }
1840 :
1841 :
1842 : /*
1843 : IsZRCType - return TRUE if type is a ZType, RType or a CType.
1844 : */
1845 :
1846 1176 : static bool IsZRCType (unsigned int type)
1847 : {
1848 1176 : return ((type == M2Base_CType) || (type == M2Base_ZType)) || (type == M2Base_RType);
1849 : /* static analysis guarentees a RETURN statement will be used before here. */
1850 : __builtin_unreachable ();
1851 : }
1852 :
1853 :
1854 : /*
1855 : isZRC - return TRUE if zrc is a ZType, RType or a CType
1856 : and sym is either a complex type when zrc = CType
1857 : or is not a composite type when zrc is a RType or ZType.
1858 : */
1859 :
1860 0 : static bool isZRC (unsigned int zrc, unsigned int sym)
1861 : {
1862 0 : if (SymbolTable_IsConst (sym))
1863 : {
1864 0 : sym = SymbolTable_SkipType (SymbolTable_GetDType (sym));
1865 : }
1866 0 : if ((zrc == M2Base_CType) && ((M2System_IsComplexN (sym)) || (M2Base_IsComplexType (sym))))
1867 : {
1868 0 : return true;
1869 : }
1870 0 : return (zrc == sym) || ((zrc == M2Base_ZType) || ((zrc == M2Base_RType) && (! (SymbolTable_IsComposite (sym)))));
1871 : /* static analysis guarentees a RETURN statement will be used before here. */
1872 : __builtin_unreachable ();
1873 : }
1874 :
1875 :
1876 : /*
1877 : isSameSizeConst -
1878 :
1879 : */
1880 :
1881 12646 : static bool isSameSizeConst (unsigned int a, unsigned int b)
1882 : {
1883 12646 : if (SymbolTable_IsConst (a))
1884 : {
1885 0 : a = SymbolTable_SkipType (SymbolTable_GetDType (a));
1886 0 : return ((isZRC (a, b)) || (a == b)) || ((a != SymbolTable_NulSym) && (isSameSize (a, b)));
1887 : }
1888 12646 : else if (SymbolTable_IsConst (b))
1889 : {
1890 : /* avoid dangling else. */
1891 0 : b = SymbolTable_SkipType (SymbolTable_GetDType (b));
1892 0 : return ((isZRC (b, a)) || (a == b)) || ((b != SymbolTable_NulSym) && (isSameSize (a, b)));
1893 : }
1894 : return false;
1895 : /* static analysis guarentees a RETURN statement will be used before here. */
1896 : __builtin_unreachable ();
1897 : }
1898 :
1899 :
1900 : /*
1901 : isSameSize - should only be called if either a or b are WORD, BYTE, etc.
1902 : */
1903 :
1904 12646 : static bool isSameSize (unsigned int a, unsigned int b)
1905 : {
1906 12646 : return (isSameSizeConst (a, b)) || (M2System_IsSameSize (a, b));
1907 : /* static analysis guarentees a RETURN statement will be used before here. */
1908 : __builtin_unreachable ();
1909 : }
1910 :
1911 :
1912 : /*
1913 : checkSystemEquivalence - check whether left and right are system types and whether they have the same size.
1914 : */
1915 :
1916 1540278 : static M2Check_status checkSystemEquivalence (M2Check_status result, M2Check_tInfo tinfo __attribute__((unused)), unsigned int left, unsigned int right)
1917 : {
1918 1540278 : if ((isFalse (result)) || (result == M2Check_visited))
1919 : {
1920 : return result;
1921 : }
1922 : else
1923 : {
1924 1540278 : if (((((M2System_IsGenericSystemType (left)) || (M2System_IsGenericSystemType (right))) && (SymbolConversion_GccKnowsAbout (left))) && (SymbolConversion_GccKnowsAbout (right))) && (isSameSize (left, right)))
1925 : {
1926 : return M2Check_true;
1927 : }
1928 : }
1929 : return result;
1930 : /* static analysis guarentees a RETURN statement will be used before here. */
1931 : __builtin_unreachable ();
1932 : }
1933 :
1934 :
1935 : /*
1936 : checkTypeKindViolation - returns false if one operand left or right is
1937 : a set, record or array.
1938 : */
1939 :
1940 841516 : static M2Check_status checkTypeKindViolation (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1941 : {
1942 841516 : if ((isFalse (result)) || (result == M2Check_visited))
1943 : {
1944 : return result;
1945 : }
1946 : else
1947 : {
1948 : /* We have checked IsSet (left) and IsSet (right) etc in doCheckPair. */
1949 841516 : if ((((SymbolTable_IsSet (left)) || (SymbolTable_IsSet (right))) || ((SymbolTable_IsRecord (left)) || (SymbolTable_IsRecord (right)))) || ((SymbolTable_IsArray (left)) || (SymbolTable_IsArray (right))))
1950 : {
1951 72 : return falseReason2 ((const char *) "a {%1ad} is incompatible with a {%2ad}", 38, tinfo, left, right);
1952 : }
1953 : }
1954 : return result;
1955 : /* static analysis guarentees a RETURN statement will be used before here. */
1956 : __builtin_unreachable ();
1957 : }
1958 :
1959 :
1960 : /*
1961 : doCheckPair - invoke a series of type checks checking compatibility
1962 : between left and right modula2 symbols.
1963 : Pre-condition: left and right are modula-2 symbols.
1964 : tinfo is configured.
1965 : Post-condition: status is returned determining the
1966 : correctness of the type check.
1967 : The tinfo resolved, unresolved, visited
1968 : lists will be updated.
1969 : */
1970 :
1971 6642645 : static M2Check_status doCheckPair (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1972 : {
1973 6642645 : unsigned int i;
1974 :
1975 6642645 : if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
1976 : {
1977 : /* We cannot check NulSym. */
1978 : return M2Check_true;
1979 : }
1980 6616311 : else if (isKnown (result))
1981 : {
1982 : /* avoid dangling else. */
1983 42 : return return_ (result, tinfo, left, right);
1984 : }
1985 6616269 : else if (left == right)
1986 : {
1987 : /* avoid dangling else. */
1988 1231969 : return return_ (M2Check_true, tinfo, left, right);
1989 : }
1990 : else
1991 : {
1992 : /* avoid dangling else. */
1993 : i = 1;
1994 21123328 : while (i <= HighEquivalence)
1995 : {
1996 20281884 : result = (*Equivalence.array[i-1].proc) (result, tinfo, left, right);
1997 20281884 : if (isKnown (result))
1998 : {
1999 4542856 : return return_ (result, tinfo, left, right);
2000 : }
2001 15739028 : i += 1;
2002 : }
2003 : }
2004 841444 : return return_ (result, tinfo, left, right);
2005 : /* static analysis guarentees a RETURN statement will be used before here. */
2006 : __builtin_unreachable ();
2007 : }
2008 :
2009 :
2010 : /*
2011 : InitEquivalenceArray - populate the Equivalence array with the
2012 : checking procedures.
2013 : */
2014 :
2015 14952 : static void InitEquivalenceArray (void)
2016 : {
2017 14952 : HighEquivalence = 0;
2018 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkVarEquivalence});
2019 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkVarTypeEquivalence});
2020 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkCharStringTypeEquivalence});
2021 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkConstEquivalence});
2022 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkEnumFieldEquivalence});
2023 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkSystemEquivalence});
2024 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkSubrangeTypeEquivalence});
2025 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkBaseTypeEquivalence});
2026 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkTypeEquivalence});
2027 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkArrayTypeEquivalence});
2028 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkTypeKindEquivalence});
2029 14952 : addEquivalence ((M2Check_EquivalenceProcedure) {(M2Check_EquivalenceProcedure_t) checkTypeKindViolation});
2030 14952 : }
2031 :
2032 :
2033 : /*
2034 : addEquivalence - places proc into Equivalence array.
2035 : */
2036 :
2037 179424 : static void addEquivalence (M2Check_EquivalenceProcedure proc)
2038 : {
2039 179424 : HighEquivalence += 1;
2040 179424 : if (HighEquivalence <= MaxEquvalence)
2041 : {
2042 179424 : Equivalence.array[HighEquivalence-1] = proc;
2043 : }
2044 : else
2045 : {
2046 0 : M2Error_InternalError ((const char *) "increase MaxEquivalence constant in M2Check.mod", 47);
2047 : }
2048 179424 : }
2049 :
2050 :
2051 : /*
2052 : checkProcType -
2053 : */
2054 :
2055 317098 : static M2Check_status checkProcType (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2056 : {
2057 317098 : unsigned int i;
2058 317098 : unsigned int n;
2059 317098 : unsigned int lt;
2060 317098 : unsigned int rt;
2061 :
2062 317098 : M2Debug_Assert (SymbolTable_IsProcType (right));
2063 317098 : M2Debug_Assert (SymbolTable_IsProcType (left));
2064 317098 : if (isFalse (result))
2065 : {
2066 : return result;
2067 : }
2068 : else
2069 : {
2070 317098 : lt = SymbolTable_GetDType (left);
2071 317098 : rt = SymbolTable_GetDType (right);
2072 317098 : if ((lt == SymbolTable_NulSym) && (rt == SymbolTable_NulSym))
2073 : {
2074 : result = M2Check_unknown;
2075 : }
2076 2290 : else if (lt == SymbolTable_NulSym)
2077 : {
2078 : /* avoid dangling else. */
2079 0 : if (tinfo->format != NULL)
2080 : {
2081 0 : M2MetaError_MetaErrorStringT3 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure type {%1a} does not have a {%kRETURN} type whereas procedure type {%2ad} has a {%kRETURN} type {%3ad}", 111), left, right, rt);
2082 : }
2083 0 : return return_ (M2Check_false, tinfo, left, right);
2084 : }
2085 2290 : else if (rt == SymbolTable_NulSym)
2086 : {
2087 : /* avoid dangling else. */
2088 0 : if (tinfo->format != NULL)
2089 : {
2090 0 : M2MetaError_MetaErrorStringT3 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure type {%1a} does not have a {%kRETURN} type whereas procedure type {%2ad} has a {%kRETURN} type {%3ad}", 111), right, left, lt);
2091 : }
2092 0 : return return_ (M2Check_false, tinfo, left, right);
2093 : }
2094 : else
2095 : {
2096 : /* avoid dangling else. */
2097 : /* two return type seen so we check them. */
2098 2290 : result = checkPair (M2Check_unknown, tinfo, lt, rt);
2099 : }
2100 317098 : if ((SymbolTable_NoOfParamAny (left)) != (SymbolTable_NoOfParamAny (right)))
2101 : {
2102 6 : if (tinfo->format != NULL)
2103 : {
2104 6 : M2MetaError_MetaErrorStringT2 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure type {%1a} has a different number of parameters from procedure type {%2ad}", 84), right, left);
2105 : }
2106 6 : return return_ (M2Check_false, tinfo, left, right);
2107 : }
2108 317092 : i = 1;
2109 317092 : n = SymbolTable_NoOfParamAny (left);
2110 822616 : while (i <= n)
2111 : {
2112 188432 : if ((isFalse (result)) || (result == M2Check_visited))
2113 : {
2114 : /* Seen a mismatch therefore return. */
2115 0 : return return_ (result, tinfo, left, right);
2116 : }
2117 188432 : result = M2Check_unknown; /* Each parameter must match. */
2118 188432 : if ((SymbolTable_IsVarParamAny (left, i)) != (SymbolTable_IsVarParamAny (right, i))) /* Each parameter must match. */
2119 : {
2120 0 : if (SymbolTable_IsVarParamAny (left, i))
2121 : {
2122 : /* avoid dangling else. */
2123 0 : if (tinfo->format != NULL)
2124 : {
2125 0 : M2MetaError_MetaErrorStringT3 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure type {%2a} {%3n} parameter was declared as a {%kVAR} whereas procedure type {%1ad} {%3n} parameter was not", 116), right, left, i);
2126 : }
2127 : }
2128 : else
2129 : {
2130 0 : if (tinfo->format != NULL)
2131 : {
2132 0 : M2MetaError_MetaErrorStringT3 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure type {%1a} {%3n} parameter was declared as a {%kVAR} whereas procedure type {%2ad} {%3n} parameter was not", 116), right, left, i);
2133 : }
2134 : }
2135 0 : return return_ (M2Check_false, tinfo, left, right);
2136 : }
2137 188432 : result = checkPair (result, tinfo, SymbolTable_GetDType (SymbolTable_GetNthParamAny (left, i)), SymbolTable_GetDType (SymbolTable_GetNthParamAny (right, i)));
2138 188432 : i += 1;
2139 : }
2140 : }
2141 317092 : return return_ (result, tinfo, left, right);
2142 : /* static analysis guarentees a RETURN statement will be used before here. */
2143 : __builtin_unreachable ();
2144 : }
2145 :
2146 :
2147 : /*
2148 : checkProcedureProcType -
2149 : */
2150 :
2151 221804 : static M2Check_status checkProcedureProcType (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2152 : {
2153 221804 : unsigned int i;
2154 221804 : unsigned int n;
2155 221804 : unsigned int lt;
2156 221804 : unsigned int rt;
2157 :
2158 221804 : M2Debug_Assert (SymbolTable_IsProcedure (right));
2159 221804 : M2Debug_Assert (SymbolTable_IsProcType (left));
2160 221804 : if (! (isFalse (result)))
2161 : {
2162 221804 : lt = SymbolTable_GetDType (left);
2163 221804 : rt = SymbolTable_GetDType (right);
2164 221804 : if ((lt == SymbolTable_NulSym) && (rt == SymbolTable_NulSym))
2165 : {} /* empty. */
2166 18 : else if (lt == SymbolTable_NulSym)
2167 : {
2168 : /* avoid dangling else. */
2169 0 : if (tinfo->format != NULL)
2170 : {
2171 0 : M2MetaError_MetaErrorStringT3 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure type {%1a} does not have a {%kRETURN} type whereas procedure {%2ad} has a {%kRETURN} type {%3ad}", 106), left, right, rt);
2172 : }
2173 0 : return return_ (M2Check_false, tinfo, left, right);
2174 : }
2175 18 : else if (rt == SymbolTable_NulSym)
2176 : {
2177 : /* avoid dangling else. */
2178 0 : if (tinfo->format != NULL)
2179 : {
2180 0 : M2MetaError_MetaErrorStringT3 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure {%1a} does not have a {%kRETURN} type whereas procedure type {%2ad} has a {%kRETURN} type {%3ad}", 106), right, left, lt);
2181 : }
2182 0 : return return_ (M2Check_false, tinfo, left, right);
2183 : }
2184 : else
2185 : {
2186 : /* avoid dangling else. */
2187 : /* two return type seen so we check them. */
2188 18 : result = checkPair (result, tinfo, lt, rt);
2189 : }
2190 221804 : if ((SymbolTable_NoOfParamAny (left)) != (SymbolTable_NoOfParamAny (right)))
2191 : {
2192 0 : if (tinfo->format != NULL)
2193 : {
2194 0 : M2MetaError_MetaErrorStringT2 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure {%1a} has a different number of parameters from procedure type {%2ad}", 79), right, left);
2195 : }
2196 0 : return return_ (M2Check_false, tinfo, left, right);
2197 : }
2198 221804 : i = 1;
2199 221804 : n = SymbolTable_NoOfParamAny (left);
2200 443698 : while (i <= n)
2201 : {
2202 90 : if ((SymbolTable_IsVarParamAny (left, i)) != (SymbolTable_IsVarParamAny (right, i)))
2203 : {
2204 0 : if (SymbolTable_IsVarParamAny (left, i))
2205 : {
2206 : /* avoid dangling else. */
2207 0 : if (tinfo->format != NULL)
2208 : {
2209 0 : M2MetaError_MetaErrorStringT3 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure type {%2a} {%3n} parameter was declared as a {%kVAR} whereas procedure {%1ad} {%3n} parameter was not", 111), right, left, i);
2210 : }
2211 : }
2212 : else
2213 : {
2214 0 : if (tinfo->format != NULL)
2215 : {
2216 0 : M2MetaError_MetaErrorStringT3 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure {%1a} {%3n} parameter was declared as a {%kVAR} whereas procedure type {%2ad} {%3n} parameter was not", 111), right, left, i);
2217 : }
2218 : }
2219 0 : return return_ (M2Check_false, tinfo, left, right);
2220 : }
2221 90 : result = checkPair (result, tinfo, SymbolTable_GetDType (SymbolTable_GetNthParamAny (left, i)), SymbolTable_GetDType (SymbolTable_GetNthParamAny (right, i)));
2222 90 : i += 1;
2223 : }
2224 : }
2225 221804 : return return_ (result, tinfo, left, right);
2226 : /* static analysis guarentees a RETURN statement will be used before here. */
2227 : __builtin_unreachable ();
2228 : }
2229 :
2230 :
2231 : /*
2232 : checkProcedure -
2233 : */
2234 :
2235 221804 : static M2Check_status checkProcedure (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2236 : {
2237 221804 : M2Debug_Assert (SymbolTable_IsProcedure (right));
2238 221804 : if (isFalse (result))
2239 : {
2240 : return result;
2241 : }
2242 221804 : else if (SymbolTable_IsVar (left))
2243 : {
2244 : /* avoid dangling else. */
2245 0 : return checkProcedure (result, tinfo, SymbolTable_GetDType (left), right);
2246 : }
2247 221804 : else if (left == M2System_Address)
2248 : {
2249 : /* avoid dangling else. */
2250 : return M2Check_true;
2251 : }
2252 221804 : else if (SymbolTable_IsProcType (left))
2253 : {
2254 : /* avoid dangling else. */
2255 221804 : return checkProcedureProcType (result, tinfo, left, right);
2256 : }
2257 : else
2258 : {
2259 : /* avoid dangling else. */
2260 : return result;
2261 : }
2262 : /* static analysis guarentees a RETURN statement will be used before here. */
2263 : __builtin_unreachable ();
2264 : }
2265 :
2266 :
2267 : /*
2268 : checkEnumerationEquivalence -
2269 : */
2270 :
2271 0 : static M2Check_status checkEnumerationEquivalence (M2Check_status result, unsigned int left, unsigned int right)
2272 : {
2273 0 : if (isFalse (result))
2274 : {
2275 : return result;
2276 : }
2277 0 : else if (left == right)
2278 : {
2279 : /* avoid dangling else. */
2280 : return M2Check_true;
2281 : }
2282 : else
2283 : {
2284 : /* avoid dangling else. */
2285 0 : return M2Check_false;
2286 : }
2287 : /* static analysis guarentees a RETURN statement will be used before here. */
2288 : __builtin_unreachable ();
2289 : }
2290 :
2291 :
2292 : /*
2293 : checkPointerType - check whether left and right are equal or are of type ADDRESS.
2294 : */
2295 :
2296 165302 : static M2Check_status checkPointerType (M2Check_status result, unsigned int left, unsigned int right)
2297 : {
2298 0 : if (isFalse (result))
2299 : {
2300 : return result;
2301 : }
2302 165302 : else if (((left == right) || (left == M2System_Address)) || (right == M2System_Address))
2303 : {
2304 : /* avoid dangling else. */
2305 : return M2Check_true;
2306 : }
2307 : else
2308 : {
2309 : /* avoid dangling else. */
2310 0 : return M2Check_false;
2311 : }
2312 : /* static analysis guarentees a RETURN statement will be used before here. */
2313 : __builtin_unreachable ();
2314 : }
2315 :
2316 :
2317 : /*
2318 : checkProcTypeEquivalence - allow proctype to be compared against another
2319 : proctype or procedure. It is legal to be compared
2320 : against an address.
2321 : */
2322 :
2323 538938 : static M2Check_status checkProcTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2324 : {
2325 538938 : if (isFalse (result))
2326 : {
2327 : return result;
2328 : }
2329 538938 : else if ((SymbolTable_IsProcedure (left)) && (SymbolTable_IsProcType (right)))
2330 : {
2331 : /* avoid dangling else. */
2332 221804 : return checkProcedure (result, tinfo, right, left);
2333 : }
2334 317134 : else if ((SymbolTable_IsProcType (left)) && (SymbolTable_IsProcedure (right)))
2335 : {
2336 : /* avoid dangling else. */
2337 0 : return checkProcedure (result, tinfo, left, right);
2338 : }
2339 317134 : else if ((SymbolTable_IsProcType (left)) && (SymbolTable_IsProcType (right)))
2340 : {
2341 : /* avoid dangling else. */
2342 317098 : return checkProcType (result, tinfo, left, right);
2343 : }
2344 36 : else if ((left == M2System_Address) || (right == M2System_Address))
2345 : {
2346 : /* avoid dangling else. */
2347 : return M2Check_true;
2348 : }
2349 : else
2350 : {
2351 : /* avoid dangling else. */
2352 : return M2Check_false;
2353 : }
2354 : /* static analysis guarentees a RETURN statement will be used before here. */
2355 : __builtin_unreachable ();
2356 : }
2357 :
2358 :
2359 : /*
2360 : checkTypeKindEquivalence -
2361 : */
2362 :
2363 1073688 : static M2Check_status checkTypeKindEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2364 : {
2365 1073688 : if (isFalse (result))
2366 : {
2367 : return result;
2368 : }
2369 1073688 : else if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
2370 : {
2371 : /* avoid dangling else. */
2372 : return M2Check_true;
2373 : }
2374 : else
2375 : {
2376 : /* avoid dangling else. */
2377 : /* Long cascade of all type kinds. */
2378 1073688 : if ((SymbolTable_IsSet (left)) && (SymbolTable_IsSet (right)))
2379 : {
2380 114 : return checkSetEquivalent (result, tinfo, left, right);
2381 : }
2382 1073574 : else if ((SymbolTable_IsArray (left)) && (SymbolTable_IsArray (right)))
2383 : {
2384 : /* avoid dangling else. */
2385 0 : return checkArrayTypeEquivalence (result, tinfo, left, right);
2386 : }
2387 1073574 : else if ((SymbolTable_IsRecord (left)) && (SymbolTable_IsRecord (right)))
2388 : {
2389 : /* avoid dangling else. */
2390 1073688 : return checkRecordEquivalence (result, left, right);
2391 : }
2392 1073574 : else if ((SymbolTable_IsEnumeration (left)) && (SymbolTable_IsEnumeration (right)))
2393 : {
2394 : /* avoid dangling else. */
2395 0 : return checkEnumerationEquivalence (result, left, right);
2396 : }
2397 1073574 : else if ((SymbolTable_IsProcType (left)) || (SymbolTable_IsProcType (right)))
2398 : {
2399 : /* avoid dangling else. */
2400 538938 : return checkProcTypeEquivalence (result, tinfo, right, left);
2401 : }
2402 534636 : else if ((SymbolTable_IsReallyPointer (left)) && (SymbolTable_IsReallyPointer (right)))
2403 : {
2404 : /* avoid dangling else. */
2405 165302 : return checkPointerType (result, left, right);
2406 : }
2407 : else
2408 : {
2409 : /* avoid dangling else. */
2410 369334 : return result;
2411 : }
2412 : }
2413 : /* static analysis guarentees a RETURN statement will be used before here. */
2414 : __builtin_unreachable ();
2415 : }
2416 :
2417 :
2418 : /*
2419 : isSkipEquivalence -
2420 : */
2421 :
2422 6828 : static bool isSkipEquivalence (unsigned int left, unsigned int right)
2423 : {
2424 6828 : return (SymbolTable_SkipType (left)) == (SymbolTable_SkipType (right));
2425 : /* static analysis guarentees a RETURN statement will be used before here. */
2426 : __builtin_unreachable ();
2427 : }
2428 :
2429 :
2430 : /*
2431 : checkValueEquivalence - check to see if left and right values are the same.
2432 : */
2433 :
2434 228 : static M2Check_status checkValueEquivalence (M2Check_status result, unsigned int left, unsigned int right)
2435 : {
2436 228 : if (isKnown (result))
2437 : {
2438 : return result;
2439 : }
2440 228 : else if (left == right)
2441 : {
2442 : /* avoid dangling else. */
2443 : return M2Check_true;
2444 : }
2445 : else
2446 : {
2447 : /* avoid dangling else. */
2448 228 : if (m2expr_AreConstantsEqual (SymbolConversion_Mod2Gcc (left), SymbolConversion_Mod2Gcc (right)))
2449 : {
2450 : return M2Check_true;
2451 : }
2452 : else
2453 : {
2454 : return M2Check_false;
2455 : }
2456 : }
2457 : /* static analysis guarentees a RETURN statement will be used before here. */
2458 : __builtin_unreachable ();
2459 : }
2460 :
2461 :
2462 : /*
2463 : and -
2464 : */
2465 :
2466 114 : static M2Check_status and_ (M2Check_status left, M2Check_status right)
2467 : {
2468 0 : if ((left == M2Check_true) && (right == M2Check_true))
2469 : {
2470 : return M2Check_true;
2471 : }
2472 : else
2473 : {
2474 78 : return M2Check_false;
2475 : }
2476 : /* static analysis guarentees a RETURN statement will be used before here. */
2477 : __builtin_unreachable ();
2478 : }
2479 :
2480 :
2481 : /*
2482 : checkTypeRangeEquivalence -
2483 : */
2484 :
2485 114 : static M2Check_status checkTypeRangeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2486 : {
2487 114 : M2Check_status result2;
2488 114 : M2Check_status result3;
2489 :
2490 114 : result = checkSkipEquivalence (result, left, right);
2491 114 : result2 = checkValueEquivalence (result, M2GCCDeclare_GetTypeMin (left), M2GCCDeclare_GetTypeMin (right));
2492 114 : result3 = checkValueEquivalence (result, M2GCCDeclare_GetTypeMax (left), M2GCCDeclare_GetTypeMax (right));
2493 192 : return return_ (and_ (result2, result3), tinfo, left, right);
2494 : /* static analysis guarentees a RETURN statement will be used before here. */
2495 : __builtin_unreachable ();
2496 : }
2497 :
2498 :
2499 : /*
2500 : include - include pair left:right into pairs with status, s.
2501 : */
2502 :
2503 26872814 : static void include (Indexing_Index pairs, unsigned int left, unsigned int right, M2Check_status s)
2504 : {
2505 26872814 : M2Check_pair p;
2506 :
2507 26872814 : p = newPair ();
2508 26872814 : p->left = left;
2509 26872814 : p->right = right;
2510 26872814 : p->pairStatus = s;
2511 26872814 : p->next = NULL;
2512 26872814 : Indexing_IncludeIndiceIntoIndex (pairs, reinterpret_cast <void *> (p));
2513 26872814 : }
2514 :
2515 :
2516 : /*
2517 : exclude - exclude pair left:right from pairs.
2518 : */
2519 :
2520 24167147 : static void exclude (Indexing_Index pairs, unsigned int left, unsigned int right)
2521 : {
2522 24167147 : M2Check_pair p;
2523 24167147 : unsigned int i;
2524 24167147 : unsigned int n;
2525 :
2526 24167147 : i = 1;
2527 24167147 : n = Indexing_HighIndice (pairs);
2528 71218092 : while (i <= n)
2529 : {
2530 35576593 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2531 35576593 : if (((p != NULL) && (p->left == left)) && (p->right == right))
2532 : {
2533 12692795 : Indexing_PutIndice (pairs, i, NULL);
2534 12692795 : disposePair (p);
2535 12692795 : return;
2536 : }
2537 22883798 : i += 1;
2538 : }
2539 : }
2540 :
2541 :
2542 : /*
2543 : getStatus -
2544 : */
2545 :
2546 58354 : static M2Check_status getStatus (Indexing_Index pairs, unsigned int left, unsigned int right)
2547 : {
2548 58354 : M2Check_pair p;
2549 58354 : unsigned int i;
2550 58354 : unsigned int n;
2551 :
2552 58354 : i = 1;
2553 58354 : n = Indexing_HighIndice (pairs);
2554 174262 : while (i <= n)
2555 : {
2556 115908 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2557 115908 : if (((p != NULL) && (p->left == left)) && (p->right == right))
2558 : {
2559 58354 : return p->pairStatus;
2560 : }
2561 57554 : i += 1;
2562 : }
2563 : return M2Check_unknown;
2564 : /* static analysis guarentees a RETURN statement will be used before here. */
2565 : __builtin_unreachable ();
2566 : }
2567 :
2568 :
2569 : /*
2570 : return -
2571 : */
2572 :
2573 11597361 : static M2Check_status return_ (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2574 : {
2575 11597361 : if (result != M2Check_unknown)
2576 : {
2577 9983494 : if (isKnown (result))
2578 : {
2579 9983494 : include (tinfo->resolved, left, right, result);
2580 9983494 : exclude (tinfo->unresolved, left, right);
2581 9983494 : exclude (tinfo->visited, left, right); /* no longer visiting as it is resolved. */
2582 : }
2583 : }
2584 9983494 : if (result == M2Check_false)
2585 : {
2586 2034 : return issueError (false, tinfo, left, right);
2587 : }
2588 : return result;
2589 : /* static analysis guarentees a RETURN statement will be used before here. */
2590 : __builtin_unreachable ();
2591 : }
2592 :
2593 :
2594 : /*
2595 : checkSkipEquivalence - return true if left right are equivalent.
2596 : */
2597 :
2598 228 : static M2Check_status checkSkipEquivalence (M2Check_status result, unsigned int left, unsigned int right)
2599 : {
2600 228 : if (isKnown (result))
2601 : {
2602 : return result;
2603 : }
2604 228 : else if (isSkipEquivalence (left, right))
2605 : {
2606 : /* avoid dangling else. */
2607 : return M2Check_true;
2608 : }
2609 : else
2610 : {
2611 : /* avoid dangling else. */
2612 : return result;
2613 : }
2614 : /* static analysis guarentees a RETURN statement will be used before here. */
2615 : __builtin_unreachable ();
2616 : }
2617 :
2618 :
2619 : /*
2620 : checkSetEquivalent - compares set types, left and right.
2621 : */
2622 :
2623 114 : static M2Check_status checkSetEquivalent (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2624 : {
2625 114 : result = checkSkipEquivalence (result, left, right);
2626 114 : result = checkTypeKindEquivalence (result, tinfo, SymbolTable_GetDType (left), SymbolTable_GetDType (right));
2627 114 : result = checkTypeRangeEquivalence (result, tinfo, SymbolTable_GetDType (left), SymbolTable_GetDType (right));
2628 114 : return return_ (result, tinfo, left, right);
2629 : /* static analysis guarentees a RETURN statement will be used before here. */
2630 : __builtin_unreachable ();
2631 : }
2632 :
2633 :
2634 : /*
2635 : checkRecordEquivalence - compares record types, left and right.
2636 : */
2637 :
2638 0 : static M2Check_status checkRecordEquivalence (M2Check_status result, unsigned int left, unsigned int right)
2639 : {
2640 0 : if (isFalse (result))
2641 : {
2642 : return result;
2643 : }
2644 0 : else if (left == right)
2645 : {
2646 : /* avoid dangling else. */
2647 : return M2Check_true;
2648 : }
2649 : else
2650 : {
2651 : /* avoid dangling else. */
2652 0 : return M2Check_false;
2653 : }
2654 : /* static analysis guarentees a RETURN statement will be used before here. */
2655 : __builtin_unreachable ();
2656 : }
2657 :
2658 :
2659 : /*
2660 : getType - only returns the type of symbol providing it is not a procedure.
2661 : */
2662 :
2663 4928767 : static unsigned int getType (unsigned int sym)
2664 : {
2665 4928767 : if ((sym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (sym)))
2666 : {
2667 760462 : return SymbolTable_GetProcedureProcType (sym);
2668 : }
2669 4168305 : else if (IsTyped (sym))
2670 : {
2671 : /* avoid dangling else. */
2672 4034627 : return SymbolTable_GetDType (sym);
2673 : }
2674 : else
2675 : {
2676 : /* avoid dangling else. */
2677 : return sym;
2678 : }
2679 : /* static analysis guarentees a RETURN statement will be used before here. */
2680 : __builtin_unreachable ();
2681 : }
2682 :
2683 :
2684 : /*
2685 : getSType -
2686 : */
2687 :
2688 2236184 : static unsigned int getSType (unsigned int sym)
2689 : {
2690 2236184 : if (SymbolTable_IsProcedure (sym))
2691 : {
2692 87428 : return M2System_Address;
2693 : }
2694 : else
2695 : {
2696 2148756 : return SymbolTable_GetDType (sym);
2697 : }
2698 : /* static analysis guarentees a RETURN statement will be used before here. */
2699 : __builtin_unreachable ();
2700 : }
2701 :
2702 :
2703 : /*
2704 : determineCompatible - check for compatibility by checking
2705 : equivalence, array, generic and type kind.
2706 : */
2707 :
2708 4441920 : static M2Check_status determineCompatible (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2709 : {
2710 4441920 : result = checkPair (result, tinfo, left, right);
2711 4441920 : return return_ (result, tinfo, left, right);
2712 : /* static analysis guarentees a RETURN statement will be used before here. */
2713 : __builtin_unreachable ();
2714 : }
2715 :
2716 :
2717 : /*
2718 : get -
2719 : */
2720 :
2721 8587001 : static bool get (Indexing_Index pairs, unsigned int *left, unsigned int *right, M2Check_status s)
2722 : {
2723 8587001 : unsigned int i;
2724 8587001 : unsigned int n;
2725 8587001 : M2Check_pair p;
2726 :
2727 8587001 : i = 1;
2728 8587001 : n = Indexing_HighIndice (pairs);
2729 25589958 : while (i <= n)
2730 : {
2731 12887168 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2732 12887168 : if ((p != NULL) && (p->pairStatus == s))
2733 : {
2734 4471212 : (*left) = p->left;
2735 4471212 : (*right) = p->right;
2736 4471212 : return true;
2737 : }
2738 8415956 : i += 1;
2739 : }
2740 : return false;
2741 : /* static analysis guarentees a RETURN statement will be used before here. */
2742 : __builtin_unreachable ();
2743 : }
2744 :
2745 :
2746 : /*
2747 : isInternal - return TRUE if sym is a constant lit which was declared
2748 : as internal.
2749 : */
2750 :
2751 8889726 : static bool isInternal (unsigned int sym)
2752 : {
2753 8889726 : return (SymbolTable_IsConstLit (sym)) && (SymbolTable_IsConstLitInternal (sym));
2754 : /* static analysis guarentees a RETURN statement will be used before here. */
2755 : __builtin_unreachable ();
2756 : }
2757 :
2758 :
2759 : /*
2760 : doCheck - keep obtaining an unresolved pair and check for the
2761 : type compatibility. This is the main check routine used by
2762 : parameter, assignment and expression compatibility.
2763 : It tests all unknown pairs and calls the appropriate
2764 : check function
2765 : */
2766 :
2767 4145717 : static bool doCheck (M2Check_tInfo tinfo)
2768 : {
2769 4145717 : M2Check_status result;
2770 4145717 : unsigned int left;
2771 4145717 : unsigned int right;
2772 :
2773 4145717 : if (debugging)
2774 : {
2775 : dumptInfo (tinfo);
2776 : }
2777 12732718 : while (get (tinfo->unresolved, &left, &right, M2Check_unknown))
2778 : {
2779 4471212 : if (debugging)
2780 : {
2781 : libc_printf ((const char *) "doCheck (%d, %d)\\n", 18, left, right);
2782 : dumptInfo (tinfo);
2783 : }
2784 4471212 : if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
2785 : {
2786 : /* Cannot test if a type is NulSym, we assume true.
2787 : It maybe that later on a symbols type is set and later
2788 : on checking will be called and more accurately resolved.
2789 : For example constant strings can be concatenated during
2790 : the quadruple folding phase. */
2791 : return true;
2792 : }
2793 4445844 : else if ((isInternal (left)) || (isInternal (right)))
2794 : {
2795 : /* avoid dangling else. */
2796 : /* Do not check constants which have been generated internally.
2797 : Currently these are generated by the default BY constant
2798 : value in a FOR loop. */
2799 3924 : return true;
2800 : }
2801 : /*
2802 : IF in (tinfo^.visited, left, right)
2803 : THEN
2804 : IF debugging
2805 : THEN
2806 : printf (" already visited (%d, %d)
2807 : ", left, right)
2808 : END ;
2809 : ELSE
2810 : IF debugging
2811 : THEN
2812 : printf (" not visited (%d, %d)
2813 : ", left, right)
2814 : END ;
2815 : */
2816 4441920 : result = (*tinfo->checkFunc.proc) (M2Check_unknown, tinfo, left, right);
2817 4441920 : if (isKnown (result))
2818 : {
2819 : /* Remove this pair from the unresolved list. */
2820 4141793 : exclude (tinfo->unresolved, left, right);
2821 : /* Add it to the resolved list. */
2822 4141793 : include (tinfo->resolved, left, right, result);
2823 4141793 : if (result == M2Check_false)
2824 : {
2825 : if (debugging)
2826 : {
2827 : libc_printf ((const char *) " known (%d, %d) false\\n", 26, left, right);
2828 : }
2829 : return false;
2830 : }
2831 : else
2832 : {
2833 : if (debugging)
2834 : {
2835 : libc_printf ((const char *) " known (%d, %d) true\\n", 25, left, right);
2836 : }
2837 : }
2838 : }
2839 : }
2840 : return true;
2841 : /* static analysis guarentees a RETURN statement will be used before here. */
2842 : __builtin_unreachable ();
2843 : }
2844 :
2845 :
2846 : /*
2847 : in - returns TRUE if the pair is in the list.
2848 : */
2849 :
2850 9260418 : static bool in (Indexing_Index pairs, unsigned int left, unsigned int right)
2851 : {
2852 9260418 : unsigned int i;
2853 9260418 : unsigned int n;
2854 9260418 : M2Check_pair p;
2855 :
2856 9260418 : i = 1;
2857 9260418 : n = Indexing_HighIndice (pairs);
2858 18878914 : while (i <= n)
2859 : {
2860 716559 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2861 716559 : if (((p != NULL) && (p->left == left)) && (p->right == right))
2862 : {
2863 : return true;
2864 : }
2865 358078 : i += 1;
2866 : }
2867 : return false;
2868 : /* static analysis guarentees a RETURN statement will be used before here. */
2869 : __builtin_unreachable ();
2870 : }
2871 :
2872 :
2873 : /*
2874 : newPair -
2875 : */
2876 :
2877 26872814 : static M2Check_pair newPair (void)
2878 : {
2879 26872814 : M2Check_pair p;
2880 :
2881 26872814 : if (pairFreeList == NULL)
2882 : {
2883 110838 : Storage_ALLOCATE ((void **) &p, sizeof (M2Check__T2));
2884 : }
2885 : else
2886 : {
2887 26761976 : p = pairFreeList;
2888 26761976 : pairFreeList = p->next;
2889 : }
2890 26872814 : M2Debug_Assert (p != NULL);
2891 26872814 : return p;
2892 : /* static analysis guarentees a RETURN statement will be used before here. */
2893 : __builtin_unreachable ();
2894 : }
2895 :
2896 :
2897 : /*
2898 : disposePair - adds pair, p, to the free list.
2899 : */
2900 :
2901 26872814 : static void disposePair (M2Check_pair p)
2902 : {
2903 26872814 : p->next = pairFreeList;
2904 12692795 : pairFreeList = p;
2905 14180019 : }
2906 :
2907 :
2908 : /*
2909 : deconstructIndex -
2910 : */
2911 :
2912 12437151 : static Indexing_Index deconstructIndex (Indexing_Index pairs)
2913 : {
2914 12437151 : M2Check_pair p;
2915 12437151 : unsigned int i;
2916 12437151 : unsigned int n;
2917 :
2918 12437151 : i = 1;
2919 12437151 : n = Indexing_HighIndice (pairs);
2920 51747116 : while (i <= n)
2921 : {
2922 26872814 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2923 26872814 : if (p != NULL)
2924 : {
2925 14180019 : disposePair (p);
2926 : }
2927 26872814 : i += 1;
2928 : }
2929 12437151 : return Indexing_KillIndex (pairs);
2930 : /* static analysis guarentees a RETURN statement will be used before here. */
2931 : __builtin_unreachable ();
2932 : }
2933 :
2934 :
2935 : /*
2936 : deconstruct - deallocate the List data structure.
2937 : */
2938 :
2939 4145717 : static void deconstruct (M2Check_tInfo tinfo)
2940 : {
2941 4145717 : tinfo->format = DynamicStrings_KillString (tinfo->format);
2942 4145717 : tinfo->reason = DynamicStrings_KillString (tinfo->reason);
2943 4145717 : tinfo->visited = deconstructIndex (tinfo->visited);
2944 4145717 : tinfo->resolved = deconstructIndex (tinfo->resolved);
2945 4145717 : tinfo->unresolved = deconstructIndex (tinfo->unresolved);
2946 4145717 : }
2947 :
2948 :
2949 : /*
2950 : newtInfo -
2951 : */
2952 :
2953 4145717 : static M2Check_tInfo newtInfo (void)
2954 : {
2955 4145717 : M2Check_tInfo tinfo;
2956 :
2957 4145717 : if (tinfoFreeList == NULL)
2958 : {
2959 4145717 : Storage_ALLOCATE ((void **) &tinfo, sizeof (M2Check__T3));
2960 : }
2961 : else
2962 : {
2963 0 : tinfo = tinfoFreeList;
2964 0 : tinfoFreeList = tinfoFreeList->next;
2965 : }
2966 4145717 : return tinfo;
2967 : /* static analysis guarentees a RETURN statement will be used before here. */
2968 : __builtin_unreachable ();
2969 : }
2970 :
2971 :
2972 : /*
2973 : collapseString - if the string, a, is "" then return NIL otherwise create
2974 : and return a dynamic string.
2975 : */
2976 :
2977 4145717 : static DynamicStrings_String collapseString (const char *a_, unsigned int _a_high)
2978 : {
2979 4145717 : char a[_a_high+1];
2980 :
2981 : /* make a local copy of each unbounded array. */
2982 4145717 : memcpy (a, a_, _a_high+1);
2983 :
2984 4145717 : if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "", 0))
2985 : {
2986 : return static_cast<DynamicStrings_String> (NULL);
2987 : }
2988 : else
2989 : {
2990 1564251 : return DynamicStrings_InitString ((const char *) a, _a_high);
2991 : }
2992 : /* static analysis guarentees a RETURN statement will be used before here. */
2993 : __builtin_unreachable ();
2994 4145717 : }
2995 :
2996 :
2997 : /*
2998 : doExpressionTypeCompatible -
2999 : */
3000 :
3001 230248 : static bool doExpressionTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int left, unsigned int right, bool strict)
3002 : {
3003 230248 : M2Check_tInfo tinfo;
3004 230248 : char format[_format_high+1];
3005 :
3006 : /* make a local copy of each unbounded array. */
3007 230248 : memcpy (format, format_, _format_high+1);
3008 :
3009 460496 : tinfo = newtInfo ();
3010 230248 : tinfo->reasonEnable = M2Options_StrictTypeReason;
3011 230248 : tinfo->reason = static_cast<DynamicStrings_String> (NULL);
3012 230248 : tinfo->format = collapseString ((const char *) format, _format_high);
3013 230248 : tinfo->token = token;
3014 230248 : tinfo->kind = M2Check_expression;
3015 230248 : tinfo->actual = SymbolTable_NulSym;
3016 230248 : tinfo->formal = SymbolTable_NulSym;
3017 230248 : tinfo->procedure = SymbolTable_NulSym;
3018 230248 : tinfo->nth = 0;
3019 230248 : tinfo->isvar = false;
3020 230248 : tinfo->error = static_cast<M2Error_Error> (NULL);
3021 230248 : tinfo->left = left;
3022 230248 : tinfo->right = right;
3023 230248 : tinfo->checkFunc.proc = static_cast<M2Check_typeCheckFunction_t> (determineCompatible);
3024 230248 : tinfo->visited = Indexing_InitIndex (1);
3025 230248 : tinfo->resolved = Indexing_InitIndex (1);
3026 230248 : tinfo->unresolved = Indexing_InitIndex (1);
3027 230248 : tinfo->strict = strict;
3028 230248 : tinfo->isin = false;
3029 230248 : include (tinfo->unresolved, left, right, M2Check_unknown);
3030 230248 : if (doCheck (tinfo))
3031 : {
3032 230056 : deconstruct (tinfo);
3033 230056 : return true;
3034 : }
3035 : else
3036 : {
3037 192 : deconstruct (tinfo);
3038 192 : return false;
3039 : }
3040 : /* static analysis guarentees a RETURN statement will be used before here. */
3041 : __builtin_unreachable ();
3042 230248 : }
3043 :
3044 :
3045 : /*
3046 : init - initialise all global data structures for this module.
3047 : */
3048 :
3049 14952 : static void init (void)
3050 : {
3051 14952 : pairFreeList = NULL;
3052 14952 : tinfoFreeList = NULL;
3053 14952 : errors = Indexing_InitIndex (1);
3054 14952 : InitEquivalenceArray ();
3055 14952 : }
3056 :
3057 :
3058 : /*
3059 : ParameterTypeCompatible - returns TRUE if the nth procedure parameter formal
3060 : is compatible with actual.
3061 : */
3062 :
3063 1104082 : extern "C" bool M2Check_ParameterTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int procedure, unsigned int formal, unsigned int actual, unsigned int nth, bool isvar)
3064 : {
3065 1104082 : unsigned int formalT;
3066 1104082 : unsigned int actualT;
3067 1104082 : M2Check_tInfo tinfo;
3068 1104082 : char format[_format_high+1];
3069 :
3070 : /* make a local copy of each unbounded array. */
3071 1104082 : memcpy (format, format_, _format_high+1);
3072 :
3073 2208164 : tinfo = newtInfo ();
3074 1104082 : formalT = getSType (formal);
3075 1104082 : actualT = getSType (actual);
3076 1104082 : tinfo->reasonEnable = M2Options_StrictTypeReason;
3077 1104082 : tinfo->reason = static_cast<DynamicStrings_String> (NULL);
3078 1104082 : tinfo->format = collapseString ((const char *) format, _format_high);
3079 1104082 : tinfo->token = token;
3080 1104082 : tinfo->kind = M2Check_parameter;
3081 1104082 : tinfo->actual = actual;
3082 1104082 : tinfo->formal = formal;
3083 1104082 : tinfo->procedure = procedure;
3084 1104082 : tinfo->nth = nth;
3085 1104082 : tinfo->isvar = isvar;
3086 1104082 : tinfo->error = static_cast<M2Error_Error> (NULL);
3087 1104082 : tinfo->left = formalT;
3088 1104082 : tinfo->right = actualT;
3089 1104082 : tinfo->checkFunc.proc = static_cast<M2Check_typeCheckFunction_t> (determineCompatible);
3090 1104082 : tinfo->visited = Indexing_InitIndex (1);
3091 1104082 : tinfo->resolved = Indexing_InitIndex (1);
3092 1104082 : tinfo->unresolved = Indexing_InitIndex (1);
3093 1104082 : tinfo->strict = false;
3094 1104082 : tinfo->isin = false;
3095 1104082 : include (tinfo->unresolved, actual, formal, M2Check_unknown);
3096 1104082 : if (debugging)
3097 : {
3098 : dumptInfo (tinfo);
3099 : }
3100 1104082 : if (doCheck (tinfo))
3101 : {
3102 1103914 : deconstruct (tinfo);
3103 1103914 : return true;
3104 : }
3105 : else
3106 : {
3107 168 : deconstruct (tinfo);
3108 168 : return false;
3109 : }
3110 : /* static analysis guarentees a RETURN statement will be used before here. */
3111 : __builtin_unreachable ();
3112 1104082 : }
3113 :
3114 :
3115 : /*
3116 : AssignmentTypeCompatible - returns TRUE if the des and the expr are assignment compatible.
3117 : */
3118 :
3119 2811387 : extern "C" bool M2Check_AssignmentTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int des, unsigned int expr, bool enableReason)
3120 : {
3121 2811387 : M2Check_tInfo tinfo;
3122 2811387 : char format[_format_high+1];
3123 :
3124 : /* make a local copy of each unbounded array. */
3125 2811387 : memcpy (format, format_, _format_high+1);
3126 :
3127 5622774 : tinfo = newtInfo ();
3128 2811387 : tinfo->reason = static_cast<DynamicStrings_String> (NULL);
3129 2811387 : tinfo->reasonEnable = enableReason && M2Options_StrictTypeReason;
3130 2811387 : tinfo->format = collapseString ((const char *) format, _format_high);
3131 2811387 : tinfo->token = token;
3132 2811387 : tinfo->kind = M2Check_assignment;
3133 2811387 : tinfo->actual = SymbolTable_NulSym;
3134 2811387 : tinfo->formal = SymbolTable_NulSym;
3135 2811387 : tinfo->procedure = SymbolTable_NulSym;
3136 2811387 : tinfo->nth = 0;
3137 2811387 : tinfo->isvar = false;
3138 2811387 : tinfo->error = static_cast<M2Error_Error> (NULL);
3139 2811387 : tinfo->left = des;
3140 2811387 : tinfo->right = expr;
3141 2811387 : tinfo->checkFunc.proc = static_cast<M2Check_typeCheckFunction_t> (determineCompatible);
3142 2811387 : tinfo->visited = Indexing_InitIndex (1);
3143 2811387 : tinfo->resolved = Indexing_InitIndex (1);
3144 2811387 : tinfo->unresolved = Indexing_InitIndex (1);
3145 2811387 : include (tinfo->unresolved, des, expr, M2Check_unknown);
3146 2811387 : tinfo->strict = false;
3147 2811387 : tinfo->isin = false;
3148 2811387 : if (doCheck (tinfo))
3149 : {
3150 2811111 : deconstruct (tinfo);
3151 2811111 : return true;
3152 : }
3153 : else
3154 : {
3155 276 : deconstruct (tinfo);
3156 276 : return false;
3157 : }
3158 : /* static analysis guarentees a RETURN statement will be used before here. */
3159 : __builtin_unreachable ();
3160 2811387 : }
3161 :
3162 :
3163 : /*
3164 : ExpressionTypeCompatible - returns TRUE if the expressions, left and right,
3165 : are expression compatible.
3166 : */
3167 :
3168 230248 : extern "C" bool M2Check_ExpressionTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int left, unsigned int right, bool strict, bool isin)
3169 : {
3170 230248 : char format[_format_high+1];
3171 :
3172 : /* make a local copy of each unbounded array. */
3173 230248 : memcpy (format, format_, _format_high+1);
3174 :
3175 230248 : if ((left != SymbolTable_NulSym) && (right != SymbolTable_NulSym))
3176 : {
3177 230248 : if (isin)
3178 : {
3179 7194 : if ((SymbolTable_IsConst (right)) || (SymbolTable_IsVar (right)))
3180 : {
3181 7194 : right = getSType (right);
3182 : }
3183 7194 : if (SymbolTable_IsSet (right))
3184 : {
3185 7158 : right = getSType (right);
3186 : }
3187 : }
3188 : }
3189 230248 : return doExpressionTypeCompatible (token, (const char *) format, _format_high, left, right, strict);
3190 : /* static analysis guarentees a RETURN statement will be used before here. */
3191 : __builtin_unreachable ();
3192 230248 : }
3193 :
3194 14952 : extern "C" void _M2_M2Check_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
3195 : {
3196 14952 : init ();
3197 14952 : }
3198 :
3199 0 : extern "C" void _M2_M2Check_fini (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
3200 : {
3201 0 : }
|