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