Branch data 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-2024 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 "GIndexing.h"
54 : : # include "GM2Error.h"
55 : : # include "GM2MetaError.h"
56 : : # include "GStrLib.h"
57 : : # include "GM2Debug.h"
58 : : # include "GSymbolTable.h"
59 : : # include "GM2GCCDeclare.h"
60 : : # include "GM2ALU.h"
61 : : # include "Gm2expr.h"
62 : : # include "GSymbolConversion.h"
63 : : # include "GDynamicStrings.h"
64 : : # include "GM2LexBuf.h"
65 : : # include "GStorage.h"
66 : : # include "GSYSTEM.h"
67 : : # include "Glibc.h"
68 : :
69 : : # define debugging false
70 : : typedef struct M2Check_typeCheckFunction_p M2Check_typeCheckFunction;
71 : :
72 : : typedef struct M2Check__T1_r M2Check__T1;
73 : :
74 : : typedef M2Check__T1 *M2Check_errorSig;
75 : :
76 : : typedef struct M2Check__T2_r M2Check__T2;
77 : :
78 : : typedef M2Check__T2 *M2Check_pair;
79 : :
80 : : typedef struct M2Check__T3_r M2Check__T3;
81 : :
82 : : typedef M2Check__T3 *M2Check_tInfo;
83 : :
84 : : typedef enum {M2Check_parameter, M2Check_assignment, M2Check_expression} M2Check_checkType;
85 : :
86 : : typedef enum {M2Check_true, M2Check_false, M2Check_unknown, M2Check_visited, M2Check_unused} M2Check_status;
87 : :
88 : : typedef M2Check_status (*M2Check_typeCheckFunction_t) (M2Check_status, M2Check_tInfo, unsigned int, unsigned int);
89 : : struct M2Check_typeCheckFunction_p { M2Check_typeCheckFunction_t proc; };
90 : :
91 : : struct M2Check__T1_r {
92 : : unsigned int token;
93 : : unsigned int left;
94 : : unsigned int right;
95 : : };
96 : :
97 : : struct M2Check__T2_r {
98 : : unsigned int left;
99 : : unsigned int right;
100 : : M2Check_status pairStatus;
101 : : M2Check_pair next;
102 : : };
103 : :
104 : : struct M2Check__T3_r {
105 : : DynamicStrings_String format;
106 : : M2Check_checkType kind;
107 : : unsigned int token;
108 : : unsigned int actual;
109 : : unsigned int formal;
110 : : unsigned int left;
111 : : unsigned int right;
112 : : unsigned int procedure;
113 : : unsigned int nth;
114 : : bool isvar;
115 : : bool strict;
116 : : bool isin;
117 : : M2Error_Error error;
118 : : M2Check_typeCheckFunction checkFunc;
119 : : Indexing_Index visited;
120 : : Indexing_Index resolved;
121 : : Indexing_Index unresolved;
122 : : M2Check_tInfo next;
123 : : };
124 : :
125 : : static M2Check_pair pairFreeList;
126 : : static M2Check_tInfo tinfoFreeList;
127 : : static Indexing_Index errors;
128 : :
129 : : /*
130 : : ParameterTypeCompatible - returns TRUE if the nth procedure parameter formal
131 : : is compatible with actual.
132 : : */
133 : :
134 : : 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);
135 : :
136 : : /*
137 : : AssignmentTypeCompatible - returns TRUE if the des and the expr are assignment compatible.
138 : : */
139 : :
140 : : extern "C" bool M2Check_AssignmentTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int des, unsigned int expr);
141 : :
142 : : /*
143 : : ExpressionTypeCompatible - returns TRUE if the expressions, left and right,
144 : : are expression compatible.
145 : : */
146 : :
147 : : 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);
148 : :
149 : : /*
150 : : dumpIndice -
151 : : */
152 : :
153 : : static void dumpIndice (M2Check_pair ptr);
154 : :
155 : : /*
156 : : dumpIndex -
157 : : */
158 : :
159 : : static void dumpIndex (const char *name_, unsigned int _name_high, Indexing_Index index);
160 : :
161 : : /*
162 : : dumptInfo -
163 : : */
164 : :
165 : : static void dumptInfo (M2Check_tInfo t);
166 : :
167 : : /*
168 : : isKnown - returns BOOLEAN:TRUE if result is status:true or status:false.
169 : : */
170 : :
171 : : static bool isKnown (M2Check_status result);
172 : :
173 : : /*
174 : : isFalse - returns BOOLEAN:TRUE if result is status:false
175 : : */
176 : :
177 : : static bool isFalse (M2Check_status result);
178 : :
179 : : /*
180 : : checkTypeEquivalence - returns TRUE if left and right can be skipped and found to be equal.
181 : : */
182 : :
183 : : static M2Check_status checkTypeEquivalence (M2Check_status result, unsigned int left, unsigned int right);
184 : :
185 : : /*
186 : : checkSubrange - check to see if subrange types left and right have the same limits.
187 : : */
188 : :
189 : : static M2Check_status checkSubrange (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
190 : :
191 : : /*
192 : : checkUnboundedArray - returns status if unbounded is parameter compatible with array.
193 : : It checks all type equivalences of the static array for a
194 : : match with the dynamic (unbounded) array.
195 : : */
196 : :
197 : : static M2Check_status checkUnboundedArray (M2Check_status result, unsigned int unbounded, unsigned int array);
198 : :
199 : : /*
200 : : checkUnboundedUnbounded - check to see if formal and actual are compatible.
201 : : Both are unbounded parameters.
202 : : */
203 : :
204 : : static M2Check_status checkUnboundedUnbounded (M2Check_status result, M2Check_tInfo tinfo, unsigned int formal, unsigned int actual);
205 : :
206 : : /*
207 : : checkUnbounded - check to see if the unbounded is type compatible with right.
208 : : This is only allowed during parameter passing.
209 : : */
210 : :
211 : : static M2Check_status checkUnbounded (M2Check_status result, M2Check_tInfo tinfo, unsigned int unbounded, unsigned int right);
212 : :
213 : : /*
214 : : checkArrayTypeEquivalence - check array and unbounded array type equivalence.
215 : : */
216 : :
217 : : static M2Check_status checkArrayTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
218 : :
219 : : /*
220 : : checkGenericTypeEquivalence - check left and right for generic equivalence.
221 : : */
222 : :
223 : : static M2Check_status checkGenericTypeEquivalence (M2Check_status result, unsigned int left, unsigned int right);
224 : :
225 : : /*
226 : : firstTime - returns TRUE if the triple (token, left, right) has not been seen before.
227 : : */
228 : :
229 : : static bool firstTime (unsigned int token, unsigned int left, unsigned int right);
230 : :
231 : : /*
232 : : buildError4 - generate a MetaString4 error. This is only used when checking
233 : : parameter compatibility.
234 : : */
235 : :
236 : : static void buildError4 (M2Check_tInfo tinfo, unsigned int left, unsigned int right);
237 : :
238 : : /*
239 : : buildError2 - generate a MetaString2 error. This is called by all three kinds of errors.
240 : : */
241 : :
242 : : static void buildError2 (M2Check_tInfo tinfo, unsigned int left, unsigned int right);
243 : :
244 : : /*
245 : : issueError -
246 : : */
247 : :
248 : : static M2Check_status issueError (bool result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
249 : :
250 : : /*
251 : : checkBaseEquivalence - the catch all check for types not specifically
252 : : handled by this module.
253 : : */
254 : :
255 : : static M2Check_status checkBaseEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
256 : :
257 : : /*
258 : : checkPair - check whether left and right are type compatible.
259 : : It will update the visited, unresolved list before
260 : : calling the docheckPair for the cascaded type checking.
261 : : Pre-condition: tinfo is initialized.
262 : : left and right are modula2 symbols.
263 : : Post-condition: tinfo visited, resolved, unresolved lists
264 : : are updated and the result status is
265 : : returned.
266 : : */
267 : :
268 : : static M2Check_status checkPair (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
269 : :
270 : : /*
271 : : useBaseCheck -
272 : : */
273 : :
274 : : static bool useBaseCheck (unsigned int sym);
275 : :
276 : : /*
277 : : checkBaseTypeEquivalence -
278 : : */
279 : :
280 : : static M2Check_status checkBaseTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
281 : :
282 : : /*
283 : : IsTyped - returns TRUE if sym will have a type.
284 : : */
285 : :
286 : : static bool IsTyped (unsigned int sym);
287 : :
288 : : /*
289 : : isLValue -
290 : : */
291 : :
292 : : static bool isLValue (unsigned int sym);
293 : :
294 : : /*
295 : : checkVarEquivalence - this test must be done early as it checks the symbol mode.
296 : : An LValue is treated as a pointer during assignment and the
297 : : LValue is attached to a variable. This function skips the variable
298 : : and checks the types - after it has considered a possible LValue.
299 : : */
300 : :
301 : : static M2Check_status checkVarEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
302 : :
303 : : /*
304 : : checkConstMeta - performs a very course grained check against
305 : : obviously incompatible type kinds.
306 : : If left is a const string then it checks right against char.
307 : : */
308 : :
309 : : static M2Check_status checkConstMeta (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
310 : :
311 : : /*
312 : : checkConstEquivalence - this check can be done first as it checks symbols which
313 : : may have no type. Ie constant strings. These constants
314 : : will likely have their type set during quadruple folding.
315 : : But we can check the meta type for obvious mismatches
316 : : early on. For example adding a string to an enum or set.
317 : : */
318 : :
319 : : static M2Check_status checkConstEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
320 : :
321 : : /*
322 : : checkSubrangeTypeEquivalence -
323 : : */
324 : :
325 : : static M2Check_status checkSubrangeTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
326 : :
327 : : /*
328 : : isZRC -
329 : : */
330 : :
331 : : static bool isZRC (unsigned int zrc, unsigned int sym);
332 : :
333 : : /*
334 : : isSameSizeConst -
335 : :
336 : : */
337 : :
338 : : static bool isSameSizeConst (unsigned int a, unsigned int b);
339 : :
340 : : /*
341 : : isSameSize - should only be called if either a or b are WORD, BYTE, etc.
342 : : */
343 : :
344 : : static bool isSameSize (unsigned int a, unsigned int b);
345 : :
346 : : /*
347 : : checkSystemEquivalence - check whether left and right are system types and whether they have the same size.
348 : : */
349 : :
350 : : static M2Check_status checkSystemEquivalence (M2Check_status result, unsigned int left, unsigned int right);
351 : :
352 : : /*
353 : : checkTypeKindViolation - returns false if one operand left or right is
354 : : a set, record or array.
355 : : */
356 : :
357 : : static M2Check_status checkTypeKindViolation (M2Check_status result, unsigned int left, unsigned int right);
358 : :
359 : : /*
360 : : doCheckPair - invoke a series of ordered type checks checking compatibility
361 : : between left and right modula2 symbols.
362 : : Pre-condition: left and right are modula-2 symbols.
363 : : tinfo is configured.
364 : : Post-condition: status is returned determining the
365 : : correctness of the type check.
366 : : The tinfo resolved, unresolved, visited
367 : : lists will be updated.
368 : : */
369 : :
370 : : static M2Check_status doCheckPair (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
371 : :
372 : : /*
373 : : checkProcType -
374 : : */
375 : :
376 : : static M2Check_status checkProcType (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
377 : :
378 : : /*
379 : : checkProcedureProcType -
380 : : */
381 : :
382 : : static M2Check_status checkProcedureProcType (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
383 : :
384 : : /*
385 : : checkProcedure -
386 : : */
387 : :
388 : : static M2Check_status checkProcedure (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
389 : :
390 : : /*
391 : : checkEnumerationEquivalence -
392 : : */
393 : :
394 : : static M2Check_status checkEnumerationEquivalence (M2Check_status result, unsigned int left, unsigned int right);
395 : :
396 : : /*
397 : : checkPointerType - check whether left and right are equal or are of type ADDRESS.
398 : : */
399 : :
400 : : static M2Check_status checkPointerType (M2Check_status result, unsigned int left, unsigned int right);
401 : :
402 : : /*
403 : : checkProcTypeEquivalence - allow proctype to be compared against another
404 : : proctype or procedure. It is legal to be compared
405 : : against an address.
406 : : */
407 : :
408 : : static M2Check_status checkProcTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
409 : :
410 : : /*
411 : : checkTypeKindEquivalence -
412 : : */
413 : :
414 : : static M2Check_status checkTypeKindEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
415 : :
416 : : /*
417 : : isSkipEquivalence -
418 : : */
419 : :
420 : : static bool isSkipEquivalence (unsigned int left, unsigned int right);
421 : :
422 : : /*
423 : : checkValueEquivalence - check to see if left and right values are the same.
424 : : */
425 : :
426 : : static M2Check_status checkValueEquivalence (M2Check_status result, unsigned int left, unsigned int right);
427 : :
428 : : /*
429 : : and -
430 : : */
431 : :
432 : : static M2Check_status and_ (M2Check_status left, M2Check_status right);
433 : :
434 : : /*
435 : : checkTypeRangeEquivalence -
436 : : */
437 : :
438 : : static M2Check_status checkTypeRangeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
439 : :
440 : : /*
441 : : include - include pair left:right into pairs with status, s.
442 : : */
443 : :
444 : : static void include (Indexing_Index pairs, unsigned int left, unsigned int right, M2Check_status s);
445 : :
446 : : /*
447 : : exclude - exclude pair left:right from pairs.
448 : : */
449 : :
450 : : static void exclude (Indexing_Index pairs, unsigned int left, unsigned int right);
451 : :
452 : : /*
453 : : getStatus -
454 : : */
455 : :
456 : : static M2Check_status getStatus (Indexing_Index pairs, unsigned int left, unsigned int right);
457 : :
458 : : /*
459 : : return -
460 : : */
461 : :
462 : : static M2Check_status return_ (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
463 : :
464 : : /*
465 : : checkSkipEquivalence - return true if left right are equivalent.
466 : : */
467 : :
468 : : static M2Check_status checkSkipEquivalence (M2Check_status result, unsigned int left, unsigned int right);
469 : :
470 : : /*
471 : : checkSetEquivalent - compares set types, left and right.
472 : : */
473 : :
474 : : static M2Check_status checkSetEquivalent (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
475 : :
476 : : /*
477 : : checkRecordEquivalence - compares record types, left and right.
478 : : */
479 : :
480 : : static M2Check_status checkRecordEquivalence (M2Check_status result, unsigned int left, unsigned int right);
481 : :
482 : : /*
483 : : getType - only returns the type of symbol providing it is not a procedure.
484 : : */
485 : :
486 : : static unsigned int getType (unsigned int sym);
487 : :
488 : : /*
489 : : getSType -
490 : : */
491 : :
492 : : static unsigned int getSType (unsigned int sym);
493 : :
494 : : /*
495 : : determineCompatible - check for compatibility by checking
496 : : equivalence, array, generic and type kind.
497 : : */
498 : :
499 : : static M2Check_status determineCompatible (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right);
500 : :
501 : : /*
502 : : get -
503 : : */
504 : :
505 : : static bool get (Indexing_Index pairs, unsigned int *left, unsigned int *right, M2Check_status s);
506 : :
507 : : /*
508 : : isInternal - return TRUE if sym is a constant lit which was declared
509 : : as internal.
510 : : */
511 : :
512 : : static bool isInternal (unsigned int sym);
513 : :
514 : : /*
515 : : doCheck - keep obtaining an unresolved pair and check for the
516 : : type compatibility. This is the main check routine used by
517 : : parameter, assignment and expression compatibility.
518 : : It tests all unknown pairs and calls the appropriate
519 : : check function
520 : : */
521 : :
522 : : static bool doCheck (M2Check_tInfo tinfo);
523 : :
524 : : /*
525 : : in - returns TRUE if the pair is in the list.
526 : : */
527 : :
528 : : static bool in (Indexing_Index pairs, unsigned int left, unsigned int right);
529 : :
530 : : /*
531 : : newPair -
532 : : */
533 : :
534 : : static M2Check_pair newPair (void);
535 : :
536 : : /*
537 : : disposePair - adds pair, p, to the free list.
538 : : */
539 : :
540 : : static void disposePair (M2Check_pair p);
541 : :
542 : : /*
543 : : deconstructIndex -
544 : : */
545 : :
546 : : static Indexing_Index deconstructIndex (Indexing_Index pairs);
547 : :
548 : : /*
549 : : deconstruct - deallocate the List data structure.
550 : : */
551 : :
552 : : static void deconstruct (M2Check_tInfo tinfo);
553 : :
554 : : /*
555 : : newtInfo -
556 : : */
557 : :
558 : : static M2Check_tInfo newtInfo (void);
559 : :
560 : : /*
561 : : collapseString - if the string, a, is "" then return NIL otherwise create
562 : : and return a dynamic string.
563 : : */
564 : :
565 : : static DynamicStrings_String collapseString (const char *a_, unsigned int _a_high);
566 : :
567 : : /*
568 : : doExpressionTypeCompatible -
569 : : */
570 : :
571 : : static bool doExpressionTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int left, unsigned int right, bool strict);
572 : :
573 : : /*
574 : : init - initialise all global data structures for this module.
575 : : */
576 : :
577 : : static void init (void);
578 : :
579 : :
580 : : /*
581 : : dumpIndice -
582 : : */
583 : :
584 : 0 : static void dumpIndice (M2Check_pair ptr)
585 : : {
586 : 0 : libc_printf ((const char *) " left (%d), right (%d), status ", 31, ptr->left, ptr->right);
587 : 0 : switch (ptr->pairStatus)
588 : : {
589 : 0 : case M2Check_true:
590 : 0 : libc_printf ((const char *) "true", 4);
591 : 0 : break;
592 : :
593 : 0 : case M2Check_false:
594 : 0 : libc_printf ((const char *) "false", 5);
595 : 0 : break;
596 : :
597 : 0 : case M2Check_unknown:
598 : 0 : libc_printf ((const char *) "unknown", 7);
599 : 0 : break;
600 : :
601 : 0 : case M2Check_visited:
602 : 0 : libc_printf ((const char *) "visited", 7);
603 : 0 : break;
604 : :
605 : 0 : case M2Check_unused:
606 : 0 : libc_printf ((const char *) "unused", 6);
607 : 0 : break;
608 : :
609 : :
610 : 0 : default:
611 : 0 : CaseException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Check.def", 20, 1);
612 : 0 : __builtin_unreachable ();
613 : : }
614 : 0 : libc_printf ((const char *) "\\n", 2);
615 : 0 : }
616 : :
617 : :
618 : : /*
619 : : dumpIndex -
620 : : */
621 : :
622 : 0 : static void dumpIndex (const char *name_, unsigned int _name_high, Indexing_Index index)
623 : : {
624 : 0 : char name[_name_high+1];
625 : :
626 : : /* make a local copy of each unbounded array. */
627 : 0 : memcpy (name, name_, _name_high+1);
628 : :
629 : 0 : libc_printf ((const char *) "status: %s\\n", 12, const_cast<void*> (static_cast<const void*>(name)));
630 : 0 : Indexing_ForeachIndiceInIndexDo (index, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) dumpIndice});
631 : 0 : }
632 : :
633 : :
634 : : /*
635 : : dumptInfo -
636 : : */
637 : :
638 : 0 : static void dumptInfo (M2Check_tInfo t)
639 : : {
640 : 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);
641 : 0 : dumpIndex ((const char *) "visited", 7, t->visited);
642 : 0 : dumpIndex ((const char *) "resolved", 8, t->resolved);
643 : 0 : dumpIndex ((const char *) "unresolved", 10, t->unresolved);
644 : 0 : }
645 : :
646 : :
647 : : /*
648 : : isKnown - returns BOOLEAN:TRUE if result is status:true or status:false.
649 : : */
650 : :
651 : 24109926 : static bool isKnown (M2Check_status result)
652 : : {
653 : 24109926 : return ((result == M2Check_true) || (result == M2Check_false)) || (result == M2Check_visited);
654 : : /* static analysis guarentees a RETURN statement will be used before here. */
655 : : __builtin_unreachable ();
656 : : }
657 : :
658 : :
659 : : /*
660 : : isFalse - returns BOOLEAN:TRUE if result is status:false
661 : : */
662 : :
663 : 0 : static bool isFalse (M2Check_status result)
664 : : {
665 : 0 : return result == M2Check_false;
666 : : /* static analysis guarentees a RETURN statement will be used before here. */
667 : : __builtin_unreachable ();
668 : : }
669 : :
670 : :
671 : : /*
672 : : checkTypeEquivalence - returns TRUE if left and right can be skipped and found to be equal.
673 : : */
674 : :
675 : 596694 : static M2Check_status checkTypeEquivalence (M2Check_status result, unsigned int left, unsigned int right)
676 : : {
677 : 596694 : unsigned int leftT;
678 : 596694 : unsigned int rightT;
679 : :
680 : : /* firstly check to see if we already have resolved this as false. */
681 : 596694 : if (isFalse (result))
682 : : {
683 : : return result;
684 : : }
685 : : else
686 : : {
687 : : /* check to see if we dont care about left or right. */
688 : 596694 : if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
689 : : {
690 : : return M2Check_true;
691 : : }
692 : : else
693 : : {
694 : 596694 : leftT = SymbolTable_SkipType (left);
695 : 596694 : rightT = SymbolTable_SkipType (right);
696 : 596694 : if (leftT == rightT)
697 : : {
698 : : return M2Check_true;
699 : : }
700 : 589446 : else if ((SymbolTable_IsType (leftT)) && (SymbolTable_IsType (rightT)))
701 : : {
702 : : /* avoid dangling else. */
703 : : /* the fundamental types are definitely different. */
704 : : return M2Check_false;
705 : : }
706 : : }
707 : : }
708 : : return result;
709 : : /* static analysis guarentees a RETURN statement will be used before here. */
710 : : __builtin_unreachable ();
711 : : }
712 : :
713 : :
714 : : /*
715 : : checkSubrange - check to see if subrange types left and right have the same limits.
716 : : */
717 : :
718 : 198 : static M2Check_status checkSubrange (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
719 : : {
720 : 198 : unsigned int lLow;
721 : 198 : unsigned int rLow;
722 : 198 : unsigned int lHigh;
723 : 198 : unsigned int rHigh;
724 : :
725 : : /* firstly check to see if we already have resolved this as false. */
726 : 198 : if (isFalse (result))
727 : : {
728 : : return result;
729 : : }
730 : : else
731 : : {
732 : 198 : M2Debug_Assert (SymbolTable_IsSubrange (left));
733 : 198 : M2Debug_Assert (SymbolTable_IsSubrange (right));
734 : 198 : lLow = M2GCCDeclare_GetTypeMin (left);
735 : 198 : lHigh = M2GCCDeclare_GetTypeMax (left);
736 : 198 : rLow = M2GCCDeclare_GetTypeMin (right);
737 : 198 : rHigh = M2GCCDeclare_GetTypeMax (right);
738 : 198 : M2ALU_PushIntegerTree (SymbolConversion_Mod2Gcc (lLow));
739 : 198 : M2ALU_PushIntegerTree (SymbolConversion_Mod2Gcc (rLow));
740 : 198 : if (! (M2ALU_Equ (tinfo->token)))
741 : : {
742 : : return M2Check_false;
743 : : }
744 : 198 : M2ALU_PushIntegerTree (SymbolConversion_Mod2Gcc (lHigh));
745 : 198 : M2ALU_PushIntegerTree (SymbolConversion_Mod2Gcc (rHigh));
746 : 198 : if (! (M2ALU_Equ (tinfo->token)))
747 : : {
748 : : return M2Check_false;
749 : : }
750 : : }
751 : : return M2Check_true;
752 : : /* static analysis guarentees a RETURN statement will be used before here. */
753 : : __builtin_unreachable ();
754 : : }
755 : :
756 : :
757 : : /*
758 : : checkUnboundedArray - returns status if unbounded is parameter compatible with array.
759 : : It checks all type equivalences of the static array for a
760 : : match with the dynamic (unbounded) array.
761 : : */
762 : :
763 : 7194 : static M2Check_status checkUnboundedArray (M2Check_status result, unsigned int unbounded, unsigned int array)
764 : : {
765 : 7194 : unsigned int dim;
766 : 7194 : unsigned int ubtype;
767 : 7194 : unsigned int type;
768 : :
769 : : /* Firstly check to see if we have resolved this as false. */
770 : 7194 : if (isFalse (result))
771 : : {
772 : : return result;
773 : : }
774 : : else
775 : : {
776 : 7194 : M2Debug_Assert (SymbolTable_IsUnbounded (unbounded));
777 : 7194 : M2Debug_Assert (SymbolTable_IsArray (array));
778 : 7194 : dim = SymbolTable_GetDimension (unbounded);
779 : 7194 : ubtype = SymbolTable_GetType (unbounded);
780 : 7194 : type = array;
781 : 7344 : do {
782 : 7344 : type = SymbolTable_GetType (type);
783 : 7344 : dim -= 1;
784 : : /* Check type equivalences. */
785 : 7344 : if ((checkTypeEquivalence (result, type, ubtype)) == M2Check_true)
786 : : {
787 : : return M2Check_true;
788 : : }
789 : 246 : type = SymbolTable_SkipType (type);
790 : : /* If we have run out of dimensions we conclude false. */
791 : 246 : if (dim == 0)
792 : : {
793 : : return M2Check_false;
794 : : }
795 : 150 : } while (! (! (SymbolTable_IsArray (type))));
796 : : }
797 : : return M2Check_false;
798 : : /* static analysis guarentees a RETURN statement will be used before here. */
799 : : __builtin_unreachable ();
800 : : }
801 : :
802 : :
803 : : /*
804 : : checkUnboundedUnbounded - check to see if formal and actual are compatible.
805 : : Both are unbounded parameters.
806 : : */
807 : :
808 : 12 : static M2Check_status checkUnboundedUnbounded (M2Check_status result, M2Check_tInfo tinfo, unsigned int formal, unsigned int actual)
809 : : {
810 : : /* Firstly check to see if we have resolved this as false. */
811 : 12 : if (isFalse (result))
812 : : {
813 : : return result;
814 : : }
815 : : else
816 : : {
817 : 12 : M2Debug_Assert (SymbolTable_IsUnbounded (formal));
818 : 12 : M2Debug_Assert (SymbolTable_IsUnbounded (actual));
819 : : /* The actual parameter above might be a different symbol to the actual parameter
820 : : symbol in the tinfo. So we must compare the original actual parameter against
821 : : the formal.
822 : : The actual above maybe a temporary which is created after derefencing an array.
823 : : For example 'bar[10]' where bar is defined as ARRAY OF ARRAY OF CARDINAL.
824 : : The GetDimension for 'bar[10]' is 1 indicating that one dimension has been
825 : : referenced. We use GetDimension for 'bar' which is 2. */
826 : 12 : if ((SymbolTable_GetDimension (formal)) != (SymbolTable_GetDimension (tinfo->actual)))
827 : : {
828 : : return M2Check_false;
829 : : }
830 : 12 : if ((checkTypeEquivalence (result, SymbolTable_GetType (formal), SymbolTable_GetType (actual))) == M2Check_true)
831 : : {
832 : : return M2Check_true;
833 : : }
834 : : }
835 : : return M2Check_false;
836 : : /* static analysis guarentees a RETURN statement will be used before here. */
837 : : __builtin_unreachable ();
838 : : }
839 : :
840 : :
841 : : /*
842 : : checkUnbounded - check to see if the unbounded is type compatible with right.
843 : : This is only allowed during parameter passing.
844 : : */
845 : :
846 : 7230 : static M2Check_status checkUnbounded (M2Check_status result, M2Check_tInfo tinfo, unsigned int unbounded, unsigned int right)
847 : : {
848 : : /* Firstly check to see if we have resolved this as false. */
849 : 7230 : if (isFalse (result))
850 : : {
851 : : return result;
852 : : }
853 : : else
854 : : {
855 : 7230 : M2Debug_Assert (SymbolTable_IsUnbounded (unbounded));
856 : 7230 : if (tinfo->kind == M2Check_parameter)
857 : : {
858 : : /* avoid gcc warning by using compound statement even if not strictly necessary. */
859 : : /* Check the unbounded data type against the type of right, SYSTEM types
860 : : are compared by the caller, so no need to test for them again. */
861 : 7206 : if (isSkipEquivalence (SymbolTable_GetType (unbounded), right))
862 : : {
863 : : return M2Check_true;
864 : : }
865 : 7206 : else if (SymbolTable_IsType (right))
866 : : {
867 : : /* avoid dangling else. */
868 : 0 : if ((SymbolTable_GetType (right)) == SymbolTable_NulSym)
869 : : {
870 : : /* Base type check. */
871 : 0 : return checkPair (result, tinfo, SymbolTable_GetType (unbounded), right);
872 : : }
873 : : else
874 : : {
875 : : /* It is safe to GetType (right) and we check the pair
876 : : [unbounded, GetType (right)]. */
877 : 0 : return checkPair (result, tinfo, unbounded, SymbolTable_GetType (right));
878 : : }
879 : : }
880 : 7206 : else if (SymbolTable_IsArray (right))
881 : : {
882 : : /* avoid dangling else. */
883 : 7194 : return checkUnboundedArray (result, unbounded, right);
884 : : }
885 : 12 : else if (SymbolTable_IsUnbounded (right))
886 : : {
887 : : /* avoid dangling else. */
888 : 12 : return checkUnboundedUnbounded (result, tinfo, unbounded, right);
889 : : }
890 : : }
891 : : }
892 : : return M2Check_false;
893 : : /* static analysis guarentees a RETURN statement will be used before here. */
894 : : __builtin_unreachable ();
895 : : }
896 : :
897 : :
898 : : /*
899 : : checkArrayTypeEquivalence - check array and unbounded array type equivalence.
900 : : */
901 : :
902 : 589176 : static M2Check_status checkArrayTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
903 : : {
904 : 589176 : unsigned int lSub;
905 : 589176 : unsigned int rSub;
906 : :
907 : 589176 : if (isFalse (result))
908 : : {
909 : : return result;
910 : : }
911 : 589176 : else if ((SymbolTable_IsArray (left)) && (SymbolTable_IsArray (right)))
912 : : {
913 : : /* avoid dangling else. */
914 : 198 : lSub = SymbolTable_GetArraySubscript (left);
915 : 198 : rSub = SymbolTable_GetArraySubscript (right);
916 : 198 : result = checkPair (result, tinfo, SymbolTable_GetSType (left), SymbolTable_GetSType (right));
917 : 198 : if ((lSub != SymbolTable_NulSym) && (rSub != SymbolTable_NulSym))
918 : : {
919 : 198 : result = checkSubrange (result, tinfo, getSType (lSub), getSType (rSub));
920 : : }
921 : : }
922 : 588978 : else if ((SymbolTable_IsUnbounded (left)) && ((SymbolTable_IsArray (right)) || (SymbolTable_IsUnbounded (right))))
923 : : {
924 : : /* avoid dangling else. */
925 : 60 : if ((M2System_IsGenericSystemType (getSType (left))) || (M2System_IsGenericSystemType (getSType (right))))
926 : : {
927 : 24 : return M2Check_true;
928 : : }
929 : : else
930 : : {
931 : 36 : result = checkUnbounded (result, tinfo, left, right);
932 : : }
933 : : }
934 : 588918 : else if ((SymbolTable_IsUnbounded (right)) && ((SymbolTable_IsArray (left)) || (SymbolTable_IsUnbounded (left))))
935 : : {
936 : : /* avoid dangling else. */
937 : 7206 : if ((M2System_IsGenericSystemType (getSType (right))) || (M2System_IsGenericSystemType (getSType (left))))
938 : : {
939 : 12 : return M2Check_true;
940 : : }
941 : : else
942 : : {
943 : 7194 : result = checkUnbounded (result, tinfo, right, left);
944 : : }
945 : : }
946 : 581712 : else if ((SymbolTable_IsArray (left)) && (SymbolTable_IsConst (right)))
947 : : {
948 : : /* avoid dangling else. */
949 : 0 : result = checkPair (result, tinfo, SymbolTable_GetType (left), SymbolTable_GetType (right));
950 : : }
951 : 581712 : else if ((SymbolTable_IsArray (right)) && (SymbolTable_IsConst (left)))
952 : : {
953 : : /* avoid dangling else. */
954 : 0 : result = checkPair (result, tinfo, SymbolTable_GetType (left), SymbolTable_GetType (right));
955 : : }
956 : : return result;
957 : : /* static analysis guarentees a RETURN statement will be used before here. */
958 : : __builtin_unreachable ();
959 : : }
960 : :
961 : :
962 : : /*
963 : : checkGenericTypeEquivalence - check left and right for generic equivalence.
964 : : */
965 : :
966 : 0 : static M2Check_status checkGenericTypeEquivalence (M2Check_status result, unsigned int left, unsigned int right)
967 : : {
968 : 0 : if (isFalse (result))
969 : : {
970 : : return result;
971 : : }
972 : 0 : else if (left == right)
973 : : {
974 : : /* avoid dangling else. */
975 : : return M2Check_true;
976 : : }
977 : : else
978 : : {
979 : : /* avoid dangling else. */
980 : 0 : return result;
981 : : }
982 : : /* static analysis guarentees a RETURN statement will be used before here. */
983 : : __builtin_unreachable ();
984 : : }
985 : :
986 : :
987 : : /*
988 : : firstTime - returns TRUE if the triple (token, left, right) has not been seen before.
989 : : */
990 : :
991 : 576 : static bool firstTime (unsigned int token, unsigned int left, unsigned int right)
992 : : {
993 : 576 : M2Check_errorSig p;
994 : 576 : unsigned int i;
995 : 576 : unsigned int n;
996 : :
997 : 576 : i = 1;
998 : 576 : n = Indexing_HighIndice (errors);
999 : 1338 : while (i <= n)
1000 : : {
1001 : 522 : p = static_cast<M2Check_errorSig> (Indexing_GetIndice (errors, i));
1002 : 522 : if (((p->token == token) && (p->left == left)) && (p->right == right))
1003 : : {
1004 : : return false;
1005 : : }
1006 : 186 : i += 1;
1007 : : }
1008 : 240 : Storage_ALLOCATE ((void **) &p, sizeof (M2Check__T1));
1009 : 240 : p->token = token;
1010 : 240 : p->left = left;
1011 : 240 : p->right = right;
1012 : 240 : Indexing_IncludeIndiceIntoIndex (errors, reinterpret_cast <void *> (p));
1013 : 240 : return true;
1014 : : /* static analysis guarentees a RETURN statement will be used before here. */
1015 : : __builtin_unreachable ();
1016 : : }
1017 : :
1018 : :
1019 : : /*
1020 : : buildError4 - generate a MetaString4 error. This is only used when checking
1021 : : parameter compatibility.
1022 : : */
1023 : :
1024 : 432 : static void buildError4 (M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1025 : : {
1026 : 432 : DynamicStrings_String s;
1027 : :
1028 : 432 : if (firstTime (tinfo->token, left, right))
1029 : : {
1030 : 96 : if (tinfo->error == NULL)
1031 : : {
1032 : : /* need to create top level error message first. */
1033 : 96 : tinfo->error = M2Error_NewError (tinfo->token);
1034 : : /* The parameters to MetaString4 in buildError4 must match the order
1035 : : of paramters passed to ParameterTypeCompatible. */
1036 : 96 : s = M2MetaError_MetaString4 (tinfo->format, tinfo->procedure, tinfo->formal, tinfo->actual, tinfo->nth);
1037 : 96 : M2Error_ErrorString (tinfo->error, s);
1038 : : }
1039 : : /* and also generate a sub error containing detail. */
1040 : 96 : if ((left != tinfo->left) || (right != tinfo->right))
1041 : : {
1042 : 96 : tinfo->error = M2Error_ChainError (tinfo->token, tinfo->error);
1043 : 96 : s = M2MetaError_MetaString2 (DynamicStrings_InitString ((const char *) "{%1Ead} and {%2ad} are incompatible as formal and actual procedure parameters", 77), left, right);
1044 : 96 : M2Error_ErrorString (tinfo->error, s);
1045 : : }
1046 : : }
1047 : 432 : }
1048 : :
1049 : :
1050 : : /*
1051 : : buildError2 - generate a MetaString2 error. This is called by all three kinds of errors.
1052 : : */
1053 : :
1054 : 144 : static void buildError2 (M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1055 : : {
1056 : 144 : DynamicStrings_String s;
1057 : :
1058 : 144 : if (firstTime (tinfo->token, left, right))
1059 : : {
1060 : 144 : if (tinfo->error == NULL)
1061 : : {
1062 : : /* Need to create top level error message first. */
1063 : 144 : tinfo->error = M2Error_NewError (tinfo->token);
1064 : 144 : s = M2MetaError_MetaString2 (tinfo->format, tinfo->left, tinfo->right);
1065 : 144 : M2Error_ErrorString (tinfo->error, s);
1066 : : }
1067 : : /* Also generate a sub error containing detail. */
1068 : 144 : if ((left != tinfo->left) || (right != tinfo->right))
1069 : : {
1070 : 132 : tinfo->error = M2Error_ChainError (tinfo->token, tinfo->error);
1071 : 132 : switch (tinfo->kind)
1072 : : {
1073 : 0 : case M2Check_parameter:
1074 : 0 : s = M2MetaError_MetaString2 (DynamicStrings_InitString ((const char *) "{%1Ead} and {%2ad} are incompatible as formal and actual procedure parameters", 77), left, right);
1075 : 0 : break;
1076 : :
1077 : 0 : case M2Check_assignment:
1078 : 0 : s = M2MetaError_MetaString2 (DynamicStrings_InitString ((const char *) "{%1Ead} and {%2ad} are assignment incompatible", 46), left, right);
1079 : 0 : break;
1080 : :
1081 : 132 : case M2Check_expression:
1082 : 132 : s = M2MetaError_MetaString2 (DynamicStrings_InitString ((const char *) "{%1Ead} and {%2ad} are expression incompatible", 46), left, right);
1083 : 132 : break;
1084 : :
1085 : :
1086 : 0 : default:
1087 : 0 : CaseException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Check.def", 20, 1);
1088 : 0 : __builtin_unreachable ();
1089 : : }
1090 : 132 : M2Error_ErrorString (tinfo->error, s);
1091 : : }
1092 : : }
1093 : 144 : }
1094 : :
1095 : :
1096 : : /*
1097 : : issueError -
1098 : : */
1099 : :
1100 : 325556 : static M2Check_status issueError (bool result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1101 : : {
1102 : 325556 : if (result)
1103 : : {
1104 : : return M2Check_true;
1105 : : }
1106 : : else
1107 : : {
1108 : : /* check whether errors are required. */
1109 : 4804 : if (tinfo->format != NULL)
1110 : : {
1111 : 576 : switch (tinfo->kind)
1112 : : {
1113 : 432 : case M2Check_parameter:
1114 : 432 : buildError4 (tinfo, left, right);
1115 : 432 : break;
1116 : :
1117 : 0 : case M2Check_assignment:
1118 : 0 : buildError2 (tinfo, left, right);
1119 : 0 : break;
1120 : :
1121 : 144 : case M2Check_expression:
1122 : 144 : buildError2 (tinfo, left, right);
1123 : 144 : break;
1124 : :
1125 : :
1126 : 0 : default:
1127 : 0 : CaseException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Check.def", 20, 1);
1128 : 0 : __builtin_unreachable ();
1129 : : }
1130 : 576 : tinfo->format = static_cast<DynamicStrings_String> (NULL); /* string is used by MetaError now. */
1131 : : }
1132 : 4804 : return M2Check_false;
1133 : : }
1134 : : /* static analysis guarentees a RETURN statement will be used before here. */
1135 : : __builtin_unreachable ();
1136 : : }
1137 : :
1138 : :
1139 : : /*
1140 : : checkBaseEquivalence - the catch all check for types not specifically
1141 : : handled by this module.
1142 : : */
1143 : :
1144 : 320986 : static M2Check_status checkBaseEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1145 : : {
1146 : 320986 : if (isKnown (result))
1147 : : {
1148 : : return result;
1149 : : }
1150 : : else
1151 : : {
1152 : 320986 : switch (tinfo->kind)
1153 : : {
1154 : 74516 : case M2Check_parameter:
1155 : 74516 : if (tinfo->isvar)
1156 : : {
1157 : 48 : return issueError (M2Base_IsExpressionCompatible (left, right), tinfo, left, right);
1158 : : }
1159 : : else
1160 : : {
1161 : 74468 : return issueError (M2Base_IsAssignmentCompatible (left, right), tinfo, left, right);
1162 : : }
1163 : 191348 : break;
1164 : :
1165 : 191348 : case M2Check_assignment:
1166 : 191348 : return issueError (M2Base_IsAssignmentCompatible (left, right), tinfo, left, right);
1167 : 55122 : break;
1168 : :
1169 : 55122 : case M2Check_expression:
1170 : 55122 : if (tinfo->isin)
1171 : : {
1172 : 0 : if ((SymbolTable_IsVar (right)) || (SymbolTable_IsConst (right)))
1173 : : {
1174 : 0 : right = getSType (right);
1175 : : }
1176 : : }
1177 : 55122 : if (tinfo->strict)
1178 : : {
1179 : 41746 : return issueError (M2Base_IsComparisonCompatible (left, right), tinfo, left, right);
1180 : : }
1181 : : else
1182 : : {
1183 : 13376 : return issueError (M2Base_IsExpressionCompatible (left, right), tinfo, left, right);
1184 : : }
1185 : 0 : break;
1186 : :
1187 : :
1188 : 0 : default:
1189 : 0 : M2Error_InternalError ((const char *) "unexpected kind value", 21);
1190 : : break;
1191 : : }
1192 : : }
1193 : : /* should never reach here. */
1194 : : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Check.def", 20, 1);
1195 : : __builtin_unreachable ();
1196 : : }
1197 : :
1198 : :
1199 : : /*
1200 : : checkPair - check whether left and right are type compatible.
1201 : : It will update the visited, unresolved list before
1202 : : calling the docheckPair for the cascaded type checking.
1203 : : Pre-condition: tinfo is initialized.
1204 : : left and right are modula2 symbols.
1205 : : Post-condition: tinfo visited, resolved, unresolved lists
1206 : : are updated and the result status is
1207 : : returned.
1208 : : */
1209 : :
1210 : 3415477 : static M2Check_status checkPair (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1211 : : {
1212 : 3415477 : if (isFalse (result))
1213 : : {
1214 : 0 : exclude (tinfo->visited, left, right);
1215 : 0 : return result;
1216 : : }
1217 : : else
1218 : : {
1219 : 3415477 : if (in (tinfo->resolved, left, right))
1220 : : {
1221 : 62416 : exclude (tinfo->visited, left, right);
1222 : 62416 : return getStatus (tinfo->resolved, left, right);
1223 : : }
1224 : 3353061 : else if (in (tinfo->visited, left, right))
1225 : : {
1226 : : /* avoid dangling else. */
1227 : : return M2Check_visited;
1228 : : }
1229 : : else
1230 : : {
1231 : : /* avoid dangling else. */
1232 : 3127835 : if (debugging)
1233 : : {
1234 : : libc_printf ((const char *) " marked as visited (%d, %d)\\n", 31, left, right);
1235 : : }
1236 : 3127835 : include (tinfo->visited, left, right, M2Check_unknown);
1237 : 3127835 : include (tinfo->unresolved, left, right, M2Check_unknown);
1238 : : }
1239 : 3127835 : return doCheckPair (result, tinfo, left, right);
1240 : : }
1241 : : /* static analysis guarentees a RETURN statement will be used before here. */
1242 : : __builtin_unreachable ();
1243 : : }
1244 : :
1245 : :
1246 : : /*
1247 : : useBaseCheck -
1248 : : */
1249 : :
1250 : 1396942 : static bool useBaseCheck (unsigned int sym)
1251 : : {
1252 : 1396942 : return (((M2Base_IsBaseType (sym)) || (M2System_IsSystemType (sym))) || (M2Base_IsMathType (sym))) || (M2Base_IsComplexType (sym));
1253 : : /* static analysis guarentees a RETURN statement will be used before here. */
1254 : : __builtin_unreachable ();
1255 : : }
1256 : :
1257 : :
1258 : : /*
1259 : : checkBaseTypeEquivalence -
1260 : : */
1261 : :
1262 : 910324 : static M2Check_status checkBaseTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1263 : : {
1264 : 910324 : if (isFalse (result))
1265 : : {
1266 : : return result;
1267 : : }
1268 : 910324 : else if ((useBaseCheck (left)) && (useBaseCheck (right)))
1269 : : {
1270 : : /* avoid dangling else. */
1271 : 320986 : return checkBaseEquivalence (result, tinfo, left, right);
1272 : : }
1273 : : else
1274 : : {
1275 : : /* avoid dangling else. */
1276 : 589338 : return result;
1277 : : }
1278 : : /* static analysis guarentees a RETURN statement will be used before here. */
1279 : : __builtin_unreachable ();
1280 : : }
1281 : :
1282 : :
1283 : : /*
1284 : : IsTyped - returns TRUE if sym will have a type.
1285 : : */
1286 : :
1287 : 10331123 : static bool IsTyped (unsigned int sym)
1288 : : {
1289 : 10331123 : return (((((SymbolTable_IsVar (sym)) || (SymbolTable_IsParameter (sym))) || (SymbolTable_IsConstructor (sym))) || ((SymbolTable_IsConst (sym)) && (SymbolTable_IsConstructor (sym)))) || (SymbolTable_IsParameter (sym))) || ((SymbolTable_IsConst (sym)) && ((SymbolTable_GetType (sym)) != SymbolTable_NulSym));
1290 : : /* static analysis guarentees a RETURN statement will be used before here. */
1291 : : __builtin_unreachable ();
1292 : : }
1293 : :
1294 : :
1295 : : /*
1296 : : isLValue -
1297 : : */
1298 : :
1299 : 3427808 : static bool isLValue (unsigned int sym)
1300 : : {
1301 : 3427808 : return (SymbolTable_IsVar (sym)) && ((SymbolTable_GetMode (sym)) == SymbolTable_LeftValue);
1302 : : /* static analysis guarentees a RETURN statement will be used before here. */
1303 : : __builtin_unreachable ();
1304 : : }
1305 : :
1306 : :
1307 : : /*
1308 : : checkVarEquivalence - this test must be done early as it checks the symbol mode.
1309 : : An LValue is treated as a pointer during assignment and the
1310 : : LValue is attached to a variable. This function skips the variable
1311 : : and checks the types - after it has considered a possible LValue.
1312 : : */
1313 : :
1314 : 3646377 : static M2Check_status checkVarEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1315 : : {
1316 : 3646377 : if (isFalse (result))
1317 : : {
1318 : : return result;
1319 : : }
1320 : 3646377 : else if ((IsTyped (left)) || (IsTyped (right)))
1321 : : {
1322 : : /* avoid dangling else. */
1323 : 2947043 : if (tinfo->kind == M2Check_assignment)
1324 : : {
1325 : : /* avoid gcc warning by using compound statement even if not strictly necessary. */
1326 : : /* LValues are only relevant during assignment. */
1327 : 1692990 : if ((isLValue (left)) && (! (isLValue (right))))
1328 : : {
1329 : : /* avoid dangling else. */
1330 : 191134 : if ((SymbolTable_SkipType (getType (right))) == M2System_Address)
1331 : : {
1332 : : return M2Check_true;
1333 : : }
1334 : 188184 : else if (SymbolTable_IsPointer (SymbolTable_SkipType (getType (right))))
1335 : : {
1336 : : /* avoid dangling else. */
1337 : 14090 : right = SymbolTable_GetDType (SymbolTable_SkipType (getType (right)));
1338 : : }
1339 : : }
1340 : 1501856 : else if ((isLValue (right)) && (! (isLValue (left))))
1341 : : {
1342 : : /* avoid dangling else. */
1343 : 16808 : if ((SymbolTable_SkipType (getType (left))) == M2System_Address)
1344 : : {
1345 : : return M2Check_true;
1346 : : }
1347 : 16808 : else if (SymbolTable_IsPointer (SymbolTable_SkipType (getType (left))))
1348 : : {
1349 : : /* avoid dangling else. */
1350 : 282 : left = SymbolTable_GetDType (SymbolTable_SkipType (getType (left)));
1351 : : }
1352 : : }
1353 : : }
1354 : 2944093 : return doCheckPair (result, tinfo, getType (left), getType (right));
1355 : : }
1356 : : else
1357 : : {
1358 : : /* avoid dangling else. */
1359 : : return result;
1360 : : }
1361 : : /* static analysis guarentees a RETURN statement will be used before here. */
1362 : : __builtin_unreachable ();
1363 : : }
1364 : :
1365 : :
1366 : : /*
1367 : : checkConstMeta - performs a very course grained check against
1368 : : obviously incompatible type kinds.
1369 : : If left is a const string then it checks right against char.
1370 : : */
1371 : :
1372 : 1141525 : static M2Check_status checkConstMeta (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1373 : : {
1374 : 1141525 : unsigned int typeRight;
1375 : :
1376 : 1141525 : M2Debug_Assert (SymbolTable_IsConst (left));
1377 : 1141525 : if (isFalse (result))
1378 : : {
1379 : : return result;
1380 : : }
1381 : 1141525 : else if (SymbolTable_IsConstString (left))
1382 : : {
1383 : : /* avoid dangling else. */
1384 : 99268 : if (SymbolTable_IsConstString (right))
1385 : : {
1386 : : return M2Check_true;
1387 : : }
1388 : 97366 : else if (IsTyped (right))
1389 : : {
1390 : : /* avoid dangling else. */
1391 : 66806 : typeRight = SymbolTable_GetDType (right);
1392 : 66806 : if (typeRight == SymbolTable_NulSym)
1393 : : {
1394 : : return result;
1395 : : }
1396 : 66806 : else if (((((SymbolTable_IsSet (typeRight)) || (SymbolTable_IsEnumeration (typeRight))) || (SymbolTable_IsProcedure (typeRight))) || (SymbolTable_IsRecord (typeRight))) || (SymbolTable_IsReallyPointer (typeRight)))
1397 : : {
1398 : : /* avoid dangling else. */
1399 : 144 : return M2Check_false;
1400 : : }
1401 : 66662 : else if (SymbolTable_IsArray (typeRight))
1402 : : {
1403 : : /* avoid dangling else. */
1404 : 22224 : return doCheckPair (result, tinfo, M2Base_Char, SymbolTable_GetType (typeRight));
1405 : : }
1406 : 44438 : else if ((SymbolTable_GetStringLength (tinfo->token, left)) == 1)
1407 : : {
1408 : : /* avoid dangling else. */
1409 : 13878 : return doCheckPair (result, tinfo, M2Base_Char, typeRight);
1410 : : }
1411 : : }
1412 : : }
1413 : : return result;
1414 : : /* static analysis guarentees a RETURN statement will be used before here. */
1415 : : __builtin_unreachable ();
1416 : : }
1417 : :
1418 : :
1419 : : /*
1420 : : checkConstEquivalence - this check can be done first as it checks symbols which
1421 : : may have no type. Ie constant strings. These constants
1422 : : will likely have their type set during quadruple folding.
1423 : : But we can check the meta type for obvious mismatches
1424 : : early on. For example adding a string to an enum or set.
1425 : : */
1426 : :
1427 : 3683899 : static M2Check_status checkConstEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1428 : : {
1429 : 3683899 : if (isFalse (result))
1430 : : {
1431 : : return result;
1432 : : }
1433 : 3683899 : else if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
1434 : : {
1435 : : /* avoid dangling else. */
1436 : : /* No option but to return true. */
1437 : : return M2Check_true;
1438 : : }
1439 : 3682965 : else if (SymbolTable_IsConst (left))
1440 : : {
1441 : : /* avoid dangling else. */
1442 : 810983 : return checkConstMeta (result, tinfo, left, right);
1443 : : }
1444 : 2871982 : else if (SymbolTable_IsConst (right))
1445 : : {
1446 : : /* avoid dangling else. */
1447 : 330542 : return checkConstMeta (result, tinfo, right, left);
1448 : : }
1449 : : return result;
1450 : : /* static analysis guarentees a RETURN statement will be used before here. */
1451 : : __builtin_unreachable ();
1452 : : }
1453 : :
1454 : :
1455 : : /*
1456 : : checkSubrangeTypeEquivalence -
1457 : : */
1458 : :
1459 : 920924 : static M2Check_status checkSubrangeTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1460 : : {
1461 : 920924 : if (isFalse (result))
1462 : : {
1463 : : return result;
1464 : : }
1465 : : else
1466 : : {
1467 : 920924 : if (SymbolTable_IsSubrange (left))
1468 : : {
1469 : 9188 : return doCheckPair (result, tinfo, SymbolTable_GetDType (left), right);
1470 : : }
1471 : 911736 : if (SymbolTable_IsSubrange (right))
1472 : : {
1473 : 4042 : return doCheckPair (result, tinfo, left, SymbolTable_GetDType (right));
1474 : : }
1475 : 907694 : if (left == right)
1476 : : {
1477 : : return M2Check_true;
1478 : : }
1479 : : else
1480 : : {
1481 : 907694 : return result;
1482 : : }
1483 : : }
1484 : : /* static analysis guarentees a RETURN statement will be used before here. */
1485 : : __builtin_unreachable ();
1486 : : }
1487 : :
1488 : :
1489 : : /*
1490 : : isZRC -
1491 : : */
1492 : :
1493 : 0 : static bool isZRC (unsigned int zrc, unsigned int sym)
1494 : : {
1495 : 0 : if (SymbolTable_IsConst (sym))
1496 : : {
1497 : 0 : sym = SymbolTable_SkipType (SymbolTable_GetType (sym));
1498 : : }
1499 : 0 : if ((zrc == M2Base_CType) && ((M2System_IsComplexN (sym)) || (M2Base_IsComplexType (sym))))
1500 : : {
1501 : 0 : return true;
1502 : : }
1503 : 0 : return (zrc == sym) || ((zrc == M2Base_ZType) || ((zrc == M2Base_RType) && (! (SymbolTable_IsComposite (sym)))));
1504 : : /* static analysis guarentees a RETURN statement will be used before here. */
1505 : : __builtin_unreachable ();
1506 : : }
1507 : :
1508 : :
1509 : : /*
1510 : : isSameSizeConst -
1511 : :
1512 : : */
1513 : :
1514 : 5026 : static bool isSameSizeConst (unsigned int a, unsigned int b)
1515 : : {
1516 : 5026 : if (SymbolTable_IsConst (a))
1517 : : {
1518 : 0 : a = SymbolTable_SkipType (SymbolTable_GetType (a));
1519 : 0 : return ((isZRC (a, b)) || (a == b)) || ((a != SymbolTable_NulSym) && (isSameSize (a, b)));
1520 : : }
1521 : 5026 : else if (SymbolTable_IsConst (b))
1522 : : {
1523 : : /* avoid dangling else. */
1524 : 0 : b = SymbolTable_SkipType (SymbolTable_GetType (b));
1525 : 0 : return ((isZRC (b, a)) || (a == b)) || ((b != SymbolTable_NulSym) && (isSameSize (a, b)));
1526 : : }
1527 : : return false;
1528 : : /* static analysis guarentees a RETURN statement will be used before here. */
1529 : : __builtin_unreachable ();
1530 : : }
1531 : :
1532 : :
1533 : : /*
1534 : : isSameSize - should only be called if either a or b are WORD, BYTE, etc.
1535 : : */
1536 : :
1537 : 5026 : static bool isSameSize (unsigned int a, unsigned int b)
1538 : : {
1539 : 5026 : return (isSameSizeConst (a, b)) || (M2System_IsSameSize (a, b));
1540 : : /* static analysis guarentees a RETURN statement will be used before here. */
1541 : : __builtin_unreachable ();
1542 : : }
1543 : :
1544 : :
1545 : : /*
1546 : : checkSystemEquivalence - check whether left and right are system types and whether they have the same size.
1547 : : */
1548 : :
1549 : 924492 : static M2Check_status checkSystemEquivalence (M2Check_status result, unsigned int left, unsigned int right)
1550 : : {
1551 : 924492 : if ((isFalse (result)) || (result == M2Check_visited))
1552 : : {
1553 : : return result;
1554 : : }
1555 : : else
1556 : : {
1557 : 924492 : if (((M2System_IsGenericSystemType (left)) || (M2System_IsGenericSystemType (right))) && (isSameSize (left, right)))
1558 : : {
1559 : : return M2Check_true;
1560 : : }
1561 : : }
1562 : : return result;
1563 : : /* static analysis guarentees a RETURN statement will be used before here. */
1564 : : __builtin_unreachable ();
1565 : : }
1566 : :
1567 : :
1568 : : /*
1569 : : checkTypeKindViolation - returns false if one operand left or right is
1570 : : a set, record or array.
1571 : : */
1572 : :
1573 : 455172 : static M2Check_status checkTypeKindViolation (M2Check_status result, unsigned int left, unsigned int right)
1574 : : {
1575 : 455172 : if ((isFalse (result)) || (result == M2Check_visited))
1576 : : {
1577 : : return result;
1578 : : }
1579 : : else
1580 : : {
1581 : : /* We have checked IsSet (left) and IsSet (right) etc in doCheckPair. */
1582 : 455172 : if ((((SymbolTable_IsSet (left)) || (SymbolTable_IsSet (right))) || ((SymbolTable_IsRecord (left)) || (SymbolTable_IsRecord (right)))) || ((SymbolTable_IsArray (left)) || (SymbolTable_IsArray (right))))
1583 : : {
1584 : 598 : return M2Check_false;
1585 : : }
1586 : : }
1587 : : return result;
1588 : : /* static analysis guarentees a RETURN statement will be used before here. */
1589 : : __builtin_unreachable ();
1590 : : }
1591 : :
1592 : :
1593 : : /*
1594 : : doCheckPair - invoke a series of ordered type checks checking compatibility
1595 : : between left and right modula2 symbols.
1596 : : Pre-condition: left and right are modula-2 symbols.
1597 : : tinfo is configured.
1598 : : Post-condition: status is returned determining the
1599 : : correctness of the type check.
1600 : : The tinfo resolved, unresolved, visited
1601 : : lists will be updated.
1602 : : */
1603 : :
1604 : 6121260 : static M2Check_status doCheckPair (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1605 : : {
1606 : 6121260 : if ((isFalse (result)) || (result == M2Check_visited))
1607 : : {
1608 : 0 : return return_ (result, tinfo, left, right);
1609 : : }
1610 : 6121260 : else if (left == right)
1611 : : {
1612 : : /* avoid dangling else. */
1613 : 2437361 : return return_ (M2Check_true, tinfo, left, right);
1614 : : }
1615 : : else
1616 : : {
1617 : : /* avoid dangling else. */
1618 : 3683899 : result = checkConstEquivalence (M2Check_unknown, tinfo, left, right);
1619 : 3683899 : if (! (isKnown (result)))
1620 : : {
1621 : 3646377 : result = checkVarEquivalence (M2Check_unknown, tinfo, left, right);
1622 : 3646377 : if (! (isKnown (result)))
1623 : : {
1624 : 924492 : result = checkSystemEquivalence (M2Check_unknown, left, right);
1625 : 924492 : if (! (isKnown (result)))
1626 : : {
1627 : 920924 : result = checkSubrangeTypeEquivalence (M2Check_unknown, tinfo, left, right);
1628 : 920924 : if (! (isKnown (result)))
1629 : : {
1630 : 910324 : result = checkBaseTypeEquivalence (M2Check_unknown, tinfo, left, right);
1631 : 910324 : if (! (isKnown (result)))
1632 : : {
1633 : 589338 : result = checkTypeEquivalence (M2Check_unknown, left, right);
1634 : 589338 : if (! (isKnown (result)))
1635 : : {
1636 : 589176 : result = checkArrayTypeEquivalence (result, tinfo, left, right);
1637 : 589176 : if (! (isKnown (result)))
1638 : : {
1639 : 581712 : result = checkGenericTypeEquivalence (result, left, right);
1640 : 581712 : if (! (isKnown (result)))
1641 : : {
1642 : 581712 : result = checkTypeKindEquivalence (result, tinfo, left, right);
1643 : 581712 : if (! (isKnown (result)))
1644 : : {
1645 : 455172 : result = checkTypeKindViolation (result, left, right);
1646 : : }
1647 : : }
1648 : : }
1649 : : }
1650 : : }
1651 : : }
1652 : : }
1653 : : }
1654 : : }
1655 : : }
1656 : 3683899 : return return_ (result, tinfo, left, right);
1657 : : /* static analysis guarentees a RETURN statement will be used before here. */
1658 : : __builtin_unreachable ();
1659 : : }
1660 : :
1661 : :
1662 : : /*
1663 : : checkProcType -
1664 : : */
1665 : :
1666 : 250738 : static M2Check_status checkProcType (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1667 : : {
1668 : 250738 : unsigned int i;
1669 : 250738 : unsigned int n;
1670 : 250738 : unsigned int lt;
1671 : 250738 : unsigned int rt;
1672 : :
1673 : 250738 : M2Debug_Assert (SymbolTable_IsProcType (right));
1674 : 250738 : M2Debug_Assert (SymbolTable_IsProcType (left));
1675 : 250738 : if (isFalse (result))
1676 : : {
1677 : : return result;
1678 : : }
1679 : : else
1680 : : {
1681 : 250738 : lt = SymbolTable_GetDType (left);
1682 : 250738 : rt = SymbolTable_GetDType (right);
1683 : 250738 : if ((lt == SymbolTable_NulSym) && (rt == SymbolTable_NulSym))
1684 : : {
1685 : : result = M2Check_unknown;
1686 : : }
1687 : 1936 : else if (lt == SymbolTable_NulSym)
1688 : : {
1689 : : /* avoid dangling else. */
1690 : 0 : if (tinfo->format != NULL)
1691 : : {
1692 : 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);
1693 : : }
1694 : 0 : return return_ (M2Check_false, tinfo, left, right);
1695 : : }
1696 : 1936 : else if (rt == SymbolTable_NulSym)
1697 : : {
1698 : : /* avoid dangling else. */
1699 : 0 : if (tinfo->format != NULL)
1700 : : {
1701 : 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);
1702 : : }
1703 : 0 : return return_ (M2Check_false, tinfo, left, right);
1704 : : }
1705 : : else
1706 : : {
1707 : : /* avoid dangling else. */
1708 : : /* two return type seen so we check them. */
1709 : 1936 : result = checkPair (M2Check_unknown, tinfo, lt, rt);
1710 : : }
1711 : 250738 : if ((SymbolTable_NoOfParamAny (left)) != (SymbolTable_NoOfParamAny (right)))
1712 : : {
1713 : 6 : if (tinfo->format != NULL)
1714 : : {
1715 : 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);
1716 : : }
1717 : 6 : return return_ (M2Check_false, tinfo, left, right);
1718 : : }
1719 : 250732 : i = 1;
1720 : 250732 : n = SymbolTable_NoOfParamAny (left);
1721 : 699354 : while (i <= n)
1722 : : {
1723 : 197890 : if ((SymbolTable_IsVarParamAny (left, i)) != (SymbolTable_IsVarParamAny (right, i)))
1724 : : {
1725 : 0 : if (SymbolTable_IsVarParamAny (left, i))
1726 : : {
1727 : : /* avoid dangling else. */
1728 : 0 : if (tinfo->format != NULL)
1729 : : {
1730 : 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);
1731 : : }
1732 : : }
1733 : : else
1734 : : {
1735 : 0 : if (tinfo->format != NULL)
1736 : : {
1737 : 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);
1738 : : }
1739 : : }
1740 : 0 : return return_ (M2Check_false, tinfo, left, right);
1741 : : }
1742 : 197890 : result = checkPair (result, tinfo, SymbolTable_GetDType (SymbolTable_GetNthParamAny (left, i)), SymbolTable_GetDType (SymbolTable_GetNthParamAny (right, i)));
1743 : 197890 : i += 1;
1744 : : }
1745 : : }
1746 : 250732 : return return_ (result, tinfo, left, right);
1747 : : /* static analysis guarentees a RETURN statement will be used before here. */
1748 : : __builtin_unreachable ();
1749 : : }
1750 : :
1751 : :
1752 : : /*
1753 : : checkProcedureProcType -
1754 : : */
1755 : :
1756 : 0 : static M2Check_status checkProcedureProcType (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1757 : : {
1758 : 0 : unsigned int i;
1759 : 0 : unsigned int n;
1760 : 0 : unsigned int lt;
1761 : 0 : unsigned int rt;
1762 : :
1763 : 0 : M2Debug_Assert (SymbolTable_IsProcedure (right));
1764 : 0 : M2Debug_Assert (SymbolTable_IsProcType (left));
1765 : 0 : if (! (isFalse (result)))
1766 : : {
1767 : 0 : lt = SymbolTable_GetDType (left);
1768 : 0 : rt = SymbolTable_GetDType (right);
1769 : 0 : if ((lt == SymbolTable_NulSym) && (rt == SymbolTable_NulSym))
1770 : : {} /* empty. */
1771 : 0 : else if (lt == SymbolTable_NulSym)
1772 : : {
1773 : : /* avoid dangling else. */
1774 : 0 : if (tinfo->format != NULL)
1775 : : {
1776 : 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);
1777 : : }
1778 : 0 : return return_ (M2Check_false, tinfo, left, right);
1779 : : }
1780 : 0 : else if (rt == SymbolTable_NulSym)
1781 : : {
1782 : : /* avoid dangling else. */
1783 : 0 : if (tinfo->format != NULL)
1784 : : {
1785 : 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);
1786 : : }
1787 : 0 : return return_ (M2Check_false, tinfo, left, right);
1788 : : }
1789 : : else
1790 : : {
1791 : : /* avoid dangling else. */
1792 : : /* two return type seen so we check them. */
1793 : 0 : result = checkPair (result, tinfo, lt, rt);
1794 : : }
1795 : 0 : if ((SymbolTable_NoOfParamAny (left)) != (SymbolTable_NoOfParamAny (right)))
1796 : : {
1797 : 0 : if (tinfo->format != NULL)
1798 : : {
1799 : 0 : M2MetaError_MetaErrorStringT2 (tinfo->token, DynamicStrings_InitString ((const char *) "procedure {%1a} has a different number of parameters from procedure type {%2ad}", 79), right, left);
1800 : : }
1801 : 0 : return return_ (M2Check_false, tinfo, left, right);
1802 : : }
1803 : 0 : i = 1;
1804 : 0 : n = SymbolTable_NoOfParamAny (left);
1805 : 0 : while (i <= n)
1806 : : {
1807 : 0 : if ((SymbolTable_IsVarParamAny (left, i)) != (SymbolTable_IsVarParamAny (right, i)))
1808 : : {
1809 : 0 : if (SymbolTable_IsVarParamAny (left, i))
1810 : : {
1811 : : /* avoid dangling else. */
1812 : 0 : if (tinfo->format != NULL)
1813 : : {
1814 : 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);
1815 : : }
1816 : : }
1817 : : else
1818 : : {
1819 : 0 : if (tinfo->format != NULL)
1820 : : {
1821 : 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);
1822 : : }
1823 : : }
1824 : 0 : return return_ (M2Check_false, tinfo, left, right);
1825 : : }
1826 : 0 : result = checkPair (result, tinfo, SymbolTable_GetDType (SymbolTable_GetNthParamAny (left, i)), SymbolTable_GetDType (SymbolTable_GetNthParamAny (right, i)));
1827 : 0 : i += 1;
1828 : : }
1829 : : }
1830 : 0 : return return_ (result, tinfo, left, right);
1831 : : /* static analysis guarentees a RETURN statement will be used before here. */
1832 : : __builtin_unreachable ();
1833 : : }
1834 : :
1835 : :
1836 : : /*
1837 : : checkProcedure -
1838 : : */
1839 : :
1840 : 0 : static M2Check_status checkProcedure (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1841 : : {
1842 : 0 : M2Debug_Assert (SymbolTable_IsProcedure (right));
1843 : 0 : if (isFalse (result))
1844 : : {
1845 : : return result;
1846 : : }
1847 : 0 : else if (SymbolTable_IsVar (left))
1848 : : {
1849 : : /* avoid dangling else. */
1850 : 0 : return checkProcedure (result, tinfo, SymbolTable_GetDType (left), right);
1851 : : }
1852 : 0 : else if (left == M2System_Address)
1853 : : {
1854 : : /* avoid dangling else. */
1855 : : return M2Check_true;
1856 : : }
1857 : 0 : else if (SymbolTable_IsProcType (left))
1858 : : {
1859 : : /* avoid dangling else. */
1860 : 0 : return checkProcedureProcType (result, tinfo, left, right);
1861 : : }
1862 : : else
1863 : : {
1864 : : /* avoid dangling else. */
1865 : : return result;
1866 : : }
1867 : : /* static analysis guarentees a RETURN statement will be used before here. */
1868 : : __builtin_unreachable ();
1869 : : }
1870 : :
1871 : :
1872 : : /*
1873 : : checkEnumerationEquivalence -
1874 : : */
1875 : :
1876 : 0 : static M2Check_status checkEnumerationEquivalence (M2Check_status result, unsigned int left, unsigned int right)
1877 : : {
1878 : 0 : if (isFalse (result))
1879 : : {
1880 : : return result;
1881 : : }
1882 : 0 : else if (left == right)
1883 : : {
1884 : : /* avoid dangling else. */
1885 : : return M2Check_true;
1886 : : }
1887 : : else
1888 : : {
1889 : : /* avoid dangling else. */
1890 : 0 : return M2Check_false;
1891 : : }
1892 : : /* static analysis guarentees a RETURN statement will be used before here. */
1893 : : __builtin_unreachable ();
1894 : : }
1895 : :
1896 : :
1897 : : /*
1898 : : checkPointerType - check whether left and right are equal or are of type ADDRESS.
1899 : : */
1900 : :
1901 : 57240 : static M2Check_status checkPointerType (M2Check_status result, unsigned int left, unsigned int right)
1902 : : {
1903 : 0 : if (isFalse (result))
1904 : : {
1905 : : return result;
1906 : : }
1907 : 57240 : else if (((left == right) || (left == M2System_Address)) || (right == M2System_Address))
1908 : : {
1909 : : /* avoid dangling else. */
1910 : : return M2Check_true;
1911 : : }
1912 : : else
1913 : : {
1914 : : /* avoid dangling else. */
1915 : 0 : return M2Check_false;
1916 : : }
1917 : : /* static analysis guarentees a RETURN statement will be used before here. */
1918 : : __builtin_unreachable ();
1919 : : }
1920 : :
1921 : :
1922 : : /*
1923 : : checkProcTypeEquivalence - allow proctype to be compared against another
1924 : : proctype or procedure. It is legal to be compared
1925 : : against an address.
1926 : : */
1927 : :
1928 : 250786 : static M2Check_status checkProcTypeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1929 : : {
1930 : 250786 : if (isFalse (result))
1931 : : {
1932 : : return result;
1933 : : }
1934 : 250786 : else if ((SymbolTable_IsProcedure (left)) && (SymbolTable_IsProcType (right)))
1935 : : {
1936 : : /* avoid dangling else. */
1937 : 0 : return checkProcedure (result, tinfo, right, left);
1938 : : }
1939 : 250786 : else if ((SymbolTable_IsProcType (left)) && (SymbolTable_IsProcedure (right)))
1940 : : {
1941 : : /* avoid dangling else. */
1942 : 0 : return checkProcedure (result, tinfo, left, right);
1943 : : }
1944 : 250786 : else if ((SymbolTable_IsProcType (left)) && (SymbolTable_IsProcType (right)))
1945 : : {
1946 : : /* avoid dangling else. */
1947 : 250738 : return checkProcType (result, tinfo, left, right);
1948 : : }
1949 : 48 : else if ((left == M2System_Address) || (right == M2System_Address))
1950 : : {
1951 : : /* avoid dangling else. */
1952 : : return M2Check_true;
1953 : : }
1954 : : else
1955 : : {
1956 : : /* avoid dangling else. */
1957 : : return M2Check_false;
1958 : : }
1959 : : /* static analysis guarentees a RETURN statement will be used before here. */
1960 : : __builtin_unreachable ();
1961 : : }
1962 : :
1963 : :
1964 : : /*
1965 : : checkTypeKindEquivalence -
1966 : : */
1967 : :
1968 : 581928 : static M2Check_status checkTypeKindEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
1969 : : {
1970 : 581928 : if (isFalse (result))
1971 : : {
1972 : : return result;
1973 : : }
1974 : 581928 : else if ((left == SymbolTable_NulSym) || (right == SymbolTable_NulSym))
1975 : : {
1976 : : /* avoid dangling else. */
1977 : : return M2Check_true;
1978 : : }
1979 : : else
1980 : : {
1981 : : /* avoid dangling else. */
1982 : : /* Long cascade of all type kinds. */
1983 : 581928 : if ((SymbolTable_IsSet (left)) && (SymbolTable_IsSet (right)))
1984 : : {
1985 : 216 : return checkSetEquivalent (result, tinfo, left, right);
1986 : : }
1987 : 581712 : else if ((SymbolTable_IsArray (left)) && (SymbolTable_IsArray (right)))
1988 : : {
1989 : : /* avoid dangling else. */
1990 : 0 : return checkArrayTypeEquivalence (result, tinfo, left, right);
1991 : : }
1992 : 581712 : else if ((SymbolTable_IsRecord (left)) && (SymbolTable_IsRecord (right)))
1993 : : {
1994 : : /* avoid dangling else. */
1995 : 581928 : return checkRecordEquivalence (result, left, right);
1996 : : }
1997 : 581712 : else if ((SymbolTable_IsEnumeration (left)) && (SymbolTable_IsEnumeration (right)))
1998 : : {
1999 : : /* avoid dangling else. */
2000 : 0 : return checkEnumerationEquivalence (result, left, right);
2001 : : }
2002 : 581712 : else if ((SymbolTable_IsProcType (left)) || (SymbolTable_IsProcType (right)))
2003 : : {
2004 : : /* avoid dangling else. */
2005 : 250786 : return checkProcTypeEquivalence (result, tinfo, right, left);
2006 : : }
2007 : 330926 : else if ((SymbolTable_IsReallyPointer (left)) && (SymbolTable_IsReallyPointer (right)))
2008 : : {
2009 : : /* avoid dangling else. */
2010 : 57240 : return checkPointerType (result, left, right);
2011 : : }
2012 : : else
2013 : : {
2014 : : /* avoid dangling else. */
2015 : 273686 : return result;
2016 : : }
2017 : : }
2018 : : /* static analysis guarentees a RETURN statement will be used before here. */
2019 : : __builtin_unreachable ();
2020 : : }
2021 : :
2022 : :
2023 : : /*
2024 : : isSkipEquivalence -
2025 : : */
2026 : :
2027 : 7638 : static bool isSkipEquivalence (unsigned int left, unsigned int right)
2028 : : {
2029 : 7638 : return (SymbolTable_SkipType (left)) == (SymbolTable_SkipType (right));
2030 : : /* static analysis guarentees a RETURN statement will be used before here. */
2031 : : __builtin_unreachable ();
2032 : : }
2033 : :
2034 : :
2035 : : /*
2036 : : checkValueEquivalence - check to see if left and right values are the same.
2037 : : */
2038 : :
2039 : 432 : static M2Check_status checkValueEquivalence (M2Check_status result, unsigned int left, unsigned int right)
2040 : : {
2041 : 432 : if (isKnown (result))
2042 : : {
2043 : : return result;
2044 : : }
2045 : 432 : else if (left == right)
2046 : : {
2047 : : /* avoid dangling else. */
2048 : : return M2Check_true;
2049 : : }
2050 : : else
2051 : : {
2052 : : /* avoid dangling else. */
2053 : 432 : if (m2expr_AreConstantsEqual (SymbolConversion_Mod2Gcc (left), SymbolConversion_Mod2Gcc (right)))
2054 : : {
2055 : : return M2Check_true;
2056 : : }
2057 : : else
2058 : : {
2059 : : return M2Check_false;
2060 : : }
2061 : : }
2062 : : /* static analysis guarentees a RETURN statement will be used before here. */
2063 : : __builtin_unreachable ();
2064 : : }
2065 : :
2066 : :
2067 : : /*
2068 : : and -
2069 : : */
2070 : :
2071 : 216 : static M2Check_status and_ (M2Check_status left, M2Check_status right)
2072 : : {
2073 : 0 : if ((left == M2Check_true) && (right == M2Check_true))
2074 : : {
2075 : : return M2Check_true;
2076 : : }
2077 : : else
2078 : : {
2079 : 210 : return M2Check_false;
2080 : : }
2081 : : /* static analysis guarentees a RETURN statement will be used before here. */
2082 : : __builtin_unreachable ();
2083 : : }
2084 : :
2085 : :
2086 : : /*
2087 : : checkTypeRangeEquivalence -
2088 : : */
2089 : :
2090 : 216 : static M2Check_status checkTypeRangeEquivalence (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2091 : : {
2092 : 216 : M2Check_status result2;
2093 : 216 : M2Check_status result3;
2094 : :
2095 : 216 : result = checkSkipEquivalence (result, left, right);
2096 : 216 : result2 = checkValueEquivalence (result, M2GCCDeclare_GetTypeMin (left), M2GCCDeclare_GetTypeMin (right));
2097 : 216 : result3 = checkValueEquivalence (result, M2GCCDeclare_GetTypeMax (left), M2GCCDeclare_GetTypeMax (right));
2098 : 426 : return return_ (and_ (result2, result3), tinfo, left, right);
2099 : : /* static analysis guarentees a RETURN statement will be used before here. */
2100 : : __builtin_unreachable ();
2101 : : }
2102 : :
2103 : :
2104 : : /*
2105 : : include - include pair left:right into pairs with status, s.
2106 : : */
2107 : :
2108 : 20965849 : static void include (Indexing_Index pairs, unsigned int left, unsigned int right, M2Check_status s)
2109 : : {
2110 : 20965849 : M2Check_pair p;
2111 : :
2112 : 20965849 : p = newPair ();
2113 : 20965849 : p->left = left;
2114 : 20965849 : p->right = right;
2115 : 20965849 : p->pairStatus = s;
2116 : 20965849 : p->next = NULL;
2117 : 20965849 : Indexing_IncludeIndiceIntoIndex (pairs, reinterpret_cast <void *> (p));
2118 : 20965849 : }
2119 : :
2120 : :
2121 : : /*
2122 : : exclude - exclude pair left:right from pairs.
2123 : : */
2124 : :
2125 : 20505405 : static void exclude (Indexing_Index pairs, unsigned int left, unsigned int right)
2126 : : {
2127 : 20505405 : M2Check_pair p;
2128 : 20505405 : unsigned int i;
2129 : 20505405 : unsigned int n;
2130 : :
2131 : 20505405 : i = 1;
2132 : 20505405 : n = Indexing_HighIndice (pairs);
2133 : 62366075 : while (i <= n)
2134 : : {
2135 : 30601162 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2136 : 30601162 : if (((p != NULL) && (p->left == left)) && (p->right == right))
2137 : : {
2138 : 9245897 : Indexing_PutIndice (pairs, i, NULL);
2139 : 9245897 : disposePair (p);
2140 : 9245897 : return;
2141 : : }
2142 : 21355265 : i += 1;
2143 : : }
2144 : : }
2145 : :
2146 : :
2147 : : /*
2148 : : getStatus -
2149 : : */
2150 : :
2151 : 62416 : static M2Check_status getStatus (Indexing_Index pairs, unsigned int left, unsigned int right)
2152 : : {
2153 : 62416 : M2Check_pair p;
2154 : 62416 : unsigned int i;
2155 : 62416 : unsigned int n;
2156 : :
2157 : 62416 : i = 1;
2158 : 62416 : n = Indexing_HighIndice (pairs);
2159 : 186660 : while (i <= n)
2160 : : {
2161 : 124244 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2162 : 124244 : if (((p != NULL) && (p->left == left)) && (p->right == right))
2163 : : {
2164 : 62416 : return p->pairStatus;
2165 : : }
2166 : 61828 : i += 1;
2167 : : }
2168 : : return M2Check_unknown;
2169 : : /* static analysis guarentees a RETURN statement will be used before here. */
2170 : : __builtin_unreachable ();
2171 : : }
2172 : :
2173 : :
2174 : : /*
2175 : : return -
2176 : : */
2177 : :
2178 : 9587883 : static M2Check_status return_ (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2179 : : {
2180 : 9587883 : if (result != M2Check_unknown)
2181 : : {
2182 : 8726381 : if (isKnown (result))
2183 : : {
2184 : 8726381 : include (tinfo->resolved, left, right, result);
2185 : 8726381 : exclude (tinfo->unresolved, left, right);
2186 : 8726381 : exclude (tinfo->visited, left, right); /* no longer visiting as it is resolved. */
2187 : : }
2188 : : }
2189 : 8726381 : if (result == M2Check_false)
2190 : : {
2191 : 4570 : return issueError (false, tinfo, left, right);
2192 : : }
2193 : : return result;
2194 : : /* static analysis guarentees a RETURN statement will be used before here. */
2195 : : __builtin_unreachable ();
2196 : : }
2197 : :
2198 : :
2199 : : /*
2200 : : checkSkipEquivalence - return true if left right are equivalent.
2201 : : */
2202 : :
2203 : 432 : static M2Check_status checkSkipEquivalence (M2Check_status result, unsigned int left, unsigned int right)
2204 : : {
2205 : 432 : if (isKnown (result))
2206 : : {
2207 : : return result;
2208 : : }
2209 : 432 : else if (isSkipEquivalence (left, right))
2210 : : {
2211 : : /* avoid dangling else. */
2212 : : return M2Check_true;
2213 : : }
2214 : : else
2215 : : {
2216 : : /* avoid dangling else. */
2217 : : return result;
2218 : : }
2219 : : /* static analysis guarentees a RETURN statement will be used before here. */
2220 : : __builtin_unreachable ();
2221 : : }
2222 : :
2223 : :
2224 : : /*
2225 : : checkSetEquivalent - compares set types, left and right.
2226 : : */
2227 : :
2228 : 216 : static M2Check_status checkSetEquivalent (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2229 : : {
2230 : 216 : result = checkSkipEquivalence (result, left, right);
2231 : 216 : result = checkTypeKindEquivalence (result, tinfo, SymbolTable_GetDType (left), SymbolTable_GetDType (right));
2232 : 216 : result = checkTypeRangeEquivalence (result, tinfo, SymbolTable_GetDType (left), SymbolTable_GetDType (right));
2233 : 216 : return return_ (result, tinfo, left, right);
2234 : : /* static analysis guarentees a RETURN statement will be used before here. */
2235 : : __builtin_unreachable ();
2236 : : }
2237 : :
2238 : :
2239 : : /*
2240 : : checkRecordEquivalence - compares record types, left and right.
2241 : : */
2242 : :
2243 : 0 : static M2Check_status checkRecordEquivalence (M2Check_status result, unsigned int left, unsigned int right)
2244 : : {
2245 : 0 : if (isFalse (result))
2246 : : {
2247 : : return result;
2248 : : }
2249 : 0 : else if (left == right)
2250 : : {
2251 : : /* avoid dangling else. */
2252 : : return M2Check_true;
2253 : : }
2254 : : else
2255 : : {
2256 : : /* avoid dangling else. */
2257 : 0 : return M2Check_false;
2258 : : }
2259 : : /* static analysis guarentees a RETURN statement will be used before here. */
2260 : : __builtin_unreachable ();
2261 : : }
2262 : :
2263 : :
2264 : : /*
2265 : : getType - only returns the type of symbol providing it is not a procedure.
2266 : : */
2267 : :
2268 : 6315492 : static unsigned int getType (unsigned int sym)
2269 : : {
2270 : 6315492 : if ((sym != SymbolTable_NulSym) && (SymbolTable_IsProcedure (sym)))
2271 : : {
2272 : 552082 : return SymbolTable_GetProcedureProcType (sym);
2273 : : }
2274 : 5763410 : else if (IsTyped (sym))
2275 : : {
2276 : : /* avoid dangling else. */
2277 : 5711524 : return SymbolTable_GetDType (sym);
2278 : : }
2279 : : else
2280 : : {
2281 : : /* avoid dangling else. */
2282 : : return sym;
2283 : : }
2284 : : /* static analysis guarentees a RETURN statement will be used before here. */
2285 : : __builtin_unreachable ();
2286 : : }
2287 : :
2288 : :
2289 : : /*
2290 : : getSType -
2291 : : */
2292 : :
2293 : 2172008 : static unsigned int getSType (unsigned int sym)
2294 : : {
2295 : 2172008 : if (SymbolTable_IsProcedure (sym))
2296 : : {
2297 : 94106 : return M2System_Address;
2298 : : }
2299 : : else
2300 : : {
2301 : 2077902 : return SymbolTable_GetSType (sym);
2302 : : }
2303 : : /* static analysis guarentees a RETURN statement will be used before here. */
2304 : : __builtin_unreachable ();
2305 : : }
2306 : :
2307 : :
2308 : : /*
2309 : : determineCompatible - check for compatibility by checking
2310 : : equivalence, array, generic and type kind.
2311 : : */
2312 : :
2313 : 3215453 : static M2Check_status determineCompatible (M2Check_status result, M2Check_tInfo tinfo, unsigned int left, unsigned int right)
2314 : : {
2315 : 3215453 : result = checkPair (result, tinfo, left, right);
2316 : 3215453 : return return_ (result, tinfo, left, right);
2317 : : /* static analysis guarentees a RETURN statement will be used before here. */
2318 : : __builtin_unreachable ();
2319 : : }
2320 : :
2321 : :
2322 : : /*
2323 : : get -
2324 : : */
2325 : :
2326 : 6207620 : static bool get (Indexing_Index pairs, unsigned int *left, unsigned int *right, M2Check_status s)
2327 : : {
2328 : 6207620 : unsigned int i;
2329 : 6207620 : unsigned int n;
2330 : 6207620 : M2Check_pair p;
2331 : :
2332 : 6207620 : i = 1;
2333 : 6207620 : n = Indexing_HighIndice (pairs);
2334 : 18530434 : while (i <= n)
2335 : : {
2336 : 9333991 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2337 : 9333991 : if ((p != NULL) && (p->pairStatus == s))
2338 : : {
2339 : 3218797 : (*left) = p->left;
2340 : 3218797 : (*right) = p->right;
2341 : 3218797 : return true;
2342 : : }
2343 : 6115194 : i += 1;
2344 : : }
2345 : : return false;
2346 : : /* static analysis guarentees a RETURN statement will be used before here. */
2347 : : __builtin_unreachable ();
2348 : : }
2349 : :
2350 : :
2351 : : /*
2352 : : isInternal - return TRUE if sym is a constant lit which was declared
2353 : : as internal.
2354 : : */
2355 : :
2356 : 6435928 : static bool isInternal (unsigned int sym)
2357 : : {
2358 : 6435928 : return (SymbolTable_IsConstLit (sym)) && (SymbolTable_IsConstLitInternal (sym));
2359 : : /* static analysis guarentees a RETURN statement will be used before here. */
2360 : : __builtin_unreachable ();
2361 : : }
2362 : :
2363 : :
2364 : : /*
2365 : : doCheck - keep obtaining an unresolved pair and check for the
2366 : : type compatibility. This is the main check routine used by
2367 : : parameter, assignment and expression compatibility.
2368 : : It tests all unknown pairs and calls the appropriate
2369 : : check function
2370 : : */
2371 : :
2372 : 2993571 : static bool doCheck (M2Check_tInfo tinfo)
2373 : : {
2374 : 2993571 : M2Check_status result;
2375 : 2993571 : unsigned int left;
2376 : 2993571 : unsigned int right;
2377 : :
2378 : 2993571 : if (debugging)
2379 : : {
2380 : : dumptInfo (tinfo);
2381 : : }
2382 : 9201191 : while (get (tinfo->unresolved, &left, &right, M2Check_unknown))
2383 : : {
2384 : 3218797 : if (debugging)
2385 : : {
2386 : : libc_printf ((const char *) "doCheck (%d, %d)\\n", 18, left, right);
2387 : : dumptInfo (tinfo);
2388 : : }
2389 : 3218797 : if ((isInternal (left)) || (isInternal (right)))
2390 : : {
2391 : : /* Do not check constants which have been generated internally.
2392 : : Currently these are generated by the default BY constant value
2393 : : in a FOR loop. */
2394 : 3332 : return true;
2395 : : }
2396 : : /*
2397 : : IF in (tinfo^.visited, left, right)
2398 : : THEN
2399 : : IF debugging
2400 : : THEN
2401 : : printf (" already visited (%d, %d)
2402 : : ", left, right)
2403 : : END ;
2404 : : ELSE
2405 : : IF debugging
2406 : : THEN
2407 : : printf (" not visited (%d, %d)
2408 : : ", left, right)
2409 : : END ;
2410 : : */
2411 : 3215453 : result = (*tinfo->checkFunc.proc) (M2Check_unknown, tinfo, left, right);
2412 : 3215453 : if (isKnown (result))
2413 : : {
2414 : : /* remove this pair from the unresolved list. */
2415 : 2990227 : exclude (tinfo->unresolved, left, right);
2416 : : /* add it to the resolved list. */
2417 : 2990227 : include (tinfo->resolved, left, right, result);
2418 : 2990227 : if (result == M2Check_false)
2419 : : {
2420 : : if (debugging)
2421 : : {
2422 : : libc_printf ((const char *) " known (%d, %d) false\\n", 26, left, right);
2423 : : }
2424 : : return false;
2425 : : }
2426 : : else
2427 : : {
2428 : : if (debugging)
2429 : : {
2430 : : libc_printf ((const char *) " known (%d, %d) true\\n", 25, left, right);
2431 : : }
2432 : : }
2433 : : }
2434 : : }
2435 : : return true;
2436 : : /* static analysis guarentees a RETURN statement will be used before here. */
2437 : : __builtin_unreachable ();
2438 : : }
2439 : :
2440 : :
2441 : : /*
2442 : : in - returns TRUE if the pair is in the list.
2443 : : */
2444 : :
2445 : 6768538 : static bool in (Indexing_Index pairs, unsigned int left, unsigned int right)
2446 : : {
2447 : 6768538 : unsigned int i;
2448 : 6768538 : unsigned int n;
2449 : 6768538 : M2Check_pair p;
2450 : :
2451 : 6768538 : i = 1;
2452 : 6768538 : n = Indexing_HighIndice (pairs);
2453 : 13881048 : while (i <= n)
2454 : : {
2455 : 631614 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2456 : 631614 : if (((p != NULL) && (p->left == left)) && (p->right == right))
2457 : : {
2458 : : return true;
2459 : : }
2460 : 343972 : i += 1;
2461 : : }
2462 : : return false;
2463 : : /* static analysis guarentees a RETURN statement will be used before here. */
2464 : : __builtin_unreachable ();
2465 : : }
2466 : :
2467 : :
2468 : : /*
2469 : : newPair -
2470 : : */
2471 : :
2472 : 20965849 : static M2Check_pair newPair (void)
2473 : : {
2474 : 20965849 : M2Check_pair p;
2475 : :
2476 : 20965849 : if (pairFreeList == NULL)
2477 : : {
2478 : 120106 : Storage_ALLOCATE ((void **) &p, sizeof (M2Check__T2));
2479 : : }
2480 : : else
2481 : : {
2482 : 20845743 : p = pairFreeList;
2483 : 20845743 : pairFreeList = p->next;
2484 : : }
2485 : 20965849 : M2Debug_Assert (p != NULL);
2486 : 20965849 : return p;
2487 : : /* static analysis guarentees a RETURN statement will be used before here. */
2488 : : __builtin_unreachable ();
2489 : : }
2490 : :
2491 : :
2492 : : /*
2493 : : disposePair - adds pair, p, to the free list.
2494 : : */
2495 : :
2496 : 20965837 : static void disposePair (M2Check_pair p)
2497 : : {
2498 : 20965837 : p->next = pairFreeList;
2499 : 9245897 : pairFreeList = p;
2500 : 11719940 : }
2501 : :
2502 : :
2503 : : /*
2504 : : deconstructIndex -
2505 : : */
2506 : :
2507 : 8980677 : static Indexing_Index deconstructIndex (Indexing_Index pairs)
2508 : : {
2509 : 8980677 : M2Check_pair p;
2510 : 8980677 : unsigned int i;
2511 : 8980677 : unsigned int n;
2512 : :
2513 : 8980677 : i = 1;
2514 : 8980677 : n = Indexing_HighIndice (pairs);
2515 : 38927191 : while (i <= n)
2516 : : {
2517 : 20965837 : p = static_cast<M2Check_pair> (Indexing_GetIndice (pairs, i));
2518 : 20965837 : if (p != NULL)
2519 : : {
2520 : 11719940 : disposePair (p);
2521 : : }
2522 : 20965837 : i += 1;
2523 : : }
2524 : 8980677 : return Indexing_KillIndex (pairs);
2525 : : /* static analysis guarentees a RETURN statement will be used before here. */
2526 : : __builtin_unreachable ();
2527 : : }
2528 : :
2529 : :
2530 : : /*
2531 : : deconstruct - deallocate the List data structure.
2532 : : */
2533 : :
2534 : 2993559 : static void deconstruct (M2Check_tInfo tinfo)
2535 : : {
2536 : 2993559 : tinfo->format = DynamicStrings_KillString (tinfo->format);
2537 : 2993559 : tinfo->visited = deconstructIndex (tinfo->visited);
2538 : 2993559 : tinfo->resolved = deconstructIndex (tinfo->resolved);
2539 : 2993559 : tinfo->unresolved = deconstructIndex (tinfo->unresolved);
2540 : 2993559 : }
2541 : :
2542 : :
2543 : : /*
2544 : : newtInfo -
2545 : : */
2546 : :
2547 : 2993571 : static M2Check_tInfo newtInfo (void)
2548 : : {
2549 : 2993571 : M2Check_tInfo tinfo;
2550 : :
2551 : 2993571 : if (tinfoFreeList == NULL)
2552 : : {
2553 : 2993571 : Storage_ALLOCATE ((void **) &tinfo, sizeof (M2Check__T3));
2554 : : }
2555 : : else
2556 : : {
2557 : 0 : tinfo = tinfoFreeList;
2558 : 0 : tinfoFreeList = tinfoFreeList->next;
2559 : : }
2560 : 2993571 : return tinfo;
2561 : : /* static analysis guarentees a RETURN statement will be used before here. */
2562 : : __builtin_unreachable ();
2563 : : }
2564 : :
2565 : :
2566 : : /*
2567 : : collapseString - if the string, a, is "" then return NIL otherwise create
2568 : : and return a dynamic string.
2569 : : */
2570 : :
2571 : 2993571 : static DynamicStrings_String collapseString (const char *a_, unsigned int _a_high)
2572 : : {
2573 : 2993571 : char a[_a_high+1];
2574 : :
2575 : : /* make a local copy of each unbounded array. */
2576 : 2993571 : memcpy (a, a_, _a_high+1);
2577 : :
2578 : 2993571 : if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "", 0))
2579 : : {
2580 : : return static_cast<DynamicStrings_String> (NULL);
2581 : : }
2582 : : else
2583 : : {
2584 : 1193447 : return DynamicStrings_InitString ((const char *) a, _a_high);
2585 : : }
2586 : : /* static analysis guarentees a RETURN statement will be used before here. */
2587 : : __builtin_unreachable ();
2588 : 2993571 : }
2589 : :
2590 : :
2591 : : /*
2592 : : doExpressionTypeCompatible -
2593 : : */
2594 : :
2595 : 200657 : static bool doExpressionTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int left, unsigned int right, bool strict)
2596 : : {
2597 : 200657 : M2Check_tInfo tinfo;
2598 : 200657 : char format[_format_high+1];
2599 : :
2600 : : /* make a local copy of each unbounded array. */
2601 : 200657 : memcpy (format, format_, _format_high+1);
2602 : :
2603 : 401314 : tinfo = newtInfo ();
2604 : 200657 : tinfo->format = collapseString ((const char *) format, _format_high);
2605 : 200657 : tinfo->token = token;
2606 : 200657 : tinfo->kind = M2Check_expression;
2607 : 200657 : tinfo->actual = SymbolTable_NulSym;
2608 : 200657 : tinfo->formal = SymbolTable_NulSym;
2609 : 200657 : tinfo->procedure = SymbolTable_NulSym;
2610 : 200657 : tinfo->nth = 0;
2611 : 200657 : tinfo->isvar = false;
2612 : 200657 : tinfo->error = static_cast<M2Error_Error> (NULL);
2613 : 200657 : tinfo->left = left;
2614 : 200657 : tinfo->right = right;
2615 : 200657 : tinfo->checkFunc.proc = static_cast<M2Check_typeCheckFunction_t> (determineCompatible);
2616 : 200657 : tinfo->visited = Indexing_InitIndex (1);
2617 : 200657 : tinfo->resolved = Indexing_InitIndex (1);
2618 : 200657 : tinfo->unresolved = Indexing_InitIndex (1);
2619 : 200657 : tinfo->strict = strict;
2620 : 200657 : tinfo->isin = false;
2621 : 200657 : include (tinfo->unresolved, left, right, M2Check_unknown);
2622 : 200657 : if (doCheck (tinfo))
2623 : : {
2624 : 200411 : deconstruct (tinfo);
2625 : 200411 : return true;
2626 : : }
2627 : : else
2628 : : {
2629 : 234 : deconstruct (tinfo);
2630 : 234 : return false;
2631 : : }
2632 : : /* static analysis guarentees a RETURN statement will be used before here. */
2633 : : __builtin_unreachable ();
2634 : 200657 : }
2635 : :
2636 : :
2637 : : /*
2638 : : init - initialise all global data structures for this module.
2639 : : */
2640 : :
2641 : 15942 : static void init (void)
2642 : : {
2643 : 15942 : pairFreeList = NULL;
2644 : 15942 : tinfoFreeList = NULL;
2645 : 15942 : errors = Indexing_InitIndex (1);
2646 : 15942 : }
2647 : :
2648 : :
2649 : : /*
2650 : : ParameterTypeCompatible - returns TRUE if the nth procedure parameter formal
2651 : : is compatible with actual.
2652 : : */
2653 : :
2654 : 1074368 : 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)
2655 : : {
2656 : 1074368 : unsigned int formalT;
2657 : 1074368 : unsigned int actualT;
2658 : 1074368 : M2Check_tInfo tinfo;
2659 : 1074368 : char format[_format_high+1];
2660 : :
2661 : : /* make a local copy of each unbounded array. */
2662 : 1074368 : memcpy (format, format_, _format_high+1);
2663 : :
2664 : 2148736 : tinfo = newtInfo ();
2665 : 1074368 : formalT = getSType (formal);
2666 : 1074368 : actualT = getSType (actual);
2667 : 1074368 : tinfo->format = collapseString ((const char *) format, _format_high);
2668 : 1074368 : tinfo->token = token;
2669 : 1074368 : tinfo->kind = M2Check_parameter;
2670 : 1074368 : tinfo->actual = actual;
2671 : 1074368 : tinfo->formal = formal;
2672 : 1074368 : tinfo->procedure = procedure;
2673 : 1074368 : tinfo->nth = nth;
2674 : 1074368 : tinfo->isvar = isvar;
2675 : 1074368 : tinfo->error = static_cast<M2Error_Error> (NULL);
2676 : 1074368 : tinfo->left = formalT;
2677 : 1074368 : tinfo->right = actualT;
2678 : 1074368 : tinfo->checkFunc.proc = static_cast<M2Check_typeCheckFunction_t> (determineCompatible);
2679 : 1074368 : tinfo->visited = Indexing_InitIndex (1);
2680 : 1074368 : tinfo->resolved = Indexing_InitIndex (1);
2681 : 1074368 : tinfo->unresolved = Indexing_InitIndex (1);
2682 : 1074368 : tinfo->strict = false;
2683 : 1074368 : tinfo->isin = false;
2684 : 1074368 : include (tinfo->unresolved, actual, formal, M2Check_unknown);
2685 : 1074368 : if (debugging)
2686 : : {
2687 : : dumptInfo (tinfo);
2688 : : }
2689 : 1074368 : if (doCheck (tinfo))
2690 : : {
2691 : 1073936 : deconstruct (tinfo);
2692 : 1073936 : return true;
2693 : : }
2694 : : else
2695 : : {
2696 : 432 : deconstruct (tinfo);
2697 : 432 : return false;
2698 : : }
2699 : : /* static analysis guarentees a RETURN statement will be used before here. */
2700 : : __builtin_unreachable ();
2701 : 1074368 : }
2702 : :
2703 : :
2704 : : /*
2705 : : AssignmentTypeCompatible - returns TRUE if the des and the expr are assignment compatible.
2706 : : */
2707 : :
2708 : 1718546 : extern "C" bool M2Check_AssignmentTypeCompatible (unsigned int token, const char *format_, unsigned int _format_high, unsigned int des, unsigned int expr)
2709 : : {
2710 : 1718546 : M2Check_tInfo tinfo;
2711 : 1718546 : char format[_format_high+1];
2712 : :
2713 : : /* make a local copy of each unbounded array. */
2714 : 1718546 : memcpy (format, format_, _format_high+1);
2715 : :
2716 : 3437092 : tinfo = newtInfo ();
2717 : 1718546 : tinfo->format = collapseString ((const char *) format, _format_high);
2718 : 1718546 : tinfo->token = token;
2719 : 1718546 : tinfo->kind = M2Check_assignment;
2720 : 1718546 : tinfo->actual = SymbolTable_NulSym;
2721 : 1718546 : tinfo->formal = SymbolTable_NulSym;
2722 : 1718546 : tinfo->procedure = SymbolTable_NulSym;
2723 : 1718546 : tinfo->nth = 0;
2724 : 1718546 : tinfo->isvar = false;
2725 : 1718546 : tinfo->error = static_cast<M2Error_Error> (NULL);
2726 : 1718546 : tinfo->left = des;
2727 : 1718546 : tinfo->right = expr;
2728 : 1718546 : tinfo->checkFunc.proc = static_cast<M2Check_typeCheckFunction_t> (determineCompatible);
2729 : 1718546 : tinfo->visited = Indexing_InitIndex (1);
2730 : 1718546 : tinfo->resolved = Indexing_InitIndex (1);
2731 : 1718546 : tinfo->unresolved = Indexing_InitIndex (1);
2732 : 1718546 : include (tinfo->unresolved, des, expr, M2Check_unknown);
2733 : 1718546 : tinfo->strict = false;
2734 : 1718546 : tinfo->isin = false;
2735 : 1718546 : if (doCheck (tinfo))
2736 : : {
2737 : 1717808 : deconstruct (tinfo);
2738 : 1717808 : return true;
2739 : : }
2740 : : else
2741 : : {
2742 : 738 : deconstruct (tinfo);
2743 : 738 : return false;
2744 : : }
2745 : : /* static analysis guarentees a RETURN statement will be used before here. */
2746 : : __builtin_unreachable ();
2747 : 1718546 : }
2748 : :
2749 : :
2750 : : /*
2751 : : ExpressionTypeCompatible - returns TRUE if the expressions, left and right,
2752 : : are expression compatible.
2753 : : */
2754 : :
2755 : 200657 : 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)
2756 : : {
2757 : 200657 : char format[_format_high+1];
2758 : :
2759 : : /* make a local copy of each unbounded array. */
2760 : 200657 : memcpy (format, format_, _format_high+1);
2761 : :
2762 : 200657 : if ((left != SymbolTable_NulSym) && (right != SymbolTable_NulSym))
2763 : : {
2764 : 200645 : if (isin)
2765 : : {
2766 : 5112 : if ((SymbolTable_IsConst (right)) || (SymbolTable_IsVar (right)))
2767 : : {
2768 : 3418 : right = getSType (right);
2769 : : }
2770 : 5112 : if (SymbolTable_IsSet (right))
2771 : : {
2772 : 4938 : right = getSType (right);
2773 : : }
2774 : : }
2775 : : }
2776 : 200657 : return doExpressionTypeCompatible (token, (const char *) format, _format_high, left, right, strict);
2777 : : /* static analysis guarentees a RETURN statement will be used before here. */
2778 : : __builtin_unreachable ();
2779 : 200657 : }
2780 : :
2781 : 15942 : extern "C" void _M2_M2Check_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
2782 : : {
2783 : 15942 : init ();
2784 : 15942 : }
2785 : :
2786 : 0 : extern "C" void _M2_M2Check_fini (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
2787 : : {
2788 : 0 : }
|
