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