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