Branch data Line data Source code
1 : : /* do not edit automatically generated by mc from M2Base. */
2 : : /* M2Base.mod provides a mechanism to check fundamental types.
3 : :
4 : : Copyright (C) 2001-2024 Free Software Foundation, Inc.
5 : : Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 : :
7 : : This file is part of GNU Modula-2.
8 : :
9 : : GNU Modula-2 is free software; you can redistribute it and/or modify
10 : : it under the terms of the GNU General Public License as published by
11 : : the Free Software Foundation; either version 3, or (at your option)
12 : : any later version.
13 : :
14 : : GNU Modula-2 is distributed in the hope that it will be useful, but
15 : : WITHOUT ANY WARRANTY; without even the implied warranty of
16 : : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 : : General Public License for more details.
18 : :
19 : : You should have received a copy of the GNU General Public License
20 : : along with GNU Modula-2; see the file COPYING3. If not see
21 : : <http://www.gnu.org/licenses/>. */
22 : :
23 : : #include "config.h"
24 : : #include "system.h"
25 : : #include <stdbool.h>
26 : : # if !defined (PROC_D)
27 : : # define PROC_D
28 : : typedef void (*PROC_t) (void);
29 : : typedef struct { PROC_t proc; } PROC;
30 : : # endif
31 : :
32 : : # if !defined (TRUE)
33 : : # define TRUE (1==1)
34 : : # endif
35 : :
36 : : # if !defined (FALSE)
37 : : # define FALSE (1==0)
38 : : # endif
39 : :
40 : : # include "Gmcrts.h"
41 : : #define _M2Base_H
42 : : #define _M2Base_C
43 : :
44 : : # include "GDynamicStrings.h"
45 : : # include "GM2LexBuf.h"
46 : : # include "GNameKey.h"
47 : : # include "GM2Debug.h"
48 : : # include "GSYSTEM.h"
49 : : # include "GM2Error.h"
50 : : # include "GM2Pass.h"
51 : : # include "GFormatStrings.h"
52 : : # include "GStrLib.h"
53 : : # include "GM2MetaError.h"
54 : : # include "GSymbolTable.h"
55 : : # include "GM2ALU.h"
56 : : # include "GM2Batch.h"
57 : : # include "GM2Bitset.h"
58 : : # include "GM2Size.h"
59 : : # include "GM2System.h"
60 : : # include "GM2Options.h"
61 : : # include "Gm2type.h"
62 : : # include "Gm2expr.h"
63 : : # include "Gm2linemap.h"
64 : : # include "Gm2decl.h"
65 : :
66 : : unsigned int M2Base_ExceptionNo;
67 : : unsigned int M2Base_ExceptionParameterBounds;
68 : : unsigned int M2Base_ExceptionRealValue;
69 : : unsigned int M2Base_ExceptionWholeValue;
70 : : unsigned int M2Base_ExceptionZeroRem;
71 : : unsigned int M2Base_ExceptionZeroDiv;
72 : : unsigned int M2Base_ExceptionNonPosMod;
73 : : unsigned int M2Base_ExceptionNonPosDiv;
74 : : unsigned int M2Base_ExceptionCase;
75 : : unsigned int M2Base_ExceptionNoReturn;
76 : : unsigned int M2Base_ExceptionPointerNil;
77 : : unsigned int M2Base_ExceptionForLoopEnd;
78 : : unsigned int M2Base_ExceptionForLoopTo;
79 : : unsigned int M2Base_ExceptionForLoopBegin;
80 : : unsigned int M2Base_ExceptionDynamicArray;
81 : : unsigned int M2Base_ExceptionStaticArray;
82 : : unsigned int M2Base_ExceptionRotate;
83 : : unsigned int M2Base_ExceptionShift;
84 : : unsigned int M2Base_ExceptionExcl;
85 : : unsigned int M2Base_ExceptionIncl;
86 : : unsigned int M2Base_ExceptionDec;
87 : : unsigned int M2Base_ExceptionInc;
88 : : unsigned int M2Base_ExceptionReturn;
89 : : unsigned int M2Base_ExceptionAssign;
90 : : unsigned int M2Base_ActivationPointer;
91 : : unsigned int M2Base_TemplateProcedure;
92 : : unsigned int M2Base_Excl;
93 : : unsigned int M2Base_Incl;
94 : : unsigned int M2Base_Dec;
95 : : unsigned int M2Base_Inc;
96 : : unsigned int M2Base_Dispose;
97 : : unsigned int M2Base_New;
98 : : unsigned int M2Base_Max;
99 : : unsigned int M2Base_Min;
100 : : unsigned int M2Base_Val;
101 : : unsigned int M2Base_Chr;
102 : : unsigned int M2Base_Odd;
103 : : unsigned int M2Base_Abs;
104 : : unsigned int M2Base_Cap;
105 : : unsigned int M2Base_Cmplx;
106 : : unsigned int M2Base_Im;
107 : : unsigned int M2Base_Re;
108 : : unsigned int M2Base_Convert;
109 : : unsigned int M2Base_LengthS;
110 : : unsigned int M2Base_High;
111 : : unsigned int M2Base_ShortComplex;
112 : : unsigned int M2Base_LongComplex;
113 : : unsigned int M2Base_Complex;
114 : : unsigned int M2Base_ShortReal;
115 : : unsigned int M2Base_LongReal;
116 : : unsigned int M2Base_Real;
117 : : unsigned int M2Base_CType;
118 : : unsigned int M2Base_RType;
119 : : unsigned int M2Base_ZType;
120 : : unsigned int M2Base_ShortCard;
121 : : unsigned int M2Base_ShortInt;
122 : : unsigned int M2Base_LongCard;
123 : : unsigned int M2Base_LongInt;
124 : : unsigned int M2Base_Proc;
125 : : unsigned int M2Base_Char;
126 : : unsigned int M2Base_False;
127 : : unsigned int M2Base_True;
128 : : unsigned int M2Base_Boolean;
129 : : unsigned int M2Base_Integer;
130 : : unsigned int M2Base_Cardinal;
131 : : unsigned int M2Base_Nil;
132 : : typedef struct M2Base_CompatibilityArray_a M2Base_CompatibilityArray;
133 : :
134 : : typedef struct M2Base__T1_a M2Base__T1;
135 : :
136 : : typedef enum {M2Base_const, M2Base_word, M2Base_byte, M2Base_address, M2Base_chr, M2Base_normint, M2Base_shortint, M2Base_longint, M2Base_normcard, M2Base_shortcard, M2Base_longcard, M2Base_pointer, M2Base_enum, M2Base_real, M2Base_shortreal, M2Base_longreal, M2Base_set, M2Base_opaque, M2Base_loc, M2Base_rtype, M2Base_ztype, M2Base_int8, M2Base_int16, M2Base_int32, M2Base_int64, M2Base_card8, M2Base_card16, M2Base_card32, M2Base_card64, M2Base_word16, M2Base_word32, M2Base_word64, M2Base_real32, M2Base_real64, M2Base_real96, M2Base_real128, M2Base_set8, M2Base_set16, M2Base_set32, M2Base_complex, M2Base_shortcomplex, M2Base_longcomplex, M2Base_complex32, M2Base_complex64, M2Base_complex96, M2Base_complex128, M2Base_ctype, M2Base_rec, M2Base_array, M2Base_procedure, M2Base_unknown} M2Base_MetaType;
137 : :
138 : : typedef enum {M2Base_uninitialized, M2Base_no, M2Base_warnfirst, M2Base_warnsecond, M2Base_first, M2Base_second} M2Base_Compatible;
139 : :
140 : : typedef enum {M2Base_expression, M2Base_assignment, M2Base_parameter, M2Base_comparison} M2Base_Compatability;
141 : :
142 : : struct M2Base__T1_a { M2Base_Compatible array[M2Base_unknown-M2Base_const+1]; };
143 : : struct M2Base_CompatibilityArray_a { M2Base__T1 array[M2Base_unknown-M2Base_const+1]; };
144 : : static M2Base_CompatibilityArray Comp;
145 : : static M2Base_CompatibilityArray Expr;
146 : : static M2Base_CompatibilityArray Ass;
147 : : static unsigned int Ord;
148 : : static unsigned int OrdS;
149 : : static unsigned int OrdL;
150 : : static unsigned int Float;
151 : : static unsigned int FloatS;
152 : : static unsigned int SFloat;
153 : : static unsigned int FloatL;
154 : : static unsigned int LFloat;
155 : : static unsigned int Trunc;
156 : : static unsigned int TruncS;
157 : : static unsigned int TruncL;
158 : : static unsigned int Int;
159 : : static unsigned int IntS;
160 : : static unsigned int IntL;
161 : : static unsigned int m2rts;
162 : : static unsigned int MinReal;
163 : : static unsigned int MaxReal;
164 : : static unsigned int MinShortReal;
165 : : static unsigned int MaxShortReal;
166 : : static unsigned int MinLongReal;
167 : : static unsigned int MaxLongReal;
168 : : static unsigned int MinLongInt;
169 : : static unsigned int MaxLongInt;
170 : : static unsigned int MinLongCard;
171 : : static unsigned int MaxLongCard;
172 : : static unsigned int MinShortInt;
173 : : static unsigned int MaxShortInt;
174 : : static unsigned int MinShortCard;
175 : : static unsigned int MaxShortCard;
176 : : static unsigned int MinChar;
177 : : static unsigned int MaxChar;
178 : : static unsigned int MinCardinal;
179 : : static unsigned int MaxCardinal;
180 : : static unsigned int MinInteger;
181 : : static unsigned int MaxInteger;
182 : : static unsigned int MaxEnum;
183 : : static unsigned int MinEnum;
184 : :
185 : : /*
186 : : InitBase - initializes the base types and procedures
187 : : used in the Modula-2 compiler.
188 : : */
189 : :
190 : : extern "C" void M2Base_InitBase (m2linemap_location_t location, unsigned int *sym);
191 : :
192 : : /*
193 : : GetBaseTypeMinMax - returns the minimum and maximum values for a
194 : : given base type. This procedure should only
195 : : be called if the type is NOT a subrange.
196 : : */
197 : :
198 : : extern "C" void M2Base_GetBaseTypeMinMax (unsigned int type, unsigned int *min, unsigned int *max);
199 : :
200 : : /*
201 : : IsPseudoBaseFunction - returns true if Sym is a Base pseudo function.
202 : : */
203 : :
204 : : extern "C" bool M2Base_IsPseudoBaseFunction (unsigned int Sym);
205 : :
206 : : /*
207 : : IsPseudoBaseProcedure - returns true if Sym is a Base pseudo procedure.
208 : : */
209 : :
210 : : extern "C" bool M2Base_IsPseudoBaseProcedure (unsigned int Sym);
211 : :
212 : : /*
213 : : IsNeededAtRunTime - returns TRUE if procedure, sym, is a
214 : : runtime procedure. A runtime procedure is
215 : : not a pseudo procedure (like NEW/DISPOSE)
216 : : and it is implemented in M2RTS or SYSTEM
217 : : and also exported.
218 : : */
219 : :
220 : : extern "C" bool M2Base_IsNeededAtRunTime (unsigned int tok, unsigned int sym);
221 : :
222 : : /*
223 : : IsBaseType - returns TRUE if Sym is a Base type.
224 : : */
225 : :
226 : : extern "C" bool M2Base_IsBaseType (unsigned int Sym);
227 : :
228 : : /*
229 : : IsOrdinalType - returns TRUE if, sym, is an ordinal type.
230 : : An ordinal type is defined as:
231 : : a base type which contains whole numbers or
232 : : a subrange type or an enumeration type.
233 : : */
234 : :
235 : : extern "C" bool M2Base_IsOrdinalType (unsigned int Sym);
236 : :
237 : : /*
238 : : IsOrd - returns TRUE if, sym, is ORD or its typed counterparts
239 : : ORDL, ORDS.
240 : : */
241 : :
242 : : extern "C" bool M2Base_IsOrd (unsigned int sym);
243 : :
244 : : /*
245 : : IsTrunc - returns TRUE if, sym, is TRUNC or its typed counterparts
246 : : TRUNCL, TRUNCS.
247 : : */
248 : :
249 : : extern "C" bool M2Base_IsTrunc (unsigned int sym);
250 : :
251 : : /*
252 : : IsFloat - returns TRUE if, sym, is FLOAT or its typed counterparts
253 : : FLOATL, FLOATS.
254 : : */
255 : :
256 : : extern "C" bool M2Base_IsFloat (unsigned int sym);
257 : :
258 : : /*
259 : : IsInt - returns TRUE if, sym, is INT or its typed counterparts
260 : : INTL, INTS.
261 : : */
262 : :
263 : : extern "C" bool M2Base_IsInt (unsigned int sym);
264 : :
265 : : /*
266 : : AssignmentRequiresWarning - returns TRUE if t1 and t2 can be used during
267 : : an assignment, but should generate a warning.
268 : : For example in PIM we can assign ADDRESS
269 : : and WORD providing they are both the
270 : : same size.
271 : : No warning is necessary if the types are the same.
272 : : */
273 : :
274 : : extern "C" bool M2Base_AssignmentRequiresWarning (unsigned int t1, unsigned int t2);
275 : :
276 : : /*
277 : : IsAssignmentCompatible - returns TRUE if t1 and t2 are assignment
278 : : compatible.
279 : : */
280 : :
281 : : extern "C" bool M2Base_IsAssignmentCompatible (unsigned int t1, unsigned int t2);
282 : :
283 : : /*
284 : : IsExpressionCompatible - returns TRUE if t1 and t2 are expression
285 : : compatible.
286 : : */
287 : :
288 : : extern "C" bool M2Base_IsExpressionCompatible (unsigned int t1, unsigned int t2);
289 : :
290 : : /*
291 : : IsParameterCompatible - returns TRUE if t1 and t2 are expression
292 : : compatible.
293 : : */
294 : :
295 : : extern "C" bool M2Base_IsParameterCompatible (unsigned int t1, unsigned int t2);
296 : :
297 : : /*
298 : : IsComparisonCompatible - returns TRUE if t1 and t2 are comparison compatible.
299 : : */
300 : :
301 : : extern "C" bool M2Base_IsComparisonCompatible (unsigned int t1, unsigned int t2);
302 : :
303 : : /*
304 : : IsValidParameter - returns TRUE if an, actual, parameter can be passed
305 : : to the, formal, parameter. This differs from
306 : : IsParameterCompatible as this procedure includes checks
307 : : for unbounded formal parameters, var parameters and
308 : : constant actual parameters.
309 : : */
310 : :
311 : : extern "C" bool M2Base_IsValidParameter (unsigned int formal, unsigned int actual);
312 : :
313 : : /*
314 : : CheckExpressionCompatible - returns if t1 and t2 are compatible types for
315 : : +, -, *, DIV, >, <, =, etc.
316 : : If t1 and t2 are not compatible then an error
317 : : message is displayed.
318 : : */
319 : :
320 : : extern "C" void M2Base_CheckExpressionCompatible (unsigned int tok, unsigned int left, unsigned int right);
321 : :
322 : : /*
323 : : CheckAssignmentCompatible - returns if t1 and t2 are compatible types for
324 : : :=, =, #.
325 : : If t1 and t2 are not compatible then an error
326 : : message is displayed.
327 : : */
328 : :
329 : : extern "C" void M2Base_CheckAssignmentCompatible (unsigned int tok, unsigned int left, unsigned int right);
330 : :
331 : : /*
332 : : CheckParameterCompatible - checks to see if types, t1, and, t2, are
333 : : compatible for parameter passing.
334 : : */
335 : :
336 : : extern "C" void M2Base_CheckParameterCompatible (unsigned int tok, unsigned int t1, unsigned int t2);
337 : :
338 : : /*
339 : : CannotCheckTypeInPass3 - returns TRUE if we are unable to check the
340 : : type of, e, in pass 3.
341 : : */
342 : :
343 : : extern "C" bool M2Base_CannotCheckTypeInPass3 (unsigned int e);
344 : :
345 : : /*
346 : : MixTypes - given types, t1 and t2, returns a type symbol that
347 : : provides expression type compatibility.
348 : : NearTok is used to identify the source position if a type
349 : : incompatability occurs.
350 : : */
351 : :
352 : : extern "C" unsigned int M2Base_MixTypes (unsigned int t1, unsigned int t2, unsigned int NearTok);
353 : :
354 : : /*
355 : : NegateType - if the type is unsigned then returns the
356 : : signed equivalent.
357 : : */
358 : :
359 : : extern "C" unsigned int M2Base_NegateType (unsigned int type);
360 : :
361 : : /*
362 : : IsMathType - returns TRUE if the type is a mathematical type.
363 : : A mathematical type has a range larger than INTEGER.
364 : : (Typically SHORTREAL/REAL/LONGREAL/LONGINT/LONGCARD)
365 : : */
366 : :
367 : : extern "C" bool M2Base_IsMathType (unsigned int type);
368 : :
369 : : /*
370 : : IsRealType - returns TRUE if, t, is a real type.
371 : : */
372 : :
373 : : extern "C" bool M2Base_IsRealType (unsigned int t);
374 : :
375 : : /*
376 : : IsComplexType - returns TRUE if, sym, is COMPLEX,
377 : : LONGCOMPLEX or SHORTCOMPLEX.
378 : : */
379 : :
380 : : extern "C" bool M2Base_IsComplexType (unsigned int sym);
381 : :
382 : : /*
383 : : ComplexToScalar - returns the scalar (or base type) of the complex type, sym.
384 : : */
385 : :
386 : : extern "C" unsigned int M2Base_ComplexToScalar (unsigned int sym);
387 : :
388 : : /*
389 : : ScalarToComplex - given a real type, t, return the equivalent complex type.
390 : : */
391 : :
392 : : extern "C" unsigned int M2Base_ScalarToComplex (unsigned int sym);
393 : :
394 : : /*
395 : : GetCmplxReturnType - this code implements the table given in the
396 : : ISO standard Page 293 with an addition for
397 : : SHORTCOMPLEX.
398 : : */
399 : :
400 : : extern "C" unsigned int M2Base_GetCmplxReturnType (unsigned int t1, unsigned int t2);
401 : :
402 : : /*
403 : : InitBuiltins -
404 : : */
405 : :
406 : : static void InitBuiltins (void);
407 : :
408 : : /*
409 : : InitBaseConstants - initialises the base constant NIL.
410 : : */
411 : :
412 : : static void InitBaseConstants (void);
413 : :
414 : : /*
415 : : InitBaseSimpleTypes - initialises the base simple types,
416 : : CARDINAL, INTEGER, CHAR, BOOLEAN.
417 : : */
418 : :
419 : : static void InitBaseSimpleTypes (m2linemap_location_t location);
420 : :
421 : : /*
422 : : FindMinMaxEnum - finds the minimum and maximum enumeration fields.
423 : : */
424 : :
425 : : static void FindMinMaxEnum (unsigned int field);
426 : :
427 : : /*
428 : : ImportFrom - imports symbol, name, from module and returns the
429 : : symbol.
430 : : */
431 : :
432 : : static unsigned int ImportFrom (unsigned int tok, unsigned int module, const char *name_, unsigned int _name_high);
433 : :
434 : : /*
435 : : InitBaseProcedures - initialises the base procedures,
436 : : INC, DEC, INCL, EXCL, NEW and DISPOSE.
437 : : */
438 : :
439 : : static void InitBaseProcedures (void);
440 : :
441 : : /*
442 : : BuildOrdFunctions - creates ORD, ORDS, ORDL.
443 : : */
444 : :
445 : : static void BuildOrdFunctions (void);
446 : :
447 : : /*
448 : : BuildTruncFunctions - creates TRUNC, TRUNCS, TRUNCL.
449 : : */
450 : :
451 : : static void BuildTruncFunctions (void);
452 : :
453 : : /*
454 : : BuildFloatFunctions - creates TRUNC, TRUNCS, TRUNCL.
455 : : */
456 : :
457 : : static void BuildFloatFunctions (void);
458 : :
459 : : /*
460 : : BuildIntFunctions - creates INT, INTS, INTL.
461 : : */
462 : :
463 : : static void BuildIntFunctions (void);
464 : :
465 : : /*
466 : : InitBaseFunctions - initialises the base function, HIGH.
467 : : */
468 : :
469 : : static void InitBaseFunctions (void);
470 : :
471 : : /*
472 : : IsISOPseudoBaseFunction -
473 : : */
474 : :
475 : : static bool IsISOPseudoBaseFunction (unsigned int Sym);
476 : :
477 : : /*
478 : : IsPIMPseudoBaseFunction -
479 : : */
480 : :
481 : : static bool IsPIMPseudoBaseFunction (unsigned int Sym);
482 : :
483 : : /*
484 : : EmitTypeIncompatibleWarning - emit a type incompatibility warning.
485 : : */
486 : :
487 : : static void EmitTypeIncompatibleWarning (unsigned int tok, M2Base_Compatability kind, unsigned int t1, unsigned int t2);
488 : :
489 : : /*
490 : : EmitTypeIncompatibleError - emit a type incompatibility error.
491 : : */
492 : :
493 : : static void EmitTypeIncompatibleError (unsigned int tok, M2Base_Compatability kind, unsigned int t1, unsigned int t2);
494 : :
495 : : /*
496 : : CheckCompatible - returns if t1 and t2 are kind compatible
497 : : */
498 : :
499 : : static void CheckCompatible (unsigned int tok, unsigned int t1, unsigned int t2, M2Base_Compatability kind);
500 : :
501 : : /*
502 : : FindMetaType - returns the MetaType associated with, sym.
503 : : */
504 : :
505 : : static M2Base_MetaType FindMetaType (unsigned int sym);
506 : :
507 : : /*
508 : : IsBaseCompatible - returns an enumeration field determining whether a simple base type
509 : : comparison is legal.
510 : : */
511 : :
512 : : static M2Base_Compatible IsBaseCompatible (unsigned int t1, unsigned int t2, M2Base_Compatability kind);
513 : :
514 : : /*
515 : : IsCompatible - returns true if the types, t1, and, t2, are compatible.
516 : : */
517 : :
518 : : static M2Base_Compatible IsCompatible (unsigned int t1, unsigned int t2, M2Base_Compatability kind);
519 : :
520 : : /*
521 : : IsPointerSame - returns TRUE if pointers, a, and, b, are the same.
522 : : */
523 : :
524 : : static bool IsPointerSame (unsigned int a, unsigned int b, bool error);
525 : :
526 : : /*
527 : : IsSubrangeSame - checks to see whether the subranges are the same.
528 : : */
529 : :
530 : : static bool IsSubrangeSame (unsigned int a, unsigned int b);
531 : :
532 : : /*
533 : : IsVarientSame - returns TRUE if varient types, a, and, b, are identical.
534 : : */
535 : :
536 : : static bool IsVarientSame (unsigned int a, unsigned int b, bool error);
537 : :
538 : : /*
539 : : IsRecordSame -
540 : : */
541 : :
542 : : static bool IsRecordSame (unsigned int a, unsigned int b, bool error);
543 : :
544 : : /*
545 : : IsArraySame -
546 : : */
547 : :
548 : : static bool IsArraySame (unsigned int t1, unsigned int t2, bool error);
549 : :
550 : : /*
551 : : IsEnumerationSame -
552 : : */
553 : :
554 : : static bool IsEnumerationSame (unsigned int t1, unsigned int t2);
555 : :
556 : : /*
557 : : IsSetSame -
558 : : */
559 : :
560 : : static bool IsSetSame (unsigned int t1, unsigned int t2, bool error);
561 : :
562 : : /*
563 : : IsSameType - returns TRUE if
564 : : */
565 : :
566 : : static bool IsSameType (unsigned int t1, unsigned int t2, bool error);
567 : :
568 : : /*
569 : : IsProcTypeSame -
570 : : */
571 : :
572 : : static bool IsProcTypeSame (unsigned int p1, unsigned int p2, bool error);
573 : :
574 : : /*
575 : : doProcTypeCheck -
576 : : */
577 : :
578 : : static bool doProcTypeCheck (unsigned int p1, unsigned int p2, bool error);
579 : :
580 : : /*
581 : : AfterResolved - a thorough test for type compatibility.
582 : : */
583 : :
584 : : static M2Base_Compatible AfterResolved (unsigned int t1, unsigned int t2, M2Base_Compatability kind);
585 : :
586 : : /*
587 : : BeforeResolved - attempts to test for type compatibility before all types are
588 : : completely resolved. In particular set types and constructor
589 : : types are not fully known before the end of pass 3.
590 : : However we can test base types.
591 : : */
592 : :
593 : : static M2Base_Compatible BeforeResolved (unsigned int t1, unsigned int t2, M2Base_Compatability kind);
594 : :
595 : : /*
596 : : MixMetaTypes -
597 : : */
598 : :
599 : : static unsigned int MixMetaTypes (unsigned int t1, unsigned int t2, unsigned int NearTok);
600 : :
601 : : /*
602 : : IsUserType - return TRUE if type was created by the user as a synonym.
603 : : */
604 : :
605 : : static bool IsUserType (unsigned int type);
606 : :
607 : : /*
608 : : IsVarParamCompatible - returns TRUE if types, actual, and, formal
609 : : are compatible even if formal is a VAR
610 : : parameter.
611 : : */
612 : :
613 : : static bool IsVarParamCompatible (unsigned int actual, unsigned int formal);
614 : :
615 : : /*
616 : : IsArrayUnboundedCompatible - returns TRUE if unbounded or array types, t1, and, t2,
617 : : are compatible.
618 : : */
619 : :
620 : : static bool IsArrayUnboundedCompatible (unsigned int t1, unsigned int t2);
621 : :
622 : : /*
623 : : IsValidUnboundedParameter -
624 : : */
625 : :
626 : : static bool IsValidUnboundedParameter (unsigned int formal, unsigned int actual);
627 : :
628 : : /*
629 : : PushSizeOf - pushes the size of a meta type.
630 : : */
631 : :
632 : : static void PushSizeOf (M2Base_MetaType t);
633 : :
634 : : /*
635 : : IsSizeSame -
636 : : */
637 : :
638 : : static bool IsSizeSame (M2Base_MetaType t1, M2Base_MetaType t2);
639 : :
640 : : /*
641 : : InitArray -
642 : : */
643 : :
644 : : static void InitArray (M2Base_CompatibilityArray *c, M2Base_MetaType y, const char *a_, unsigned int _a_high);
645 : :
646 : : /*
647 : : A - initialize the assignment array
648 : : */
649 : :
650 : : static void A (M2Base_MetaType y, const char *a_, unsigned int _a_high);
651 : :
652 : : /*
653 : : E - initialize the expression array
654 : : */
655 : :
656 : : static void E (M2Base_MetaType y, const char *a_, unsigned int _a_high);
657 : :
658 : : /*
659 : : C - initialize the comparision array
660 : : */
661 : :
662 : : static void C (M2Base_MetaType y, const char *a_, unsigned int _a_high);
663 : :
664 : : /*
665 : : InitCompatibilityMatrices - initializes the tables above.
666 : : */
667 : :
668 : : static void InitCompatibilityMatrices (void);
669 : :
670 : :
671 : : /*
672 : : InitBuiltins -
673 : : */
674 : :
675 : 16817 : static void InitBuiltins (void)
676 : : {
677 : 16817 : unsigned int builtins;
678 : :
679 : 16817 : if (M2Options_DebugBuiltins)
680 : : {
681 : : /* We will need to parse this module as functions alloca/memcpy will be used. */
682 : 0 : builtins = M2Batch_MakeDefinitionSource (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "Builtins", 8));
683 : 0 : if (builtins == SymbolTable_NulSym)
684 : : {
685 : 0 : M2MetaError_MetaError0 ((const char *) "unable to find core module Builtins", 35);
686 : : }
687 : : }
688 : 16817 : }
689 : :
690 : :
691 : : /*
692 : : InitBaseConstants - initialises the base constant NIL.
693 : : */
694 : :
695 : 16817 : static void InitBaseConstants (void)
696 : : {
697 : 16817 : M2Base_Nil = SymbolTable_MakeConstVar (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "NIL", 3));
698 : 16817 : SymbolTable_PutConst (M2Base_Nil, M2System_Address);
699 : 16817 : }
700 : :
701 : :
702 : : /*
703 : : InitBaseSimpleTypes - initialises the base simple types,
704 : : CARDINAL, INTEGER, CHAR, BOOLEAN.
705 : : */
706 : :
707 : 16817 : static void InitBaseSimpleTypes (m2linemap_location_t location)
708 : : {
709 : 16817 : m2type_InitBaseTypes (location);
710 : 16817 : M2Base_ZType = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "Modula-2 base Z", 15));
711 : 16817 : SymbolTable_PutType (M2Base_ZType, SymbolTable_NulSym); /* Base Type */
712 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2ZType ())); /* Base Type */
713 : 16817 : SymbolTable_PopSize (M2Base_ZType);
714 : 16817 : M2Base_RType = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "Modula-2 base R", 15));
715 : 16817 : SymbolTable_PutType (M2Base_RType, SymbolTable_NulSym); /* Base Type */
716 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2RType ())); /* Base Type */
717 : 16817 : SymbolTable_PopSize (M2Base_RType);
718 : 16817 : M2Base_CType = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "Modula-2 base C", 15));
719 : 16817 : SymbolTable_PutType (M2Base_CType, SymbolTable_NulSym); /* Base Type */
720 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2CType ())); /* Base Type */
721 : 16817 : SymbolTable_PopSize (M2Base_CType);
722 : 16817 : M2Base_Integer = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "INTEGER", 7));
723 : 16817 : SymbolTable_PutType (M2Base_Integer, SymbolTable_NulSym); /* Base Type */
724 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2IntegerType ())); /* Base Type */
725 : 16817 : SymbolTable_PopSize (M2Base_Integer);
726 : 16817 : M2Base_Cardinal = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "CARDINAL", 8));
727 : 16817 : SymbolTable_PutType (M2Base_Cardinal, SymbolTable_NulSym);
728 : : /* Base Type */
729 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2CardinalType ()));
730 : 16817 : SymbolTable_PopSize (M2Base_Cardinal);
731 : 16817 : M2Base_LongInt = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "LONGINT", 7));
732 : 16817 : SymbolTable_PutType (M2Base_LongInt, SymbolTable_NulSym); /* Base Type */
733 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2LongIntType ())); /* Base Type */
734 : 16817 : SymbolTable_PopSize (M2Base_LongInt);
735 : 16817 : M2Base_LongCard = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "LONGCARD", 8));
736 : 16817 : SymbolTable_PutType (M2Base_LongCard, SymbolTable_NulSym); /* Base Type */
737 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2LongCardType ())); /* Base Type */
738 : 16817 : SymbolTable_PopSize (M2Base_LongCard);
739 : 16817 : M2Base_ShortInt = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "SHORTINT", 8));
740 : 16817 : SymbolTable_PutType (M2Base_ShortInt, SymbolTable_NulSym); /* Base Type */
741 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2ShortIntType ())); /* Base Type */
742 : 16817 : SymbolTable_PopSize (M2Base_ShortInt);
743 : 16817 : M2Base_ShortCard = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "SHORTCARD", 9));
744 : 16817 : SymbolTable_PutType (M2Base_ShortCard, SymbolTable_NulSym); /* Base Type */
745 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2ShortCardType ())); /* Base Type */
746 : 16817 : SymbolTable_PopSize (M2Base_ShortCard);
747 : 16817 : M2Base_Real = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "REAL", 4));
748 : 16817 : SymbolTable_PutType (M2Base_Real, SymbolTable_NulSym); /* Base Type */
749 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2RealType ())); /* Base Type */
750 : 16817 : SymbolTable_PopSize (M2Base_Real);
751 : 16817 : M2Base_ShortReal = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "SHORTREAL", 9));
752 : 16817 : SymbolTable_PutType (M2Base_ShortReal, SymbolTable_NulSym); /* Base Type */
753 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2ShortRealType ())); /* Base Type */
754 : 16817 : SymbolTable_PopSize (M2Base_ShortReal);
755 : 16817 : M2Base_LongReal = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "LONGREAL", 8));
756 : 16817 : SymbolTable_PutType (M2Base_LongReal, SymbolTable_NulSym); /* Base Type */
757 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2LongRealType ())); /* Base Type */
758 : 16817 : SymbolTable_PopSize (M2Base_LongReal);
759 : 16817 : M2Base_Complex = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "COMPLEX", 7));
760 : 16817 : SymbolTable_PutType (M2Base_Complex, SymbolTable_NulSym); /* Base Type */
761 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2ComplexType ())); /* Base Type */
762 : 16817 : SymbolTable_PopSize (M2Base_Complex);
763 : 16817 : M2Base_LongComplex = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "LONGCOMPLEX", 11));
764 : 16817 : SymbolTable_PutType (M2Base_LongComplex, SymbolTable_NulSym); /* Base Type */
765 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2LongComplexType ())); /* Base Type */
766 : 16817 : SymbolTable_PopSize (M2Base_LongComplex);
767 : 16817 : M2Base_ShortComplex = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "SHORTCOMPLEX", 12));
768 : 16817 : SymbolTable_PutType (M2Base_ShortComplex, SymbolTable_NulSym); /* Base Type */
769 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2ShortComplexType ())); /* Base Type */
770 : 16817 : SymbolTable_PopSize (M2Base_ShortComplex);
771 : 16817 : M2Base_Char = SymbolTable_MakeType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "CHAR", 4));
772 : 16817 : SymbolTable_PutType (M2Base_Char, SymbolTable_NulSym); /* Base Type */
773 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetM2CharType ())); /* Base Type */
774 : 16817 : SymbolTable_PopSize (M2Base_Char);
775 : : /*
776 : : Boolean = (FALSE, TRUE) ;
777 : : */
778 : 16817 : M2Base_Boolean = SymbolTable_MakeEnumeration (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "BOOLEAN", 7));
779 : 16817 : SymbolTable_PutFieldEnumeration (M2LexBuf_BuiltinTokenNo, M2Base_Boolean, NameKey_MakeKey ((const char *) "FALSE", 5));
780 : 16817 : SymbolTable_PutFieldEnumeration (M2LexBuf_BuiltinTokenNo, M2Base_Boolean, NameKey_MakeKey ((const char *) "TRUE", 4));
781 : 16817 : M2Base_True = SymbolTable_RequestSym (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "TRUE", 4));
782 : 16817 : M2Base_False = SymbolTable_RequestSym (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "FALSE", 5));
783 : 16817 : M2Base_Proc = SymbolTable_MakeProcType (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "PROC", 4));
784 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (location, m2type_GetProcType ()));
785 : 16817 : SymbolTable_PopSize (M2Base_Proc);
786 : : /* MinChar */
787 : 16817 : MinChar = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
788 : 16817 : M2ALU_PushIntegerTree (m2type_GetMinFrom (location, m2type_GetM2CharType ()));
789 : 16817 : SymbolTable_PopValue (MinChar);
790 : 16817 : SymbolTable_PutVar (MinChar, M2Base_Char);
791 : : /* MaxChar */
792 : 16817 : MaxChar = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
793 : 16817 : M2ALU_PushIntegerTree (m2type_GetMaxFrom (location, m2type_GetM2CharType ()));
794 : 16817 : SymbolTable_PopValue (MaxChar);
795 : 16817 : SymbolTable_PutVar (MaxChar, M2Base_Char);
796 : : /* MinInteger */
797 : 16817 : MinInteger = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
798 : 16817 : M2ALU_PushIntegerTree (m2type_GetMinFrom (location, m2type_GetM2IntegerType ()));
799 : 16817 : SymbolTable_PopValue (MinInteger);
800 : 16817 : SymbolTable_PutVar (MinInteger, M2Base_Integer);
801 : : /* MaxInteger */
802 : 16817 : MaxInteger = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
803 : 16817 : M2ALU_PushIntegerTree (m2type_GetMaxFrom (location, m2type_GetM2IntegerType ()));
804 : 16817 : SymbolTable_PopValue (MaxInteger);
805 : 16817 : SymbolTable_PutVar (MaxInteger, M2Base_Integer);
806 : : /* MinCardinal */
807 : 16817 : MinCardinal = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
808 : 16817 : M2ALU_PushIntegerTree (m2type_GetMinFrom (m2linemap_BuiltinsLocation (), m2type_GetM2CardinalType ()));
809 : 16817 : SymbolTable_PopValue (MinCardinal);
810 : 16817 : SymbolTable_PutVar (MinCardinal, M2Base_Cardinal);
811 : : /* MaxCardinal */
812 : 16817 : MaxCardinal = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
813 : 16817 : M2ALU_PushIntegerTree (m2type_GetMaxFrom (location, m2type_GetM2CardinalType ()));
814 : 16817 : SymbolTable_PopValue (MaxCardinal);
815 : 16817 : SymbolTable_PutVar (MaxCardinal, M2Base_Cardinal);
816 : : /* MinLongInt */
817 : 16817 : MinLongInt = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
818 : 16817 : M2ALU_PushIntegerTree (m2type_GetMinFrom (location, m2type_GetM2LongIntType ()));
819 : 16817 : SymbolTable_PopValue (MinLongInt);
820 : 16817 : SymbolTable_PutVar (MinLongInt, M2Base_LongInt);
821 : : /* MaxLongInt */
822 : 16817 : MaxLongInt = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
823 : 16817 : M2ALU_PushIntegerTree (m2type_GetMaxFrom (location, m2type_GetM2LongIntType ()));
824 : 16817 : SymbolTable_PopValue (MaxLongInt);
825 : 16817 : SymbolTable_PutVar (MaxLongInt, M2Base_LongInt);
826 : : /* MinLongCard */
827 : 16817 : MinLongCard = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
828 : 16817 : M2ALU_PushIntegerTree (m2type_GetMinFrom (location, m2type_GetM2LongCardType ()));
829 : 16817 : SymbolTable_PopValue (MinLongCard);
830 : 16817 : SymbolTable_PutVar (MinLongCard, M2Base_LongCard);
831 : : /* MinLongCard */
832 : 16817 : MaxLongCard = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
833 : 16817 : M2ALU_PushIntegerTree (m2type_GetMaxFrom (m2linemap_BuiltinsLocation (), m2type_GetM2LongCardType ()));
834 : 16817 : SymbolTable_PopValue (MaxLongCard);
835 : 16817 : SymbolTable_PutVar (MaxLongCard, M2Base_LongCard);
836 : : /* MinReal */
837 : 16817 : MinReal = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
838 : 16817 : M2ALU_PushRealTree (m2type_GetMinFrom (location, m2type_GetM2RealType ()));
839 : 16817 : SymbolTable_PopValue (MinReal);
840 : 16817 : SymbolTable_PutVar (MinReal, M2Base_Real);
841 : : /* MaxReal */
842 : 16817 : MaxReal = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
843 : 16817 : M2ALU_PushRealTree (m2type_GetMaxFrom (location, m2type_GetM2RealType ()));
844 : 16817 : SymbolTable_PopValue (MaxReal);
845 : 16817 : SymbolTable_PutVar (MaxReal, M2Base_Real);
846 : : /* MinShortReal */
847 : 16817 : MinShortReal = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
848 : 16817 : M2ALU_PushRealTree (m2type_GetMinFrom (location, m2type_GetM2ShortRealType ()));
849 : 16817 : SymbolTable_PopValue (MinShortReal);
850 : 16817 : SymbolTable_PutVar (MinShortReal, M2Base_ShortReal);
851 : : /* MaxShortReal */
852 : 16817 : MaxShortReal = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
853 : 16817 : M2ALU_PushRealTree (m2type_GetMaxFrom (location, m2type_GetM2ShortRealType ()));
854 : 16817 : SymbolTable_PopValue (MaxShortReal);
855 : 16817 : SymbolTable_PutVar (MaxShortReal, M2Base_ShortReal);
856 : : /* MinLongReal */
857 : 16817 : MinLongReal = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
858 : 16817 : M2ALU_PushRealTree (m2type_GetMinFrom (location, m2type_GetM2LongRealType ()));
859 : 16817 : SymbolTable_PopValue (MinLongReal);
860 : 16817 : SymbolTable_PutVar (MinLongReal, M2Base_LongReal);
861 : : /* MaxLongReal */
862 : 16817 : MaxLongReal = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
863 : 16817 : M2ALU_PushRealTree (m2type_GetMaxFrom (location, m2type_GetM2LongRealType ()));
864 : 16817 : SymbolTable_PopValue (MaxLongReal);
865 : 16817 : SymbolTable_PutVar (MaxLongReal, M2Base_LongReal);
866 : : /* MaxShortInt */
867 : 16817 : MaxShortInt = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
868 : 16817 : M2ALU_PushIntegerTree (m2type_GetMaxFrom (location, m2type_GetM2ShortIntType ()));
869 : 16817 : SymbolTable_PopValue (MaxShortInt);
870 : 16817 : SymbolTable_PutVar (MaxShortInt, M2Base_ShortInt);
871 : : /* MinShortInt */
872 : 16817 : MinShortInt = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
873 : 16817 : M2ALU_PushIntegerTree (m2type_GetMinFrom (location, m2type_GetM2ShortIntType ()));
874 : 16817 : SymbolTable_PopValue (MinShortInt);
875 : 16817 : SymbolTable_PutVar (MinShortInt, M2Base_ShortInt);
876 : : /* MaxShortCard */
877 : 16817 : MaxShortCard = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
878 : 16817 : M2ALU_PushIntegerTree (m2type_GetMaxFrom (location, m2type_GetM2ShortCardType ()));
879 : 16817 : SymbolTable_PopValue (MaxShortCard);
880 : 16817 : SymbolTable_PutVar (MaxShortCard, M2Base_ShortCard);
881 : : /* MinShortCard */
882 : 16817 : MinShortCard = SymbolTable_MakeTemporary (M2LexBuf_BuiltinTokenNo, SymbolTable_ImmediateValue);
883 : 16817 : M2ALU_PushIntegerTree (m2type_GetMinFrom (location, m2type_GetM2ShortCardType ()));
884 : 16817 : SymbolTable_PopValue (MinShortCard);
885 : 16817 : SymbolTable_PutVar (MinShortCard, M2Base_ShortCard);
886 : 16817 : }
887 : :
888 : :
889 : : /*
890 : : FindMinMaxEnum - finds the minimum and maximum enumeration fields.
891 : : */
892 : :
893 : 305829 : static void FindMinMaxEnum (unsigned int field)
894 : : {
895 : 305829 : if (MaxEnum == SymbolTable_NulSym)
896 : : {
897 : 68879 : MaxEnum = static_cast<unsigned int> (field);
898 : : }
899 : : else
900 : : {
901 : 236950 : SymbolTable_PushValue (field);
902 : 236950 : SymbolTable_PushValue (MaxEnum);
903 : 236950 : if (M2ALU_Gre (M2LexBuf_GetTokenNo ()))
904 : : {
905 : 9879 : MaxEnum = static_cast<unsigned int> (field);
906 : : }
907 : : }
908 : 305829 : if (MinEnum == SymbolTable_NulSym)
909 : : {
910 : 68879 : MinEnum = static_cast<unsigned int> (field);
911 : : }
912 : : else
913 : : {
914 : 236950 : SymbolTable_PushValue (field);
915 : 236950 : SymbolTable_PushValue (MinEnum);
916 : 236950 : if (M2ALU_Less (M2LexBuf_GetTokenNo ()))
917 : : {
918 : 210396 : MinEnum = static_cast<unsigned int> (field);
919 : : }
920 : : }
921 : 305829 : }
922 : :
923 : :
924 : : /*
925 : : ImportFrom - imports symbol, name, from module and returns the
926 : : symbol.
927 : : */
928 : :
929 : 57264 : static unsigned int ImportFrom (unsigned int tok, unsigned int module, const char *name_, unsigned int _name_high)
930 : : {
931 : 57264 : char name[_name_high+1];
932 : :
933 : : /* make a local copy of each unbounded array. */
934 : 57264 : memcpy (name, name_, _name_high+1);
935 : :
936 : 57264 : SymbolTable_PutImported (SymbolTable_GetExported (tok, module, NameKey_MakeKey ((const char *) name, _name_high)));
937 : 57264 : return SymbolTable_GetSym (NameKey_MakeKey ((const char *) name, _name_high));
938 : : /* static analysis guarentees a RETURN statement will be used before here. */
939 : : __builtin_unreachable ();
940 : 57264 : }
941 : :
942 : :
943 : : /*
944 : : InitBaseProcedures - initialises the base procedures,
945 : : INC, DEC, INCL, EXCL, NEW and DISPOSE.
946 : : */
947 : :
948 : 16817 : static void InitBaseProcedures (void)
949 : : {
950 : 16817 : unsigned int rtexceptions;
951 : :
952 : : /*
953 : : The pseudo procedures NEW and DISPOSE are in fact "macro"
954 : : substituted for ALLOCATE and DEALLOCATE.
955 : : However they both have symbols in the base module so that
956 : : the procedure mechanism treats all procedure calls the same.
957 : : "Macro" substitution occurs in M2Quads.
958 : : */
959 : 16817 : M2Base_New = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "NEW", 3));
960 : 16817 : M2Base_Dispose = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "DISPOSE", 7));
961 : 16817 : M2Base_Inc = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "INC", 3));
962 : 16817 : M2Base_Dec = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "DEC", 3));
963 : 16817 : M2Base_Incl = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "INCL", 4));
964 : 16817 : M2Base_Excl = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "EXCL", 4));
965 : 16817 : if (! M2Options_Pim2)
966 : : {
967 : : /* PIM-2 Modula-2 */
968 : 16731 : M2Size_MakeSize ();
969 : : }
970 : : /*
971 : : The procedure HALT is a real procedure which
972 : : is defined in M2RTS. However to remain compatible
973 : : with other Modula-2 implementations HALT can be used
974 : : without the need to import it from M2RTS. ie it is
975 : : within the BaseType module scope.
976 : : */
977 : 16817 : m2rts = M2Batch_MakeDefinitionSource (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "M2RTS", 5));
978 : 16817 : SymbolTable_PutImported (SymbolTable_GetExported (M2LexBuf_BuiltinTokenNo, m2rts, NameKey_MakeKey ((const char *) "HALT", 4)));
979 : 16817 : M2Base_ExceptionAssign = SymbolTable_NulSym;
980 : 16817 : M2Base_ExceptionReturn = SymbolTable_NulSym;
981 : 16817 : M2Base_ExceptionInc = SymbolTable_NulSym;
982 : 16817 : M2Base_ExceptionDec = SymbolTable_NulSym;
983 : 16817 : M2Base_ExceptionIncl = SymbolTable_NulSym;
984 : 16817 : M2Base_ExceptionExcl = SymbolTable_NulSym;
985 : 16817 : M2Base_ExceptionShift = SymbolTable_NulSym;
986 : 16817 : M2Base_ExceptionRotate = SymbolTable_NulSym;
987 : 16817 : M2Base_ExceptionStaticArray = SymbolTable_NulSym;
988 : 16817 : M2Base_ExceptionDynamicArray = SymbolTable_NulSym;
989 : 16817 : M2Base_ExceptionForLoopBegin = SymbolTable_NulSym;
990 : 16817 : M2Base_ExceptionForLoopTo = SymbolTable_NulSym;
991 : 16817 : M2Base_ExceptionForLoopEnd = SymbolTable_NulSym;
992 : 16817 : M2Base_ExceptionPointerNil = SymbolTable_NulSym;
993 : 16817 : M2Base_ExceptionNoReturn = SymbolTable_NulSym;
994 : 16817 : M2Base_ExceptionCase = SymbolTable_NulSym;
995 : 16817 : M2Base_ExceptionNonPosDiv = SymbolTable_NulSym;
996 : 16817 : M2Base_ExceptionNonPosMod = SymbolTable_NulSym;
997 : 16817 : M2Base_ExceptionZeroDiv = SymbolTable_NulSym;
998 : 16817 : M2Base_ExceptionZeroRem = SymbolTable_NulSym;
999 : 16817 : M2Base_ExceptionWholeValue = SymbolTable_NulSym;
1000 : 16817 : M2Base_ExceptionRealValue = SymbolTable_NulSym;
1001 : 16817 : M2Base_ExceptionParameterBounds = SymbolTable_NulSym;
1002 : 16817 : M2Base_ExceptionNo = SymbolTable_NulSym;
1003 : 16817 : if (M2Options_NilChecking)
1004 : : {
1005 : 1731 : M2Base_ExceptionPointerNil = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "PointerNilException", 19);
1006 : : }
1007 : 16817 : if (M2Options_RangeChecking)
1008 : : {
1009 : 1737 : M2Base_ExceptionAssign = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "AssignmentException", 19);
1010 : 1737 : M2Base_ExceptionReturn = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "ReturnException", 15);
1011 : 1737 : M2Base_ExceptionInc = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "IncException", 12);
1012 : 1737 : M2Base_ExceptionDec = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "DecException", 12);
1013 : 1737 : M2Base_ExceptionIncl = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "InclException", 13);
1014 : 1737 : M2Base_ExceptionExcl = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "ExclException", 13);
1015 : 1737 : M2Base_ExceptionShift = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "ShiftException", 14);
1016 : 1737 : M2Base_ExceptionRotate = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "RotateException", 15);
1017 : 1737 : M2Base_ExceptionForLoopBegin = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "ForLoopBeginException", 21);
1018 : 1737 : M2Base_ExceptionForLoopTo = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "ForLoopToException", 18);
1019 : 1737 : M2Base_ExceptionForLoopEnd = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "ForLoopEndException", 19);
1020 : 1737 : M2Base_ExceptionParameterBounds = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "ParameterException", 18);
1021 : : }
1022 : 16817 : if (M2Options_IndexChecking)
1023 : : {
1024 : 1731 : M2Base_ExceptionStaticArray = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "StaticArraySubscriptException", 29);
1025 : 1731 : M2Base_ExceptionDynamicArray = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "DynamicArraySubscriptException", 30);
1026 : : }
1027 : 16817 : if (M2Options_WholeDivChecking)
1028 : : {
1029 : 1731 : M2Base_ExceptionNonPosDiv = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "WholeNonPosDivException", 23);
1030 : 1731 : M2Base_ExceptionNonPosMod = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "WholeNonPosModException", 23);
1031 : 1731 : M2Base_ExceptionZeroDiv = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "WholeZeroDivException", 21);
1032 : 1731 : M2Base_ExceptionZeroRem = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "WholeZeroRemException", 21);
1033 : : }
1034 : 16817 : if (M2Options_ReturnChecking)
1035 : : {
1036 : 1731 : M2Base_ExceptionNoReturn = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "NoReturnException", 17);
1037 : : }
1038 : 16817 : if (M2Options_CaseElseChecking)
1039 : : {
1040 : 2311 : M2Base_ExceptionCase = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "CaseException", 13);
1041 : : }
1042 : 16817 : if (M2Options_WholeValueChecking)
1043 : : {
1044 : 1731 : M2Base_ExceptionWholeValue = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "WholeValueException", 19);
1045 : 1731 : M2Base_ExceptionRealValue = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "RealValueException", 18);
1046 : : }
1047 : 16817 : if (M2Options_Exceptions)
1048 : : {
1049 : 16799 : M2Base_ExceptionNo = ImportFrom (M2LexBuf_BuiltinTokenNo, m2rts, (const char *) "NoException", 11);
1050 : : /* ensure that this module is included */
1051 : 16799 : rtexceptions = M2Batch_MakeDefinitionSource (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "RTExceptions", 12));
1052 : 16799 : if (rtexceptions == SymbolTable_NulSym)
1053 : : {
1054 : 0 : M2MetaError_MetaError0 ((const char *) "unable to find required runtime module RTExceptions", 51);
1055 : : }
1056 : : }
1057 : 16817 : }
1058 : :
1059 : :
1060 : : /*
1061 : : BuildOrdFunctions - creates ORD, ORDS, ORDL.
1062 : : */
1063 : :
1064 : 16817 : static void BuildOrdFunctions (void)
1065 : : {
1066 : 16817 : Ord = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "ORD", 3));
1067 : 16817 : SymbolTable_PutFunction (Ord, M2Base_Cardinal);
1068 : 16817 : OrdS = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "ORDS", 4));
1069 : 16817 : SymbolTable_PutFunction (OrdS, M2Base_ShortCard);
1070 : 16817 : OrdL = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "ORDL", 4));
1071 : 16817 : SymbolTable_PutFunction (OrdL, M2Base_LongCard);
1072 : 16817 : }
1073 : :
1074 : :
1075 : : /*
1076 : : BuildTruncFunctions - creates TRUNC, TRUNCS, TRUNCL.
1077 : : */
1078 : :
1079 : 16817 : static void BuildTruncFunctions (void)
1080 : : {
1081 : 16817 : if ((M2Options_Pim2 || M2Options_Pim3) || M2Options_Iso)
1082 : : {
1083 : 3398 : Trunc = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "TRUNC", 5));
1084 : 3398 : SymbolTable_PutFunction (Trunc, M2Base_Cardinal);
1085 : 3398 : TruncS = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "STRUNC", 6));
1086 : 3398 : SymbolTable_PutFunction (TruncS, M2Base_ShortCard);
1087 : 3398 : TruncL = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "LTRUNC", 6));
1088 : 3398 : SymbolTable_PutFunction (TruncL, M2Base_LongCard);
1089 : : }
1090 : : else
1091 : : {
1092 : 13419 : Trunc = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "TRUNC", 5));
1093 : 13419 : SymbolTable_PutFunction (Trunc, M2Base_Integer);
1094 : 13419 : TruncS = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "STRUNC", 6));
1095 : 13419 : SymbolTable_PutFunction (TruncS, M2Base_ShortInt);
1096 : 13419 : TruncL = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "LTRUNC", 6));
1097 : 13419 : SymbolTable_PutFunction (TruncL, M2Base_LongInt);
1098 : : }
1099 : 16817 : }
1100 : :
1101 : :
1102 : : /*
1103 : : BuildFloatFunctions - creates TRUNC, TRUNCS, TRUNCL.
1104 : : */
1105 : :
1106 : 16817 : static void BuildFloatFunctions (void)
1107 : : {
1108 : 16817 : Float = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "FLOAT", 5));
1109 : 16817 : SymbolTable_PutFunction (Float, M2Base_Real);
1110 : 16817 : SFloat = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "SFLOAT", 6));
1111 : 16817 : SymbolTable_PutFunction (SFloat, M2Base_ShortReal);
1112 : 16817 : LFloat = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "LFLOAT", 6));
1113 : 16817 : SymbolTable_PutFunction (LFloat, M2Base_LongReal);
1114 : 16817 : FloatS = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "FLOATS", 6));
1115 : 16817 : SymbolTable_PutFunction (FloatS, M2Base_ShortReal);
1116 : 16817 : FloatL = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "FLOATL", 6));
1117 : 16817 : SymbolTable_PutFunction (FloatL, M2Base_LongReal);
1118 : 16817 : }
1119 : :
1120 : :
1121 : : /*
1122 : : BuildIntFunctions - creates INT, INTS, INTL.
1123 : : */
1124 : :
1125 : 16817 : static void BuildIntFunctions (void)
1126 : : {
1127 : 16817 : Int = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "INT", 3));
1128 : 16817 : SymbolTable_PutFunction (Int, M2Base_Integer);
1129 : 16817 : IntS = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "INTS", 4));
1130 : 16817 : SymbolTable_PutFunction (IntS, M2Base_ShortInt);
1131 : 16817 : IntL = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "INTL", 4));
1132 : 16817 : SymbolTable_PutFunction (IntL, M2Base_LongInt);
1133 : 16817 : }
1134 : :
1135 : :
1136 : : /*
1137 : : InitBaseFunctions - initialises the base function, HIGH.
1138 : : */
1139 : :
1140 : 16817 : static void InitBaseFunctions (void)
1141 : : {
1142 : : /* Now declare the dynamic array components, HIGH */
1143 : 16817 : M2Base_High = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "HIGH", 4)); /* Pseudo Base function HIGH */
1144 : 16817 : SymbolTable_PutFunction (M2Base_High, M2Base_Cardinal);
1145 : : /*
1146 : : _TemplateProcedure is a procedure which has a local variable _ActivationPointer
1147 : : whose offset is used for all nested procedures. (The activation pointer
1148 : : being in the same relative position for all procedures).
1149 : : */
1150 : 16817 : M2Base_TemplateProcedure = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "_TemplateProcedure", 18));
1151 : 16817 : SymbolTable_StartScope (M2Base_TemplateProcedure);
1152 : 16817 : M2Base_ActivationPointer = SymbolTable_MakeVar (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "_ActivationPointer", 18));
1153 : 16817 : SymbolTable_PutVar (M2Base_ActivationPointer, M2System_Address);
1154 : 16817 : SymbolTable_EndScope ();
1155 : : /* and the base functions */
1156 : 16817 : M2Base_Convert = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "CONVERT", 7)); /* Internal function CONVERT */
1157 : 16817 : if (M2Options_Iso) /* Internal function CONVERT */
1158 : : {
1159 : 3300 : M2Base_LengthS = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "LENGTH", 6)); /* Pseudo Base function LENGTH */
1160 : 3300 : SymbolTable_PutFunction (M2Base_LengthS, M2Base_ZType); /* Pseudo Base function LENGTH */
1161 : : }
1162 : : else
1163 : : {
1164 : 13517 : M2Base_LengthS = SymbolTable_NulSym;
1165 : : }
1166 : 16817 : M2Base_Abs = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "ABS", 3)); /* Pseudo Base function ABS */
1167 : 16817 : SymbolTable_PutFunction (M2Base_Abs, M2Base_ZType); /* Pseudo Base function ABS */
1168 : 16817 : M2Base_Cap = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "CAP", 3)); /* Pseudo Base function CAP */
1169 : 16817 : SymbolTable_PutFunction (M2Base_Cap, M2Base_Char); /* Pseudo Base function CAP */
1170 : 16817 : M2Base_Odd = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "ODD", 3)); /* Pseudo Base function ODD */
1171 : 16817 : SymbolTable_PutFunction (M2Base_Odd, M2Base_Boolean); /* Pseudo Base function ODD */
1172 : 16817 : M2Base_Chr = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "CHR", 3)); /* Pseudo Base function CHR */
1173 : 16817 : SymbolTable_PutFunction (M2Base_Chr, M2Base_Char);
1174 : : /* the parameters. */
1175 : 16817 : M2Base_Val = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "VAL", 3)); /* Pseudo Base function VAL */
1176 : 16817 : M2Base_Min = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "MIN", 3)); /* Pseudo Base function MIN */
1177 : 16817 : M2Base_Max = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "MAX", 3)); /* Pseudo Base function MIN */
1178 : 16817 : M2Base_Re = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "RE", 2)); /* Pseudo Base function RE */
1179 : 16817 : SymbolTable_PutFunction (M2Base_Re, M2Base_RType); /* Pseudo Base function RE */
1180 : 16817 : M2Base_Im = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "IM", 2)); /* Pseudo Base function IM */
1181 : 16817 : SymbolTable_PutFunction (M2Base_Im, M2Base_RType); /* Pseudo Base function IM */
1182 : 16817 : M2Base_Cmplx = SymbolTable_MakeProcedure (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "CMPLX", 5)); /* Pseudo Base function CMPLX */
1183 : 16817 : SymbolTable_PutFunction (M2Base_Cmplx, M2Base_CType); /* Pseudo Base function CMPLX */
1184 : 16817 : BuildFloatFunctions ();
1185 : 16817 : BuildTruncFunctions ();
1186 : 16817 : BuildOrdFunctions ();
1187 : 16817 : BuildIntFunctions ();
1188 : 16817 : }
1189 : :
1190 : :
1191 : : /*
1192 : : IsISOPseudoBaseFunction -
1193 : : */
1194 : :
1195 : 3642795 : static bool IsISOPseudoBaseFunction (unsigned int Sym)
1196 : : {
1197 : 3642795 : return (M2Options_Iso && (Sym != SymbolTable_NulSym)) && ((((((Sym == M2Base_LengthS) || (Sym == M2Size_Size)) || (Sym == M2Base_Cmplx)) || (Sym == M2Base_Re)) || (Sym == M2Base_Im)) || (M2Base_IsInt (Sym)));
1198 : : /* static analysis guarentees a RETURN statement will be used before here. */
1199 : : __builtin_unreachable ();
1200 : : }
1201 : :
1202 : :
1203 : : /*
1204 : : IsPIMPseudoBaseFunction -
1205 : : */
1206 : :
1207 : 3615377 : static bool IsPIMPseudoBaseFunction (unsigned int Sym)
1208 : : {
1209 : 3615377 : return ((! M2Options_Iso && ! M2Options_Pim2) && (Sym != SymbolTable_NulSym)) && (Sym == M2Size_Size);
1210 : : /* static analysis guarentees a RETURN statement will be used before here. */
1211 : : __builtin_unreachable ();
1212 : : }
1213 : :
1214 : :
1215 : : /*
1216 : : EmitTypeIncompatibleWarning - emit a type incompatibility warning.
1217 : : */
1218 : :
1219 : 0 : static void EmitTypeIncompatibleWarning (unsigned int tok, M2Base_Compatability kind, unsigned int t1, unsigned int t2)
1220 : : {
1221 : 0 : switch (kind)
1222 : : {
1223 : 0 : case M2Base_expression:
1224 : 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in an expression, hint one of the expressions should be converted", 141, t1, t2);
1225 : 0 : break;
1226 : :
1227 : 0 : case M2Base_assignment:
1228 : 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} during an assignment, hint maybe the expression should be converted", 143, t1, t2);
1229 : 0 : break;
1230 : :
1231 : 0 : case M2Base_parameter:
1232 : 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "{%1W:} type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} {%2as}}}, hint the actual parameter {%2a} should be converted", 191, t1, t2);
1233 : 0 : break;
1234 : :
1235 : 0 : case M2Base_comparison:
1236 : 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in a relational expression, hint one of the expressions should be converted", 151, t1, t2);
1237 : 0 : break;
1238 : :
1239 : :
1240 : : default:
1241 : : break;
1242 : : }
1243 : 0 : }
1244 : :
1245 : :
1246 : : /*
1247 : : EmitTypeIncompatibleError - emit a type incompatibility error.
1248 : : */
1249 : :
1250 : 24 : static void EmitTypeIncompatibleError (unsigned int tok, M2Base_Compatability kind, unsigned int t1, unsigned int t2)
1251 : : {
1252 : 24 : switch (kind)
1253 : : {
1254 : 0 : case M2Base_expression:
1255 : 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in an expression, hint one of the expressions should be converted", 138, t1, t2);
1256 : 0 : break;
1257 : :
1258 : 24 : case M2Base_assignment:
1259 : 24 : M2MetaError_MetaErrorT2 (tok, (const char *) "type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} during an assignment, hint maybe the expression should be converted", 140, t1, t2);
1260 : 24 : break;
1261 : :
1262 : 0 : case M2Base_parameter:
1263 : 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} and {%2as}}}, hint the actual parameter should be converted", 182, t1, t2);
1264 : 0 : break;
1265 : :
1266 : 0 : case M2Base_comparison:
1267 : 0 : M2MetaError_MetaErrorT2 (tok, (const char *) "type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in a relational expression, hint one of the expressions should be converted", 148, t1, t2);
1268 : 0 : break;
1269 : :
1270 : :
1271 : : default:
1272 : : break;
1273 : : }
1274 : 24 : }
1275 : :
1276 : :
1277 : : /*
1278 : : CheckCompatible - returns if t1 and t2 are kind compatible
1279 : : */
1280 : :
1281 : 22882 : static void CheckCompatible (unsigned int tok, unsigned int t1, unsigned int t2, M2Base_Compatability kind)
1282 : : {
1283 : 22882 : DynamicStrings_String s;
1284 : 22882 : M2Base_Compatible r;
1285 : :
1286 : 22882 : r = IsCompatible (t1, t2, kind);
1287 : 22882 : if ((r != M2Base_first) && (r != M2Base_second))
1288 : : {
1289 : 24 : if ((r == M2Base_warnfirst) || (r == M2Base_warnsecond))
1290 : : {
1291 : 0 : s = DynamicStrings_InitString ((const char *) "{%1W}", 5);
1292 : : }
1293 : : else
1294 : : {
1295 : 24 : s = DynamicStrings_InitString ((const char *) "", 0);
1296 : : }
1297 : 24 : if ((SymbolTable_IsUnknown (t1)) && (SymbolTable_IsUnknown (t2)))
1298 : : {
1299 : 0 : s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) "two different unknown types {%1a:{%2a:{%1a} and {%2a}}} must either be declared or imported)", 92));
1300 : 0 : M2MetaError_MetaErrorStringT2 (tok, s, t1, t2);
1301 : : }
1302 : 24 : else if (SymbolTable_IsUnknown (t1))
1303 : : {
1304 : : /* avoid dangling else. */
1305 : 0 : s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) "this type {%1a} is currently unknown, it must be declared or imported", 69));
1306 : 0 : M2MetaError_MetaErrorStringT1 (tok, s, t1);
1307 : : }
1308 : 24 : else if (SymbolTable_IsUnknown (t2))
1309 : : {
1310 : : /* avoid dangling else. */
1311 : 0 : s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) "this type {%1a} is currently unknown, it must be declared or imported", 69));
1312 : 0 : M2MetaError_MetaErrorStringT1 (tok, s, t2);
1313 : : }
1314 : : else
1315 : : {
1316 : : /* avoid dangling else. */
1317 : 24 : if ((r == M2Base_warnfirst) || (r == M2Base_warnsecond))
1318 : : {
1319 : 0 : EmitTypeIncompatibleWarning (tok, kind, t1, t2);
1320 : : }
1321 : : else
1322 : : {
1323 : 24 : EmitTypeIncompatibleError (tok, kind, t1, t2);
1324 : : }
1325 : : }
1326 : : }
1327 : 22882 : }
1328 : :
1329 : :
1330 : : /*
1331 : : FindMetaType - returns the MetaType associated with, sym.
1332 : : */
1333 : :
1334 : 1846814 : static M2Base_MetaType FindMetaType (unsigned int sym)
1335 : : {
1336 : 1888701 : if (sym == SymbolTable_NulSym)
1337 : : {
1338 : : return M2Base_const;
1339 : : }
1340 : 1846814 : else if (sym == M2System_Word)
1341 : : {
1342 : : /* avoid dangling else. */
1343 : : return M2Base_word;
1344 : : }
1345 : 1845954 : else if (sym == M2System_Byte)
1346 : : {
1347 : : /* avoid dangling else. */
1348 : : return M2Base_byte;
1349 : : }
1350 : 1845618 : else if (sym == M2System_Loc)
1351 : : {
1352 : : /* avoid dangling else. */
1353 : : return M2Base_loc;
1354 : : }
1355 : 1845602 : else if (sym == M2System_Address)
1356 : : {
1357 : : /* avoid dangling else. */
1358 : : return M2Base_address;
1359 : : }
1360 : 1696696 : else if (sym == M2Base_Char)
1361 : : {
1362 : : /* avoid dangling else. */
1363 : : return M2Base_chr;
1364 : : }
1365 : 1696392 : else if (sym == M2Base_Integer)
1366 : : {
1367 : : /* avoid dangling else. */
1368 : : return M2Base_normint;
1369 : : }
1370 : 1376234 : else if (sym == M2Base_ShortInt)
1371 : : {
1372 : : /* avoid dangling else. */
1373 : : return M2Base_shortint;
1374 : : }
1375 : 1375944 : else if (sym == M2Base_LongInt)
1376 : : {
1377 : : /* avoid dangling else. */
1378 : : return M2Base_longint;
1379 : : }
1380 : 1368422 : else if (sym == M2Base_Cardinal)
1381 : : {
1382 : : /* avoid dangling else. */
1383 : : return M2Base_normcard;
1384 : : }
1385 : 963737 : else if (sym == M2Base_ShortCard)
1386 : : {
1387 : : /* avoid dangling else. */
1388 : : return M2Base_shortcard;
1389 : : }
1390 : 963423 : else if (sym == M2Base_LongCard)
1391 : : {
1392 : : /* avoid dangling else. */
1393 : : return M2Base_longcard;
1394 : : }
1395 : 960611 : else if (sym == M2Base_ZType)
1396 : : {
1397 : : /* avoid dangling else. */
1398 : : return M2Base_ztype;
1399 : : }
1400 : 362337 : else if (sym == M2Base_RType)
1401 : : {
1402 : : /* avoid dangling else. */
1403 : : return M2Base_rtype;
1404 : : }
1405 : 327201 : else if (sym == M2Base_Real)
1406 : : {
1407 : : /* avoid dangling else. */
1408 : : return M2Base_real;
1409 : : }
1410 : 307783 : else if (sym == M2Base_ShortReal)
1411 : : {
1412 : : /* avoid dangling else. */
1413 : : return M2Base_shortreal;
1414 : : }
1415 : 304455 : else if (sym == M2Base_LongReal)
1416 : : {
1417 : : /* avoid dangling else. */
1418 : : return M2Base_longreal;
1419 : : }
1420 : 287499 : else if (sym == (M2System_IntegerN (8)))
1421 : : {
1422 : : /* avoid dangling else. */
1423 : : return M2Base_int8;
1424 : : }
1425 : 278613 : else if (sym == (M2System_IntegerN (16)))
1426 : : {
1427 : : /* avoid dangling else. */
1428 : : return M2Base_int16;
1429 : : }
1430 : 270501 : else if (sym == (M2System_IntegerN (32)))
1431 : : {
1432 : : /* avoid dangling else. */
1433 : : return M2Base_int32;
1434 : : }
1435 : 262719 : else if (sym == (M2System_IntegerN (64)))
1436 : : {
1437 : : /* avoid dangling else. */
1438 : : return M2Base_int64;
1439 : : }
1440 : 255759 : else if (sym == (M2System_CardinalN (8)))
1441 : : {
1442 : : /* avoid dangling else. */
1443 : : return M2Base_card8;
1444 : : }
1445 : 240109 : else if (sym == (M2System_CardinalN (16)))
1446 : : {
1447 : : /* avoid dangling else. */
1448 : : return M2Base_card16;
1449 : : }
1450 : 232813 : else if (sym == (M2System_CardinalN (32)))
1451 : : {
1452 : : /* avoid dangling else. */
1453 : : return M2Base_card32;
1454 : : }
1455 : 225235 : else if (sym == (M2System_CardinalN (64)))
1456 : : {
1457 : : /* avoid dangling else. */
1458 : : return M2Base_card64;
1459 : : }
1460 : 217429 : else if (sym == (M2System_WordN (16)))
1461 : : {
1462 : : /* avoid dangling else. */
1463 : : return M2Base_word16;
1464 : : }
1465 : 217429 : else if (sym == (M2System_WordN (32)))
1466 : : {
1467 : : /* avoid dangling else. */
1468 : : return M2Base_word32;
1469 : : }
1470 : 217081 : else if (sym == (M2System_WordN (64)))
1471 : : {
1472 : : /* avoid dangling else. */
1473 : : return M2Base_word64;
1474 : : }
1475 : 217081 : else if (sym == (M2System_SetN (8)))
1476 : : {
1477 : : /* avoid dangling else. */
1478 : : return M2Base_set8;
1479 : : }
1480 : 217081 : else if (sym == (M2System_SetN (16)))
1481 : : {
1482 : : /* avoid dangling else. */
1483 : : return M2Base_set16;
1484 : : }
1485 : 217081 : else if (sym == (M2System_SetN (32)))
1486 : : {
1487 : : /* avoid dangling else. */
1488 : : return M2Base_set32;
1489 : : }
1490 : 217081 : else if (sym == (M2System_RealN (32)))
1491 : : {
1492 : : /* avoid dangling else. */
1493 : : return M2Base_real32;
1494 : : }
1495 : 215053 : else if (sym == (M2System_RealN (64)))
1496 : : {
1497 : : /* avoid dangling else. */
1498 : : return M2Base_real64;
1499 : : }
1500 : 215053 : else if (sym == (M2System_RealN (96)))
1501 : : {
1502 : : /* avoid dangling else. */
1503 : : return M2Base_real96;
1504 : : }
1505 : 215053 : else if (sym == (M2System_RealN (128)))
1506 : : {
1507 : : /* avoid dangling else. */
1508 : : return M2Base_real128;
1509 : : }
1510 : 215053 : else if (sym == M2Base_Complex)
1511 : : {
1512 : : /* avoid dangling else. */
1513 : : return M2Base_complex;
1514 : : }
1515 : 208321 : else if (sym == M2Base_ShortComplex)
1516 : : {
1517 : : /* avoid dangling else. */
1518 : : return M2Base_shortcomplex;
1519 : : }
1520 : 208321 : else if (sym == M2Base_LongComplex)
1521 : : {
1522 : : /* avoid dangling else. */
1523 : : return M2Base_longcomplex;
1524 : : }
1525 : 203857 : else if (sym == (M2System_ComplexN (32)))
1526 : : {
1527 : : /* avoid dangling else. */
1528 : : return M2Base_complex32;
1529 : : }
1530 : 203857 : else if (sym == (M2System_ComplexN (64)))
1531 : : {
1532 : : /* avoid dangling else. */
1533 : : return M2Base_complex64;
1534 : : }
1535 : 203857 : else if (sym == (M2System_ComplexN (96)))
1536 : : {
1537 : : /* avoid dangling else. */
1538 : : return M2Base_complex96;
1539 : : }
1540 : 203857 : else if (sym == (M2System_ComplexN (128)))
1541 : : {
1542 : : /* avoid dangling else. */
1543 : : return M2Base_complex128;
1544 : : }
1545 : 203857 : else if (sym == M2Base_CType)
1546 : : {
1547 : : /* avoid dangling else. */
1548 : : return M2Base_ctype;
1549 : : }
1550 : 192661 : else if (SymbolTable_IsSet (sym))
1551 : : {
1552 : : /* avoid dangling else. */
1553 : : return M2Base_set;
1554 : : }
1555 : 192431 : else if (SymbolTable_IsHiddenType (sym))
1556 : : {
1557 : : /* avoid dangling else. */
1558 : : return M2Base_opaque;
1559 : : }
1560 : 192317 : else if (SymbolTable_IsPointer (sym))
1561 : : {
1562 : : /* avoid dangling else. */
1563 : : return M2Base_pointer;
1564 : : }
1565 : 178085 : else if (SymbolTable_IsEnumeration (sym))
1566 : : {
1567 : : /* avoid dangling else. */
1568 : : return M2Base_enum;
1569 : : }
1570 : 176951 : else if (SymbolTable_IsRecord (sym))
1571 : : {
1572 : : /* avoid dangling else. */
1573 : : return M2Base_rec;
1574 : : }
1575 : 176951 : else if (SymbolTable_IsArray (sym))
1576 : : {
1577 : : /* avoid dangling else. */
1578 : : return M2Base_array;
1579 : : }
1580 : 176927 : else if (SymbolTable_IsType (sym))
1581 : : {
1582 : : /* avoid dangling else. */
1583 : 41887 : return FindMetaType (SymbolTable_GetType (sym));
1584 : : }
1585 : 135040 : else if ((SymbolTable_IsProcedure (sym)) || (SymbolTable_IsProcType (sym)))
1586 : : {
1587 : : /* avoid dangling else. */
1588 : 135040 : return M2Base_procedure;
1589 : : }
1590 : : else
1591 : : {
1592 : : /* avoid dangling else. */
1593 : : return M2Base_unknown;
1594 : : }
1595 : : /* static analysis guarentees a RETURN statement will be used before here. */
1596 : : __builtin_unreachable ();
1597 : : }
1598 : :
1599 : :
1600 : : /*
1601 : : IsBaseCompatible - returns an enumeration field determining whether a simple base type
1602 : : comparison is legal.
1603 : : */
1604 : :
1605 : 485555 : static M2Base_Compatible IsBaseCompatible (unsigned int t1, unsigned int t2, M2Base_Compatability kind)
1606 : : {
1607 : 485555 : M2Base_MetaType mt1;
1608 : 485555 : M2Base_MetaType mt2;
1609 : :
1610 : 485555 : if ((t1 == t2) && ((kind == M2Base_assignment) || (kind == M2Base_parameter)))
1611 : : {
1612 : : return M2Base_first;
1613 : : }
1614 : : else
1615 : : {
1616 : 485555 : mt1 = FindMetaType (t1);
1617 : 485555 : mt2 = FindMetaType (t2);
1618 : 485555 : if ((mt1 == M2Base_unknown) || (mt2 == M2Base_unknown))
1619 : : {
1620 : : return M2Base_no;
1621 : : }
1622 : 485555 : switch (kind)
1623 : : {
1624 : 29594 : case M2Base_expression:
1625 : 29594 : return Expr.array[mt1-M2Base_const].array[mt2-M2Base_const];
1626 : 403235 : break;
1627 : :
1628 : 403235 : case M2Base_assignment:
1629 : 403235 : return Ass.array[mt1-M2Base_const].array[mt2-M2Base_const];
1630 : 4408 : break;
1631 : :
1632 : 4408 : case M2Base_parameter:
1633 : 4408 : return Ass.array[mt1-M2Base_const].array[mt2-M2Base_const];
1634 : 48318 : break;
1635 : :
1636 : 48318 : case M2Base_comparison:
1637 : 48318 : return Comp.array[mt1-M2Base_const].array[mt2-M2Base_const];
1638 : 0 : break;
1639 : :
1640 : :
1641 : 0 : default:
1642 : 0 : M2Error_InternalError ((const char *) "unexpected compatibility", 24);
1643 : : break;
1644 : : }
1645 : : }
1646 : : ReturnException ("/home/worker/buildworker/tiber-lcov/build/gcc/m2/gm2-compiler/M2Base.def", 20, 1);
1647 : : __builtin_unreachable ();
1648 : : }
1649 : :
1650 : :
1651 : : /*
1652 : : IsCompatible - returns true if the types, t1, and, t2, are compatible.
1653 : : */
1654 : :
1655 : 548010 : static M2Base_Compatible IsCompatible (unsigned int t1, unsigned int t2, M2Base_Compatability kind)
1656 : : {
1657 : 548010 : t1 = SymbolTable_SkipType (t1);
1658 : 548010 : t2 = SymbolTable_SkipType (t2);
1659 : 548010 : if (t1 == t2)
1660 : : {
1661 : : /* same types are always compatible. */
1662 : : return M2Base_first;
1663 : : }
1664 : 504441 : else if (M2Pass_IsPassCodeGeneration ())
1665 : : {
1666 : : /* avoid dangling else. */
1667 : 448836 : return AfterResolved (t1, t2, kind);
1668 : : }
1669 : : else
1670 : : {
1671 : : /* avoid dangling else. */
1672 : 55605 : return BeforeResolved (t1, t2, kind);
1673 : : }
1674 : : /* static analysis guarentees a RETURN statement will be used before here. */
1675 : : __builtin_unreachable ();
1676 : : }
1677 : :
1678 : :
1679 : : /*
1680 : : IsPointerSame - returns TRUE if pointers, a, and, b, are the same.
1681 : : */
1682 : :
1683 : 0 : static bool IsPointerSame (unsigned int a, unsigned int b, bool error)
1684 : : {
1685 : 0 : return IsSameType (SymbolTable_SkipType (SymbolTable_GetType (a)), SymbolTable_SkipType (SymbolTable_GetType (b)), error);
1686 : : /* static analysis guarentees a RETURN statement will be used before here. */
1687 : : __builtin_unreachable ();
1688 : : }
1689 : :
1690 : :
1691 : : /*
1692 : : IsSubrangeSame - checks to see whether the subranges are the same.
1693 : : */
1694 : :
1695 : 42 : static bool IsSubrangeSame (unsigned int a, unsigned int b)
1696 : : {
1697 : 42 : unsigned int al;
1698 : 42 : unsigned int ah;
1699 : 42 : unsigned int bl;
1700 : 42 : unsigned int bh;
1701 : :
1702 : 42 : a = SymbolTable_SkipType (a);
1703 : 42 : b = SymbolTable_SkipType (b);
1704 : 42 : if (a != b)
1705 : : {
1706 : 42 : SymbolTable_GetSubrange (a, &ah, &al);
1707 : 42 : SymbolTable_GetSubrange (b, &bh, &bl);
1708 : 42 : SymbolTable_PushValue (al);
1709 : 42 : SymbolTable_PushValue (bl);
1710 : 42 : if (! (M2ALU_Equ (SymbolTable_GetDeclaredMod (a))))
1711 : : {
1712 : : return false;
1713 : : }
1714 : 42 : SymbolTable_PushValue (ah);
1715 : 42 : SymbolTable_PushValue (bh);
1716 : 42 : if (! (M2ALU_Equ (SymbolTable_GetDeclaredMod (a))))
1717 : : {
1718 : : return false;
1719 : : }
1720 : : }
1721 : : return true;
1722 : : /* static analysis guarentees a RETURN statement will be used before here. */
1723 : : __builtin_unreachable ();
1724 : : }
1725 : :
1726 : :
1727 : : /*
1728 : : IsVarientSame - returns TRUE if varient types, a, and, b, are identical.
1729 : : */
1730 : :
1731 : 0 : static bool IsVarientSame (unsigned int a, unsigned int b, bool error)
1732 : : {
1733 : 0 : unsigned int i;
1734 : 0 : unsigned int j;
1735 : 0 : unsigned int fa;
1736 : 0 : unsigned int fb;
1737 : 0 : unsigned int ga;
1738 : 0 : unsigned int gb;
1739 : :
1740 : 0 : i = 1;
1741 : 0 : ga = SymbolTable_NulSym;
1742 : 0 : gb = SymbolTable_NulSym;
1743 : 0 : do {
1744 : 0 : fa = SymbolTable_GetNth (a, i);
1745 : 0 : fb = SymbolTable_GetNth (b, i);
1746 : 0 : if ((fa != SymbolTable_NulSym) && (fb != SymbolTable_NulSym))
1747 : : {
1748 : 0 : M2Debug_Assert (SymbolTable_IsFieldVarient (fa));
1749 : 0 : M2Debug_Assert (SymbolTable_IsFieldVarient (fb));
1750 : 0 : j = 1;
1751 : 0 : do {
1752 : 0 : ga = SymbolTable_GetNth (fa, j);
1753 : 0 : gb = SymbolTable_GetNth (fb, j);
1754 : 0 : if ((ga != SymbolTable_NulSym) && (gb != SymbolTable_NulSym))
1755 : : {
1756 : 0 : if (! (IsSameType (SymbolTable_GetType (ga), SymbolTable_GetType (gb), error)))
1757 : : {
1758 : : return false;
1759 : : }
1760 : 0 : j += 1;
1761 : : }
1762 : 0 : } while (! ((ga == SymbolTable_NulSym) || (gb == SymbolTable_NulSym)));
1763 : 0 : if (ga != gb)
1764 : : {
1765 : : return false;
1766 : : }
1767 : : }
1768 : 0 : i += 1;
1769 : 0 : } while (! ((fa == SymbolTable_NulSym) || (fb == SymbolTable_NulSym)));
1770 : 0 : return ga == gb;
1771 : : /* static analysis guarentees a RETURN statement will be used before here. */
1772 : : __builtin_unreachable ();
1773 : : }
1774 : :
1775 : :
1776 : : /*
1777 : : IsRecordSame -
1778 : : */
1779 : :
1780 : 0 : static bool IsRecordSame (unsigned int a, unsigned int b, bool error)
1781 : : {
1782 : 0 : unsigned int ta;
1783 : 0 : unsigned int tb;
1784 : 0 : unsigned int fa;
1785 : 0 : unsigned int fb;
1786 : 0 : unsigned int i;
1787 : :
1788 : 0 : i = 1;
1789 : 0 : do {
1790 : 0 : fa = SymbolTable_GetNth (a, i);
1791 : 0 : fb = SymbolTable_GetNth (b, i);
1792 : 0 : if ((fa != SymbolTable_NulSym) && (fb != SymbolTable_NulSym))
1793 : : {
1794 : 0 : ta = SymbolTable_GetType (fa);
1795 : 0 : tb = SymbolTable_GetType (fb);
1796 : 0 : if ((SymbolTable_IsRecordField (fa)) && (SymbolTable_IsRecordField (fb)))
1797 : : {
1798 : : /* avoid dangling else. */
1799 : 0 : if (! (IsSameType (ta, tb, error)))
1800 : : {
1801 : : return false;
1802 : : }
1803 : : }
1804 : 0 : else if ((SymbolTable_IsVarient (fa)) && (SymbolTable_IsVarient (fb)))
1805 : : {
1806 : : /* avoid dangling else. */
1807 : 0 : if (! (IsVarientSame (ta, tb, error)))
1808 : : {
1809 : : return false;
1810 : : }
1811 : : }
1812 : 0 : else if ((SymbolTable_IsFieldVarient (fa)) || (SymbolTable_IsFieldVarient (fb)))
1813 : : {
1814 : : /* avoid dangling else. */
1815 : 0 : M2Error_InternalError ((const char *) "should not see a field varient", 30);
1816 : : }
1817 : : else
1818 : : {
1819 : : /* avoid dangling else. */
1820 : : return false;
1821 : : }
1822 : : }
1823 : 0 : i += 1;
1824 : 0 : } while (! ((fa == SymbolTable_NulSym) || (fb == SymbolTable_NulSym)));
1825 : 0 : return fa == fb;
1826 : : /* static analysis guarentees a RETURN statement will be used before here. */
1827 : : __builtin_unreachable ();
1828 : : }
1829 : :
1830 : :
1831 : : /*
1832 : : IsArraySame -
1833 : : */
1834 : :
1835 : 0 : static bool IsArraySame (unsigned int t1, unsigned int t2, bool error)
1836 : : {
1837 : 0 : unsigned int s1;
1838 : 0 : unsigned int s2;
1839 : :
1840 : 0 : s1 = SymbolTable_GetArraySubscript (t1);
1841 : 0 : s2 = SymbolTable_GetArraySubscript (t2);
1842 : 0 : return (IsSameType (SymbolTable_GetType (s1), SymbolTable_GetType (s2), error)) && (IsSameType (SymbolTable_GetType (t1), SymbolTable_GetType (t2), error));
1843 : : /* static analysis guarentees a RETURN statement will be used before here. */
1844 : : __builtin_unreachable ();
1845 : : }
1846 : :
1847 : :
1848 : : /*
1849 : : IsEnumerationSame -
1850 : : */
1851 : :
1852 : 0 : static bool IsEnumerationSame (unsigned int t1, unsigned int t2)
1853 : : {
1854 : 0 : return t1 == t2;
1855 : : /* static analysis guarentees a RETURN statement will be used before here. */
1856 : : __builtin_unreachable ();
1857 : : }
1858 : :
1859 : :
1860 : : /*
1861 : : IsSetSame -
1862 : : */
1863 : :
1864 : 54 : static bool IsSetSame (unsigned int t1, unsigned int t2, bool error)
1865 : : {
1866 : 54 : return IsSameType (SymbolTable_GetType (t1), SymbolTable_GetType (t2), error);
1867 : : /* static analysis guarentees a RETURN statement will be used before here. */
1868 : : __builtin_unreachable ();
1869 : : }
1870 : :
1871 : :
1872 : : /*
1873 : : IsSameType - returns TRUE if
1874 : : */
1875 : :
1876 : 168 : static bool IsSameType (unsigned int t1, unsigned int t2, bool error)
1877 : : {
1878 : 168 : t1 = SymbolTable_SkipType (t1);
1879 : 168 : t2 = SymbolTable_SkipType (t2);
1880 : 168 : if (t1 == t2)
1881 : : {
1882 : : return true;
1883 : : }
1884 : 66 : else if ((SymbolTable_IsArray (t1)) && (SymbolTable_IsArray (t2)))
1885 : : {
1886 : : /* avoid dangling else. */
1887 : 0 : return IsArraySame (t1, t2, error);
1888 : : }
1889 : 66 : else if ((SymbolTable_IsSubrange (t1)) && (SymbolTable_IsSubrange (t2)))
1890 : : {
1891 : : /* avoid dangling else. */
1892 : 42 : return IsSubrangeSame (t1, t2);
1893 : : }
1894 : 24 : else if ((SymbolTable_IsProcType (t1)) && (SymbolTable_IsProcType (t2)))
1895 : : {
1896 : : /* avoid dangling else. */
1897 : 0 : return IsProcTypeSame (t1, t2, error);
1898 : : }
1899 : 24 : else if ((SymbolTable_IsEnumeration (t1)) && (SymbolTable_IsEnumeration (t2)))
1900 : : {
1901 : : /* avoid dangling else. */
1902 : : return IsEnumerationSame (t1, t2); /* , error */
1903 : : }
1904 : 24 : else if ((SymbolTable_IsRecord (t1)) && (SymbolTable_IsRecord (t2)))
1905 : : {
1906 : : /* avoid dangling else. */
1907 : 0 : return IsRecordSame (t1, t2, error);
1908 : : }
1909 : 24 : else if ((SymbolTable_IsSet (t1)) && (SymbolTable_IsSet (t2)))
1910 : : {
1911 : : /* avoid dangling else. */
1912 : 0 : return IsSetSame (t1, t2, error);
1913 : : }
1914 : 24 : else if ((SymbolTable_IsPointer (t1)) && (SymbolTable_IsPointer (t2)))
1915 : : {
1916 : : /* avoid dangling else. */
1917 : 0 : return IsPointerSame (t1, t2, error);
1918 : : }
1919 : : else
1920 : : {
1921 : : /* avoid dangling else. */
1922 : 24 : return false;
1923 : : }
1924 : : /* static analysis guarentees a RETURN statement will be used before here. */
1925 : : __builtin_unreachable ();
1926 : : }
1927 : :
1928 : :
1929 : : /*
1930 : : IsProcTypeSame -
1931 : : */
1932 : :
1933 : 42 : static bool IsProcTypeSame (unsigned int p1, unsigned int p2, bool error)
1934 : : {
1935 : 42 : unsigned int pa;
1936 : 42 : unsigned int pb;
1937 : 42 : unsigned int n;
1938 : 42 : unsigned int i;
1939 : :
1940 : 42 : n = SymbolTable_NoOfParam (p1);
1941 : 42 : if (n != (SymbolTable_NoOfParam (p2)))
1942 : : {
1943 : 0 : if (error)
1944 : : {
1945 : 0 : M2MetaError_MetaError2 ((const char *) "parameter is incompatible as {%1Dd} was declared with {%2n} parameters", 70, p1, SymbolTable_NoOfParam (p1));
1946 : 0 : M2MetaError_MetaError2 ((const char *) "whereas {%1Dd} was declared with {%2n} parameters", 49, p2, SymbolTable_NoOfParam (p2));
1947 : : }
1948 : 0 : return false;
1949 : : }
1950 : : i = 1;
1951 : 114 : while (i <= n)
1952 : : {
1953 : 84 : pa = SymbolTable_GetNthParam (p1, i);
1954 : 84 : pb = SymbolTable_GetNthParam (p2, i);
1955 : 84 : if ((SymbolTable_IsVarParam (p1, i)) != (SymbolTable_IsVarParam (p2, i)))
1956 : : {
1957 : 0 : if (error)
1958 : : {
1959 : 0 : M2MetaError_MetaErrors3 ((const char *) "the {%1n} parameter is incompatible between {%2Dad} and {%3ad} as only one was declared as VAR", 94, (const char *) "the {%1n} parameter is incompatible between {%2ad} and {%3Dad} as only one was declared as VAR", 94, i, p1, p2);
1960 : : }
1961 : 0 : return false;
1962 : : }
1963 : 84 : if (! (IsSameType (SymbolTable_GetType (pa), SymbolTable_GetType (pb), error)))
1964 : : {
1965 : : return false;
1966 : : }
1967 : 72 : i += 1;
1968 : : }
1969 : 30 : return IsSameType (SymbolTable_GetType (p1), SymbolTable_GetType (p2), error);
1970 : : /* static analysis guarentees a RETURN statement will be used before here. */
1971 : : __builtin_unreachable ();
1972 : : }
1973 : :
1974 : :
1975 : : /*
1976 : : doProcTypeCheck -
1977 : : */
1978 : :
1979 : 42 : static bool doProcTypeCheck (unsigned int p1, unsigned int p2, bool error)
1980 : : {
1981 : 42 : if (((SymbolTable_IsProcType (p1)) || (SymbolTable_IsProcedure (p1))) && ((SymbolTable_IsProcType (p2)) || (SymbolTable_IsProcedure (p2))))
1982 : : {
1983 : 42 : if (p1 == p2)
1984 : : {
1985 : : return true;
1986 : : }
1987 : : else
1988 : : {
1989 : 42 : return IsProcTypeSame (p1, p2, error);
1990 : : }
1991 : : }
1992 : : else
1993 : : {
1994 : 0 : return false;
1995 : : }
1996 : : /* static analysis guarentees a RETURN statement will be used before here. */
1997 : : __builtin_unreachable ();
1998 : : }
1999 : :
2000 : :
2001 : : /*
2002 : : AfterResolved - a thorough test for type compatibility.
2003 : : */
2004 : :
2005 : 448836 : static M2Base_Compatible AfterResolved (unsigned int t1, unsigned int t2, M2Base_Compatability kind)
2006 : : {
2007 : 448836 : M2Base_MetaType mt1;
2008 : 448836 : M2Base_MetaType mt2;
2009 : :
2010 : 448836 : if ((t1 == SymbolTable_NulSym) || (t2 == SymbolTable_NulSym))
2011 : : {
2012 : : return M2Base_first;
2013 : : }
2014 : 448812 : else if (((kind == M2Base_parameter) || (kind == M2Base_assignment)) && (t1 == t2))
2015 : : {
2016 : : /* avoid dangling else. */
2017 : : return M2Base_first;
2018 : : }
2019 : 448812 : else if (SymbolTable_IsSubrange (t1))
2020 : : {
2021 : : /* avoid dangling else. */
2022 : 14352 : return IsCompatible (SymbolTable_GetType (t1), t2, kind);
2023 : : }
2024 : 434460 : else if (SymbolTable_IsSubrange (t2))
2025 : : {
2026 : : /* avoid dangling else. */
2027 : 1483 : return IsCompatible (t1, SymbolTable_GetType (t2), kind);
2028 : : }
2029 : : else
2030 : : {
2031 : : /* avoid dangling else. */
2032 : 432977 : mt1 = FindMetaType (t1);
2033 : 432977 : mt2 = FindMetaType (t2);
2034 : 432977 : if (mt1 == mt2)
2035 : : {
2036 : 102 : switch (mt1)
2037 : : {
2038 : 54 : case M2Base_set:
2039 : 54 : case M2Base_set8:
2040 : 54 : case M2Base_set16:
2041 : 54 : case M2Base_set32:
2042 : 54 : if (IsSetSame (t1, t2, false))
2043 : : {
2044 : : return M2Base_first;
2045 : : }
2046 : : else
2047 : : {
2048 : : return M2Base_no;
2049 : : }
2050 : 0 : break;
2051 : :
2052 : 0 : case M2Base_enum:
2053 : 0 : if (IsEnumerationSame (t1, t2)) /* , FALSE */
2054 : : {
2055 : : return M2Base_first;
2056 : : }
2057 : : else
2058 : : {
2059 : : return M2Base_no;
2060 : : }
2061 : 0 : break;
2062 : :
2063 : 0 : case M2Base_pointer:
2064 : 0 : if (IsPointerSame (t1, t2, false))
2065 : : {
2066 : : return M2Base_first;
2067 : : }
2068 : : else
2069 : : {
2070 : : return M2Base_no;
2071 : : }
2072 : : break;
2073 : :
2074 : : case M2Base_opaque:
2075 : : return M2Base_no;
2076 : 42 : break;
2077 : :
2078 : 42 : case M2Base_procedure:
2079 : 42 : if (doProcTypeCheck (t1, t2, false))
2080 : : {
2081 : : return M2Base_first;
2082 : : }
2083 : : else
2084 : : {
2085 : : return M2Base_no;
2086 : : }
2087 : : break;
2088 : :
2089 : :
2090 : : default:
2091 : : break;
2092 : : }
2093 : : }
2094 : : /* fall through */
2095 : 432881 : return IsBaseCompatible (t1, t2, kind);
2096 : : }
2097 : : /* static analysis guarentees a RETURN statement will be used before here. */
2098 : : __builtin_unreachable ();
2099 : : }
2100 : :
2101 : :
2102 : : /*
2103 : : BeforeResolved - attempts to test for type compatibility before all types are
2104 : : completely resolved. In particular set types and constructor
2105 : : types are not fully known before the end of pass 3.
2106 : : However we can test base types.
2107 : : */
2108 : :
2109 : 55605 : static M2Base_Compatible BeforeResolved (unsigned int t1, unsigned int t2, M2Base_Compatability kind)
2110 : : {
2111 : 55605 : if ((t1 == SymbolTable_NulSym) || (t2 == SymbolTable_NulSym))
2112 : : {
2113 : : return M2Base_first;
2114 : : }
2115 : 53538 : else if (SymbolTable_IsSubrange (t1))
2116 : : {
2117 : : /* avoid dangling else. */
2118 : 250 : return IsCompatible (SymbolTable_GetType (t1), t2, kind);
2119 : : }
2120 : 53288 : else if (SymbolTable_IsSubrange (t2))
2121 : : {
2122 : : /* avoid dangling else. */
2123 : 404 : return IsCompatible (t1, SymbolTable_GetType (t2), kind);
2124 : : }
2125 : 52884 : else if ((SymbolTable_IsSet (t1)) || (SymbolTable_IsSet (t2)))
2126 : : {
2127 : : /* avoid dangling else. */
2128 : : /* cannot test set compatibility at this point so we do this again after pass 3 */
2129 : 102 : return M2Base_first;
2130 : : }
2131 : 52782 : else if (((SymbolTable_IsProcType (t1)) && (SymbolTable_IsProcedure (t2))) || ((SymbolTable_IsProcedure (t1)) && (SymbolTable_IsProcType (t2))))
2132 : : {
2133 : : /* avoid dangling else. */
2134 : : /* we will perform checking during code generation */
2135 : 84 : return M2Base_first;
2136 : : }
2137 : 52698 : else if ((SymbolTable_IsHiddenType (t1)) && (SymbolTable_IsHiddenType (t2)))
2138 : : {
2139 : : /* avoid dangling else. */
2140 : 24 : if (t1 == t2)
2141 : : {
2142 : 0 : M2MetaError_MetaError0 ((const char *) "assert about to fail as t1 = t2", 31);
2143 : : }
2144 : 24 : M2Debug_Assert (t1 != t2);
2145 : : /* different opaque types are not assignment or expression compatible. */
2146 : 24 : return M2Base_no;
2147 : : }
2148 : : else
2149 : : {
2150 : : /* avoid dangling else. */
2151 : : /*
2152 : : see M2Quads for the fixme comment at assignment.
2153 : :
2154 : : PIM2 says that CARDINAL and INTEGER are compatible with subranges of CARDINAL and INTEGER,
2155 : : however we do not know the type to our subranges yet as (GetType(SubrangeType)=NulSym).
2156 : : So we add type checking in the range checking module which is done post pass 3,
2157 : : when all is resolved.
2158 : : */
2159 : 52674 : return IsBaseCompatible (t1, t2, kind);
2160 : : }
2161 : : /* static analysis guarentees a RETURN statement will be used before here. */
2162 : : __builtin_unreachable ();
2163 : : }
2164 : :
2165 : :
2166 : : /*
2167 : : MixMetaTypes -
2168 : : */
2169 : :
2170 : 3897 : static unsigned int MixMetaTypes (unsigned int t1, unsigned int t2, unsigned int NearTok)
2171 : : {
2172 : 3897 : M2Base_MetaType mt1;
2173 : 3897 : M2Base_MetaType mt2;
2174 : :
2175 : 3897 : mt1 = FindMetaType (t1);
2176 : 3897 : mt2 = FindMetaType (t2);
2177 : 3897 : switch (Expr.array[mt1-M2Base_const].array[mt2-M2Base_const])
2178 : : {
2179 : 72 : case M2Base_no:
2180 : 72 : M2MetaError_MetaErrorT2 (NearTok, (const char *) "type incompatibility between {%1asd} and {%2asd}", 48, t1, t2);
2181 : 72 : M2Error_FlushErrors (); /* unrecoverable at present */
2182 : 0 : break;
2183 : :
2184 : : case M2Base_warnfirst:
2185 : : case M2Base_first:
2186 : : return t1;
2187 : 100 : break;
2188 : :
2189 : 100 : case M2Base_warnsecond:
2190 : 100 : case M2Base_second:
2191 : 100 : return t2;
2192 : 0 : break;
2193 : :
2194 : :
2195 : 0 : default:
2196 : 0 : M2Error_InternalError ((const char *) "not expecting this metatype value", 33);
2197 : 0 : break;
2198 : : }
2199 : 0 : return SymbolTable_MakeError (NearTok, NameKey_NulName);
2200 : : /* static analysis guarentees a RETURN statement will be used before here. */
2201 : : __builtin_unreachable ();
2202 : : }
2203 : :
2204 : :
2205 : : /*
2206 : : IsUserType - return TRUE if type was created by the user as a synonym.
2207 : : */
2208 : :
2209 : 109213 : static bool IsUserType (unsigned int type)
2210 : : {
2211 : 109213 : return ((SymbolTable_IsType (type)) && (! (M2Base_IsBaseType (type)))) && (! (M2System_IsSystemType (type)));
2212 : : /* static analysis guarentees a RETURN statement will be used before here. */
2213 : : __builtin_unreachable ();
2214 : : }
2215 : :
2216 : :
2217 : : /*
2218 : : IsVarParamCompatible - returns TRUE if types, actual, and, formal
2219 : : are compatible even if formal is a VAR
2220 : : parameter.
2221 : : */
2222 : :
2223 : 0 : static bool IsVarParamCompatible (unsigned int actual, unsigned int formal)
2224 : : {
2225 : 0 : actual = SymbolTable_SkipType (actual);
2226 : 0 : formal = SymbolTable_SkipType (formal);
2227 : 0 : if ((SymbolTable_IsParameter (formal)) && (SymbolTable_IsParameterUnbounded (formal)))
2228 : : {
2229 : 0 : formal = SymbolTable_SkipType (SymbolTable_GetType (SymbolTable_GetType (formal))); /* move over unbounded */
2230 : 0 : if (M2System_IsGenericSystemType (formal)) /* move over unbounded */
2231 : : {
2232 : : return true;
2233 : : }
2234 : 0 : return (formal == actual) || ((SymbolTable_IsArray (actual)) && (formal == (SymbolTable_SkipType (SymbolTable_GetType (actual)))));
2235 : : }
2236 : : else
2237 : : {
2238 : 0 : return (((((actual == formal) || ((SymbolTable_IsPointer (actual)) && (formal == M2System_Address))) || ((SymbolTable_IsPointer (formal)) && (actual == M2System_Address))) || ((M2System_IsGenericSystemType (actual)) && (IsSizeSame (FindMetaType (actual), FindMetaType (formal))))) || ((M2System_IsGenericSystemType (formal)) && (IsSizeSame (FindMetaType (actual), FindMetaType (formal))))) || (M2System_IsSameSizePervasiveType (formal, actual));
2239 : : }
2240 : : /* static analysis guarentees a RETURN statement will be used before here. */
2241 : : __builtin_unreachable ();
2242 : : }
2243 : :
2244 : :
2245 : : /*
2246 : : IsArrayUnboundedCompatible - returns TRUE if unbounded or array types, t1, and, t2,
2247 : : are compatible.
2248 : : */
2249 : :
2250 : 0 : static bool IsArrayUnboundedCompatible (unsigned int t1, unsigned int t2)
2251 : : {
2252 : 0 : if ((t1 == SymbolTable_NulSym) || (t2 == SymbolTable_NulSym))
2253 : : {
2254 : : return false;
2255 : : }
2256 : 0 : else if (((SymbolTable_IsUnbounded (t1)) || (SymbolTable_IsArray (t1))) && ((SymbolTable_IsUnbounded (t2)) || (SymbolTable_IsArray (t2))))
2257 : : {
2258 : : /* avoid dangling else. */
2259 : 0 : return (SymbolTable_SkipType (SymbolTable_GetType (t1))) == (SymbolTable_SkipType (SymbolTable_GetType (t2)));
2260 : : }
2261 : : else
2262 : : {
2263 : : /* avoid dangling else. */
2264 : 0 : return false;
2265 : : }
2266 : : /* static analysis guarentees a RETURN statement will be used before here. */
2267 : : __builtin_unreachable ();
2268 : : }
2269 : :
2270 : :
2271 : : /*
2272 : : IsValidUnboundedParameter -
2273 : : */
2274 : :
2275 : 0 : static bool IsValidUnboundedParameter (unsigned int formal, unsigned int actual)
2276 : : {
2277 : 0 : unsigned int ft;
2278 : 0 : unsigned int at;
2279 : 0 : unsigned int n;
2280 : 0 : unsigned int m;
2281 : 0 : unsigned int o;
2282 : :
2283 : 0 : M2Debug_Assert (SymbolTable_IsParameterUnbounded (formal));
2284 : 0 : ft = SymbolTable_SkipType (SymbolTable_GetType (SymbolTable_GetType (formal))); /* ARRAY OF ft */
2285 : 0 : if ((M2System_IsGenericSystemType (ft)) || (IsArrayUnboundedCompatible (SymbolTable_GetType (formal), SymbolTable_GetType (actual)))) /* ARRAY OF ft */
2286 : : {
2287 : 0 : return true;
2288 : : }
2289 : : else
2290 : : {
2291 : 0 : if ((SymbolTable_IsParameter (actual)) && (SymbolTable_IsParameterUnbounded (actual)))
2292 : : {
2293 : 0 : n = SymbolTable_GetDimension (actual);
2294 : 0 : m = SymbolTable_GetDimension (formal);
2295 : 0 : if (n != m)
2296 : : {
2297 : 0 : return (M2System_IsGenericSystemType (ft)) && (n < m);
2298 : : }
2299 : : else
2300 : : {
2301 : 0 : return ((SymbolTable_GetDimension (actual)) == (SymbolTable_GetDimension (formal))) && (M2Base_IsParameterCompatible (SymbolTable_GetType (SymbolTable_GetType (actual)), ft));
2302 : : }
2303 : : }
2304 : : else
2305 : : {
2306 : 0 : if (SymbolTable_IsConstString (actual))
2307 : : {
2308 : 0 : return M2Base_IsParameterCompatible (M2Base_Char, ft);
2309 : : }
2310 : : else
2311 : : {
2312 : 0 : at = SymbolTable_SkipType (SymbolTable_GetType (actual));
2313 : 0 : if (SymbolTable_IsArray (at))
2314 : : {
2315 : 0 : m = SymbolTable_GetDimension (formal);
2316 : 0 : n = SymbolTable_GetDimension (at);
2317 : 0 : o = 0;
2318 : 0 : while (SymbolTable_IsArray (at))
2319 : : {
2320 : 0 : o += 1;
2321 : 0 : at = SymbolTable_SkipType (SymbolTable_GetType (at));
2322 : 0 : if ((m == o) && (at == ft))
2323 : : {
2324 : : return true;
2325 : : }
2326 : : }
2327 : 0 : if (n != m)
2328 : : {
2329 : 0 : return (M2System_IsGenericSystemType (ft)) && (n < m);
2330 : : }
2331 : 0 : else if (SymbolTable_IsParameterVar (formal))
2332 : : {
2333 : : /* avoid dangling else. */
2334 : 0 : return IsVarParamCompatible (at, formal);
2335 : : }
2336 : : else
2337 : : {
2338 : : /* avoid dangling else. */
2339 : 0 : return M2Base_IsParameterCompatible (at, ft);
2340 : : }
2341 : : }
2342 : : else
2343 : : {
2344 : 0 : if (SymbolTable_IsParameterVar (formal))
2345 : : {
2346 : 0 : return IsVarParamCompatible (at, formal);
2347 : : }
2348 : : else
2349 : : {
2350 : 0 : return M2Base_IsParameterCompatible (at, ft);
2351 : : }
2352 : : }
2353 : : }
2354 : : }
2355 : : }
2356 : : /* static analysis guarentees a RETURN statement will be used before here. */
2357 : : __builtin_unreachable ();
2358 : : }
2359 : :
2360 : :
2361 : : /*
2362 : : PushSizeOf - pushes the size of a meta type.
2363 : : */
2364 : :
2365 : 2650486 : static void PushSizeOf (M2Base_MetaType t)
2366 : : {
2367 : 2650486 : switch (t)
2368 : : {
2369 : 0 : case M2Base_const:
2370 : 0 : M2Error_InternalError ((const char *) "do not know the size of a constant", 34);
2371 : 652563 : break;
2372 : :
2373 : 652563 : case M2Base_word:
2374 : 652563 : if (M2Options_Iso)
2375 : : {
2376 : 125400 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetISOWordType ()));
2377 : : }
2378 : : else
2379 : : {
2380 : 527163 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetWordType ()));
2381 : : }
2382 : : break;
2383 : :
2384 : 672680 : case M2Base_byte:
2385 : 672680 : if (M2Options_Iso)
2386 : : {
2387 : 132000 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetISOByteType ()));
2388 : : }
2389 : : else
2390 : : {
2391 : 540680 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetByteType ()));
2392 : : }
2393 : : break;
2394 : :
2395 : 33634 : case M2Base_address:
2396 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetPointerType ()));
2397 : 33634 : break;
2398 : :
2399 : 16817 : case M2Base_chr:
2400 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2CharType ()));
2401 : 16817 : break;
2402 : :
2403 : 16817 : case M2Base_normint:
2404 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2IntegerType ()));
2405 : 16817 : break;
2406 : :
2407 : 33634 : case M2Base_shortint:
2408 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2ShortIntType ()));
2409 : 33634 : break;
2410 : :
2411 : 33634 : case M2Base_longint:
2412 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2LongIntType ()));
2413 : 33634 : break;
2414 : :
2415 : 16817 : case M2Base_normcard:
2416 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2CardinalType ()));
2417 : 16817 : break;
2418 : :
2419 : 33634 : case M2Base_shortcard:
2420 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2ShortCardType ()));
2421 : 33634 : break;
2422 : :
2423 : 33634 : case M2Base_longcard:
2424 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2LongCardType ()));
2425 : 33634 : break;
2426 : :
2427 : 33634 : case M2Base_pointer:
2428 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetPointerType ()));
2429 : 33634 : break;
2430 : :
2431 : 16817 : case M2Base_enum:
2432 : 16817 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetIntegerType ()));
2433 : 16817 : break;
2434 : :
2435 : 33634 : case M2Base_real:
2436 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2RealType ()));
2437 : 33634 : break;
2438 : :
2439 : 33634 : case M2Base_shortreal:
2440 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2ShortRealType ()));
2441 : 33634 : break;
2442 : :
2443 : 33634 : case M2Base_longreal:
2444 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2LongRealType ()));
2445 : 33634 : break;
2446 : :
2447 : 0 : case M2Base_set:
2448 : 0 : M2Error_InternalError ((const char *) "do not know the size of a set", 29);
2449 : 0 : break;
2450 : :
2451 : 0 : case M2Base_opaque:
2452 : 0 : M2Error_InternalError ((const char *) "do not know the size of an opaque", 33);
2453 : 50451 : break;
2454 : :
2455 : 50451 : case M2Base_loc:
2456 : 50451 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetISOLocType ()));
2457 : 50451 : break;
2458 : :
2459 : 47151 : case M2Base_rtype:
2460 : 47151 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2RType ()));
2461 : 47151 : break;
2462 : :
2463 : 0 : case M2Base_ztype:
2464 : 0 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2ZType ()));
2465 : 0 : break;
2466 : :
2467 : 117719 : case M2Base_int8:
2468 : 117719 : case M2Base_card8:
2469 : 117719 : case M2Base_set8:
2470 : 117719 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (1));
2471 : 117719 : break;
2472 : :
2473 : 134536 : case M2Base_word16:
2474 : 134536 : case M2Base_set16:
2475 : 134536 : case M2Base_card16:
2476 : 134536 : case M2Base_int16:
2477 : 134536 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (2));
2478 : 134536 : break;
2479 : :
2480 : 168170 : case M2Base_real32:
2481 : 168170 : case M2Base_word32:
2482 : 168170 : case M2Base_set32:
2483 : 168170 : case M2Base_card32:
2484 : 168170 : case M2Base_int32:
2485 : 168170 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (4));
2486 : 168170 : break;
2487 : :
2488 : 134536 : case M2Base_real64:
2489 : 134536 : case M2Base_word64:
2490 : 134536 : case M2Base_card64:
2491 : 134536 : case M2Base_int64:
2492 : 134536 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (8));
2493 : 134536 : break;
2494 : :
2495 : 33634 : case M2Base_real96:
2496 : 33634 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (12));
2497 : 33634 : break;
2498 : :
2499 : 33634 : case M2Base_real128:
2500 : 33634 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (16));
2501 : 33634 : break;
2502 : :
2503 : 33634 : case M2Base_complex:
2504 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2ComplexType ()));
2505 : 33634 : break;
2506 : :
2507 : 33634 : case M2Base_shortcomplex:
2508 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2ShortComplexType ()));
2509 : 33634 : break;
2510 : :
2511 : 33634 : case M2Base_longcomplex:
2512 : 33634 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2LongComplexType ()));
2513 : 33634 : break;
2514 : :
2515 : 33634 : case M2Base_complex32:
2516 : 33634 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (4*2));
2517 : 33634 : break;
2518 : :
2519 : 33634 : case M2Base_complex64:
2520 : 33634 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (8*2));
2521 : 33634 : break;
2522 : :
2523 : 33634 : case M2Base_complex96:
2524 : 33634 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (12*2));
2525 : 33634 : break;
2526 : :
2527 : 33634 : case M2Base_complex128:
2528 : 33634 : M2ALU_PushIntegerTree (m2decl_BuildIntegerConstant (16*2));
2529 : 33634 : break;
2530 : :
2531 : 0 : case M2Base_ctype:
2532 : 0 : M2ALU_PushIntegerTree (m2expr_GetSizeOf (m2linemap_BuiltinsLocation (), m2type_GetM2CType ()));
2533 : 0 : break;
2534 : :
2535 : 0 : case M2Base_unknown:
2536 : 0 : M2Error_InternalError ((const char *) "should not get here", 19);
2537 : 0 : break;
2538 : :
2539 : :
2540 : 0 : default:
2541 : 0 : M2Error_InternalError ((const char *) "should not get here", 19);
2542 : 2650486 : break;
2543 : : }
2544 : 2650486 : }
2545 : :
2546 : :
2547 : : /*
2548 : : IsSizeSame -
2549 : : */
2550 : :
2551 : 1325243 : static bool IsSizeSame (M2Base_MetaType t1, M2Base_MetaType t2)
2552 : : {
2553 : 1325243 : PushSizeOf (t1);
2554 : 1325243 : PushSizeOf (t2);
2555 : 1325243 : return M2ALU_Equ (0);
2556 : : /* static analysis guarentees a RETURN statement will be used before here. */
2557 : : __builtin_unreachable ();
2558 : : }
2559 : :
2560 : :
2561 : : /*
2562 : : InitArray -
2563 : : */
2564 : :
2565 : 2522550 : static void InitArray (M2Base_CompatibilityArray *c, M2Base_MetaType y, const char *a_, unsigned int _a_high)
2566 : : {
2567 : 2522550 : M2Base_MetaType x;
2568 : 2522550 : unsigned int h;
2569 : 2522550 : unsigned int i;
2570 : 2522550 : char a[_a_high+1];
2571 : :
2572 : : /* make a local copy of each unbounded array. */
2573 : 2522550 : memcpy (a, a_, _a_high+1);
2574 : :
2575 : 2522550 : h = StrLib_StrLen ((const char *) a, _a_high);
2576 : 2522550 : i = 0;
2577 : 2522550 : x = M2Base_const;
2578 : 252255000 : while (i < h)
2579 : : {
2580 : 249732450 : if ((((*c).array[x-M2Base_const].array[y-M2Base_const] != M2Base_uninitialized) && (x != M2Base_unknown)) && (y != M2Base_unknown))
2581 : : {
2582 : 0 : M2Error_InternalError ((const char *) "expecting array element to be uninitialized", 43);
2583 : : }
2584 : 249732450 : switch (a[i])
2585 : : {
2586 : : case ' ':
2587 : : break;
2588 : :
2589 : 61802475 : case '.':
2590 : 61802475 : switch ((*c).array[y-M2Base_const].array[x-M2Base_const])
2591 : : {
2592 : 0 : case M2Base_uninitialized:
2593 : 0 : M2Error_InternalError ((const char *) "cannot reflect value as it is unknown", 37);
2594 : 5179636 : break;
2595 : :
2596 : 5179636 : case M2Base_first:
2597 : 5179636 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_second;
2598 : 5179636 : break;
2599 : :
2600 : 727336 : case M2Base_second:
2601 : 727336 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_first;
2602 : 727336 : break;
2603 : :
2604 : 0 : case M2Base_warnfirst:
2605 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_warnsecond;
2606 : 0 : break;
2607 : :
2608 : 0 : case M2Base_warnsecond:
2609 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_warnfirst;
2610 : 0 : break;
2611 : :
2612 : :
2613 : 55895503 : default:
2614 : 55895503 : (*c).array[x-M2Base_const].array[y-M2Base_const] = (*c).array[y-M2Base_const].array[x-M2Base_const];
2615 : 55895503 : break;
2616 : : }
2617 : 61802475 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2618 : 61802475 : break;
2619 : :
2620 : 54941139 : case 'F':
2621 : 54941139 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2622 : 54941139 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2623 : 54941139 : break;
2624 : :
2625 : 7500382 : case 'T':
2626 : 7500382 : case '1':
2627 : 7500382 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_first;
2628 : 7500382 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2629 : 7500382 : break;
2630 : :
2631 : 487693 : case '2':
2632 : 487693 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_second;
2633 : 487693 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2634 : 487693 : break;
2635 : :
2636 : 16817 : case 'W':
2637 : 16817 : if (M2Options_Pim)
2638 : : {
2639 : 13517 : if (IsSizeSame (x, y))
2640 : : {
2641 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_warnsecond;
2642 : : }
2643 : : else
2644 : : {
2645 : 13517 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2646 : : }
2647 : : }
2648 : : else
2649 : : {
2650 : 3300 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2651 : : }
2652 : 16817 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2653 : 16817 : break;
2654 : :
2655 : 0 : case 'w':
2656 : 0 : if (M2Options_Pim)
2657 : : {
2658 : 0 : if (IsSizeSame (x, y))
2659 : : {
2660 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_warnfirst;
2661 : : }
2662 : : else
2663 : : {
2664 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2665 : : }
2666 : : }
2667 : : else
2668 : : {
2669 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2670 : : }
2671 : 0 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2672 : 0 : break;
2673 : :
2674 : 67268 : case 'P':
2675 : 67268 : if (M2Options_Pim)
2676 : : {
2677 : 54068 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_second;
2678 : : }
2679 : : else
2680 : : {
2681 : 13200 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2682 : : }
2683 : 67268 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2684 : 67268 : break;
2685 : :
2686 : 0 : case 'p':
2687 : 0 : if (M2Options_Pim)
2688 : : {
2689 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_first;
2690 : : }
2691 : : else
2692 : : {
2693 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2694 : : }
2695 : 0 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2696 : 0 : break;
2697 : :
2698 : 0 : case 's':
2699 : 0 : if (IsSizeSame (x, y))
2700 : : {
2701 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_first;
2702 : : }
2703 : : else
2704 : : {
2705 : 0 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2706 : : }
2707 : 0 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2708 : 0 : break;
2709 : :
2710 : 1311726 : case 'S':
2711 : 1311726 : if (IsSizeSame (x, y))
2712 : : {
2713 : 185575 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_second;
2714 : : }
2715 : : else
2716 : : {
2717 : 1126151 : (*c).array[x-M2Base_const].array[y-M2Base_const] = M2Base_no;
2718 : : }
2719 : 1311726 : x = static_cast<M2Base_MetaType>(static_cast<int>(x)+1);
2720 : 1311726 : break;
2721 : :
2722 : :
2723 : 0 : default:
2724 : 0 : M2Error_InternalError ((const char *) "unexpected specifier", 20);
2725 : 249732450 : break;
2726 : : }
2727 : 249732450 : i += 1;
2728 : : }
2729 : 2522550 : }
2730 : :
2731 : :
2732 : : /*
2733 : : A - initialize the assignment array
2734 : : */
2735 : :
2736 : 840850 : static void A (M2Base_MetaType y, const char *a_, unsigned int _a_high)
2737 : : {
2738 : 840850 : char a[_a_high+1];
2739 : :
2740 : : /* make a local copy of each unbounded array. */
2741 : 840850 : memcpy (a, a_, _a_high+1);
2742 : :
2743 : 840850 : InitArray (&Ass, y, (const char *) a, _a_high);
2744 : 840850 : }
2745 : :
2746 : :
2747 : : /*
2748 : : E - initialize the expression array
2749 : : */
2750 : :
2751 : 840850 : static void E (M2Base_MetaType y, const char *a_, unsigned int _a_high)
2752 : : {
2753 : 840850 : char a[_a_high+1];
2754 : :
2755 : : /* make a local copy of each unbounded array. */
2756 : 840850 : memcpy (a, a_, _a_high+1);
2757 : :
2758 : 840850 : InitArray (&Expr, y, (const char *) a, _a_high);
2759 : 840850 : }
2760 : :
2761 : :
2762 : : /*
2763 : : C - initialize the comparision array
2764 : : */
2765 : :
2766 : 840850 : static void C (M2Base_MetaType y, const char *a_, unsigned int _a_high)
2767 : : {
2768 : 840850 : char a[_a_high+1];
2769 : :
2770 : : /* make a local copy of each unbounded array. */
2771 : 840850 : memcpy (a, a_, _a_high+1);
2772 : :
2773 : 840850 : InitArray (&Comp, y, (const char *) a, _a_high);
2774 : 840850 : }
2775 : :
2776 : :
2777 : : /*
2778 : : InitCompatibilityMatrices - initializes the tables above.
2779 : : */
2780 : :
2781 : 16817 : static void InitCompatibilityMatrices (void)
2782 : : {
2783 : 16817 : M2Base_MetaType i;
2784 : 16817 : M2Base_MetaType j;
2785 : :
2786 : 874484 : for (i=M2Base_const; i<=M2Base_unknown; i= static_cast<M2Base_MetaType>(static_cast<int>(i+1)))
2787 : : {
2788 : 44598684 : for (j=M2Base_const; j<=M2Base_unknown; j= static_cast<M2Base_MetaType>(static_cast<int>(j+1)))
2789 : : {
2790 : : /* initialize to a known state */
2791 : 43741017 : Ass.array[i-M2Base_const].array[j-M2Base_const] = M2Base_uninitialized;
2792 : 43741017 : Expr.array[i-M2Base_const].array[j-M2Base_const] = M2Base_uninitialized;
2793 : : }
2794 : : }
2795 : 874484 : for (i=M2Base_const; i<=M2Base_unknown; i= static_cast<M2Base_MetaType>(static_cast<int>(i+1)))
2796 : : {
2797 : : /* all unknowns are false */
2798 : 857667 : Ass.array[i-M2Base_const].array[M2Base_unknown-M2Base_const] = M2Base_no;
2799 : 857667 : Expr.array[M2Base_unknown-M2Base_const].array[i-M2Base_const] = M2Base_no;
2800 : : }
2801 : : /*
2802 : : 1 p w
2803 : :
2804 : : C W B A C I S L C S L P E R S L S O L R Z I I I I C C C C W W W R R R R S S S C S L C C C C C R A P
2805 : : o o y d h n h o a h o t n e h o e p o t t n n n n a a a a o o o e e e e e e e o h o o o o o t e r r
2806 : : n r t d a t o n r o n r u a o n t a c y y t t t t r r r r r r r a a a a t t t m o n m m m m y c r o
2807 : : s d e r r e r g d r g m l r g q p p 8 1 3 6 d d d d d d d l l l l 8 1 3 p r g p p p p p a c
2808 : : t e g t i i t c t r u e e 6 2 4 8 1 3 6 1 3 6 3 6 9 1 6 2 l t C l l l l e y
2809 : : s e i n n c a r e e 6 2 4 6 2 4 2 4 6 2 e C o e e e e
2810 : : s r n t a a r e a 8 x o m x x x x
2811 : : t l r d a l m p 3 6 9 1
2812 : : d l p l 2 4 6 2
2813 : : l e 8
2814 : : e x
2815 : : x
2816 : : --------------------------------------------------------------------------------------------------------------
2817 : : 2
2818 : : P
2819 : : W
2820 : : */
2821 : 16817 : A (M2Base_const, (const char *) "T T T T T T T T T T T T T T T T T T T F T T T T T T T T T T T T F F F F F F F F F F F F F F F F F F", 99);
2822 : 16817 : A (M2Base_word, (const char *) ". T S S S 2 S S 2 S S S 2 S S S T T S S T S S S S S S S S S S S S S S S S S S S S S S S S S T T T F", 99);
2823 : 16817 : A (M2Base_byte, (const char *) ". . T S 2 S S S S S S S S S S S T T S S T S S S S S S S S S S S S S S S S S S S S S S S S S T T T F", 99);
2824 : 16817 : A (M2Base_address, (const char *) ". . . T F F F F P F F 2 F F F F F 2 2 F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F T", 99);
2825 : 16817 : A (M2Base_chr, (const char *) ". . . . T F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2826 : 16817 : A (M2Base_normint, (const char *) ". . . . . T T T T T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2827 : 16817 : A (M2Base_shortint, (const char *) ". . . . . . T T T T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2828 : 16817 : A (M2Base_longint, (const char *) ". . . . . . . T T T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2829 : 16817 : A (M2Base_normcard, (const char *) ". . . . . . . . T T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2830 : 16817 : A (M2Base_shortcard, (const char *) ". . . . . . . . . T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2831 : 16817 : A (M2Base_longcard, (const char *) ". . . . . . . . . . T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2832 : 16817 : A (M2Base_pointer, (const char *) ". . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2833 : 16817 : A (M2Base_enum, (const char *) ". . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F T T F F F F F F F F F F F F F F F F", 99);
2834 : 16817 : A (M2Base_real, (const char *) ". . . . . . . . . . . . . T T T F F F 2 F F F F F F F F F F F F T T T T F F F F F F F F F F F F F F", 99);
2835 : 16817 : A (M2Base_shortreal, (const char *) ". . . . . . . . . . . . . . T T F F F 2 F F F F F F F F F F F F T T T T F F F F F F F F F F F F F F", 99);
2836 : 16817 : A (M2Base_longreal, (const char *) ". . . . . . . . . . . . . . . T F F F 2 F F F F F F F F F F F F T T T T F F F F F F F F F F F F F F", 99);
2837 : 16817 : A (M2Base_set, (const char *) ". . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2838 : 16817 : A (M2Base_opaque, (const char *) ". . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2839 : 16817 : A (M2Base_loc, (const char *) ". . . . . . . . . . . . . . . . . . T F F T F F F T F F F F F F F F F F S F F F F F F F F F F T T F", 99);
2840 : 16817 : A (M2Base_rtype, (const char *) ". . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F 1 1 1 1 F F F F F F F F F F F F F F", 99);
2841 : 16817 : A (M2Base_ztype, (const char *) ". . . . . . . . . . . . . . . . . . . . T T T T T T T T T T T T F F F F F F F F F F F F F F F F F F", 99);
2842 : 16817 : A (M2Base_int8, (const char *) ". . . . . . . . . . . . . . . . . . . . . T T T T T T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2843 : 16817 : A (M2Base_int16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . T T T T T T T T F F F F F F F F F F F F F F F F F F F F", 99);
2844 : 16817 : A (M2Base_int32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . T T T T T T F T T F F F F F F F F F F F F F F F F F F", 99);
2845 : 16817 : A (M2Base_int64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . T T T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2846 : 16817 : A (M2Base_card8, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . T T T T T F F F F F F F F F F F F F F F F F F F F", 99);
2847 : 16817 : A (M2Base_card16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . T T T F F F F F F F F F F F F F F F F F F F F F", 99);
2848 : 16817 : A (M2Base_card32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . T T F T F F F F F F F F F F F F F F F F F F F", 99);
2849 : 16817 : A (M2Base_card64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F F F F F F F F F F F F F F F F", 99);
2850 : 16817 : A (M2Base_word16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F", 99);
2851 : 16817 : A (M2Base_word32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F F F F F F F F F F F F F F F", 99);
2852 : 16817 : A (M2Base_word64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F F F F F F F F F F F F F F", 99);
2853 : 16817 : A (M2Base_real32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F", 99);
2854 : 16817 : A (M2Base_real64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F", 99);
2855 : 16817 : A (M2Base_real96, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F", 99);
2856 : 16817 : A (M2Base_real128, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F", 99);
2857 : 16817 : A (M2Base_set8, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F", 99);
2858 : 16817 : A (M2Base_set16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F", 99);
2859 : 16817 : A (M2Base_set32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F", 99);
2860 : 16817 : A (M2Base_complex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F F", 99);
2861 : 16817 : A (M2Base_shortcomplex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F F", 99);
2862 : 16817 : A (M2Base_longcomplex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F F", 99);
2863 : 16817 : A (M2Base_complex32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F F", 99);
2864 : 16817 : A (M2Base_complex64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F", 99);
2865 : 16817 : A (M2Base_complex96, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F", 99);
2866 : 16817 : A (M2Base_complex128, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F F", 99);
2867 : 16817 : A (M2Base_ctype, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F", 99);
2868 : 16817 : A (M2Base_rec, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F", 99);
2869 : 16817 : A (M2Base_array, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F", 99);
2870 : 16817 : A (M2Base_procedure, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T", 99);
2871 : : /*
2872 : : 1 p w
2873 : :
2874 : : C W B A C I S L C S L P E R S L S O L R Z I I I I C C C C W W W R R R R S S S C S L C C C C C R A P
2875 : : o o y d h n h o a h o t n e h o e p o t t n n n n a a a a o o o e e e e e e e o h o o o o o t e r r
2876 : : n r t d a t o n r o n r u a o n t a c y y t t t t r r r r r r r a a a a t t t m o n m m m m y c r o
2877 : : s d e r r e r g d r g m l r g q p p 8 1 3 6 d d d d d d d l l l l 8 1 3 p r g p p p p p a c
2878 : : t e g t i i t c t r u e e 6 2 4 8 1 3 6 1 3 6 3 6 9 1 6 2 l t C l l l l e y
2879 : : s e i n n c a r e e 6 2 4 6 2 4 2 4 6 2 e C o e e e e
2880 : : s r n t a a r e a 8 x o m x x x x
2881 : : t l r d a l m p 3 6 9 1
2882 : : d l p l 2 4 6 2
2883 : : l e 8
2884 : : e x
2885 : : x
2886 : : ------------------------------------------------------------------------------------------------------------
2887 : : 2
2888 : : P
2889 : : W
2890 : : */
2891 : 16817 : E (M2Base_const, (const char *) "T T T T T T T T T T T T T T T T T T F F T T T T T T T T T T T T T T T T F F F F F F F F F F F F F F", 99);
2892 : 16817 : E (M2Base_word, (const char *) ". T F F F F F F F F F F F F F F F F F W F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2893 : 16817 : E (M2Base_byte, (const char *) ". . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2894 : 16817 : E (M2Base_address, (const char *) ". . . T F P F F P F F T F F F F F F F F P F F F F F F F F F F F F F F F F F F F F F F F F F F F F T", 99);
2895 : 16817 : E (M2Base_chr, (const char *) ". . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2896 : 16817 : E (M2Base_normint, (const char *) ". . . . . T F F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2897 : 16817 : E (M2Base_shortint, (const char *) ". . . . . . T F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2898 : 16817 : E (M2Base_longint, (const char *) ". . . . . . . T F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2899 : 16817 : E (M2Base_normcard, (const char *) ". . . . . . . . T F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2900 : 16817 : E (M2Base_shortcard, (const char *) ". . . . . . . . . T F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2901 : 16817 : E (M2Base_longcard, (const char *) ". . . . . . . . . . T F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2902 : 16817 : E (M2Base_pointer, (const char *) ". . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2903 : 16817 : E (M2Base_enum, (const char *) ". . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2904 : 16817 : E (M2Base_real, (const char *) ". . . . . . . . . . . . . T F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2905 : 16817 : E (M2Base_shortreal, (const char *) ". . . . . . . . . . . . . . T F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2906 : 16817 : E (M2Base_longreal, (const char *) ". . . . . . . . . . . . . . . T F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2907 : 16817 : E (M2Base_set, (const char *) ". . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2908 : 16817 : E (M2Base_opaque, (const char *) ". . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2909 : 16817 : E (M2Base_loc, (const char *) ". . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2910 : 16817 : E (M2Base_rtype, (const char *) ". . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F 1 1 1 1 F F F F F F F F F F F F F F", 99);
2911 : 16817 : E (M2Base_ztype, (const char *) ". . . . . . . . . . . . . . . . . . . . T 1 1 1 1 1 1 1 1 1 1 1 F F F F F F F F F F F F F F F F F F", 99);
2912 : 16817 : E (M2Base_int8, (const char *) ". . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2913 : 16817 : E (M2Base_int16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2914 : 16817 : E (M2Base_int32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2915 : 16817 : E (M2Base_int64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2916 : 16817 : E (M2Base_card8, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2917 : 16817 : E (M2Base_card16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F", 99);
2918 : 16817 : E (M2Base_card32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F", 99);
2919 : 16817 : E (M2Base_card64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F", 99);
2920 : 16817 : E (M2Base_word16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F", 99);
2921 : 16817 : E (M2Base_word32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F", 99);
2922 : 16817 : E (M2Base_word64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F", 99);
2923 : 16817 : E (M2Base_real32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F", 99);
2924 : 16817 : E (M2Base_real64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F", 99);
2925 : 16817 : E (M2Base_real96, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F", 99);
2926 : 16817 : E (M2Base_real128, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F", 99);
2927 : 16817 : E (M2Base_set8, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F", 99);
2928 : 16817 : E (M2Base_set16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F", 99);
2929 : 16817 : E (M2Base_set32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F", 99);
2930 : 16817 : E (M2Base_complex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F F", 99);
2931 : 16817 : E (M2Base_shortcomplex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F F", 99);
2932 : 16817 : E (M2Base_longcomplex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F F", 99);
2933 : 16817 : E (M2Base_complex32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F F", 99);
2934 : 16817 : E (M2Base_complex64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F", 99);
2935 : 16817 : E (M2Base_complex96, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F", 99);
2936 : 16817 : E (M2Base_complex128, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F F", 99);
2937 : 16817 : E (M2Base_ctype, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F", 99);
2938 : 16817 : E (M2Base_rec, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F", 99);
2939 : 16817 : E (M2Base_array, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F", 99);
2940 : 16817 : E (M2Base_procedure, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T", 99);
2941 : : /*
2942 : : 1 p w
2943 : :
2944 : : C W B A C I S L C S L P E R S L S O L R Z I I I I C C C C W W W R R R R S S S C S L C C C C C R A P
2945 : : o o y d h n h o a h o t n e h o e p o t t n n n n a a a a o o o e e e e e e e o h o o o o o t e r r
2946 : : n r t d a t o n r o n r u a o n t a c y y t t t t r r r r r r r a a a a t t t m o n m m m m y c r o
2947 : : s d e r r e r g d r g m l r g q p p 8 1 3 6 d d d d d d d l l l l 8 1 3 p r g p p p p p a c
2948 : : t e g t i i t c t r u e e 6 2 4 8 1 3 6 1 3 6 3 6 9 1 6 2 l t C l l l l e y
2949 : : s e i n n c a r e e 6 2 4 6 2 4 2 4 6 2 e C o e e e e
2950 : : s r n t a a r e a 8 x o m x x x x
2951 : : t l r d a l m p 3 6 9 1
2952 : : d l p l 2 4 6 2
2953 : : l e 8
2954 : : e x
2955 : : x
2956 : : ------------------------------------------------------------------------------------------------------------
2957 : : 2
2958 : : P
2959 : : W
2960 : : */
2961 : 16817 : C (M2Base_const, (const char *) "T T T T T T T T T T T T T T T T T T F F T T T T T T T T T T T T T T T T F F F F F F F F F F F F F F", 99);
2962 : 16817 : C (M2Base_word, (const char *) ". T F F F F F F F F F F F F F F F F F F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2963 : 16817 : C (M2Base_byte, (const char *) ". . T F F F F F F F F F F F F F F F F F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2964 : 16817 : C (M2Base_address, (const char *) ". . . T F F F F F F F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F T", 99);
2965 : 16817 : C (M2Base_chr, (const char *) ". . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2966 : 16817 : C (M2Base_normint, (const char *) ". . . . . T F F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2967 : 16817 : C (M2Base_shortint, (const char *) ". . . . . . T F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2968 : 16817 : C (M2Base_longint, (const char *) ". . . . . . . T F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2969 : 16817 : C (M2Base_normcard, (const char *) ". . . . . . . . T F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2970 : 16817 : C (M2Base_shortcard, (const char *) ". . . . . . . . . T F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2971 : 16817 : C (M2Base_longcard, (const char *) ". . . . . . . . . . T F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2972 : 16817 : C (M2Base_pointer, (const char *) ". . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2973 : 16817 : C (M2Base_enum, (const char *) ". . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2974 : 16817 : C (M2Base_real, (const char *) ". . . . . . . . . . . . . T F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2975 : 16817 : C (M2Base_shortreal, (const char *) ". . . . . . . . . . . . . . T F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2976 : 16817 : C (M2Base_longreal, (const char *) ". . . . . . . . . . . . . . . T F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2977 : 16817 : C (M2Base_set, (const char *) ". . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2978 : 16817 : C (M2Base_opaque, (const char *) ". . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2979 : 16817 : C (M2Base_loc, (const char *) ". . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2980 : 16817 : C (M2Base_rtype, (const char *) ". . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F 1 1 1 1 F F F F F F F F F F F F F F", 99);
2981 : 16817 : C (M2Base_ztype, (const char *) ". . . . . . . . . . . . . . . . . . . . T 1 1 1 1 1 1 1 1 1 1 1 F F F F F F F F F F F F F F F F F F", 99);
2982 : 16817 : C (M2Base_int8, (const char *) ". . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2983 : 16817 : C (M2Base_int16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2984 : 16817 : C (M2Base_int32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2985 : 16817 : C (M2Base_int64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2986 : 16817 : C (M2Base_card8, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F", 99);
2987 : 16817 : C (M2Base_card16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F", 99);
2988 : 16817 : C (M2Base_card32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F", 99);
2989 : 16817 : C (M2Base_card64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F", 99);
2990 : 16817 : C (M2Base_word16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F", 99);
2991 : 16817 : C (M2Base_word32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F", 99);
2992 : 16817 : C (M2Base_word64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F", 99);
2993 : 16817 : C (M2Base_real32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F", 99);
2994 : 16817 : C (M2Base_real64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F", 99);
2995 : 16817 : C (M2Base_real96, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F", 99);
2996 : 16817 : C (M2Base_real128, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F", 99);
2997 : 16817 : C (M2Base_set8, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F", 99);
2998 : 16817 : C (M2Base_set16, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F", 99);
2999 : 16817 : C (M2Base_set32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F", 99);
3000 : 16817 : C (M2Base_complex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F F", 99);
3001 : 16817 : C (M2Base_shortcomplex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F F", 99);
3002 : 16817 : C (M2Base_longcomplex, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F F", 99);
3003 : 16817 : C (M2Base_complex32, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F F", 99);
3004 : 16817 : C (M2Base_complex64, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F", 99);
3005 : 16817 : C (M2Base_complex96, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F", 99);
3006 : 16817 : C (M2Base_complex128, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F F", 99);
3007 : 16817 : C (M2Base_ctype, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F", 99);
3008 : 16817 : C (M2Base_rec, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F", 99);
3009 : 16817 : C (M2Base_array, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F", 99);
3010 : 16817 : C (M2Base_procedure, (const char *) ". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T", 99);
3011 : 16817 : }
3012 : :
3013 : :
3014 : : /*
3015 : : InitBase - initializes the base types and procedures
3016 : : used in the Modula-2 compiler.
3017 : : */
3018 : :
3019 : 16817 : extern "C" void M2Base_InitBase (m2linemap_location_t location, unsigned int *sym)
3020 : : {
3021 : 16817 : (*sym) = SymbolTable_MakeModule (M2LexBuf_BuiltinTokenNo, NameKey_MakeKey ((const char *) "_BaseTypes", 10));
3022 : 16817 : SymbolTable_PutModuleBuiltin ((*sym), true);
3023 : 16817 : SymbolTable_SetCurrentModule ((*sym));
3024 : 16817 : SymbolTable_StartScope ((*sym));
3025 : 16817 : InitBaseSimpleTypes (location);
3026 : : /* Initialize the SYSTEM module before we ADDRESS. */
3027 : 16817 : M2System_InitSystem ();
3028 : 16817 : M2Bitset_MakeBitset (); /* We do this after SYSTEM has been created as BITSET
3029 : : is dependant upon WORD. */
3030 : 16817 : InitBaseConstants (); /* We do this after SYSTEM has been created as BITSET
3031 : : is dependant upon WORD. */
3032 : 16817 : InitBaseFunctions ();
3033 : 16817 : InitBaseProcedures ();
3034 : : /*
3035 : : Note: that we do end the Scope since we keep the symbol to the head
3036 : : of the base scope. This head of base scope is searched
3037 : : when all other scopes fail to deliver a symbol.
3038 : : */
3039 : 16817 : SymbolTable_EndScope ();
3040 : 16817 : InitBuiltins ();
3041 : 16817 : InitCompatibilityMatrices ();
3042 : 16817 : }
3043 : :
3044 : :
3045 : : /*
3046 : : GetBaseTypeMinMax - returns the minimum and maximum values for a
3047 : : given base type. This procedure should only
3048 : : be called if the type is NOT a subrange.
3049 : : */
3050 : :
3051 : 83464 : extern "C" void M2Base_GetBaseTypeMinMax (unsigned int type, unsigned int *min, unsigned int *max)
3052 : : {
3053 : 83464 : if (type == M2Base_Integer)
3054 : : {
3055 : 456 : (*min) = MinInteger;
3056 : 456 : (*max) = MaxInteger;
3057 : : }
3058 : 83008 : else if (type == M2Base_Cardinal)
3059 : : {
3060 : : /* avoid dangling else. */
3061 : 1123 : (*min) = MinCardinal;
3062 : 1123 : (*max) = MaxCardinal;
3063 : : }
3064 : 81885 : else if (type == M2Base_Char)
3065 : : {
3066 : : /* avoid dangling else. */
3067 : 12566 : (*min) = MinChar;
3068 : 12566 : (*max) = MaxChar;
3069 : : }
3070 : 69319 : else if (type == M2Bitset_Bitset)
3071 : : {
3072 : : /* avoid dangling else. */
3073 : 0 : M2Bitset_GetBitsetMinMax (min, max);
3074 : : }
3075 : 69319 : else if (type == M2Base_LongInt)
3076 : : {
3077 : : /* avoid dangling else. */
3078 : 312 : (*min) = MinLongInt;
3079 : 312 : (*max) = MaxLongInt;
3080 : : }
3081 : 69007 : else if (type == M2Base_LongCard)
3082 : : {
3083 : : /* avoid dangling else. */
3084 : 38 : (*min) = MinLongCard;
3085 : 38 : (*max) = MaxLongCard;
3086 : : }
3087 : 68969 : else if (type == M2Base_ShortInt)
3088 : : {
3089 : : /* avoid dangling else. */
3090 : 12 : (*min) = MinShortInt;
3091 : 12 : (*max) = MaxShortInt;
3092 : : }
3093 : 68957 : else if (type == M2Base_ShortCard)
3094 : : {
3095 : : /* avoid dangling else. */
3096 : 0 : (*min) = MinShortCard;
3097 : 0 : (*max) = MaxShortCard;
3098 : : }
3099 : 68957 : else if (type == M2Base_Real)
3100 : : {
3101 : : /* avoid dangling else. */
3102 : 54 : (*min) = MinReal;
3103 : 54 : (*max) = MaxReal;
3104 : : }
3105 : 68903 : else if (type == M2Base_ShortReal)
3106 : : {
3107 : : /* avoid dangling else. */
3108 : 12 : (*min) = MinShortReal;
3109 : 12 : (*max) = MaxShortReal;
3110 : : }
3111 : 68891 : else if (type == M2Base_LongReal)
3112 : : {
3113 : : /* avoid dangling else. */
3114 : 12 : (*min) = MinLongReal;
3115 : 12 : (*max) = MaxLongReal;
3116 : : }
3117 : 68879 : else if (SymbolTable_IsEnumeration (type))
3118 : : {
3119 : : /* avoid dangling else. */
3120 : 68879 : MinEnum = SymbolTable_NulSym;
3121 : 68879 : MaxEnum = SymbolTable_NulSym;
3122 : 68879 : SymbolTable_ForeachFieldEnumerationDo (type, (SymbolKey_PerformOperation) {(SymbolKey_PerformOperation_t) FindMinMaxEnum});
3123 : 68879 : (*min) = MinEnum;
3124 : 68879 : (*max) = MaxEnum;
3125 : : }
3126 : : else
3127 : : {
3128 : : /* avoid dangling else. */
3129 : 0 : M2MetaError_MetaError1 ((const char *) "unable to find MIN or MAX for the base type {%1as}", 50, type);
3130 : : }
3131 : 83464 : }
3132 : :
3133 : :
3134 : : /*
3135 : : IsPseudoBaseFunction - returns true if Sym is a Base pseudo function.
3136 : : */
3137 : :
3138 : 3996793 : extern "C" bool M2Base_IsPseudoBaseFunction (unsigned int Sym)
3139 : : {
3140 : 3996793 : return (((((((((((((Sym == M2Base_High) || (Sym == M2Base_Val)) || (Sym == M2Base_Convert)) || (M2Base_IsOrd (Sym))) || (Sym == M2Base_Chr)) || (M2Base_IsFloat (Sym))) || (M2Base_IsTrunc (Sym))) || (Sym == M2Base_Min)) || (Sym == M2Base_Max)) || (Sym == M2Base_Abs)) || (Sym == M2Base_Odd)) || (Sym == M2Base_Cap)) || (IsISOPseudoBaseFunction (Sym))) || (IsPIMPseudoBaseFunction (Sym));
3141 : : /* static analysis guarentees a RETURN statement will be used before here. */
3142 : : __builtin_unreachable ();
3143 : : }
3144 : :
3145 : :
3146 : : /*
3147 : : IsPseudoBaseProcedure - returns true if Sym is a Base pseudo procedure.
3148 : : */
3149 : :
3150 : 4032059 : extern "C" bool M2Base_IsPseudoBaseProcedure (unsigned int Sym)
3151 : : {
3152 : 4032059 : return (((((Sym == M2Base_New) || (Sym == M2Base_Dispose)) || (Sym == M2Base_Inc)) || (Sym == M2Base_Dec)) || (Sym == M2Base_Incl)) || (Sym == M2Base_Excl);
3153 : : /* static analysis guarentees a RETURN statement will be used before here. */
3154 : : __builtin_unreachable ();
3155 : : }
3156 : :
3157 : :
3158 : : /*
3159 : : IsNeededAtRunTime - returns TRUE if procedure, sym, is a
3160 : : runtime procedure. A runtime procedure is
3161 : : not a pseudo procedure (like NEW/DISPOSE)
3162 : : and it is implemented in M2RTS or SYSTEM
3163 : : and also exported.
3164 : : */
3165 : :
3166 : 2578481 : extern "C" bool M2Base_IsNeededAtRunTime (unsigned int tok, unsigned int sym)
3167 : : {
3168 : 2578481 : return (((SymbolTable_FromModuleGetSym (tok, SymbolTable_GetSymName (sym), M2System_System)) == sym) || ((SymbolTable_FromModuleGetSym (tok, SymbolTable_GetSymName (sym), m2rts)) == sym)) && ((SymbolTable_IsExportQualified (sym)) || (SymbolTable_IsExportUnQualified (sym)));
3169 : : /* static analysis guarentees a RETURN statement will be used before here. */
3170 : : __builtin_unreachable ();
3171 : : }
3172 : :
3173 : :
3174 : : /*
3175 : : IsBaseType - returns TRUE if Sym is a Base type.
3176 : : */
3177 : :
3178 : 1087835 : extern "C" bool M2Base_IsBaseType (unsigned int Sym)
3179 : : {
3180 : 1087835 : return (((((((((((((((Sym == M2Base_Cardinal) || (Sym == M2Base_Integer)) || (Sym == M2Base_Boolean)) || (Sym == M2Base_Char)) || (Sym == M2Base_Proc)) || (Sym == M2Base_LongInt)) || (Sym == M2Base_LongCard)) || (Sym == M2Base_ShortInt)) || (Sym == M2Base_ShortCard)) || (Sym == M2Base_Real)) || (Sym == M2Base_LongReal)) || (Sym == M2Base_ShortReal)) || (Sym == M2Base_Complex)) || (Sym == M2Base_LongComplex)) || (Sym == M2Base_ShortComplex)) || (Sym == M2Bitset_Bitset);
3181 : : /* static analysis guarentees a RETURN statement will be used before here. */
3182 : : __builtin_unreachable ();
3183 : : }
3184 : :
3185 : :
3186 : : /*
3187 : : IsOrdinalType - returns TRUE if, sym, is an ordinal type.
3188 : : An ordinal type is defined as:
3189 : : a base type which contains whole numbers or
3190 : : a subrange type or an enumeration type.
3191 : : */
3192 : :
3193 : 1110144 : extern "C" bool M2Base_IsOrdinalType (unsigned int Sym)
3194 : : {
3195 : 1110144 : return ((((((((((((Sym == M2Base_Cardinal) || (Sym == M2Base_Integer)) || (Sym == M2Base_Char)) || (Sym == M2Base_Boolean)) || (Sym == M2Base_LongInt)) || (Sym == M2Base_LongCard)) || (Sym == M2Base_ShortInt)) || (Sym == M2Base_ShortCard)) || (Sym == M2Base_ZType)) || (SymbolTable_IsSubrange (Sym))) || (SymbolTable_IsEnumeration (Sym))) || (M2System_IsIntegerN (Sym))) || (M2System_IsCardinalN (Sym));
3196 : : /* static analysis guarentees a RETURN statement will be used before here. */
3197 : : __builtin_unreachable ();
3198 : : }
3199 : :
3200 : :
3201 : : /*
3202 : : IsOrd - returns TRUE if, sym, is ORD or its typed counterparts
3203 : : ORDL, ORDS.
3204 : : */
3205 : :
3206 : 3951813 : extern "C" bool M2Base_IsOrd (unsigned int sym)
3207 : : {
3208 : 3951813 : return ((sym == Ord) || (sym == OrdS)) || (sym == OrdL);
3209 : : /* static analysis guarentees a RETURN statement will be used before here. */
3210 : : __builtin_unreachable ();
3211 : : }
3212 : :
3213 : :
3214 : : /*
3215 : : IsTrunc - returns TRUE if, sym, is TRUNC or its typed counterparts
3216 : : TRUNCL, TRUNCS.
3217 : : */
3218 : :
3219 : 3794891 : extern "C" bool M2Base_IsTrunc (unsigned int sym)
3220 : : {
3221 : 3794891 : return ((sym == Trunc) || (sym == TruncS)) || (sym == TruncL);
3222 : : /* static analysis guarentees a RETURN statement will be used before here. */
3223 : : __builtin_unreachable ();
3224 : : }
3225 : :
3226 : :
3227 : : /*
3228 : : IsFloat - returns TRUE if, sym, is FLOAT or its typed counterparts
3229 : : FLOATL, FLOATS.
3230 : : */
3231 : :
3232 : 3878037 : extern "C" bool M2Base_IsFloat (unsigned int sym)
3233 : : {
3234 : 3878037 : return ((((sym == Float) || (sym == FloatS)) || (sym == FloatL)) || (sym == SFloat)) || (sym == LFloat);
3235 : : /* static analysis guarentees a RETURN statement will be used before here. */
3236 : : __builtin_unreachable ();
3237 : : }
3238 : :
3239 : :
3240 : : /*
3241 : : IsInt - returns TRUE if, sym, is INT or its typed counterparts
3242 : : INTL, INTS.
3243 : : */
3244 : :
3245 : 1076829 : extern "C" bool M2Base_IsInt (unsigned int sym)
3246 : : {
3247 : 1076829 : return ((sym == Int) || (sym == IntS)) || (sym == IntL);
3248 : : /* static analysis guarentees a RETURN statement will be used before here. */
3249 : : __builtin_unreachable ();
3250 : : }
3251 : :
3252 : :
3253 : : /*
3254 : : AssignmentRequiresWarning - returns TRUE if t1 and t2 can be used during
3255 : : an assignment, but should generate a warning.
3256 : : For example in PIM we can assign ADDRESS
3257 : : and WORD providing they are both the
3258 : : same size.
3259 : : No warning is necessary if the types are the same.
3260 : : */
3261 : :
3262 : 26642 : extern "C" bool M2Base_AssignmentRequiresWarning (unsigned int t1, unsigned int t2)
3263 : : {
3264 : 26642 : return (t1 != t2) && (((IsCompatible (t1, t2, M2Base_assignment)) == M2Base_warnfirst) || ((IsCompatible (t1, t2, M2Base_assignment)) == M2Base_warnsecond));
3265 : : /* static analysis guarentees a RETURN statement will be used before here. */
3266 : : __builtin_unreachable ();
3267 : : }
3268 : :
3269 : :
3270 : : /*
3271 : : IsAssignmentCompatible - returns TRUE if t1 and t2 are assignment
3272 : : compatible.
3273 : : */
3274 : :
3275 : 310798 : extern "C" bool M2Base_IsAssignmentCompatible (unsigned int t1, unsigned int t2)
3276 : : {
3277 : 310798 : return ((t1 == t2) || ((IsCompatible (t1, t2, M2Base_assignment)) == M2Base_first)) || ((IsCompatible (t1, t2, M2Base_assignment)) == M2Base_second);
3278 : : /* static analysis guarentees a RETURN statement will be used before here. */
3279 : : __builtin_unreachable ();
3280 : : }
3281 : :
3282 : :
3283 : : /*
3284 : : IsExpressionCompatible - returns TRUE if t1 and t2 are expression
3285 : : compatible.
3286 : : */
3287 : :
3288 : 62464 : extern "C" bool M2Base_IsExpressionCompatible (unsigned int t1, unsigned int t2)
3289 : : {
3290 : 62464 : return ((IsCompatible (t1, t2, M2Base_expression)) == M2Base_first) || ((IsCompatible (t1, t2, M2Base_expression)) == M2Base_second);
3291 : : /* static analysis guarentees a RETURN statement will be used before here. */
3292 : : __builtin_unreachable ();
3293 : : }
3294 : :
3295 : :
3296 : : /*
3297 : : IsParameterCompatible - returns TRUE if t1 and t2 are expression
3298 : : compatible.
3299 : : */
3300 : :
3301 : 5860 : extern "C" bool M2Base_IsParameterCompatible (unsigned int t1, unsigned int t2)
3302 : : {
3303 : 5860 : return ((IsCompatible (t1, t2, M2Base_parameter)) == M2Base_first) || ((IsCompatible (t1, t2, M2Base_parameter)) == M2Base_second); /* ; tokenNo: CARDINAL */
3304 : : /* static analysis guarentees a RETURN statement will be used before here. */
3305 : : __builtin_unreachable ();
3306 : : }
3307 : :
3308 : :
3309 : : /*
3310 : : IsComparisonCompatible - returns TRUE if t1 and t2 are comparison compatible.
3311 : : */
3312 : :
3313 : 47112 : extern "C" bool M2Base_IsComparisonCompatible (unsigned int t1, unsigned int t2)
3314 : : {
3315 : 47112 : return ((IsCompatible (t1, t2, M2Base_comparison)) == M2Base_first) || ((IsCompatible (t1, t2, M2Base_comparison)) == M2Base_second); /* ; tokenNo: CARDINAL */
3316 : : /* static analysis guarentees a RETURN statement will be used before here. */
3317 : : __builtin_unreachable ();
3318 : : }
3319 : :
3320 : :
3321 : : /*
3322 : : IsValidParameter - returns TRUE if an, actual, parameter can be passed
3323 : : to the, formal, parameter. This differs from
3324 : : IsParameterCompatible as this procedure includes checks
3325 : : for unbounded formal parameters, var parameters and
3326 : : constant actual parameters.
3327 : : */
3328 : :
3329 : 0 : extern "C" bool M2Base_IsValidParameter (unsigned int formal, unsigned int actual)
3330 : : {
3331 : 0 : unsigned int at;
3332 : 0 : unsigned int ft;
3333 : :
3334 : 0 : M2Debug_Assert (SymbolTable_IsParameter (formal)); /* ; tokenNo: CARDINAL */
3335 : 0 : M2Debug_Assert (M2Pass_IsPassCodeGeneration ());
3336 : 0 : if ((SymbolTable_IsConst (actual)) && (SymbolTable_IsParameterVar (formal)))
3337 : : {
3338 : : return false;
3339 : : }
3340 : : else
3341 : : {
3342 : 0 : if (SymbolTable_IsParameterUnbounded (formal))
3343 : : {
3344 : 0 : return IsValidUnboundedParameter (formal, actual);
3345 : : }
3346 : : else
3347 : : {
3348 : 0 : ft = SymbolTable_SkipType (SymbolTable_GetType (formal));
3349 : : }
3350 : 0 : if ((((SymbolTable_IsConst (actual)) && ((SymbolTable_SkipType (SymbolTable_GetType (actual))) == M2Base_Char)) && (SymbolTable_IsArray (ft))) && ((SymbolTable_SkipType (SymbolTable_GetType (ft))) == M2Base_Char))
3351 : : {
3352 : : /* a constant char can be either a char or a string */
3353 : : return true;
3354 : : }
3355 : 0 : if (SymbolTable_IsProcType (ft))
3356 : : {
3357 : 0 : if (SymbolTable_IsProcedure (actual))
3358 : : {
3359 : : /* we check this by calling IsValidProcedure for each and every
3360 : : parameter of actual and formal */
3361 : : return true;
3362 : : }
3363 : : else
3364 : : {
3365 : 0 : at = SymbolTable_SkipType (SymbolTable_GetType (actual));
3366 : 0 : return doProcTypeCheck (at, ft, true);
3367 : : }
3368 : : }
3369 : 0 : else if (SymbolTable_IsParameterVar (formal))
3370 : : {
3371 : : /* avoid dangling else. */
3372 : 0 : return IsVarParamCompatible (SymbolTable_GetType (actual), ft);
3373 : : }
3374 : : else
3375 : : {
3376 : : /* avoid dangling else. */
3377 : 0 : return M2Base_IsParameterCompatible (SymbolTable_GetType (actual), ft);
3378 : : }
3379 : : }
3380 : : /* static analysis guarentees a RETURN statement will be used before here. */
3381 : : __builtin_unreachable ();
3382 : : }
3383 : :
3384 : :
3385 : : /*
3386 : : CheckExpressionCompatible - returns if t1 and t2 are compatible types for
3387 : : +, -, *, DIV, >, <, =, etc.
3388 : : If t1 and t2 are not compatible then an error
3389 : : message is displayed.
3390 : : */
3391 : :
3392 : 486 : extern "C" void M2Base_CheckExpressionCompatible (unsigned int tok, unsigned int left, unsigned int right)
3393 : : {
3394 : 486 : CheckCompatible (tok, left, right, M2Base_expression);
3395 : 486 : }
3396 : :
3397 : :
3398 : : /*
3399 : : CheckAssignmentCompatible - returns if t1 and t2 are compatible types for
3400 : : :=, =, #.
3401 : : If t1 and t2 are not compatible then an error
3402 : : message is displayed.
3403 : : */
3404 : :
3405 : 49660 : extern "C" void M2Base_CheckAssignmentCompatible (unsigned int tok, unsigned int left, unsigned int right)
3406 : : {
3407 : 49660 : if (left != right)
3408 : : {
3409 : 22396 : CheckCompatible (tok, left, right, M2Base_assignment);
3410 : : }
3411 : 49660 : }
3412 : :
3413 : :
3414 : : /*
3415 : : CheckParameterCompatible - checks to see if types, t1, and, t2, are
3416 : : compatible for parameter passing.
3417 : : */
3418 : :
3419 : 0 : extern "C" void M2Base_CheckParameterCompatible (unsigned int tok, unsigned int t1, unsigned int t2)
3420 : : {
3421 : 0 : CheckCompatible (tok, t1, t2, M2Base_parameter);
3422 : 0 : }
3423 : :
3424 : :
3425 : : /*
3426 : : CannotCheckTypeInPass3 - returns TRUE if we are unable to check the
3427 : : type of, e, in pass 3.
3428 : : */
3429 : :
3430 : 0 : extern "C" bool M2Base_CannotCheckTypeInPass3 (unsigned int e)
3431 : : {
3432 : 0 : unsigned int t;
3433 : 0 : M2Base_MetaType mt;
3434 : :
3435 : 0 : t = SymbolTable_SkipType (SymbolTable_GetType (e));
3436 : 0 : mt = FindMetaType (t);
3437 : 0 : switch (mt)
3438 : : {
3439 : : case M2Base_pointer:
3440 : : case M2Base_enum:
3441 : : case M2Base_set:
3442 : : case M2Base_set8:
3443 : : case M2Base_set16:
3444 : : case M2Base_set32:
3445 : : case M2Base_opaque:
3446 : : return true;
3447 : 0 : break;
3448 : :
3449 : :
3450 : 0 : default:
3451 : 0 : return false;
3452 : : break;
3453 : : }
3454 : : /* static analysis guarentees a RETURN statement will be used before here. */
3455 : : __builtin_unreachable ();
3456 : : }
3457 : :
3458 : :
3459 : : /*
3460 : : MixTypes - given types, t1 and t2, returns a type symbol that
3461 : : provides expression type compatibility.
3462 : : NearTok is used to identify the source position if a type
3463 : : incompatability occurs.
3464 : : */
3465 : :
3466 : 294514 : extern "C" unsigned int M2Base_MixTypes (unsigned int t1, unsigned int t2, unsigned int NearTok)
3467 : : {
3468 : 369264 : if (t1 == t2)
3469 : : {
3470 : : return t1;
3471 : : }
3472 : 144736 : else if ((t1 == M2System_Address) && (t2 == M2Base_Cardinal))
3473 : : {
3474 : : /* avoid dangling else. */
3475 : : return M2System_Address;
3476 : : }
3477 : 144480 : else if ((t1 == M2Base_Cardinal) && (t2 == M2System_Address))
3478 : : {
3479 : : /* avoid dangling else. */
3480 : : return M2System_Address;
3481 : : }
3482 : 144224 : else if ((t1 == M2System_Address) && (t2 == M2Base_Integer))
3483 : : {
3484 : : /* avoid dangling else. */
3485 : : return M2System_Address;
3486 : : }
3487 : 144144 : else if ((t1 == M2Base_Integer) && (t2 == M2System_Address))
3488 : : {
3489 : : /* avoid dangling else. */
3490 : : return M2System_Address;
3491 : : }
3492 : 144064 : else if (t1 == SymbolTable_NulSym)
3493 : : {
3494 : : /* avoid dangling else. */
3495 : : return t2;
3496 : : }
3497 : 118394 : else if (t2 == SymbolTable_NulSym)
3498 : : {
3499 : : /* avoid dangling else. */
3500 : : return t1;
3501 : : }
3502 : 79803 : else if ((t1 == M2Bitset_Bitset) && (SymbolTable_IsSet (t2)))
3503 : : {
3504 : : /* avoid dangling else. */
3505 : : return t1;
3506 : : }
3507 : 79803 : else if ((SymbolTable_IsSet (t1)) && (t2 == M2Bitset_Bitset))
3508 : : {
3509 : : /* avoid dangling else. */
3510 : : return t2;
3511 : : }
3512 : 79803 : else if (SymbolTable_IsEnumeration (t1))
3513 : : {
3514 : : /* avoid dangling else. */
3515 : 110 : return M2Base_MixTypes (M2Base_Integer, t2, NearTok);
3516 : : }
3517 : 79693 : else if (SymbolTable_IsEnumeration (t2))
3518 : : {
3519 : : /* avoid dangling else. */
3520 : 120 : return M2Base_MixTypes (t1, M2Base_Integer, NearTok);
3521 : : }
3522 : 79573 : else if (SymbolTable_IsSubrange (t1))
3523 : : {
3524 : : /* avoid dangling else. */
3525 : 3112 : return M2Base_MixTypes (SymbolTable_GetType (t1), t2, NearTok);
3526 : : }
3527 : 76461 : else if (SymbolTable_IsSubrange (t2))
3528 : : {
3529 : : /* avoid dangling else. */
3530 : 7946 : return M2Base_MixTypes (t1, SymbolTable_GetType (t2), NearTok);
3531 : : }
3532 : 68515 : else if ((M2Base_IsRealType (t1)) && (M2Base_IsRealType (t2)))
3533 : : {
3534 : : /* avoid dangling else. */
3535 : 1054 : if (t1 == M2Base_RType)
3536 : : {
3537 : : return t2;
3538 : : }
3539 : 732 : else if (t2 == M2Base_RType)
3540 : : {
3541 : : /* avoid dangling else. */
3542 : : return t1;
3543 : : }
3544 : : else
3545 : : {
3546 : : /* avoid dangling else. */
3547 : : return M2Base_RType;
3548 : : }
3549 : : }
3550 : 67461 : else if ((M2Base_IsComplexType (t1)) && (M2Base_IsComplexType (t2)))
3551 : : {
3552 : : /* avoid dangling else. */
3553 : 102 : if (t1 == M2Base_CType)
3554 : : {
3555 : : return t2;
3556 : : }
3557 : 90 : else if (t2 == M2Base_CType)
3558 : : {
3559 : : /* avoid dangling else. */
3560 : : return t1;
3561 : : }
3562 : : else
3563 : : {
3564 : : /* avoid dangling else. */
3565 : : return M2Base_CType;
3566 : : }
3567 : : }
3568 : 67359 : else if (IsUserType (t1))
3569 : : {
3570 : : /* avoid dangling else. */
3571 : 25505 : return M2Base_MixTypes (SymbolTable_GetType (t1), t2, NearTok);
3572 : : }
3573 : 41854 : else if (IsUserType (t2))
3574 : : {
3575 : : /* avoid dangling else. */
3576 : 37957 : return M2Base_MixTypes (t1, SymbolTable_GetType (t2), NearTok);
3577 : : }
3578 : 3897 : else if ((t1 == (SymbolTable_GetLowestType (t1))) && (t2 == (SymbolTable_GetLowestType (t2))))
3579 : : {
3580 : : /* avoid dangling else. */
3581 : 3897 : return MixMetaTypes (t1, t2, NearTok);
3582 : : }
3583 : : else
3584 : : {
3585 : : /* avoid dangling else. */
3586 : 0 : t1 = SymbolTable_GetLowestType (t1);
3587 : 0 : t2 = SymbolTable_GetLowestType (t2);
3588 : 0 : return M2Base_MixTypes (t1, t2, NearTok);
3589 : : }
3590 : : /* static analysis guarentees a RETURN statement will be used before here. */
3591 : : __builtin_unreachable ();
3592 : : }
3593 : :
3594 : :
3595 : : /*
3596 : : NegateType - if the type is unsigned then returns the
3597 : : signed equivalent.
3598 : : */
3599 : :
3600 : 22010 : extern "C" unsigned int M2Base_NegateType (unsigned int type)
3601 : : {
3602 : 22010 : unsigned int lowType;
3603 : :
3604 : 22010 : if (type != SymbolTable_NulSym) /* ; sympos: CARDINAL */
3605 : : {
3606 : 22010 : lowType = SymbolTable_GetLowestType (type);
3607 : 22010 : if (lowType == M2Base_LongCard)
3608 : : {
3609 : 0 : return M2Base_LongInt;
3610 : : }
3611 : 22010 : else if (lowType == M2Base_Cardinal)
3612 : : {
3613 : : /* avoid dangling else. */
3614 : : /* ELSE
3615 : : MetaErrorT1 (sympos, 'the type {%1ad} does not have a negated equivalent and an unary minus cannot be used on an operand of this type', type)
3616 : : */
3617 : 198 : return M2Base_Integer;
3618 : : }
3619 : : }
3620 : : return type;
3621 : : /* static analysis guarentees a RETURN statement will be used before here. */
3622 : : __builtin_unreachable ();
3623 : : }
3624 : :
3625 : :
3626 : : /*
3627 : : IsMathType - returns TRUE if the type is a mathematical type.
3628 : : A mathematical type has a range larger than INTEGER.
3629 : : (Typically SHORTREAL/REAL/LONGREAL/LONGINT/LONGCARD)
3630 : : */
3631 : :
3632 : 484441 : extern "C" bool M2Base_IsMathType (unsigned int type)
3633 : : {
3634 : 484441 : return ((((((type == M2Base_LongCard) || (type == M2Base_LongInt)) || (type == M2Base_Real)) || (type == M2Base_LongReal)) || (type == M2Base_ShortReal)) || (type == M2Base_RType)) || (type == M2Base_ZType);
3635 : : /* static analysis guarentees a RETURN statement will be used before here. */
3636 : : __builtin_unreachable ();
3637 : : }
3638 : :
3639 : :
3640 : : /*
3641 : : IsRealType - returns TRUE if, t, is a real type.
3642 : : */
3643 : :
3644 : 2833586 : extern "C" bool M2Base_IsRealType (unsigned int t)
3645 : : {
3646 : 2833586 : return (((t == M2Base_Real) || (t == M2Base_LongReal)) || (t == M2Base_ShortReal)) || (t == M2Base_RType);
3647 : : /* static analysis guarentees a RETURN statement will be used before here. */
3648 : : __builtin_unreachable ();
3649 : : }
3650 : :
3651 : :
3652 : : /*
3653 : : IsComplexType - returns TRUE if, sym, is COMPLEX,
3654 : : LONGCOMPLEX or SHORTCOMPLEX.
3655 : : */
3656 : :
3657 : 2363681 : extern "C" bool M2Base_IsComplexType (unsigned int sym)
3658 : : {
3659 : 2363681 : return ((((sym == M2Base_Complex) || (sym == M2Base_LongComplex)) || (sym == M2Base_ShortComplex)) || (sym == M2Base_CType)) || (M2System_IsComplexN (sym));
3660 : : /* static analysis guarentees a RETURN statement will be used before here. */
3661 : : __builtin_unreachable ();
3662 : : }
3663 : :
3664 : :
3665 : : /*
3666 : : ComplexToScalar - returns the scalar (or base type) of the complex type, sym.
3667 : : */
3668 : :
3669 : 174 : extern "C" unsigned int M2Base_ComplexToScalar (unsigned int sym)
3670 : : {
3671 : 174 : if (sym == SymbolTable_NulSym)
3672 : : {
3673 : : /* a const complex may have a NulSym type */
3674 : 0 : return M2Base_RType;
3675 : : }
3676 : 174 : else if (sym == M2Base_Complex)
3677 : : {
3678 : : /* avoid dangling else. */
3679 : 42 : return M2Base_Real;
3680 : : }
3681 : 132 : else if (sym == M2Base_LongComplex)
3682 : : {
3683 : : /* avoid dangling else. */
3684 : 12 : return M2Base_LongReal;
3685 : : }
3686 : 120 : else if (sym == M2Base_ShortComplex)
3687 : : {
3688 : : /* avoid dangling else. */
3689 : 12 : return M2Base_ShortReal;
3690 : : }
3691 : 108 : else if (sym == M2Base_CType)
3692 : : {
3693 : : /* avoid dangling else. */
3694 : 108 : return M2Base_RType;
3695 : : }
3696 : 0 : else if (sym == (M2System_ComplexN (32)))
3697 : : {
3698 : : /* avoid dangling else. */
3699 : 0 : return M2System_RealN (32);
3700 : : }
3701 : 0 : else if (sym == (M2System_ComplexN (64)))
3702 : : {
3703 : : /* avoid dangling else. */
3704 : 0 : return M2System_RealN (64);
3705 : : }
3706 : 0 : else if (sym == (M2System_ComplexN (96)))
3707 : : {
3708 : : /* avoid dangling else. */
3709 : 0 : return M2System_RealN (96);
3710 : : }
3711 : 0 : else if (sym == (M2System_ComplexN (128)))
3712 : : {
3713 : : /* avoid dangling else. */
3714 : 0 : return M2System_RealN (128);
3715 : : }
3716 : : else
3717 : : {
3718 : : /* avoid dangling else. */
3719 : 0 : M2MetaError_MetaError1 ((const char *) "{%1ad} must be a COMPLEX type", 29, sym);
3720 : 0 : return M2Base_RType;
3721 : : }
3722 : : /* static analysis guarentees a RETURN statement will be used before here. */
3723 : : __builtin_unreachable ();
3724 : : }
3725 : :
3726 : :
3727 : : /*
3728 : : ScalarToComplex - given a real type, t, return the equivalent complex type.
3729 : : */
3730 : :
3731 : 978 : extern "C" unsigned int M2Base_ScalarToComplex (unsigned int sym)
3732 : : {
3733 : 978 : if (sym == M2Base_Real)
3734 : : {
3735 : 58 : return M2Base_Complex;
3736 : : }
3737 : 920 : else if (sym == M2Base_LongReal)
3738 : : {
3739 : : /* avoid dangling else. */
3740 : 40 : return M2Base_LongComplex;
3741 : : }
3742 : 880 : else if (sym == M2Base_ShortReal)
3743 : : {
3744 : : /* avoid dangling else. */
3745 : 40 : return M2Base_ShortComplex;
3746 : : }
3747 : 840 : else if (sym == M2Base_RType)
3748 : : {
3749 : : /* avoid dangling else. */
3750 : 816 : return M2Base_CType;
3751 : : }
3752 : 24 : else if (sym == (M2System_RealN (32)))
3753 : : {
3754 : : /* avoid dangling else. */
3755 : 24 : return M2System_ComplexN (32);
3756 : : }
3757 : 0 : else if (sym == (M2System_RealN (64)))
3758 : : {
3759 : : /* avoid dangling else. */
3760 : 0 : return M2System_ComplexN (64);
3761 : : }
3762 : 0 : else if (sym == (M2System_RealN (96)))
3763 : : {
3764 : : /* avoid dangling else. */
3765 : 0 : return M2System_ComplexN (96);
3766 : : }
3767 : 0 : else if (sym == (M2System_RealN (128)))
3768 : : {
3769 : : /* avoid dangling else. */
3770 : 0 : return M2System_ComplexN (128);
3771 : : }
3772 : : else
3773 : : {
3774 : : /* avoid dangling else. */
3775 : 0 : M2MetaError_MetaError1 ((const char *) "{%1ad} must be a REAL type", 26, sym);
3776 : 0 : return M2Base_Complex;
3777 : : }
3778 : : /* static analysis guarentees a RETURN statement will be used before here. */
3779 : : __builtin_unreachable ();
3780 : : }
3781 : :
3782 : :
3783 : : /*
3784 : : GetCmplxReturnType - this code implements the table given in the
3785 : : ISO standard Page 293 with an addition for
3786 : : SHORTCOMPLEX.
3787 : : */
3788 : :
3789 : 978 : extern "C" unsigned int M2Base_GetCmplxReturnType (unsigned int t1, unsigned int t2)
3790 : : {
3791 : 978 : M2Base_MetaType mt1;
3792 : 978 : M2Base_MetaType mt2;
3793 : :
3794 : 978 : t1 = SymbolTable_SkipType (t1);
3795 : 978 : t2 = SymbolTable_SkipType (t2);
3796 : 978 : if (((M2Base_IsRealType (t1)) || (M2System_IsRealN (t1))) && ((M2Base_IsRealType (t2)) || (M2System_IsRealN (t2))))
3797 : : {
3798 : 978 : mt1 = FindMetaType (t1);
3799 : 978 : mt2 = FindMetaType (t2);
3800 : 978 : if (mt1 == mt2)
3801 : : {
3802 : 918 : return M2Base_ScalarToComplex (t1);
3803 : : }
3804 : : else
3805 : : {
3806 : 60 : if (mt1 == M2Base_rtype)
3807 : : {
3808 : 12 : return M2Base_ScalarToComplex (t2);
3809 : : }
3810 : 48 : else if (mt2 == M2Base_rtype)
3811 : : {
3812 : : /* avoid dangling else. */
3813 : 48 : return M2Base_ScalarToComplex (t1);
3814 : : }
3815 : : else
3816 : : {
3817 : : /* avoid dangling else. */
3818 : : return SymbolTable_NulSym;
3819 : : }
3820 : : }
3821 : : }
3822 : : else
3823 : : {
3824 : 0 : return SymbolTable_NulSym;
3825 : : }
3826 : : /* static analysis guarentees a RETURN statement will be used before here. */
3827 : : __builtin_unreachable ();
3828 : : }
3829 : :
3830 : 16817 : extern "C" void _M2_M2Base_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
3831 : : {
3832 : 16817 : }
3833 : :
3834 : 0 : extern "C" void _M2_M2Base_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
3835 : : {
3836 : 0 : }
|
