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