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