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