]>
Commit | Line | Data |
---|---|---|
1 | (* M2Base.mod provides a mechanism to check fundamental types. | |
2 | ||
3 | Copyright (C) 2001-2024 Free Software Foundation, Inc. | |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. | |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with GNU Modula-2; see the file COPYING3. If not see | |
20 | <http://www.gnu.org/licenses/>. *) | |
21 | ||
22 | IMPLEMENTATION MODULE M2Base ; | |
23 | ||
24 | (* | |
25 | Title : M2Base | |
26 | Author : Gaius Mulley | |
27 | System : UNIX (gm2) | |
28 | Date : Mon Jul 10 20:16:54 2000 | |
29 | Description: gcc version of M2Base. This module initializes the front end | |
30 | symbol table with the base types. We collect the size of the | |
31 | base types and range of values from the gcc backend. | |
32 | *) | |
33 | ||
34 | FROM DynamicStrings IMPORT InitString, String, Mark, InitStringCharStar, ConCat ; | |
35 | FROM M2LexBuf IMPORT BuiltinTokenNo, GetTokenNo ; | |
36 | FROM NameKey IMPORT NulName, MakeKey, WriteKey, KeyToCharStar ; | |
37 | FROM M2Debug IMPORT Assert ; | |
38 | FROM SYSTEM IMPORT WORD ; | |
39 | ||
40 | FROM M2Error IMPORT InternalError, FlushErrors ; | |
41 | FROM M2Pass IMPORT IsPassCodeGeneration ; | |
42 | FROM FormatStrings IMPORT Sprintf2 ; | |
43 | FROM StrLib IMPORT StrLen ; | |
44 | ||
45 | FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaErrors3, | |
46 | MetaErrorT1, MetaErrorT2, | |
47 | MetaErrorStringT2, MetaErrorStringT1 ; | |
48 | ||
49 | FROM SymbolTable IMPORT ModeOfAddr, | |
50 | MakeModule, MakeType, PutType, | |
51 | MakeEnumeration, PutFieldEnumeration, | |
52 | MakeProcType, | |
53 | MakeProcedure, PutFunction, | |
54 | MakeRecord, PutFieldRecord, | |
55 | MakeConstVar, PutConst, | |
56 | MakeTemporary, | |
57 | MakeVar, PutVar, | |
58 | MakeSubrange, PutSubrange, IsSubrange, | |
59 | PutModuleBuiltin, | |
60 | IsEnumeration, IsSet, IsPointer, IsType, IsUnknown, | |
61 | IsHiddenType, IsProcType, | |
62 | GetType, GetLowestType, GetDeclaredMod, SkipType, | |
63 | SetCurrentModule, | |
64 | StartScope, EndScope, PseudoScope, | |
65 | ForeachFieldEnumerationDo, | |
66 | RequestSym, GetSymName, NulSym, | |
67 | PutImported, GetExported, | |
68 | PopSize, PopValue, PushValue, | |
69 | FromModuleGetSym, GetSym, | |
70 | IsExportQualified, IsExportUnQualified, | |
71 | IsParameter, IsParameterVar, IsUnbounded, | |
72 | IsConst, IsUnboundedParam, | |
73 | IsParameterUnbounded, GetSubrange, | |
74 | IsArray, IsProcedure, IsConstString, | |
75 | IsVarient, IsRecordField, IsFieldVarient, | |
76 | GetArraySubscript, IsRecord, NoOfParam, | |
77 | GetNthParam, IsVarParam, GetNth, GetDimension, | |
78 | MakeError ; | |
79 | ||
80 | FROM M2ALU IMPORT PushIntegerTree, PushRealTree, PushCard, Equ, Gre, Less ; | |
81 | FROM M2Batch IMPORT MakeDefinitionSource ; | |
82 | FROM M2Bitset IMPORT Bitset, GetBitsetMinMax, MakeBitset ; | |
83 | FROM M2Size IMPORT Size, MakeSize ; | |
84 | ||
85 | FROM M2System IMPORT Address, Byte, Word, System, Loc, InitSystem, | |
86 | IntegerN, CardinalN, WordN, SetN, RealN, ComplexN, | |
87 | IsCardinalN, IsIntegerN, IsRealN, IsComplexN, | |
88 | IsGenericSystemType, IsSameSizePervasiveType ; | |
89 | ||
90 | FROM M2Options IMPORT NilChecking, | |
91 | WholeDivChecking, WholeValueChecking, | |
92 | IndexChecking, RangeChecking, | |
93 | ReturnChecking, CaseElseChecking, Exceptions, | |
94 | WholeValueChecking, | |
95 | DebugBuiltins, | |
96 | Iso, Pim, Pim2, Pim3 ; | |
97 | ||
98 | FROM m2type IMPORT GetIntegerType, | |
99 | GetM2IntegerType, GetM2CharType, | |
100 | GetMaxFrom, GetMinFrom, GetRealType, | |
101 | GetM2LongIntType, GetLongRealType, GetProcType, | |
102 | GetM2ShortRealType, GetM2RealType, | |
103 | GetM2LongRealType, GetM2LongCardType, | |
104 | GetM2ShortIntType, GetM2ShortCardType, | |
105 | GetM2CardinalType, GetPointerType, GetWordType, | |
106 | GetByteType, GetISOWordType, GetISOByteType, | |
107 | GetISOLocType, | |
108 | GetM2ComplexType, GetM2LongComplexType, | |
109 | GetM2ShortComplexType, | |
110 | GetM2Complex32, GetM2Complex64, | |
111 | GetM2Complex96, GetM2Complex128, | |
112 | GetM2RType, GetM2ZType, GetM2CType, | |
113 | InitBaseTypes ; | |
114 | ||
115 | FROM m2expr IMPORT GetSizeOf ; | |
116 | FROM m2linemap IMPORT location_t, BuiltinsLocation ; | |
117 | FROM m2decl IMPORT BuildIntegerConstant ; | |
118 | ||
119 | ||
120 | TYPE | |
121 | Compatability = (expression, assignment, parameter, comparison) ; | |
122 | MetaType = (const, word, byte, address, chr, | |
123 | normint, shortint, longint, | |
124 | normcard, shortcard, longcard, | |
125 | pointer, enum, | |
126 | real, shortreal, longreal, | |
127 | set, opaque, loc, rtype, ztype, | |
128 | int8, int16, int32, int64, | |
129 | card8, card16, card32, card64, | |
130 | word16, word32, word64, | |
131 | real32, real64, real96, real128, | |
132 | set8, set16, set32, | |
133 | complex, shortcomplex, longcomplex, | |
134 | complex32, complex64, complex96, complex128, | |
135 | ctype, rec, array, | |
136 | procedure, unknown) ; | |
137 | Compatible = (uninitialized, no, warnfirst, warnsecond, | |
138 | first, second) ; | |
139 | ||
140 | ||
141 | TYPE | |
142 | CompatibilityArray = ARRAY MetaType, MetaType OF Compatible ; | |
143 | ||
144 | VAR | |
145 | Comp, | |
146 | Expr, | |
147 | Ass : CompatibilityArray ; | |
148 | Ord, | |
149 | OrdS, OrdL, | |
150 | Float, | |
151 | FloatS, SFloat, | |
152 | FloatL, LFloat, | |
153 | Trunc, | |
154 | TruncS, | |
155 | TruncL, | |
156 | Int, IntS, IntL, | |
157 | m2rts, | |
158 | MinReal, | |
159 | MaxReal, | |
160 | MinShortReal, | |
161 | MaxShortReal, | |
162 | MinLongReal, | |
163 | MaxLongReal, | |
164 | MinLongInt, | |
165 | MaxLongInt, | |
166 | MinLongCard, | |
167 | MaxLongCard, | |
168 | MinShortInt, | |
169 | MaxShortInt, | |
170 | MinShortCard, | |
171 | MaxShortCard, | |
172 | MinChar, | |
173 | MaxChar, | |
174 | MinCardinal, | |
175 | MaxCardinal, | |
176 | MinInteger, | |
177 | MaxInteger, | |
178 | MaxEnum, | |
179 | MinEnum : CARDINAL ; | |
180 | ||
181 | ||
182 | (* | |
183 | InitBuiltins - | |
184 | *) | |
185 | ||
186 | PROCEDURE InitBuiltins ; | |
187 | VAR | |
188 | builtins: CARDINAL ; | |
189 | BEGIN | |
190 | IF DebugBuiltins | |
191 | THEN | |
192 | (* We will need to parse this module as functions alloca/memcpy will be used. *) | |
193 | builtins := MakeDefinitionSource (BuiltinTokenNo, MakeKey ('Builtins')) ; | |
194 | IF builtins = NulSym | |
195 | THEN | |
196 | MetaError0 ('unable to find core module Builtins') | |
197 | END | |
198 | END | |
199 | END InitBuiltins ; | |
200 | ||
201 | ||
202 | (* | |
203 | InitBase - initializes the base types and procedures | |
204 | used in the Modula-2 compiler. | |
205 | *) | |
206 | ||
207 | PROCEDURE InitBase (location: location_t; VAR sym: CARDINAL) ; | |
208 | BEGIN | |
209 | sym := MakeModule (BuiltinTokenNo, MakeKey ('_BaseTypes')) ; | |
210 | PutModuleBuiltin (sym, TRUE) ; | |
211 | SetCurrentModule (sym) ; | |
212 | StartScope (sym) ; | |
213 | ||
214 | InitBaseSimpleTypes (location) ; | |
215 | ||
216 | (* Initialize the SYSTEM module before we ADDRESS. *) | |
217 | InitSystem ; | |
218 | ||
219 | MakeBitset ; (* We do this after SYSTEM has been created as BITSET | |
220 | is dependant upon WORD. *) | |
221 | ||
222 | InitBaseConstants ; | |
223 | InitBaseFunctions ; | |
224 | InitBaseProcedures ; | |
225 | ||
226 | (* | |
227 | Note: that we do end the Scope since we keep the symbol to the head | |
228 | of the base scope. This head of base scope is searched | |
229 | when all other scopes fail to deliver a symbol. | |
230 | *) | |
231 | EndScope ; | |
232 | InitBuiltins ; | |
233 | InitCompatibilityMatrices | |
234 | END InitBase ; | |
235 | ||
236 | ||
237 | (* | |
238 | IsNeededAtRunTime - returns TRUE if procedure, sym, is a | |
239 | runtime procedure. A runtime procedure is | |
240 | not a pseudo procedure (like NEW/DISPOSE) | |
241 | and it is implemented in M2RTS or SYSTEM | |
242 | and also exported. | |
243 | *) | |
244 | ||
245 | PROCEDURE IsNeededAtRunTime (tok: CARDINAL; sym: CARDINAL) : BOOLEAN ; | |
246 | BEGIN | |
247 | RETURN( | |
248 | ((FromModuleGetSym(tok, GetSymName(sym), System)=sym) OR | |
249 | (FromModuleGetSym(tok, GetSymName(sym), m2rts)=sym)) AND | |
250 | (IsExportQualified(sym) OR IsExportUnQualified(sym)) | |
251 | ) | |
252 | END IsNeededAtRunTime ; | |
253 | ||
254 | ||
255 | (* | |
256 | InitBaseConstants - initialises the base constant NIL. | |
257 | *) | |
258 | ||
259 | PROCEDURE InitBaseConstants ; | |
260 | BEGIN | |
261 | Nil := MakeConstVar (BuiltinTokenNo, MakeKey ('NIL')) ; | |
262 | PutConst (Nil, Address) | |
263 | END InitBaseConstants ; | |
264 | ||
265 | ||
266 | (* | |
267 | InitBaseSimpleTypes - initialises the base simple types, | |
268 | CARDINAL, INTEGER, CHAR, BOOLEAN. | |
269 | *) | |
270 | ||
271 | PROCEDURE InitBaseSimpleTypes (location: location_t) ; | |
272 | BEGIN | |
273 | InitBaseTypes (location) ; | |
274 | ||
275 | ZType := MakeType (BuiltinTokenNo, MakeKey('Modula-2 base Z')) ; | |
276 | PutType(ZType, NulSym) ; (* Base Type *) | |
277 | PushIntegerTree(GetSizeOf(location, GetM2ZType())) ; | |
278 | PopSize(ZType) ; | |
279 | ||
280 | RType := MakeType(BuiltinTokenNo, MakeKey('Modula-2 base R')) ; | |
281 | PutType(RType, NulSym) ; (* Base Type *) | |
282 | PushIntegerTree(GetSizeOf(location, GetM2RType())) ; | |
283 | PopSize(RType) ; | |
284 | ||
285 | CType := MakeType (BuiltinTokenNo, MakeKey('Modula-2 base C')) ; | |
286 | PutType(CType, NulSym) ; (* Base Type *) | |
287 | PushIntegerTree(GetSizeOf(location, GetM2CType())) ; | |
288 | PopSize(CType) ; | |
289 | ||
290 | Integer := MakeType (BuiltinTokenNo, MakeKey('INTEGER')) ; | |
291 | PutType(Integer, NulSym) ; (* Base Type *) | |
292 | PushIntegerTree(GetSizeOf(location, GetM2IntegerType())) ; | |
293 | PopSize(Integer) ; | |
294 | ||
295 | Cardinal := MakeType (BuiltinTokenNo, MakeKey('CARDINAL')) ; | |
296 | PutType(Cardinal, NulSym) ; | |
297 | (* Base Type *) | |
298 | PushIntegerTree(GetSizeOf(location, GetM2CardinalType())) ; | |
299 | PopSize(Cardinal) ; | |
300 | ||
301 | LongInt := MakeType (BuiltinTokenNo, MakeKey('LONGINT')) ; | |
302 | PutType(LongInt, NulSym) ; (* Base Type *) | |
303 | PushIntegerTree(GetSizeOf(location, GetM2LongIntType())) ; | |
304 | PopSize(LongInt) ; | |
305 | ||
306 | LongCard := MakeType (BuiltinTokenNo, MakeKey('LONGCARD')) ; | |
307 | PutType(LongCard, NulSym) ; (* Base Type *) | |
308 | PushIntegerTree(GetSizeOf(location, GetM2LongCardType())) ; | |
309 | PopSize(LongCard) ; | |
310 | ||
311 | ShortInt := MakeType (BuiltinTokenNo, MakeKey('SHORTINT')) ; | |
312 | PutType(ShortInt, NulSym) ; (* Base Type *) | |
313 | PushIntegerTree(GetSizeOf(location, GetM2ShortIntType())) ; | |
314 | PopSize(ShortInt) ; | |
315 | ||
316 | ShortCard := MakeType (BuiltinTokenNo, MakeKey('SHORTCARD')) ; | |
317 | PutType(ShortCard, NulSym) ; (* Base Type *) | |
318 | PushIntegerTree(GetSizeOf(location, GetM2ShortCardType())) ; | |
319 | PopSize(ShortCard) ; | |
320 | ||
321 | Real := MakeType (BuiltinTokenNo, MakeKey('REAL')) ; | |
322 | PutType(Real, NulSym) ; (* Base Type *) | |
323 | PushIntegerTree(GetSizeOf(location, GetM2RealType())) ; | |
324 | PopSize(Real) ; | |
325 | ||
326 | ShortReal := MakeType (BuiltinTokenNo, MakeKey('SHORTREAL')) ; | |
327 | PutType(ShortReal, NulSym) ; (* Base Type *) | |
328 | PushIntegerTree(GetSizeOf(location, GetM2ShortRealType())) ; | |
329 | PopSize(ShortReal) ; | |
330 | ||
331 | LongReal := MakeType (BuiltinTokenNo, MakeKey('LONGREAL')) ; | |
332 | PutType(LongReal, NulSym) ; (* Base Type *) | |
333 | PushIntegerTree(GetSizeOf(location, GetM2LongRealType())) ; | |
334 | PopSize(LongReal) ; | |
335 | ||
336 | Complex := MakeType (BuiltinTokenNo, MakeKey('COMPLEX')) ; | |
337 | PutType(Complex, NulSym) ; (* Base Type *) | |
338 | PushIntegerTree(GetSizeOf(location, GetM2ComplexType())) ; | |
339 | PopSize(Complex) ; | |
340 | ||
341 | LongComplex := MakeType (BuiltinTokenNo, MakeKey('LONGCOMPLEX')) ; | |
342 | PutType(LongComplex, NulSym) ; (* Base Type *) | |
343 | PushIntegerTree(GetSizeOf(location, GetM2LongComplexType())) ; | |
344 | PopSize(LongComplex) ; | |
345 | ||
346 | ShortComplex := MakeType (BuiltinTokenNo, MakeKey('SHORTCOMPLEX')) ; | |
347 | PutType(ShortComplex, NulSym) ; (* Base Type *) | |
348 | PushIntegerTree(GetSizeOf(location, GetM2ShortComplexType())) ; | |
349 | PopSize(ShortComplex) ; | |
350 | ||
351 | Char := MakeType (BuiltinTokenNo, MakeKey('CHAR')) ; | |
352 | PutType(Char, NulSym) ; (* Base Type *) | |
353 | PushIntegerTree(GetSizeOf(location, GetM2CharType())) ; | |
354 | PopSize(Char) ; | |
355 | ||
356 | (* | |
357 | Boolean = (FALSE, TRUE) ; | |
358 | *) | |
359 | Boolean := MakeEnumeration (BuiltinTokenNo, MakeKey('BOOLEAN')) ; | |
360 | ||
361 | PutFieldEnumeration (BuiltinTokenNo, Boolean, MakeKey('FALSE')) ; | |
362 | PutFieldEnumeration (BuiltinTokenNo, Boolean, MakeKey('TRUE')) ; | |
363 | ||
364 | True := RequestSym (BuiltinTokenNo, MakeKey('TRUE')) ; | |
365 | False := RequestSym (BuiltinTokenNo, MakeKey('FALSE')) ; | |
366 | ||
367 | Proc := MakeProcType (BuiltinTokenNo, MakeKey('PROC')) ; | |
368 | PushIntegerTree(GetSizeOf(location, GetProcType())) ; | |
369 | PopSize(Proc) ; | |
370 | ||
371 | (* MinChar *) | |
372 | MinChar := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
373 | PushIntegerTree(GetMinFrom(location, GetM2CharType())) ; | |
374 | PopValue(MinChar) ; | |
375 | PutVar(MinChar, Char) ; | |
376 | ||
377 | (* MaxChar *) | |
378 | MaxChar := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
379 | PushIntegerTree(GetMaxFrom(location, GetM2CharType())) ; | |
380 | PopValue(MaxChar) ; | |
381 | PutVar(MaxChar, Char) ; | |
382 | ||
383 | (* MinInteger *) | |
384 | MinInteger := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
385 | PushIntegerTree(GetMinFrom(location, GetM2IntegerType())) ; | |
386 | PopValue(MinInteger) ; | |
387 | PutVar(MinInteger, Integer) ; | |
388 | ||
389 | (* MaxInteger *) | |
390 | MaxInteger := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
391 | PushIntegerTree(GetMaxFrom(location, GetM2IntegerType())) ; | |
392 | PopValue(MaxInteger) ; | |
393 | PutVar(MaxInteger, Integer) ; | |
394 | ||
395 | (* MinCardinal *) | |
396 | MinCardinal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
397 | PushIntegerTree(GetMinFrom(BuiltinsLocation(), GetM2CardinalType())) ; | |
398 | PopValue(MinCardinal) ; | |
399 | PutVar(MinCardinal, Cardinal) ; | |
400 | ||
401 | (* MaxCardinal *) | |
402 | MaxCardinal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
403 | PushIntegerTree(GetMaxFrom(location, GetM2CardinalType())) ; | |
404 | PopValue(MaxCardinal) ; | |
405 | PutVar(MaxCardinal, Cardinal) ; | |
406 | ||
407 | (* MinLongInt *) | |
408 | MinLongInt := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
409 | PushIntegerTree(GetMinFrom(location, GetM2LongIntType())) ; | |
410 | PopValue(MinLongInt) ; | |
411 | PutVar(MinLongInt, LongInt) ; | |
412 | ||
413 | (* MaxLongInt *) | |
414 | MaxLongInt := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
415 | PushIntegerTree(GetMaxFrom(location, GetM2LongIntType())) ; | |
416 | PopValue(MaxLongInt) ; | |
417 | PutVar(MaxLongInt, LongInt) ; | |
418 | ||
419 | (* MinLongCard *) | |
420 | MinLongCard := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
421 | PushIntegerTree(GetMinFrom(location, GetM2LongCardType())) ; | |
422 | PopValue(MinLongCard) ; | |
423 | PutVar(MinLongCard, LongCard) ; | |
424 | ||
425 | (* MinLongCard *) | |
426 | MaxLongCard := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
427 | PushIntegerTree(GetMaxFrom(BuiltinsLocation(), GetM2LongCardType())) ; | |
428 | PopValue(MaxLongCard) ; | |
429 | PutVar(MaxLongCard, LongCard) ; | |
430 | ||
431 | (* MinReal *) | |
432 | MinReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
433 | PushRealTree(GetMinFrom(location, GetM2RealType())) ; | |
434 | PopValue(MinReal) ; | |
435 | PutVar(MinReal, Real) ; | |
436 | ||
437 | (* MaxReal *) | |
438 | MaxReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
439 | PushRealTree(GetMaxFrom(location, GetM2RealType())) ; | |
440 | PopValue(MaxReal) ; | |
441 | PutVar(MaxReal, Real) ; | |
442 | ||
443 | (* MinShortReal *) | |
444 | MinShortReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
445 | PushRealTree(GetMinFrom(location, GetM2ShortRealType())) ; | |
446 | PopValue(MinShortReal) ; | |
447 | PutVar(MinShortReal, ShortReal) ; | |
448 | ||
449 | (* MaxShortReal *) | |
450 | MaxShortReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
451 | PushRealTree(GetMaxFrom(location, GetM2ShortRealType())) ; | |
452 | PopValue(MaxShortReal) ; | |
453 | PutVar(MaxShortReal, ShortReal) ; | |
454 | ||
455 | (* MinLongReal *) | |
456 | MinLongReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
457 | PushRealTree(GetMinFrom(location, GetM2LongRealType())) ; | |
458 | PopValue(MinLongReal) ; | |
459 | PutVar(MinLongReal, LongReal) ; | |
460 | ||
461 | (* MaxLongReal *) | |
462 | MaxLongReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
463 | PushRealTree(GetMaxFrom(location, GetM2LongRealType())) ; | |
464 | PopValue(MaxLongReal) ; | |
465 | PutVar(MaxLongReal, LongReal) ; | |
466 | ||
467 | (* MaxShortInt *) | |
468 | MaxShortInt := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
469 | PushIntegerTree(GetMaxFrom(location, GetM2ShortIntType())) ; | |
470 | PopValue(MaxShortInt) ; | |
471 | PutVar(MaxShortInt, ShortInt) ; | |
472 | ||
473 | (* MinShortInt *) | |
474 | MinShortInt := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
475 | PushIntegerTree(GetMinFrom(location, GetM2ShortIntType())) ; | |
476 | PopValue(MinShortInt) ; | |
477 | PutVar(MinShortInt, ShortInt) ; | |
478 | ||
479 | (* MaxShortCard *) | |
480 | MaxShortCard := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
481 | PushIntegerTree(GetMaxFrom(location, GetM2ShortCardType())) ; | |
482 | PopValue(MaxShortCard) ; | |
483 | PutVar(MaxShortCard, ShortCard) ; | |
484 | ||
485 | (* MinShortCard *) | |
486 | MinShortCard := MakeTemporary(BuiltinTokenNo, ImmediateValue) ; | |
487 | PushIntegerTree(GetMinFrom(location, GetM2ShortCardType())) ; | |
488 | PopValue(MinShortCard) ; | |
489 | PutVar(MinShortCard, ShortCard) | |
490 | ||
491 | END InitBaseSimpleTypes ; | |
492 | ||
493 | ||
494 | (* | |
495 | FindMinMaxEnum - finds the minimum and maximum enumeration fields. | |
496 | *) | |
497 | ||
498 | PROCEDURE FindMinMaxEnum (field: WORD) ; | |
499 | BEGIN | |
500 | IF MaxEnum=NulSym | |
501 | THEN | |
502 | MaxEnum := field | |
503 | ELSE | |
504 | PushValue(field) ; | |
505 | PushValue(MaxEnum) ; | |
506 | IF Gre(GetTokenNo()) | |
507 | THEN | |
508 | MaxEnum := field | |
509 | END | |
510 | END ; | |
511 | IF MinEnum=NulSym | |
512 | THEN | |
513 | MinEnum := field | |
514 | ELSE | |
515 | PushValue(field) ; | |
516 | PushValue(MinEnum) ; | |
517 | IF Less(GetTokenNo()) | |
518 | THEN | |
519 | MinEnum := field | |
520 | END | |
521 | END | |
522 | END FindMinMaxEnum ; | |
523 | ||
524 | ||
525 | (* | |
526 | GetBaseTypeMinMax - returns the minimum and maximum values for a | |
527 | given base type. This procedure should only | |
528 | be called if the type is NOT a subrange. | |
529 | *) | |
530 | ||
531 | PROCEDURE GetBaseTypeMinMax (type: CARDINAL; VAR min, max: CARDINAL) ; | |
532 | BEGIN | |
533 | IF type=Integer | |
534 | THEN | |
535 | min := MinInteger ; | |
536 | max := MaxInteger | |
537 | ELSIF type=Cardinal | |
538 | THEN | |
539 | min := MinCardinal ; | |
540 | max := MaxCardinal | |
541 | ELSIF type=Char | |
542 | THEN | |
543 | min := MinChar ; | |
544 | max := MaxChar | |
545 | ELSIF type=Bitset | |
546 | THEN | |
547 | GetBitsetMinMax(min, max) | |
548 | ELSIF (type=LongInt) | |
549 | THEN | |
550 | min := MinLongInt ; | |
551 | max := MaxLongInt | |
552 | ELSIF (type=LongCard) | |
553 | THEN | |
554 | min := MinLongCard ; | |
555 | max := MaxLongCard | |
556 | ELSIF (type=ShortInt) | |
557 | THEN | |
558 | min := MinShortInt ; | |
559 | max := MaxShortInt | |
560 | ELSIF (type=ShortCard) | |
561 | THEN | |
562 | min := MinShortCard ; | |
563 | max := MaxShortCard | |
564 | ELSIF (type=Real) | |
565 | THEN | |
566 | min := MinReal ; | |
567 | max := MaxReal | |
568 | ELSIF (type=ShortReal) | |
569 | THEN | |
570 | min := MinShortReal ; | |
571 | max := MaxShortReal | |
572 | ELSIF (type=LongReal) | |
573 | THEN | |
574 | min := MinLongReal ; | |
575 | max := MaxLongReal | |
576 | ELSIF IsEnumeration(type) | |
577 | THEN | |
578 | MinEnum := NulSym ; | |
579 | MaxEnum := NulSym ; | |
580 | ForeachFieldEnumerationDo(type, FindMinMaxEnum) ; | |
581 | min := MinEnum ; | |
582 | max := MaxEnum | |
583 | ELSE | |
584 | MetaError1 ('unable to find MIN or MAX for the base type {%1as}', type) | |
585 | END | |
586 | END GetBaseTypeMinMax ; | |
587 | ||
588 | ||
589 | (* | |
590 | ImportFrom - imports symbol, name, from module and returns the | |
591 | symbol. | |
592 | *) | |
593 | ||
594 | PROCEDURE ImportFrom (tok: CARDINAL; | |
595 | module: CARDINAL; name: ARRAY OF CHAR) : CARDINAL ; | |
596 | BEGIN | |
597 | PutImported(GetExported(tok, module, MakeKey(name))) ; | |
598 | RETURN( GetSym(MakeKey(name)) ) | |
599 | END ImportFrom ; | |
600 | ||
601 | ||
602 | (* | |
603 | InitBaseProcedures - initialises the base procedures, | |
604 | INC, DEC, INCL, EXCL, NEW and DISPOSE. | |
605 | *) | |
606 | ||
607 | PROCEDURE InitBaseProcedures ; | |
608 | VAR | |
609 | rtexceptions: CARDINAL ; | |
610 | BEGIN | |
611 | (* | |
612 | The pseudo procedures NEW and DISPOSE are in fact "macro" | |
613 | substituted for ALLOCATE and DEALLOCATE. | |
614 | However they both have symbols in the base module so that | |
615 | the procedure mechanism treats all procedure calls the same. | |
616 | "Macro" substitution occurs in M2Quads. | |
617 | *) | |
618 | ||
619 | New := MakeProcedure(BuiltinTokenNo, MakeKey('NEW')) ; | |
620 | Dispose := MakeProcedure(BuiltinTokenNo, MakeKey('DISPOSE')) ; | |
621 | Inc := MakeProcedure(BuiltinTokenNo, MakeKey('INC')) ; | |
622 | Dec := MakeProcedure(BuiltinTokenNo, MakeKey('DEC')) ; | |
623 | Incl := MakeProcedure(BuiltinTokenNo, MakeKey('INCL')) ; | |
624 | Excl := MakeProcedure(BuiltinTokenNo, MakeKey('EXCL')) ; | |
625 | ||
626 | IF NOT Pim2 | |
627 | THEN | |
628 | MakeSize (* SIZE is declared as a standard function in *) | |
629 | (* ISO Modula-2 and PIM-[34] Modula-2 but not *) | |
630 | (* PIM-2 Modula-2 *) | |
631 | END ; | |
632 | ||
633 | (* | |
634 | The procedure HALT is a real procedure which | |
635 | is defined in M2RTS. However to remain compatible | |
636 | with other Modula-2 implementations HALT can be used | |
637 | without the need to import it from M2RTS. ie it is | |
638 | within the BaseType module scope. | |
639 | *) | |
640 | m2rts := MakeDefinitionSource(BuiltinTokenNo, MakeKey('M2RTS')) ; | |
641 | PutImported(GetExported(BuiltinTokenNo, m2rts, MakeKey('HALT'))) ; | |
642 | ||
643 | ExceptionAssign := NulSym ; | |
644 | ExceptionReturn := NulSym ; | |
645 | ExceptionInc := NulSym ; | |
646 | ExceptionDec := NulSym ; | |
647 | ExceptionIncl := NulSym ; | |
648 | ExceptionExcl := NulSym ; | |
649 | ExceptionShift := NulSym ; | |
650 | ExceptionRotate := NulSym ; | |
651 | ExceptionStaticArray := NulSym ; | |
652 | ExceptionDynamicArray := NulSym ; | |
653 | ExceptionForLoopBegin := NulSym ; | |
654 | ExceptionForLoopTo := NulSym ; | |
655 | ExceptionForLoopEnd := NulSym ; | |
656 | ExceptionPointerNil := NulSym ; | |
657 | ExceptionNoReturn := NulSym ; | |
658 | ExceptionCase := NulSym ; | |
659 | ExceptionNonPosDiv := NulSym ; | |
660 | ExceptionNonPosMod := NulSym ; | |
661 | ExceptionZeroDiv := NulSym ; | |
662 | ExceptionZeroRem := NulSym ; | |
663 | ExceptionWholeValue := NulSym ; | |
664 | ExceptionRealValue := NulSym ; | |
665 | ExceptionParameterBounds := NulSym ; | |
666 | ||
667 | ExceptionNo := NulSym ; | |
668 | ||
669 | IF NilChecking | |
670 | THEN | |
671 | ExceptionPointerNil := ImportFrom(BuiltinTokenNo, m2rts, 'PointerNilException') | |
672 | END ; | |
673 | IF RangeChecking | |
674 | THEN | |
675 | ExceptionAssign := ImportFrom(BuiltinTokenNo, m2rts, 'AssignmentException') ; | |
676 | ExceptionReturn := ImportFrom(BuiltinTokenNo, m2rts, 'ReturnException') ; | |
677 | ExceptionInc := ImportFrom(BuiltinTokenNo, m2rts, 'IncException') ; | |
678 | ExceptionDec := ImportFrom(BuiltinTokenNo, m2rts, 'DecException') ; | |
679 | ExceptionIncl := ImportFrom(BuiltinTokenNo, m2rts, 'InclException') ; | |
680 | ExceptionExcl := ImportFrom(BuiltinTokenNo, m2rts, 'ExclException') ; | |
681 | ExceptionShift := ImportFrom(BuiltinTokenNo, m2rts, 'ShiftException') ; | |
682 | ExceptionRotate := ImportFrom(BuiltinTokenNo, m2rts, 'RotateException') ; | |
683 | ExceptionForLoopBegin := ImportFrom(BuiltinTokenNo, m2rts, 'ForLoopBeginException') ; | |
684 | ExceptionForLoopTo := ImportFrom(BuiltinTokenNo, m2rts, 'ForLoopToException') ; | |
685 | ExceptionForLoopEnd := ImportFrom(BuiltinTokenNo, m2rts, 'ForLoopEndException') ; | |
686 | ExceptionParameterBounds := ImportFrom(BuiltinTokenNo, m2rts, 'ParameterException') ; | |
687 | END ; | |
688 | IF IndexChecking | |
689 | THEN | |
690 | ExceptionStaticArray := ImportFrom(BuiltinTokenNo, m2rts, 'StaticArraySubscriptException') ; | |
691 | ExceptionDynamicArray := ImportFrom(BuiltinTokenNo, m2rts, 'DynamicArraySubscriptException') | |
692 | END ; | |
693 | IF WholeDivChecking | |
694 | THEN | |
695 | ExceptionNonPosDiv := ImportFrom(BuiltinTokenNo, m2rts, 'WholeNonPosDivException') ; | |
696 | ExceptionNonPosMod := ImportFrom(BuiltinTokenNo, m2rts, 'WholeNonPosModException') ; | |
697 | ExceptionZeroDiv := ImportFrom(BuiltinTokenNo, m2rts, 'WholeZeroDivException') ; | |
698 | ExceptionZeroRem := ImportFrom(BuiltinTokenNo, m2rts, 'WholeZeroRemException') | |
699 | END ; | |
700 | IF ReturnChecking | |
701 | THEN | |
702 | ExceptionNoReturn := ImportFrom(BuiltinTokenNo, m2rts, 'NoReturnException') | |
703 | END ; | |
704 | IF CaseElseChecking | |
705 | THEN | |
706 | ExceptionCase := ImportFrom(BuiltinTokenNo, m2rts, 'CaseException') | |
707 | END ; | |
708 | IF WholeValueChecking | |
709 | THEN | |
710 | ExceptionWholeValue := ImportFrom(BuiltinTokenNo, m2rts, 'WholeValueException') ; | |
711 | ExceptionRealValue := ImportFrom(BuiltinTokenNo, m2rts, 'RealValueException') | |
712 | END ; | |
713 | IF Exceptions | |
714 | THEN | |
715 | ExceptionNo := ImportFrom(BuiltinTokenNo, m2rts, 'NoException') ; | |
716 | (* ensure that this module is included *) | |
717 | rtexceptions := MakeDefinitionSource(BuiltinTokenNo, MakeKey('RTExceptions')) ; | |
718 | IF rtexceptions = NulSym | |
719 | THEN | |
720 | MetaError0 ('unable to find required runtime module RTExceptions') | |
721 | END | |
722 | END | |
723 | END InitBaseProcedures ; | |
724 | ||
725 | ||
726 | (* | |
727 | IsOrd - returns TRUE if, sym, is ORD or its typed counterparts | |
728 | ORDL, ORDS. | |
729 | *) | |
730 | ||
731 | PROCEDURE IsOrd (sym: CARDINAL) : BOOLEAN ; | |
732 | BEGIN | |
733 | RETURN (sym=Ord) OR (sym=OrdS) OR (sym=OrdL) | |
734 | END IsOrd ; | |
735 | ||
736 | ||
737 | (* | |
738 | BuildOrdFunctions - creates ORD, ORDS, ORDL. | |
739 | *) | |
740 | ||
741 | PROCEDURE BuildOrdFunctions ; | |
742 | BEGIN | |
743 | Ord := MakeProcedure(BuiltinTokenNo, MakeKey('ORD')) ; | |
744 | PutFunction(Ord, Cardinal) ; | |
745 | OrdS := MakeProcedure(BuiltinTokenNo, MakeKey('ORDS')) ; | |
746 | PutFunction(OrdS, ShortCard) ; | |
747 | OrdL := MakeProcedure(BuiltinTokenNo, MakeKey('ORDL')) ; | |
748 | PutFunction(OrdL, LongCard) | |
749 | END BuildOrdFunctions ; | |
750 | ||
751 | ||
752 | (* | |
753 | IsTrunc - returns TRUE if, sym, is TRUNC or its typed counterparts | |
754 | TRUNCL, TRUNCS. | |
755 | *) | |
756 | ||
757 | PROCEDURE IsTrunc (sym: CARDINAL) : BOOLEAN ; | |
758 | BEGIN | |
759 | RETURN (sym=Trunc) OR (sym=TruncS) OR (sym=TruncL) | |
760 | END IsTrunc ; | |
761 | ||
762 | ||
763 | (* | |
764 | BuildTruncFunctions - creates TRUNC, TRUNCS, TRUNCL. | |
765 | *) | |
766 | ||
767 | PROCEDURE BuildTruncFunctions ; | |
768 | BEGIN | |
769 | IF Pim2 OR Pim3 OR Iso | |
770 | THEN | |
771 | Trunc := MakeProcedure(BuiltinTokenNo, MakeKey('TRUNC')) ; | |
772 | PutFunction(Trunc, Cardinal) ; | |
773 | TruncS := MakeProcedure(BuiltinTokenNo, MakeKey('STRUNC')) ; | |
774 | PutFunction(TruncS, ShortCard) ; | |
775 | TruncL := MakeProcedure(BuiltinTokenNo, MakeKey('LTRUNC')) ; | |
776 | PutFunction(TruncL, LongCard) | |
777 | ELSE | |
778 | Trunc := MakeProcedure(BuiltinTokenNo, MakeKey('TRUNC')) ; | |
779 | PutFunction(Trunc, Integer) ; | |
780 | TruncS := MakeProcedure(BuiltinTokenNo, MakeKey('STRUNC')) ; | |
781 | PutFunction(TruncS, ShortInt) ; | |
782 | TruncL := MakeProcedure(BuiltinTokenNo, MakeKey('LTRUNC')) ; | |
783 | PutFunction(TruncL, LongInt) | |
784 | END | |
785 | END BuildTruncFunctions ; | |
786 | ||
787 | ||
788 | (* | |
789 | IsFloat - returns TRUE if, sym, is FLOAT or its typed counterparts | |
790 | FLOATL, FLOATS. | |
791 | *) | |
792 | ||
793 | PROCEDURE IsFloat (sym: CARDINAL) : BOOLEAN ; | |
794 | BEGIN | |
795 | RETURN( | |
796 | (sym=Float) OR (sym=FloatS) OR (sym=FloatL) OR | |
797 | (sym=SFloat) OR (sym=LFloat) | |
798 | ) | |
799 | END IsFloat ; | |
800 | ||
801 | ||
802 | (* | |
803 | BuildFloatFunctions - creates TRUNC, TRUNCS, TRUNCL. | |
804 | *) | |
805 | ||
806 | PROCEDURE BuildFloatFunctions ; | |
807 | BEGIN | |
808 | Float := MakeProcedure(BuiltinTokenNo, MakeKey('FLOAT')) ; | |
809 | PutFunction(Float, Real) ; | |
810 | SFloat := MakeProcedure(BuiltinTokenNo, MakeKey('SFLOAT')) ; | |
811 | PutFunction(SFloat, ShortReal) ; | |
812 | LFloat := MakeProcedure(BuiltinTokenNo, MakeKey('LFLOAT')) ; | |
813 | PutFunction(LFloat, LongReal) ; | |
814 | FloatS := MakeProcedure(BuiltinTokenNo, MakeKey('FLOATS')) ; | |
815 | PutFunction(FloatS, ShortReal) ; | |
816 | FloatL := MakeProcedure(BuiltinTokenNo, MakeKey('FLOATL')) ; | |
817 | PutFunction(FloatL, LongReal) | |
818 | END BuildFloatFunctions ; | |
819 | ||
820 | ||
821 | (* | |
822 | IsInt - returns TRUE if, sym, is INT or its typed counterparts | |
823 | INTL, INTS. | |
824 | *) | |
825 | ||
826 | PROCEDURE IsInt (sym: CARDINAL) : BOOLEAN ; | |
827 | BEGIN | |
828 | RETURN (sym=Int) OR (sym=IntS) OR (sym=IntL) | |
829 | END IsInt ; | |
830 | ||
831 | ||
832 | (* | |
833 | BuildIntFunctions - creates INT, INTS, INTL. | |
834 | *) | |
835 | ||
836 | PROCEDURE BuildIntFunctions ; | |
837 | BEGIN | |
838 | Int := MakeProcedure(BuiltinTokenNo, MakeKey('INT')) ; | |
839 | PutFunction(Int, Integer) ; | |
840 | IntS := MakeProcedure(BuiltinTokenNo, MakeKey('INTS')) ; | |
841 | PutFunction(IntS, ShortInt) ; | |
842 | IntL := MakeProcedure(BuiltinTokenNo, MakeKey('INTL')) ; | |
843 | PutFunction(IntL, LongInt) | |
844 | END BuildIntFunctions ; | |
845 | ||
846 | ||
847 | (* | |
848 | InitBaseFunctions - initialises the base function, HIGH. | |
849 | *) | |
850 | ||
851 | PROCEDURE InitBaseFunctions ; | |
852 | BEGIN | |
853 | (* Now declare the dynamic array components, HIGH *) | |
854 | High := MakeProcedure(BuiltinTokenNo, MakeKey('HIGH')) ; (* Pseudo Base function HIGH *) | |
855 | PutFunction(High, Cardinal) ; | |
856 | ||
857 | (* | |
858 | _TemplateProcedure is a procedure which has a local variable _ActivationPointer | |
859 | whose offset is used for all nested procedures. (The activation pointer | |
860 | being in the same relative position for all procedures). | |
861 | *) | |
862 | TemplateProcedure := MakeProcedure(BuiltinTokenNo, MakeKey('_TemplateProcedure')) ; | |
863 | StartScope(TemplateProcedure) ; | |
864 | ActivationPointer := MakeVar(BuiltinTokenNo, MakeKey('_ActivationPointer')) ; | |
865 | PutVar(ActivationPointer, Address) ; | |
866 | EndScope ; | |
867 | ||
868 | (* and the base functions *) | |
869 | ||
870 | Convert := MakeProcedure(BuiltinTokenNo, MakeKey('CONVERT')) ; (* Internal function CONVERT *) | |
871 | IF Iso | |
872 | THEN | |
873 | LengthS := MakeProcedure(BuiltinTokenNo, MakeKey('LENGTH')) ; (* Pseudo Base function LENGTH *) | |
874 | PutFunction(LengthS, ZType) | |
875 | ELSE | |
876 | LengthS := NulSym | |
877 | END ; | |
878 | Abs := MakeProcedure(BuiltinTokenNo, MakeKey('ABS')) ; (* Pseudo Base function ABS *) | |
879 | PutFunction(Abs, ZType) ; | |
880 | ||
881 | Cap := MakeProcedure(BuiltinTokenNo, MakeKey('CAP')) ; (* Pseudo Base function CAP *) | |
882 | PutFunction(Cap, Char) ; | |
883 | ||
884 | Odd := MakeProcedure(BuiltinTokenNo, MakeKey('ODD')) ; (* Pseudo Base function ODD *) | |
885 | PutFunction(Odd, Boolean) ; | |
886 | ||
887 | Chr := MakeProcedure(BuiltinTokenNo, MakeKey('CHR')) ; (* Pseudo Base function CHR *) | |
888 | PutFunction(Chr, Char) ; | |
889 | ||
890 | (* the following three procedure functions have a return type depending upon *) | |
891 | (* the parameters. *) | |
892 | ||
893 | Val := MakeProcedure(BuiltinTokenNo, MakeKey('VAL')) ; (* Pseudo Base function VAL *) | |
894 | Min := MakeProcedure(BuiltinTokenNo, MakeKey('MIN')) ; (* Pseudo Base function MIN *) | |
895 | Max := MakeProcedure(BuiltinTokenNo, MakeKey('MAX')) ; (* Pseudo Base function MIN *) | |
896 | ||
897 | Re := MakeProcedure(BuiltinTokenNo, MakeKey('RE')) ; (* Pseudo Base function RE *) | |
898 | PutFunction(Re, RType) ; | |
899 | ||
900 | Im := MakeProcedure(BuiltinTokenNo, MakeKey('IM')) ; (* Pseudo Base function IM *) | |
901 | PutFunction(Im, RType) ; | |
902 | ||
903 | Cmplx := MakeProcedure(BuiltinTokenNo, MakeKey('CMPLX')) ; (* Pseudo Base function CMPLX *) | |
904 | PutFunction(Cmplx, CType) ; | |
905 | ||
906 | BuildFloatFunctions ; | |
907 | BuildTruncFunctions ; | |
908 | BuildOrdFunctions ; | |
909 | BuildIntFunctions | |
910 | END InitBaseFunctions ; | |
911 | ||
912 | ||
913 | (* | |
914 | IsISOPseudoBaseFunction - | |
915 | *) | |
916 | ||
917 | PROCEDURE IsISOPseudoBaseFunction (Sym: CARDINAL) : BOOLEAN ; | |
918 | BEGIN | |
919 | RETURN( Iso AND (Sym#NulSym) AND | |
920 | ((Sym=LengthS) OR (Sym=Size) OR | |
921 | (Sym=Cmplx) OR (Sym=Re) OR (Sym=Im) OR IsInt(Sym)) ) | |
922 | END IsISOPseudoBaseFunction ; | |
923 | ||
924 | ||
925 | (* | |
926 | IsPIMPseudoBaseFunction - | |
927 | *) | |
928 | ||
929 | PROCEDURE IsPIMPseudoBaseFunction (Sym: CARDINAL) : BOOLEAN ; | |
930 | BEGIN | |
931 | RETURN( (NOT Iso) AND (NOT Pim2) AND (Sym#NulSym) AND (Sym=Size) ) | |
932 | END IsPIMPseudoBaseFunction ; | |
933 | ||
934 | ||
935 | (* | |
936 | IsPseudoBaseFunction - returns true if Sym is a Base pseudo function. | |
937 | *) | |
938 | ||
939 | PROCEDURE IsPseudoBaseFunction (Sym: CARDINAL) : BOOLEAN ; | |
940 | BEGIN | |
941 | RETURN( | |
942 | (Sym=High) OR (Sym=Val) OR (Sym=Convert) OR IsOrd(Sym) OR | |
943 | (Sym=Chr) OR IsFloat(Sym) OR IsTrunc(Sym) OR (Sym=Min) OR | |
944 | (Sym=Max) OR (Sym=Abs) OR (Sym=Odd) OR (Sym=Cap) OR | |
945 | IsISOPseudoBaseFunction(Sym) OR IsPIMPseudoBaseFunction(Sym) | |
946 | ) | |
947 | END IsPseudoBaseFunction ; | |
948 | ||
949 | ||
950 | (* | |
951 | IsPseudoBaseProcedure - returns true if Sym is a Base pseudo procedure. | |
952 | *) | |
953 | ||
954 | PROCEDURE IsPseudoBaseProcedure (Sym: CARDINAL) : BOOLEAN ; | |
955 | BEGIN | |
956 | RETURN( | |
957 | (Sym=New) OR (Sym=Dispose) OR (Sym=Inc) OR (Sym=Dec) OR | |
958 | (Sym=Incl) OR (Sym=Excl) | |
959 | ) | |
960 | END IsPseudoBaseProcedure ; | |
961 | ||
962 | ||
963 | (* | |
964 | IsBaseType - returns TRUE if Sym is a Base type. | |
965 | *) | |
966 | ||
967 | PROCEDURE IsBaseType (Sym: CARDINAL) : BOOLEAN ; | |
968 | BEGIN | |
969 | RETURN( | |
970 | (Sym=Cardinal) OR (Sym=Integer) OR (Sym=Boolean) OR | |
971 | (Sym=Char) OR (Sym=Proc) OR | |
972 | (Sym=LongInt) OR (Sym=LongCard) OR | |
973 | (Sym=ShortInt) OR (Sym=ShortCard) OR | |
974 | (Sym=Real) OR (Sym=LongReal) OR (Sym=ShortReal) OR | |
975 | (Sym=Complex) OR (Sym=LongComplex) OR (Sym=ShortComplex) OR | |
976 | (Sym=Bitset) | |
977 | ) | |
978 | END IsBaseType ; | |
979 | ||
980 | ||
981 | (* | |
982 | IsOrdinalType - returns TRUE if, sym, is an ordinal type. | |
983 | An ordinal type is defined as: | |
984 | a base type which contains whole numbers or | |
985 | a subrange type or an enumeration type. | |
986 | *) | |
987 | ||
988 | PROCEDURE IsOrdinalType (Sym: CARDINAL) : BOOLEAN ; | |
989 | BEGIN | |
990 | RETURN( | |
991 | (Sym=Cardinal) OR (Sym=Integer) OR | |
992 | (Sym=Char) OR (Sym=Boolean) OR | |
993 | (Sym=LongInt) OR (Sym=LongCard) OR | |
994 | (Sym=ShortInt) OR (Sym=ShortCard) OR | |
995 | (Sym=ZType) OR | |
996 | IsSubrange(Sym) OR IsEnumeration(Sym) OR | |
997 | IsIntegerN(Sym) OR IsCardinalN(Sym) | |
998 | ) | |
999 | END IsOrdinalType ; | |
1000 | ||
1001 | ||
1002 | (* | |
1003 | IsComplexType - returns TRUE if, sym, is COMPLEX, | |
1004 | LONGCOMPLEX or SHORTCOMPLEX. | |
1005 | *) | |
1006 | ||
1007 | PROCEDURE IsComplexType (sym: CARDINAL) : BOOLEAN ; | |
1008 | BEGIN | |
1009 | RETURN( (sym=Complex) OR (sym=LongComplex) OR (sym=ShortComplex) OR (sym=CType) OR IsComplexN (sym) ) | |
1010 | END IsComplexType ; | |
1011 | ||
1012 | ||
1013 | (* | |
1014 | ComplexToScalar - returns the scalar (or base type) of the complex type, sym. | |
1015 | *) | |
1016 | ||
1017 | PROCEDURE ComplexToScalar (sym: CARDINAL) : CARDINAL ; | |
1018 | BEGIN | |
1019 | IF sym=NulSym | |
1020 | THEN | |
1021 | (* a const complex may have a NulSym type *) | |
1022 | RETURN( RType ) | |
1023 | ELSIF sym=Complex | |
1024 | THEN | |
1025 | RETURN( Real ) | |
1026 | ELSIF sym=LongComplex | |
1027 | THEN | |
1028 | RETURN( LongReal ) | |
1029 | ELSIF sym=ShortComplex | |
1030 | THEN | |
1031 | RETURN( ShortReal ) | |
1032 | ELSIF sym=CType | |
1033 | THEN | |
1034 | RETURN( RType ) | |
1035 | ELSIF sym=ComplexN(32) | |
1036 | THEN | |
1037 | RETURN( RealN(32) ) | |
1038 | ELSIF sym=ComplexN(64) | |
1039 | THEN | |
1040 | RETURN( RealN(64) ) | |
1041 | ELSIF sym=ComplexN(96) | |
1042 | THEN | |
1043 | RETURN( RealN(96) ) | |
1044 | ELSIF sym=ComplexN(128) | |
1045 | THEN | |
1046 | RETURN( RealN(128) ) | |
1047 | ELSE | |
1048 | MetaError1('{%1ad} must be a COMPLEX type', sym) ; | |
1049 | RETURN RType | |
1050 | END | |
1051 | END ComplexToScalar ; | |
1052 | ||
1053 | ||
1054 | (* | |
1055 | ScalarToComplex - given a real type, t, return the equivalent complex type. | |
1056 | *) | |
1057 | ||
1058 | PROCEDURE ScalarToComplex (sym: CARDINAL) : CARDINAL ; | |
1059 | BEGIN | |
1060 | IF sym=Real | |
1061 | THEN | |
1062 | RETURN( Complex ) | |
1063 | ELSIF sym=LongReal | |
1064 | THEN | |
1065 | RETURN( LongComplex ) | |
1066 | ELSIF sym=ShortReal | |
1067 | THEN | |
1068 | RETURN( ShortComplex ) | |
1069 | ELSIF sym=RType | |
1070 | THEN | |
1071 | RETURN( CType ) | |
1072 | ELSIF sym=RealN(32) | |
1073 | THEN | |
1074 | RETURN( ComplexN(32) ) | |
1075 | ELSIF sym=RealN(64) | |
1076 | THEN | |
1077 | RETURN( ComplexN(64) ) | |
1078 | ELSIF sym=RealN(96) | |
1079 | THEN | |
1080 | RETURN( ComplexN(96) ) | |
1081 | ELSIF sym=RealN(128) | |
1082 | THEN | |
1083 | RETURN( ComplexN(128) ) | |
1084 | ELSE | |
1085 | MetaError1('{%1ad} must be a REAL type', sym) ; | |
1086 | RETURN( Complex ) | |
1087 | END | |
1088 | END ScalarToComplex ; | |
1089 | ||
1090 | ||
1091 | (* | |
1092 | GetCmplxReturnType - this code implements the table given in the | |
1093 | ISO standard Page 293 with an addition for | |
1094 | SHORTCOMPLEX. | |
1095 | *) | |
1096 | ||
1097 | PROCEDURE GetCmplxReturnType (t1, t2: CARDINAL) : CARDINAL ; | |
1098 | VAR | |
1099 | mt1, mt2: MetaType ; | |
1100 | BEGIN | |
1101 | t1 := SkipType(t1) ; | |
1102 | t2 := SkipType(t2) ; | |
1103 | IF (IsRealType(t1) OR IsRealN(t1)) AND | |
1104 | (IsRealType(t2) OR IsRealN(t2)) | |
1105 | THEN | |
1106 | mt1 := FindMetaType(t1) ; | |
1107 | mt2 := FindMetaType(t2) ; | |
1108 | IF mt1=mt2 | |
1109 | THEN | |
1110 | RETURN( ScalarToComplex(t1) ) | |
1111 | ELSE | |
1112 | IF mt1=rtype | |
1113 | THEN | |
1114 | RETURN( ScalarToComplex(t2) ) | |
1115 | ELSIF mt2=rtype | |
1116 | THEN | |
1117 | RETURN( ScalarToComplex(t1) ) | |
1118 | ELSE | |
1119 | RETURN( NulSym ) | |
1120 | END | |
1121 | END | |
1122 | ELSE | |
1123 | RETURN( NulSym ) | |
1124 | END | |
1125 | END GetCmplxReturnType ; | |
1126 | ||
1127 | ||
1128 | (* | |
1129 | EmitTypeIncompatibleWarning - emit a type incompatibility warning. | |
1130 | *) | |
1131 | ||
1132 | PROCEDURE EmitTypeIncompatibleWarning (tok: CARDINAL; | |
1133 | kind: Compatability; t1, t2: CARDINAL) ; | |
1134 | BEGIN | |
1135 | CASE kind OF | |
1136 | ||
1137 | expression: MetaErrorT2 (tok, | |
1138 | '{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in an expression, hint one of the expressions should be converted', | |
1139 | t1, t2) | | |
1140 | assignment: MetaErrorT2 (tok, | |
1141 | '{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} during an assignment, hint maybe the expression should be converted', | |
1142 | t1, t2) | | |
1143 | parameter : MetaErrorT2 (tok, | |
1144 | '{%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', | |
1145 | t1, t2) | | |
1146 | comparison: MetaErrorT2 (tok, | |
1147 | '{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in a relational expression, hint one of the expressions should be converted', | |
1148 | t1, t2) | |
1149 | ||
1150 | ELSE | |
1151 | END | |
1152 | END EmitTypeIncompatibleWarning ; | |
1153 | ||
1154 | ||
1155 | (* | |
1156 | EmitTypeIncompatibleError - emit a type incompatibility error. | |
1157 | *) | |
1158 | ||
1159 | PROCEDURE EmitTypeIncompatibleError (tok: CARDINAL; | |
1160 | kind: Compatability; t1, t2: CARDINAL) ; | |
1161 | BEGIN | |
1162 | CASE kind OF | |
1163 | ||
1164 | expression: MetaErrorT2 (tok, | |
1165 | 'type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in an expression, hint one of the expressions should be converted', | |
1166 | t1, t2) | | |
1167 | assignment: MetaErrorT2 (tok, | |
1168 | 'type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} during an assignment, hint maybe the expression should be converted', | |
1169 | t1, t2) | | |
1170 | parameter : MetaErrorT2 (tok, | |
1171 | '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', | |
1172 | t1, t2) | | |
1173 | comparison: MetaErrorT2 (tok, | |
1174 | 'type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in a relational expression, hint one of the expressions should be converted', | |
1175 | t1, t2) | |
1176 | ||
1177 | ELSE | |
1178 | END | |
1179 | END EmitTypeIncompatibleError ; | |
1180 | ||
1181 | ||
1182 | (* | |
1183 | CheckCompatible - returns if t1 and t2 are kind compatible | |
1184 | *) | |
1185 | ||
1186 | PROCEDURE CheckCompatible (tok: CARDINAL; | |
1187 | t1, t2: CARDINAL; kind: Compatability) ; | |
1188 | VAR | |
1189 | s: String ; | |
1190 | r: Compatible ; | |
1191 | BEGIN | |
1192 | r := IsCompatible (t1, t2, kind) ; | |
1193 | IF (r#first) AND (r#second) | |
1194 | THEN | |
1195 | IF (r=warnfirst) OR (r=warnsecond) | |
1196 | THEN | |
1197 | s := InitString('{%1W}') | |
1198 | ELSE | |
1199 | s := InitString('') | |
1200 | END ; | |
1201 | IF IsUnknown(t1) AND IsUnknown(t2) | |
1202 | THEN | |
1203 | s := ConCat(s, InitString('two different unknown types {%1a:{%2a:{%1a} and {%2a}}} must either be declared or imported)')) ; | |
1204 | MetaErrorStringT2 (tok, s, t1, t2) | |
1205 | ELSIF IsUnknown(t1) | |
1206 | THEN | |
1207 | s := ConCat(s, InitString('this type {%1a} is currently unknown, it must be declared or imported')) ; | |
1208 | MetaErrorStringT1 (tok, s, t1) | |
1209 | ELSIF IsUnknown(t2) | |
1210 | THEN | |
1211 | s := ConCat (s, InitString('this type {%1a} is currently unknown, it must be declared or imported')) ; | |
1212 | MetaErrorStringT1 (tok, s, t2) | |
1213 | ELSE | |
1214 | IF (r=warnfirst) OR (r=warnsecond) | |
1215 | THEN | |
1216 | EmitTypeIncompatibleWarning (tok, kind, t1, t2) | |
1217 | ELSE | |
1218 | EmitTypeIncompatibleError (tok, kind, t1, t2) | |
1219 | END | |
1220 | END | |
1221 | END | |
1222 | END CheckCompatible ; | |
1223 | ||
1224 | ||
1225 | (* | |
1226 | CheckExpressionCompatible - returns if t1 and t2 are compatible types for | |
1227 | +, -, *, DIV, >, <, =, etc. | |
1228 | If t1 and t2 are not compatible then an error | |
1229 | message is displayed. | |
1230 | *) | |
1231 | ||
1232 | PROCEDURE CheckExpressionCompatible (tok: CARDINAL; left, right: CARDINAL) ; | |
1233 | BEGIN | |
1234 | CheckCompatible (tok, left, right, expression) | |
1235 | END CheckExpressionCompatible ; | |
1236 | ||
1237 | ||
1238 | (* | |
1239 | CheckParameterCompatible - checks to see if types, t1, and, t2, are | |
1240 | compatible for parameter passing. | |
1241 | *) | |
1242 | ||
1243 | PROCEDURE CheckParameterCompatible (tok: CARDINAL; | |
1244 | t1, t2: CARDINAL) ; | |
1245 | BEGIN | |
1246 | CheckCompatible (tok, t1, t2, parameter) | |
1247 | END CheckParameterCompatible ; | |
1248 | ||
1249 | ||
1250 | (* | |
1251 | CheckAssignmentCompatible - returns if t1 and t2 are compatible types for | |
1252 | :=, =, #. | |
1253 | If t1 and t2 are not compatible then an error | |
1254 | message is displayed. | |
1255 | *) | |
1256 | ||
1257 | PROCEDURE CheckAssignmentCompatible (tok: CARDINAL; | |
1258 | left, right: CARDINAL) ; | |
1259 | BEGIN | |
1260 | IF left # right | |
1261 | THEN | |
1262 | CheckCompatible (tok, left, right, assignment) | |
1263 | END | |
1264 | END CheckAssignmentCompatible ; | |
1265 | ||
1266 | ||
1267 | (* | |
1268 | FindMetaType - returns the MetaType associated with, sym. | |
1269 | *) | |
1270 | ||
1271 | PROCEDURE FindMetaType (sym: CARDINAL) : MetaType ; | |
1272 | BEGIN | |
1273 | IF sym=NulSym | |
1274 | THEN | |
1275 | RETURN( const ) | |
1276 | ELSIF sym=Word | |
1277 | THEN | |
1278 | RETURN( word ) | |
1279 | ELSIF sym=Byte | |
1280 | THEN | |
1281 | RETURN( byte ) | |
1282 | ELSIF sym=Loc | |
1283 | THEN | |
1284 | RETURN( loc ) | |
1285 | ELSIF sym=Address | |
1286 | THEN | |
1287 | RETURN( address ) | |
1288 | ELSIF sym=Char | |
1289 | THEN | |
1290 | RETURN( chr ) | |
1291 | ELSIF sym=Integer | |
1292 | THEN | |
1293 | RETURN( normint ) | |
1294 | ELSIF sym=ShortInt | |
1295 | THEN | |
1296 | RETURN( shortint ) | |
1297 | ELSIF sym=LongInt | |
1298 | THEN | |
1299 | RETURN( longint ) | |
1300 | ELSIF sym=Cardinal | |
1301 | THEN | |
1302 | RETURN( normcard ) | |
1303 | ELSIF sym=ShortCard | |
1304 | THEN | |
1305 | RETURN( shortcard ) | |
1306 | ELSIF sym=LongCard | |
1307 | THEN | |
1308 | RETURN( longcard ) | |
1309 | ELSIF sym=ZType | |
1310 | THEN | |
1311 | RETURN( ztype ) | |
1312 | ELSIF sym=RType | |
1313 | THEN | |
1314 | RETURN( rtype ) | |
1315 | ELSIF sym=Real | |
1316 | THEN | |
1317 | RETURN( real ) | |
1318 | ELSIF sym=ShortReal | |
1319 | THEN | |
1320 | RETURN( shortreal ) | |
1321 | ELSIF sym=LongReal | |
1322 | THEN | |
1323 | RETURN( longreal ) | |
1324 | ELSIF sym=IntegerN(8) | |
1325 | THEN | |
1326 | RETURN( int8 ) | |
1327 | ELSIF sym=IntegerN(16) | |
1328 | THEN | |
1329 | RETURN( int16 ) | |
1330 | ELSIF sym=IntegerN(32) | |
1331 | THEN | |
1332 | RETURN( int32 ) | |
1333 | ELSIF sym=IntegerN(64) | |
1334 | THEN | |
1335 | RETURN( int64 ) | |
1336 | ELSIF sym=CardinalN(8) | |
1337 | THEN | |
1338 | RETURN( card8 ) | |
1339 | ELSIF sym=CardinalN(16) | |
1340 | THEN | |
1341 | RETURN( card16 ) | |
1342 | ELSIF sym=CardinalN(32) | |
1343 | THEN | |
1344 | RETURN( card32 ) | |
1345 | ELSIF sym=CardinalN(64) | |
1346 | THEN | |
1347 | RETURN( card64 ) | |
1348 | ELSIF sym=WordN(16) | |
1349 | THEN | |
1350 | RETURN( word16 ) | |
1351 | ELSIF sym=WordN(32) | |
1352 | THEN | |
1353 | RETURN( word32 ) | |
1354 | ELSIF sym=WordN(64) | |
1355 | THEN | |
1356 | RETURN( word64 ) | |
1357 | ELSIF sym=SetN(8) | |
1358 | THEN | |
1359 | RETURN( set8 ) | |
1360 | ELSIF sym=SetN(16) | |
1361 | THEN | |
1362 | RETURN( set16 ) | |
1363 | ELSIF sym=SetN(32) | |
1364 | THEN | |
1365 | RETURN( set32 ) | |
1366 | ELSIF sym=RealN(32) | |
1367 | THEN | |
1368 | RETURN( real32 ) | |
1369 | ELSIF sym=RealN(64) | |
1370 | THEN | |
1371 | RETURN( real64 ) | |
1372 | ELSIF sym=RealN(96) | |
1373 | THEN | |
1374 | RETURN( real96 ) | |
1375 | ELSIF sym=RealN(128) | |
1376 | THEN | |
1377 | RETURN( real128 ) | |
1378 | ELSIF sym=Complex | |
1379 | THEN | |
1380 | RETURN( complex ) | |
1381 | ELSIF sym=ShortComplex | |
1382 | THEN | |
1383 | RETURN( shortcomplex ) | |
1384 | ELSIF sym=LongComplex | |
1385 | THEN | |
1386 | RETURN( longcomplex ) | |
1387 | ELSIF sym=ComplexN(32) | |
1388 | THEN | |
1389 | RETURN( complex32 ) | |
1390 | ELSIF sym=ComplexN(64) | |
1391 | THEN | |
1392 | RETURN( complex64 ) | |
1393 | ELSIF sym=ComplexN(96) | |
1394 | THEN | |
1395 | RETURN( complex96 ) | |
1396 | ELSIF sym=ComplexN(128) | |
1397 | THEN | |
1398 | RETURN( complex128 ) | |
1399 | ELSIF sym=CType | |
1400 | THEN | |
1401 | RETURN( ctype ) | |
1402 | ELSIF IsSet(sym) | |
1403 | THEN | |
1404 | RETURN( set ) | |
1405 | ELSIF IsHiddenType(sym) | |
1406 | THEN | |
1407 | RETURN( opaque ) | |
1408 | ELSIF IsPointer(sym) | |
1409 | THEN | |
1410 | RETURN( pointer ) | |
1411 | ELSIF IsEnumeration(sym) | |
1412 | THEN | |
1413 | RETURN( enum ) | |
1414 | ELSIF IsRecord(sym) | |
1415 | THEN | |
1416 | RETURN( rec ) | |
1417 | ELSIF IsArray(sym) | |
1418 | THEN | |
1419 | RETURN( array ) | |
1420 | ELSIF IsType(sym) | |
1421 | THEN | |
1422 | RETURN( FindMetaType(GetType(sym)) ) | |
1423 | ELSIF IsProcedure(sym) OR IsProcType(sym) | |
1424 | THEN | |
1425 | RETURN( procedure ) | |
1426 | ELSE | |
1427 | RETURN( unknown ) | |
1428 | END | |
1429 | END FindMetaType ; | |
1430 | ||
1431 | ||
1432 | (* | |
1433 | IsBaseCompatible - returns an enumeration field determining whether a simple base type | |
1434 | comparison is legal. | |
1435 | *) | |
1436 | ||
1437 | PROCEDURE IsBaseCompatible (t1, t2: CARDINAL; | |
1438 | kind: Compatability) : Compatible ; | |
1439 | VAR | |
1440 | mt1, mt2: MetaType ; | |
1441 | BEGIN | |
1442 | IF (t1=t2) AND ((kind=assignment) OR (kind=parameter)) | |
1443 | THEN | |
1444 | RETURN( first ) | |
1445 | ELSE | |
1446 | mt1 := FindMetaType (t1) ; | |
1447 | mt2 := FindMetaType (t2) ; | |
1448 | IF (mt1=unknown) OR (mt2=unknown) | |
1449 | THEN | |
1450 | RETURN( no ) | |
1451 | END ; | |
1452 | ||
1453 | CASE kind OF | |
1454 | ||
1455 | expression: RETURN( Expr [mt1, mt2] ) | | |
1456 | assignment: RETURN( Ass [mt1, mt2] ) | | |
1457 | parameter : RETURN( Ass [mt1, mt2] ) | | |
1458 | comparison: RETURN( Comp [mt1, mt2] ) | |
1459 | ||
1460 | ELSE | |
1461 | InternalError ('unexpected compatibility') | |
1462 | END | |
1463 | END | |
1464 | END IsBaseCompatible ; | |
1465 | ||
1466 | ||
1467 | (* | |
1468 | IsRealType - returns TRUE if, t, is a real type. | |
1469 | *) | |
1470 | ||
1471 | PROCEDURE IsRealType (t: CARDINAL) : BOOLEAN ; | |
1472 | BEGIN | |
1473 | RETURN( (t=Real) OR (t=LongReal) OR (t=ShortReal) OR (t=RType) ) | |
1474 | END IsRealType ; | |
1475 | ||
1476 | ||
1477 | (* | |
1478 | CannotCheckTypeInPass3 - returns TRUE if we are unable to check the | |
1479 | type of, e, in pass 3. | |
1480 | *) | |
1481 | ||
1482 | PROCEDURE CannotCheckTypeInPass3 (e: CARDINAL) : BOOLEAN ; | |
1483 | VAR | |
1484 | t : CARDINAL ; | |
1485 | mt: MetaType ; | |
1486 | BEGIN | |
1487 | t := SkipType(GetType(e)) ; | |
1488 | mt := FindMetaType(t) ; | |
1489 | CASE mt OF | |
1490 | ||
1491 | pointer, | |
1492 | enum, | |
1493 | set, | |
1494 | set8, | |
1495 | set16, | |
1496 | set32, | |
1497 | opaque : RETURN( TRUE ) | |
1498 | ||
1499 | ELSE | |
1500 | RETURN( FALSE ) | |
1501 | END | |
1502 | END CannotCheckTypeInPass3 ; | |
1503 | ||
1504 | ||
1505 | (* | |
1506 | IsCompatible - returns true if the types, t1, and, t2, are compatible. | |
1507 | *) | |
1508 | ||
1509 | PROCEDURE IsCompatible (t1, t2: CARDINAL; kind: Compatability) : Compatible ; | |
1510 | BEGIN | |
1511 | t1 := SkipType (t1) ; | |
1512 | t2 := SkipType (t2) ; | |
1513 | IF t1 = t2 | |
1514 | THEN | |
1515 | (* same types are always compatible. *) | |
1516 | RETURN first | |
1517 | ELSIF IsPassCodeGeneration () | |
1518 | THEN | |
1519 | RETURN AfterResolved (t1, t2, kind) | |
1520 | ELSE | |
1521 | RETURN BeforeResolved (t1, t2, kind) | |
1522 | END | |
1523 | END IsCompatible ; | |
1524 | ||
1525 | ||
1526 | (* | |
1527 | IsPointerSame - returns TRUE if pointers, a, and, b, are the same. | |
1528 | *) | |
1529 | ||
1530 | PROCEDURE IsPointerSame (a, b: CARDINAL; error: BOOLEAN) : BOOLEAN ; | |
1531 | BEGIN | |
1532 | RETURN( IsSameType(SkipType(GetType(a)), SkipType(GetType(b)), error) ) | |
1533 | END IsPointerSame ; | |
1534 | ||
1535 | ||
1536 | (* | |
1537 | IsSubrangeSame - checks to see whether the subranges are the same. | |
1538 | *) | |
1539 | ||
1540 | PROCEDURE IsSubrangeSame (a, b: CARDINAL) : BOOLEAN ; | |
1541 | VAR | |
1542 | al, ah, | |
1543 | bl, bh: CARDINAL ; | |
1544 | BEGIN | |
1545 | a := SkipType(a) ; | |
1546 | b := SkipType(b) ; | |
1547 | IF a#b | |
1548 | THEN | |
1549 | GetSubrange(a, ah, al) ; | |
1550 | GetSubrange(b, bh, bl) ; | |
1551 | PushValue(al) ; | |
1552 | PushValue(bl) ; | |
1553 | IF NOT Equ(GetDeclaredMod(a)) | |
1554 | THEN | |
1555 | RETURN( FALSE ) | |
1556 | END ; | |
1557 | PushValue(ah) ; | |
1558 | PushValue(bh) ; | |
1559 | IF NOT Equ(GetDeclaredMod(a)) | |
1560 | THEN | |
1561 | RETURN( FALSE ) | |
1562 | END | |
1563 | END ; | |
1564 | RETURN( TRUE ) | |
1565 | END IsSubrangeSame ; | |
1566 | ||
1567 | ||
1568 | (* | |
1569 | IsVarientSame - returns TRUE if varient types, a, and, b, are identical. | |
1570 | *) | |
1571 | ||
1572 | PROCEDURE IsVarientSame (a, b: CARDINAL; error: BOOLEAN) : BOOLEAN ; | |
1573 | VAR | |
1574 | i, j : CARDINAL ; | |
1575 | fa, fb, | |
1576 | ga, gb: CARDINAL ; | |
1577 | BEGIN | |
1578 | i := 1 ; | |
1579 | ga := NulSym ; | |
1580 | gb := NulSym ; | |
1581 | REPEAT | |
1582 | fa := GetNth(a, i) ; | |
1583 | fb := GetNth(b, i) ; | |
1584 | IF (fa#NulSym) AND (fb#NulSym) | |
1585 | THEN | |
1586 | Assert(IsFieldVarient(fa)) ; | |
1587 | Assert(IsFieldVarient(fb)) ; | |
1588 | j := 1 ; | |
1589 | REPEAT | |
1590 | ga := GetNth(fa, j) ; | |
1591 | gb := GetNth(fb, j) ; | |
1592 | IF (ga#NulSym) AND (gb#NulSym) | |
1593 | THEN | |
1594 | IF NOT IsSameType(GetType(ga), GetType(gb), error) | |
1595 | THEN | |
1596 | RETURN( FALSE ) | |
1597 | END ; | |
1598 | INC(j) | |
1599 | END | |
1600 | UNTIL (ga=NulSym) OR (gb=NulSym) ; | |
1601 | IF ga#gb | |
1602 | THEN | |
1603 | RETURN( FALSE ) | |
1604 | END | |
1605 | END ; | |
1606 | INC(i) | |
1607 | UNTIL (fa=NulSym) OR (fb=NulSym) ; | |
1608 | RETURN( ga=gb ) | |
1609 | END IsVarientSame ; | |
1610 | ||
1611 | ||
1612 | (* | |
1613 | IsRecordSame - | |
1614 | *) | |
1615 | ||
1616 | PROCEDURE IsRecordSame (a, b: CARDINAL; error: BOOLEAN) : BOOLEAN ; | |
1617 | VAR | |
1618 | ta, tb, | |
1619 | fa, fb: CARDINAL ; | |
1620 | i : CARDINAL ; | |
1621 | BEGIN | |
1622 | i := 1 ; | |
1623 | REPEAT | |
1624 | fa := GetNth(a, i) ; | |
1625 | fb := GetNth(b, i) ; | |
1626 | IF (fa#NulSym) AND (fb#NulSym) | |
1627 | THEN | |
1628 | ta := GetType(fa) ; | |
1629 | tb := GetType(fb) ; | |
1630 | IF IsRecordField(fa) AND IsRecordField(fb) | |
1631 | THEN | |
1632 | IF NOT IsSameType(ta, tb, error) | |
1633 | THEN | |
1634 | RETURN( FALSE ) | |
1635 | END | |
1636 | ELSIF IsVarient(fa) AND IsVarient(fb) | |
1637 | THEN | |
1638 | IF NOT IsVarientSame(ta, tb, error) | |
1639 | THEN | |
1640 | RETURN( FALSE ) | |
1641 | END | |
1642 | ELSIF IsFieldVarient(fa) OR IsFieldVarient(fb) | |
1643 | THEN | |
1644 | InternalError ('should not see a field varient') | |
1645 | ELSE | |
1646 | RETURN( FALSE ) | |
1647 | END | |
1648 | END ; | |
1649 | INC(i) | |
1650 | UNTIL (fa=NulSym) OR (fb=NulSym) ; | |
1651 | RETURN( fa=fb ) | |
1652 | END IsRecordSame ; | |
1653 | ||
1654 | ||
1655 | (* | |
1656 | IsArraySame - | |
1657 | *) | |
1658 | ||
1659 | PROCEDURE IsArraySame (t1, t2: CARDINAL; error: BOOLEAN) : BOOLEAN ; | |
1660 | VAR | |
1661 | s1, s2: CARDINAL ; | |
1662 | BEGIN | |
1663 | s1 := GetArraySubscript(t1) ; | |
1664 | s2 := GetArraySubscript(t2) ; | |
1665 | RETURN( IsSameType(GetType(s1), GetType(s2), error) AND | |
1666 | IsSameType(GetType(t1), GetType(t2), error) ) | |
1667 | END IsArraySame ; | |
1668 | ||
1669 | ||
1670 | (* | |
1671 | IsEnumerationSame - | |
1672 | *) | |
1673 | ||
1674 | PROCEDURE IsEnumerationSame (t1, t2: CARDINAL) : BOOLEAN ; | |
1675 | BEGIN | |
1676 | RETURN( t1=t2 ) | |
1677 | END IsEnumerationSame ; | |
1678 | ||
1679 | ||
1680 | (* | |
1681 | IsSetSame - | |
1682 | *) | |
1683 | ||
1684 | PROCEDURE IsSetSame (t1, t2: CARDINAL; error: BOOLEAN) : BOOLEAN ; | |
1685 | BEGIN | |
1686 | RETURN( IsSameType(GetType(t1), GetType(t2), error) ) | |
1687 | END IsSetSame ; | |
1688 | ||
1689 | ||
1690 | (* | |
1691 | IsSameType - returns TRUE if | |
1692 | *) | |
1693 | ||
1694 | PROCEDURE IsSameType (t1, t2: CARDINAL; error: BOOLEAN) : BOOLEAN ; | |
1695 | BEGIN | |
1696 | t1 := SkipType(t1) ; | |
1697 | t2 := SkipType(t2) ; | |
1698 | IF t1=t2 | |
1699 | THEN | |
1700 | RETURN( TRUE ) | |
1701 | ELSIF IsArray(t1) AND IsArray(t2) | |
1702 | THEN | |
1703 | RETURN( IsArraySame(t1, t2, error) ) | |
1704 | ELSIF IsSubrange(t1) AND IsSubrange(t2) | |
1705 | THEN | |
1706 | RETURN( IsSubrangeSame(t1, t2) ) | |
1707 | ELSIF IsProcType(t1) AND IsProcType(t2) | |
1708 | THEN | |
1709 | RETURN( IsProcTypeSame(t1, t2, error) ) | |
1710 | ELSIF IsEnumeration(t1) AND IsEnumeration(t2) | |
1711 | THEN | |
1712 | RETURN( IsEnumerationSame(t1, t2 (* , error *) ) ) | |
1713 | ELSIF IsRecord(t1) AND IsRecord(t2) | |
1714 | THEN | |
1715 | RETURN( IsRecordSame(t1, t2, error) ) | |
1716 | ELSIF IsSet(t1) AND IsSet(t2) | |
1717 | THEN | |
1718 | RETURN( IsSetSame(t1, t2, error) ) | |
1719 | ELSIF IsPointer(t1) AND IsPointer(t2) | |
1720 | THEN | |
1721 | RETURN( IsPointerSame(t1, t2, error) ) | |
1722 | ELSE | |
1723 | RETURN( FALSE ) | |
1724 | END | |
1725 | END IsSameType ; | |
1726 | ||
1727 | ||
1728 | (* | |
1729 | IsProcTypeSame - | |
1730 | *) | |
1731 | ||
1732 | PROCEDURE IsProcTypeSame (p1, p2: CARDINAL; error: BOOLEAN) : BOOLEAN ; | |
1733 | VAR | |
1734 | pa, pb: CARDINAL ; | |
1735 | n, i : CARDINAL ; | |
1736 | BEGIN | |
1737 | n := NoOfParam(p1) ; | |
1738 | IF n#NoOfParam(p2) | |
1739 | THEN | |
1740 | IF error | |
1741 | THEN | |
1742 | MetaError2('parameter is incompatible as {%1Dd} was declared with {%2n} parameters', p1, NoOfParam(p1)) ; | |
1743 | MetaError2('whereas {%1Dd} was declared with {%2n} parameters', p2, NoOfParam(p2)) | |
1744 | END ; | |
1745 | RETURN( FALSE ) | |
1746 | END ; | |
1747 | i := 1 ; | |
1748 | WHILE i<=n DO | |
1749 | pa := GetNthParam(p1, i) ; | |
1750 | pb := GetNthParam(p2, i) ; | |
1751 | IF IsVarParam(p1, i)#IsVarParam(p2, i) | |
1752 | THEN | |
1753 | IF error | |
1754 | THEN | |
1755 | MetaErrors3('the {%1n} parameter is incompatible between {%2Dad} and {%3ad} as only one was declared as VAR', | |
1756 | 'the {%1n} parameter is incompatible between {%2ad} and {%3Dad} as only one was declared as VAR', | |
1757 | i, p1, p2) | |
1758 | END ; | |
1759 | RETURN( FALSE ) | |
1760 | END ; | |
1761 | IF NOT IsSameType(GetType(pa), GetType(pb), error) | |
1762 | THEN | |
1763 | RETURN( FALSE ) | |
1764 | END ; | |
1765 | INC(i) | |
1766 | END ; | |
1767 | RETURN( IsSameType(GetType(p1), GetType(p2), error) ) | |
1768 | END IsProcTypeSame ; | |
1769 | ||
1770 | ||
1771 | (* | |
1772 | doProcTypeCheck - | |
1773 | *) | |
1774 | ||
1775 | PROCEDURE doProcTypeCheck (p1, p2: CARDINAL; error: BOOLEAN) : BOOLEAN ; | |
1776 | BEGIN | |
1777 | IF (IsProcType(p1) OR IsProcedure(p1)) AND | |
1778 | (IsProcType(p2) OR IsProcedure(p2)) | |
1779 | THEN | |
1780 | IF p1=p2 | |
1781 | THEN | |
1782 | RETURN( TRUE ) | |
1783 | ELSE | |
1784 | RETURN( IsProcTypeSame(p1, p2, error) ) | |
1785 | END | |
1786 | ELSE | |
1787 | RETURN( FALSE ) | |
1788 | END | |
1789 | END doProcTypeCheck ; | |
1790 | ||
1791 | ||
1792 | (* | |
1793 | AfterResolved - a thorough test for type compatibility. | |
1794 | *) | |
1795 | ||
1796 | PROCEDURE AfterResolved (t1, t2: CARDINAL; kind: Compatability) : Compatible ; | |
1797 | VAR | |
1798 | mt1, mt2: MetaType ; | |
1799 | BEGIN | |
1800 | IF (t1=NulSym) OR (t2=NulSym) | |
1801 | THEN | |
1802 | RETURN( first ) | |
1803 | ELSIF ((kind=parameter) OR (kind=assignment)) AND (t1=t2) | |
1804 | THEN | |
1805 | RETURN( first ) | |
1806 | ELSIF IsSubrange(t1) | |
1807 | THEN | |
1808 | RETURN( IsCompatible(GetType(t1), t2, kind) ) | |
1809 | ELSIF IsSubrange(t2) | |
1810 | THEN | |
1811 | RETURN( IsCompatible(t1, GetType(t2), kind) ) | |
1812 | ELSE | |
1813 | mt1 := FindMetaType(t1) ; | |
1814 | mt2 := FindMetaType(t2) ; | |
1815 | IF mt1=mt2 | |
1816 | THEN | |
1817 | CASE mt1 OF | |
1818 | ||
1819 | set, | |
1820 | set8, | |
1821 | set16, | |
1822 | set32 : IF IsSetSame(t1, t2, FALSE) | |
1823 | THEN | |
1824 | RETURN( first ) | |
1825 | ELSE | |
1826 | RETURN( no ) | |
1827 | END | | |
1828 | enum : IF IsEnumerationSame(t1, t2 (* , FALSE *) ) | |
1829 | THEN | |
1830 | RETURN( first ) | |
1831 | ELSE | |
1832 | RETURN( no ) | |
1833 | END | | |
1834 | pointer : IF IsPointerSame(t1, t2, FALSE) | |
1835 | THEN | |
1836 | RETURN( first ) | |
1837 | ELSE | |
1838 | RETURN( no ) | |
1839 | END | | |
1840 | opaque : RETURN( no ) | | |
1841 | procedure: IF doProcTypeCheck(t1, t2, FALSE) | |
1842 | THEN | |
1843 | RETURN( first ) | |
1844 | ELSE | |
1845 | RETURN( no ) | |
1846 | END | |
1847 | ||
1848 | ELSE | |
1849 | (* fall through *) | |
1850 | END | |
1851 | END ; | |
1852 | RETURN( IsBaseCompatible(t1, t2, kind) ) | |
1853 | END | |
1854 | END AfterResolved ; | |
1855 | ||
1856 | ||
1857 | (* | |
1858 | BeforeResolved - attempts to test for type compatibility before all types are | |
1859 | completely resolved. In particular set types and constructor | |
1860 | types are not fully known before the end of pass 3. | |
1861 | However we can test base types. | |
1862 | *) | |
1863 | ||
1864 | PROCEDURE BeforeResolved (t1, t2: CARDINAL; kind: Compatability) : Compatible ; | |
1865 | BEGIN | |
1866 | IF (t1=NulSym) OR (t2=NulSym) | |
1867 | THEN | |
1868 | RETURN( first ) | |
1869 | ELSIF IsSubrange(t1) | |
1870 | THEN | |
1871 | RETURN( IsCompatible(GetType(t1), t2, kind) ) | |
1872 | ELSIF IsSubrange(t2) | |
1873 | THEN | |
1874 | RETURN( IsCompatible(t1, GetType(t2), kind) ) | |
1875 | ELSIF IsSet(t1) OR IsSet(t2) | |
1876 | THEN | |
1877 | (* cannot test set compatibility at this point so we do this again after pass 3 *) | |
1878 | RETURN( first ) | |
1879 | ELSIF (IsProcType(t1) AND IsProcedure(t2)) OR | |
1880 | (IsProcedure(t1) AND IsProcType(t2)) | |
1881 | THEN | |
1882 | (* we will perform checking during code generation *) | |
1883 | RETURN( first ) | |
1884 | ELSIF IsHiddenType (t1) AND IsHiddenType (t2) | |
1885 | THEN | |
1886 | IF t1 = t2 | |
1887 | THEN | |
1888 | MetaError0 ('assert about to fail as t1 = t2') | |
1889 | END ; | |
1890 | Assert (t1 # t2) ; | |
1891 | (* different opaque types are not assignment or expression compatible. *) | |
1892 | RETURN no | |
1893 | ELSE | |
1894 | (* | |
1895 | see M2Quads for the fixme comment at assignment. | |
1896 | ||
1897 | PIM2 says that CARDINAL and INTEGER are compatible with subranges of CARDINAL and INTEGER, | |
1898 | however we do not know the type to our subranges yet as (GetType(SubrangeType)=NulSym). | |
1899 | So we add type checking in the range checking module which is done post pass 3, | |
1900 | when all is resolved. | |
1901 | *) | |
1902 | ||
1903 | RETURN IsBaseCompatible (t1, t2, kind) | |
1904 | END | |
1905 | END BeforeResolved ; | |
1906 | ||
1907 | ||
1908 | (* | |
1909 | AssignmentRequiresWarning - returns TRUE if t1 and t2 can be used during | |
1910 | an assignment, but should generate a warning. | |
1911 | For example in PIM we can assign ADDRESS | |
1912 | and WORD providing they are both the | |
1913 | same size. | |
1914 | No warning is necessary if the types are the same. | |
1915 | *) | |
1916 | ||
1917 | PROCEDURE AssignmentRequiresWarning (t1, t2: CARDINAL) : BOOLEAN ; | |
1918 | BEGIN | |
1919 | RETURN ((t1 # t2) AND | |
1920 | ((IsCompatible(t1, t2, assignment)=warnfirst) OR | |
1921 | (IsCompatible(t1, t2, assignment)=warnsecond))) | |
1922 | END AssignmentRequiresWarning ; | |
1923 | ||
1924 | ||
1925 | (* | |
1926 | IsAssignmentCompatible - returns TRUE if t1 and t2 are assignment | |
1927 | compatible. | |
1928 | *) | |
1929 | ||
1930 | PROCEDURE IsAssignmentCompatible (t1, t2: CARDINAL) : BOOLEAN ; | |
1931 | BEGIN | |
1932 | RETURN( | |
1933 | (t1=t2) OR | |
1934 | (IsCompatible(t1, t2, assignment)=first) OR | |
1935 | (IsCompatible(t1, t2, assignment)=second) | |
1936 | ) | |
1937 | END IsAssignmentCompatible ; | |
1938 | ||
1939 | ||
1940 | (* | |
1941 | IsExpressionCompatible - returns TRUE if t1 and t2 are expression | |
1942 | compatible. | |
1943 | *) | |
1944 | ||
1945 | PROCEDURE IsExpressionCompatible (t1, t2: CARDINAL) : BOOLEAN ; | |
1946 | BEGIN | |
1947 | RETURN( | |
1948 | (IsCompatible(t1, t2, expression)=first) OR | |
1949 | (IsCompatible(t1, t2, expression)=second) | |
1950 | ) | |
1951 | END IsExpressionCompatible ; | |
1952 | ||
1953 | ||
1954 | (* | |
1955 | IsParameterCompatible - returns TRUE if t1 and t2 are expression | |
1956 | compatible. | |
1957 | *) | |
1958 | ||
1959 | PROCEDURE IsParameterCompatible (t1, t2: CARDINAL (* ; tokenNo: CARDINAL *) ) : BOOLEAN ; | |
1960 | BEGIN | |
1961 | RETURN( | |
1962 | (IsCompatible(t1, t2, parameter)=first) OR | |
1963 | (IsCompatible(t1, t2, parameter)=second) | |
1964 | ) | |
1965 | END IsParameterCompatible ; | |
1966 | ||
1967 | ||
1968 | (* | |
1969 | IsComparisonCompatible - returns TRUE if t1 and t2 are comparison compatible. | |
1970 | *) | |
1971 | ||
1972 | PROCEDURE IsComparisonCompatible (t1, t2: CARDINAL (* ; tokenNo: CARDINAL *) ) : BOOLEAN ; | |
1973 | BEGIN | |
1974 | RETURN( | |
1975 | (IsCompatible(t1, t2, comparison)=first) OR | |
1976 | (IsCompatible(t1, t2, comparison)=second) | |
1977 | ) | |
1978 | END IsComparisonCompatible ; | |
1979 | ||
1980 | ||
1981 | (* | |
1982 | MixMetaTypes - | |
1983 | *) | |
1984 | ||
1985 | PROCEDURE MixMetaTypes (t1, t2: CARDINAL; NearTok: CARDINAL) : CARDINAL ; | |
1986 | VAR | |
1987 | mt1, mt2: MetaType ; | |
1988 | BEGIN | |
1989 | mt1 := FindMetaType(t1) ; | |
1990 | mt2 := FindMetaType(t2) ; | |
1991 | CASE Expr[mt1, mt2] OF | |
1992 | ||
1993 | no : MetaErrorT2 (NearTok, 'type incompatibility between {%1as} and {%2as}', t1, t2) ; | |
1994 | FlushErrors (* unrecoverable at present *) | | |
1995 | warnfirst, | |
1996 | first : RETURN( t1 ) | | |
1997 | warnsecond, | |
1998 | second : RETURN( t2 ) | |
1999 | ||
2000 | ELSE | |
2001 | InternalError ('not expecting this metatype value') | |
2002 | END ; | |
2003 | RETURN MakeError (NearTok, NulName) | |
2004 | END MixMetaTypes ; | |
2005 | ||
2006 | ||
2007 | (* | |
2008 | MixTypes - given types, t1 and t2, returns a type symbol that | |
2009 | provides expression type compatibility. | |
2010 | NearTok is used to identify the source position if a type | |
2011 | incompatability occurs. | |
2012 | *) | |
2013 | ||
2014 | PROCEDURE MixTypes (t1, t2: CARDINAL; NearTok: CARDINAL) : CARDINAL ; | |
2015 | BEGIN | |
2016 | IF t1=t2 | |
2017 | THEN | |
2018 | RETURN( t1 ) | |
2019 | ELSIF (t1=Address) AND (t2=Cardinal) | |
2020 | THEN | |
2021 | RETURN( Address ) | |
2022 | ELSIF (t1=Cardinal) AND (t2=Address) | |
2023 | THEN | |
2024 | RETURN( Address ) | |
2025 | ELSIF (t1=Address) AND (t2=Integer) | |
2026 | THEN | |
2027 | RETURN( Address ) | |
2028 | ELSIF (t1=Integer) AND (t2=Address) | |
2029 | THEN | |
2030 | RETURN( Address ) | |
2031 | ELSIF t1=NulSym | |
2032 | THEN | |
2033 | RETURN( t2 ) | |
2034 | ELSIF t2=NulSym | |
2035 | THEN | |
2036 | RETURN( t1 ) | |
2037 | ELSIF (t1=Bitset) AND IsSet(t2) | |
2038 | THEN | |
2039 | RETURN( t1 ) | |
2040 | ELSIF IsSet(t1) AND (t2=Bitset) | |
2041 | THEN | |
2042 | RETURN( t2 ) | |
2043 | ELSIF IsEnumeration(t1) | |
2044 | THEN | |
2045 | RETURN( MixTypes(Integer, t2, NearTok) ) | |
2046 | ELSIF IsEnumeration(t2) | |
2047 | THEN | |
2048 | RETURN( MixTypes(t1, Integer, NearTok) ) | |
2049 | ELSIF IsSubrange(t1) | |
2050 | THEN | |
2051 | RETURN( MixTypes(GetType(t1), t2, NearTok) ) | |
2052 | ELSIF IsSubrange(t2) | |
2053 | THEN | |
2054 | RETURN( MixTypes(t1, GetType(t2), NearTok) ) | |
2055 | ELSIF IsRealType(t1) AND IsRealType(t2) | |
2056 | THEN | |
2057 | IF t1=RType | |
2058 | THEN | |
2059 | RETURN( t2 ) | |
2060 | ELSIF t2=RType | |
2061 | THEN | |
2062 | RETURN( t1 ) | |
2063 | ELSE | |
2064 | RETURN( RType ) | |
2065 | END | |
2066 | ELSIF IsComplexType(t1) AND IsComplexType(t2) | |
2067 | THEN | |
2068 | IF t1=CType | |
2069 | THEN | |
2070 | RETURN( t2 ) | |
2071 | ELSIF t2=CType | |
2072 | THEN | |
2073 | RETURN( t1 ) | |
2074 | ELSE | |
2075 | RETURN( CType ) | |
2076 | END | |
2077 | ELSIF IsType(t1) | |
2078 | THEN | |
2079 | RETURN( MixTypes(GetType(t1), t2, NearTok) ) | |
2080 | ELSIF IsType(t2) | |
2081 | THEN | |
2082 | RETURN( MixTypes(t1, GetType(t2), NearTok) ) | |
2083 | ELSIF (t1=GetLowestType(t1)) AND (t2=GetLowestType(t2)) | |
2084 | THEN | |
2085 | RETURN( MixMetaTypes(t1, t2, NearTok) ) | |
2086 | ELSE | |
2087 | t1 := GetLowestType(t1) ; | |
2088 | t2 := GetLowestType(t2) ; | |
2089 | RETURN( MixTypes(t1, t2, NearTok) ) | |
2090 | END | |
2091 | END MixTypes ; | |
2092 | ||
2093 | ||
2094 | (* | |
2095 | NegateType - if the type is unsigned then returns the | |
2096 | signed equivalent. | |
2097 | *) | |
2098 | ||
2099 | PROCEDURE NegateType (type: CARDINAL (* ; sympos: CARDINAL *) ) : CARDINAL ; | |
2100 | VAR | |
2101 | lowType: CARDINAL ; | |
2102 | BEGIN | |
2103 | IF type#NulSym | |
2104 | THEN | |
2105 | lowType := GetLowestType (type) ; | |
2106 | IF lowType=LongCard | |
2107 | THEN | |
2108 | RETURN LongInt | |
2109 | ELSIF lowType=Cardinal | |
2110 | THEN | |
2111 | RETURN Integer | |
2112 | (* ELSE | |
2113 | 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) | |
2114 | *) | |
2115 | END | |
2116 | END ; | |
2117 | RETURN type | |
2118 | END NegateType ; | |
2119 | ||
2120 | ||
2121 | (* | |
2122 | IsMathType - returns TRUE if the type is a mathematical type. | |
2123 | A mathematical type has a range larger than INTEGER. | |
2124 | (Typically SHORTREAL/REAL/LONGREAL/LONGINT/LONGCARD) | |
2125 | *) | |
2126 | ||
2127 | PROCEDURE IsMathType (type: CARDINAL) : BOOLEAN ; | |
2128 | BEGIN | |
2129 | RETURN( | |
2130 | (type=LongCard) OR (type=LongInt) OR (type=Real) OR | |
2131 | (type=LongReal) OR (type=ShortReal) OR | |
2132 | (type=RType) OR (type=ZType) | |
2133 | ) | |
2134 | END IsMathType ; | |
2135 | ||
2136 | ||
2137 | (* | |
2138 | IsVarParamCompatible - returns TRUE if types, actual, and, formal | |
2139 | are compatible even if formal is a VAR | |
2140 | parameter. | |
2141 | *) | |
2142 | ||
2143 | PROCEDURE IsVarParamCompatible (actual, formal: CARDINAL) : BOOLEAN ; | |
2144 | BEGIN | |
2145 | actual := SkipType(actual) ; | |
2146 | formal := SkipType(formal) ; | |
2147 | IF IsParameter(formal) AND IsParameterUnbounded(formal) | |
2148 | THEN | |
2149 | formal := SkipType(GetType(GetType(formal))) ; (* move over unbounded *) | |
2150 | IF IsGenericSystemType(formal) | |
2151 | THEN | |
2152 | RETURN( TRUE ) | |
2153 | END ; | |
2154 | RETURN( (formal=actual) OR (IsArray(actual) AND (formal=SkipType(GetType(actual)))) ) | |
2155 | ELSE | |
2156 | RETURN( (actual=formal) OR | |
2157 | (IsPointer(actual) AND (formal=Address)) OR | |
2158 | (IsPointer(formal) AND (actual=Address)) OR | |
2159 | (IsGenericSystemType(actual) AND IsSizeSame(FindMetaType(actual), FindMetaType(formal))) OR | |
2160 | (IsGenericSystemType(formal) AND IsSizeSame(FindMetaType(actual), FindMetaType(formal))) OR | |
2161 | IsSameSizePervasiveType(formal, actual) ) | |
2162 | END | |
2163 | END IsVarParamCompatible ; | |
2164 | ||
2165 | ||
2166 | (* | |
2167 | IsArrayUnboundedCompatible - returns TRUE if unbounded or array types, t1, and, t2, | |
2168 | are compatible. | |
2169 | *) | |
2170 | ||
2171 | PROCEDURE IsArrayUnboundedCompatible (t1, t2: CARDINAL) : BOOLEAN ; | |
2172 | BEGIN | |
2173 | IF (t1=NulSym) OR (t2=NulSym) | |
2174 | THEN | |
2175 | RETURN( FALSE) | |
2176 | ELSIF (IsUnbounded(t1) OR IsArray(t1)) AND | |
2177 | (IsUnbounded(t2) OR IsArray(t2)) | |
2178 | THEN | |
2179 | RETURN( SkipType(GetType(t1))=SkipType(GetType(t2)) ) | |
2180 | ELSE | |
2181 | RETURN( FALSE ) | |
2182 | END | |
2183 | END IsArrayUnboundedCompatible ; | |
2184 | ||
2185 | ||
2186 | (* | |
2187 | IsValidUnboundedParameter - | |
2188 | *) | |
2189 | ||
2190 | PROCEDURE IsValidUnboundedParameter (formal, actual: CARDINAL) : BOOLEAN ; | |
2191 | VAR | |
2192 | ft, at : CARDINAL ; | |
2193 | n, m, o: CARDINAL ; | |
2194 | BEGIN | |
2195 | Assert(IsParameterUnbounded(formal)) ; | |
2196 | ft := SkipType(GetType(GetType(formal))) ; (* ARRAY OF ft *) | |
2197 | IF IsGenericSystemType(ft) OR IsArrayUnboundedCompatible(GetType(formal), GetType(actual)) | |
2198 | THEN | |
2199 | RETURN( TRUE ) | |
2200 | ELSE | |
2201 | IF IsParameter(actual) AND IsParameterUnbounded(actual) | |
2202 | THEN | |
2203 | n := GetDimension(actual) ; | |
2204 | m := GetDimension(formal) ; | |
2205 | IF n#m | |
2206 | THEN | |
2207 | RETURN( IsGenericSystemType(ft) AND (n<m) ) | |
2208 | ELSE | |
2209 | RETURN( (GetDimension(actual)=GetDimension(formal)) AND | |
2210 | IsParameterCompatible(GetType(GetType(actual)), ft) ) | |
2211 | END | |
2212 | ELSE | |
2213 | IF IsConstString(actual) | |
2214 | THEN | |
2215 | RETURN( IsParameterCompatible(Char, ft) ) | |
2216 | ELSE | |
2217 | at := SkipType(GetType(actual)) ; | |
2218 | IF IsArray(at) | |
2219 | THEN | |
2220 | m := GetDimension(formal) ; | |
2221 | n := GetDimension(at) ; | |
2222 | o := 0 ; | |
2223 | WHILE IsArray(at) DO | |
2224 | INC(o) ; | |
2225 | at := SkipType(GetType(at)) ; | |
2226 | IF (m=o) AND (at=ft) | |
2227 | THEN | |
2228 | RETURN( TRUE ) | |
2229 | END | |
2230 | END ; | |
2231 | IF n#m | |
2232 | THEN | |
2233 | RETURN( IsGenericSystemType(ft) AND (n<m) ) | |
2234 | ELSIF IsParameterVar(formal) | |
2235 | THEN | |
2236 | RETURN( IsVarParamCompatible(at, formal) ) | |
2237 | ELSE | |
2238 | RETURN( IsParameterCompatible(at, ft) ) | |
2239 | END | |
2240 | ELSE | |
2241 | IF IsParameterVar(formal) | |
2242 | THEN | |
2243 | RETURN( IsVarParamCompatible(at, formal) ) | |
2244 | ELSE | |
2245 | RETURN( IsParameterCompatible(at, ft) ) | |
2246 | END | |
2247 | END | |
2248 | END | |
2249 | END | |
2250 | END | |
2251 | END IsValidUnboundedParameter ; | |
2252 | ||
2253 | ||
2254 | (* | |
2255 | IsValidParameter - returns TRUE if an, actual, parameter can be passed | |
2256 | to the, formal, parameter. This differs from | |
2257 | IsParameterCompatible as this procedure includes checks | |
2258 | for unbounded formal parameters, var parameters and | |
2259 | constant actual parameters. | |
2260 | *) | |
2261 | ||
2262 | PROCEDURE IsValidParameter (formal, actual: CARDINAL (* ; tokenNo: CARDINAL *) ) : BOOLEAN ; | |
2263 | VAR | |
2264 | at, ft: CARDINAL ; | |
2265 | BEGIN | |
2266 | Assert(IsParameter(formal)) ; | |
2267 | Assert(IsPassCodeGeneration()) ; | |
2268 | IF IsConst(actual) AND IsParameterVar(formal) | |
2269 | THEN | |
2270 | RETURN( FALSE ) | |
2271 | ELSE | |
2272 | IF IsParameterUnbounded(formal) | |
2273 | THEN | |
2274 | RETURN( IsValidUnboundedParameter(formal, actual) ) | |
2275 | ELSE | |
2276 | ft := SkipType(GetType(formal)) | |
2277 | END ; | |
2278 | IF IsConst(actual) AND (SkipType(GetType(actual))=Char) AND IsArray(ft) AND (SkipType(GetType(ft))=Char) | |
2279 | THEN | |
2280 | (* a constant char can be either a char or a string *) | |
2281 | RETURN( TRUE ) | |
2282 | END ; | |
2283 | IF IsProcType(ft) | |
2284 | THEN | |
2285 | IF IsProcedure(actual) | |
2286 | THEN | |
2287 | (* we check this by calling IsValidProcedure for each and every | |
2288 | parameter of actual and formal *) | |
2289 | RETURN( TRUE ) | |
2290 | ELSE | |
2291 | at := SkipType(GetType(actual)) ; | |
2292 | RETURN( doProcTypeCheck(at, ft, TRUE) ) | |
2293 | END | |
2294 | ELSIF IsParameterVar(formal) | |
2295 | THEN | |
2296 | RETURN( IsVarParamCompatible(GetType(actual), ft) ) | |
2297 | ELSE | |
2298 | RETURN( IsParameterCompatible(GetType(actual), ft) ) | |
2299 | END | |
2300 | END | |
2301 | END IsValidParameter ; | |
2302 | ||
2303 | ||
2304 | (* | |
2305 | PushSizeOf - pushes the size of a meta type. | |
2306 | *) | |
2307 | ||
2308 | PROCEDURE PushSizeOf (t: MetaType) ; | |
2309 | BEGIN | |
2310 | CASE t OF | |
2311 | ||
2312 | const : InternalError ('do not know the size of a constant') | | |
2313 | word : IF Iso | |
2314 | THEN | |
2315 | PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetISOWordType())) | |
2316 | ELSE | |
2317 | PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetWordType())) | |
2318 | END | | |
2319 | byte : IF Iso | |
2320 | THEN | |
2321 | PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetISOByteType())) | |
2322 | ELSE | |
2323 | PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetByteType())) | |
2324 | END | | |
2325 | address : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetPointerType())) | | |
2326 | chr : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2CharType())) | | |
2327 | normint : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2IntegerType())) | | |
2328 | shortint : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ShortIntType())) | | |
2329 | longint : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2LongIntType())) | | |
2330 | normcard : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2CardinalType())) | | |
2331 | shortcard: PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ShortCardType())) | | |
2332 | longcard : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2LongCardType())) | | |
2333 | pointer : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetPointerType())) | | |
2334 | enum : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetIntegerType())) | | |
2335 | real : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2RealType())) | | |
2336 | shortreal: PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ShortRealType())) | | |
2337 | longreal : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2LongRealType())) | | |
2338 | set : InternalError ('do not know the size of a set') | | |
2339 | opaque : InternalError ('do not know the size of an opaque') | | |
2340 | loc : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetISOLocType())) | | |
2341 | rtype : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2RType())) | | |
2342 | ztype : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ZType())) | | |
2343 | int8, | |
2344 | card8, | |
2345 | set8 : PushIntegerTree(BuildIntegerConstant(1)) | | |
2346 | word16, | |
2347 | set16, | |
2348 | card16, | |
2349 | int16 : PushIntegerTree(BuildIntegerConstant(2)) | | |
2350 | real32, | |
2351 | word32, | |
2352 | set32, | |
2353 | card32, | |
2354 | int32 : PushIntegerTree(BuildIntegerConstant(4)) | | |
2355 | real64, | |
2356 | word64, | |
2357 | card64, | |
2358 | int64 : PushIntegerTree(BuildIntegerConstant(8)) | | |
2359 | real96 : PushIntegerTree(BuildIntegerConstant(12)) | | |
2360 | real128 : PushIntegerTree(BuildIntegerConstant(16)) | | |
2361 | complex : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ComplexType())) | | |
2362 | shortcomplex: PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ShortComplexType())) | | |
2363 | longcomplex: PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2LongComplexType())) | | |
2364 | complex32: PushIntegerTree(BuildIntegerConstant(4*2)) | | |
2365 | complex64: PushIntegerTree(BuildIntegerConstant(8*2)) | | |
2366 | complex96: PushIntegerTree(BuildIntegerConstant(12*2)) | | |
2367 | complex128: PushIntegerTree(BuildIntegerConstant(16*2)) | | |
2368 | ctype : PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2CType())) | | |
2369 | ||
2370 | unknown : InternalError ('should not get here') | |
2371 | ||
2372 | ELSE | |
2373 | InternalError ('should not get here') | |
2374 | END | |
2375 | END PushSizeOf ; | |
2376 | ||
2377 | ||
2378 | (* | |
2379 | IsSizeSame - | |
2380 | *) | |
2381 | ||
2382 | PROCEDURE IsSizeSame (t1, t2: MetaType) : BOOLEAN ; | |
2383 | BEGIN | |
2384 | PushSizeOf(t1) ; | |
2385 | PushSizeOf(t2) ; | |
2386 | RETURN( Equ(0) ) | |
2387 | END IsSizeSame ; | |
2388 | ||
2389 | ||
2390 | (* | |
2391 | InitArray - | |
2392 | *) | |
2393 | ||
2394 | PROCEDURE InitArray (VAR c: CompatibilityArray; | |
2395 | y: MetaType; a: ARRAY OF CHAR) ; | |
2396 | VAR | |
2397 | x : MetaType ; | |
2398 | h, i: CARDINAL ; | |
2399 | BEGIN | |
2400 | h := StrLen(a) ; | |
2401 | i := 0 ; | |
2402 | x := MIN(MetaType) ; | |
2403 | WHILE i<h DO | |
2404 | IF (c[x, y]#uninitialized) AND (x#unknown) AND (y#unknown) | |
2405 | THEN | |
2406 | InternalError('expecting array element to be uninitialized') | |
2407 | END ; | |
2408 | CASE a[i] OF | |
2409 | ||
2410 | ' ': | | |
2411 | '.': CASE c[y, x] OF | |
2412 | ||
2413 | uninitialized: InternalError('cannot reflect value as it is unknown') | | |
2414 | first : c[x, y] := second | | |
2415 | second : c[x, y] := first | | |
2416 | warnfirst : c[x, y] := warnsecond | | |
2417 | warnsecond : c[x, y] := warnfirst | |
2418 | ||
2419 | ELSE | |
2420 | c[x, y] := c[y, x] | |
2421 | END ; | |
2422 | INC(x) | | |
2423 | 'F': c[x, y] := no ; | |
2424 | INC(x) | | |
2425 | 'T', | |
2426 | '1': c[x, y] := first ; | |
2427 | INC(x) | | |
2428 | '2': c[x, y] := second ; | |
2429 | INC(x) | | |
2430 | 'W': IF Pim | |
2431 | THEN | |
2432 | IF IsSizeSame(x, y) | |
2433 | THEN | |
2434 | c[x, y] := warnsecond | |
2435 | ELSE | |
2436 | c[x, y] := no | |
2437 | END | |
2438 | ELSE | |
2439 | c[x, y] := no | |
2440 | END ; | |
2441 | INC(x) | | |
2442 | 'w': IF Pim | |
2443 | THEN | |
2444 | IF IsSizeSame(x, y) | |
2445 | THEN | |
2446 | c[x, y] := warnfirst | |
2447 | ELSE | |
2448 | c[x, y] := no | |
2449 | END | |
2450 | ELSE | |
2451 | c[x, y] := no | |
2452 | END ; | |
2453 | INC(x) | | |
2454 | 'P': IF Pim | |
2455 | THEN | |
2456 | c[x, y] := second | |
2457 | ELSE | |
2458 | c[x, y] := no | |
2459 | END ; | |
2460 | INC(x) | | |
2461 | 'p': IF Pim | |
2462 | THEN | |
2463 | c[x, y] := first | |
2464 | ELSE | |
2465 | c[x, y] := no | |
2466 | END ; | |
2467 | INC(x) | | |
2468 | 's': IF IsSizeSame(x, y) | |
2469 | THEN | |
2470 | c[x, y] := first | |
2471 | ELSE | |
2472 | c[x, y] := no | |
2473 | END ; | |
2474 | INC(x) | | |
2475 | 'S': IF IsSizeSame(x, y) | |
2476 | THEN | |
2477 | c[x, y] := second | |
2478 | ELSE | |
2479 | c[x, y] := no | |
2480 | END ; | |
2481 | INC(x) | | |
2482 | ||
2483 | ELSE | |
2484 | InternalError ('unexpected specifier') | |
2485 | END ; | |
2486 | INC(i) | |
2487 | END | |
2488 | END InitArray ; | |
2489 | ||
2490 | ||
2491 | (* | |
2492 | A - initialize the assignment array | |
2493 | *) | |
2494 | ||
2495 | PROCEDURE A (y: MetaType; a: ARRAY OF CHAR) ; | |
2496 | BEGIN | |
2497 | InitArray (Ass, y, a) | |
2498 | END A ; | |
2499 | ||
2500 | ||
2501 | (* | |
2502 | E - initialize the expression array | |
2503 | *) | |
2504 | ||
2505 | PROCEDURE E (y: MetaType; a: ARRAY OF CHAR) ; | |
2506 | BEGIN | |
2507 | InitArray (Expr, y, a) | |
2508 | END E ; | |
2509 | ||
2510 | ||
2511 | (* | |
2512 | C - initialize the comparision array | |
2513 | *) | |
2514 | ||
2515 | PROCEDURE C (y: MetaType; a: ARRAY OF CHAR) ; | |
2516 | BEGIN | |
2517 | InitArray (Comp, y, a) | |
2518 | END C ; | |
2519 | ||
2520 | ||
2521 | (* | |
2522 | InitCompatibilityMatrices - initializes the tables above. | |
2523 | *) | |
2524 | ||
2525 | PROCEDURE InitCompatibilityMatrices ; | |
2526 | VAR | |
2527 | i, j: MetaType ; | |
2528 | BEGIN | |
2529 | (* initialize to a known state *) | |
2530 | FOR i := MIN(MetaType) TO MAX(MetaType) DO | |
2531 | FOR j := MIN(MetaType) TO MAX(MetaType) DO | |
2532 | Ass[i, j] := uninitialized ; | |
2533 | Expr[i, j] := uninitialized | |
2534 | END | |
2535 | END ; | |
2536 | ||
2537 | (* all unknowns are false *) | |
2538 | FOR i := MIN(MetaType) TO MAX(MetaType) DO | |
2539 | Ass[i, unknown] := no ; | |
2540 | Expr[unknown, i] := no | |
2541 | END ; | |
2542 | ||
2543 | (* | |
2544 | 1 p w | |
2545 | ||
2546 | 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 | |
2547 | 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 | |
2548 | 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 | |
2549 | 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 | |
2550 | 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 | |
2551 | 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 | |
2552 | s r n t a a r e a 8 x o m x x x x | |
2553 | t l r d a l m p 3 6 9 1 | |
2554 | d l p l 2 4 6 2 | |
2555 | l e 8 | |
2556 | e x | |
2557 | x | |
2558 | -------------------------------------------------------------------------------------------------------------- | |
2559 | 2 | |
2560 | P | |
2561 | W | |
2562 | *) | |
2563 | A(const , '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') ; | |
2564 | A(word , '. 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') ; | |
2565 | A(byte , '. . 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') ; | |
2566 | A(address , '. . . 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') ; | |
2567 | A(chr , '. . . . 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') ; | |
2568 | A(normint , '. . . . . 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') ; | |
2569 | A(shortint , '. . . . . . 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') ; | |
2570 | A(longint , '. . . . . . . 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') ; | |
2571 | A(normcard , '. . . . . . . . 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') ; | |
2572 | A(shortcard , '. . . . . . . . . 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') ; | |
2573 | A(longcard , '. . . . . . . . . . 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') ; | |
2574 | A(pointer , '. . . . . . . . . . . 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') ; | |
2575 | A(enum , '. . . . . . . . . . . . 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') ; | |
2576 | A(real , '. . . . . . . . . . . . . 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') ; | |
2577 | A(shortreal , '. . . . . . . . . . . . . . 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') ; | |
2578 | A(longreal , '. . . . . . . . . . . . . . . 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') ; | |
2579 | A(set , '. . . . . . . . . . . . . . . . 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') ; | |
2580 | A(opaque , '. . . . . . . . . . . . . . . . . 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') ; | |
2581 | A(loc , '. . . . . . . . . . . . . . . . . . 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') ; | |
2582 | A(rtype , '. . . . . . . . . . . . . . . . . . . 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') ; | |
2583 | A(ztype , '. . . . . . . . . . . . . . . . . . . . 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') ; | |
2584 | A(int8 , '. . . . . . . . . . . . . . . . . . . . . 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') ; | |
2585 | A(int16 , '. . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2586 | A(int32 , '. . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2587 | A(int64 , '. . . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2588 | A(card8 , '. . . . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2589 | A(card16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . T T T F F F F F F F F F F F F F F F F F F F F F') ; | |
2590 | A(card32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . T T F T F F F F F F F F F F F F F F F F F F F') ; | |
2591 | A(card64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F F F F F F F F F F F F F F F F') ; | |
2592 | A(word16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F') ; | |
2593 | A(word32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F F F F F F F F F F F F F F F') ; | |
2594 | A(word64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F F F F F F F F F F F F F F') ; | |
2595 | A(real32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F') ; | |
2596 | A(real64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F') ; | |
2597 | A(real96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F') ; | |
2598 | A(real128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F') ; | |
2599 | A(set8 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F') ; | |
2600 | A(set16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F') ; | |
2601 | A(set32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F') ; | |
2602 | A(complex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F F') ; | |
2603 | A(shortcomplex, '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F F') ; | |
2604 | A(longcomplex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F F') ; | |
2605 | A(complex32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F F') ; | |
2606 | A(complex64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F') ; | |
2607 | A(complex96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F') ; | |
2608 | A(complex128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F F') ; | |
2609 | A(ctype , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F') ; | |
2610 | A(rec , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F') ; | |
2611 | A(array , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F') ; | |
2612 | A(procedure , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T') ; | |
2613 | (* Expression compatibility *) | |
2614 | ||
2615 | ||
2616 | (* | |
2617 | 1 p w | |
2618 | ||
2619 | 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 | |
2620 | 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 | |
2621 | 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 | |
2622 | 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 | |
2623 | 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 | |
2624 | 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 | |
2625 | s r n t a a r e a 8 x o m x x x x | |
2626 | t l r d a l m p 3 6 9 1 | |
2627 | d l p l 2 4 6 2 | |
2628 | l e 8 | |
2629 | e x | |
2630 | x | |
2631 | ------------------------------------------------------------------------------------------------------------ | |
2632 | 2 | |
2633 | P | |
2634 | W | |
2635 | *) | |
2636 | ||
2637 | E(const , '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') ; | |
2638 | E(word , '. 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') ; | |
2639 | E(byte , '. . 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') ; | |
2640 | E(address , '. . . 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') ; | |
2641 | E(chr , '. . . . 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') ; | |
2642 | E(normint , '. . . . . 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') ; | |
2643 | E(shortint , '. . . . . . 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') ; | |
2644 | E(longint , '. . . . . . . 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') ; | |
2645 | E(normcard , '. . . . . . . . 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') ; | |
2646 | E(shortcard , '. . . . . . . . . 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') ; | |
2647 | E(longcard , '. . . . . . . . . . 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') ; | |
2648 | E(pointer , '. . . . . . . . . . . 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') ; | |
2649 | E(enum , '. . . . . . . . . . . . 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') ; | |
2650 | E(real , '. . . . . . . . . . . . . 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') ; | |
2651 | E(shortreal , '. . . . . . . . . . . . . . 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') ; | |
2652 | E(longreal , '. . . . . . . . . . . . . . . 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') ; | |
2653 | E(set , '. . . . . . . . . . . . . . . . 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') ; | |
2654 | E(opaque , '. . . . . . . . . . . . . . . . . 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') ; | |
2655 | E(loc , '. . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; | |
2656 | E(rtype , '. . . . . . . . . . . . . . . . . . . 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') ; | |
2657 | E(ztype , '. . . . . . . . . . . . . . . . . . . . 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') ; | |
2658 | E(int8 , '. . . . . . . . . . . . . . . . . . . . . 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') ; | |
2659 | E(int16 , '. . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2660 | E(int32 , '. . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2661 | E(int64 , '. . . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2662 | E(card8 , '. . . . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2663 | E(card16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F') ; | |
2664 | E(card32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F') ; | |
2665 | E(card64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F') ; | |
2666 | E(word16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F') ; | |
2667 | E(word32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F') ; | |
2668 | E(word64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F') ; | |
2669 | E(real32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F') ; | |
2670 | E(real64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F') ; | |
2671 | E(real96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F') ; | |
2672 | E(real128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F') ; | |
2673 | E(set8 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F') ; | |
2674 | E(set16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F') ; | |
2675 | E(set32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F') ; | |
2676 | E(complex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F F') ; | |
2677 | E(shortcomplex, '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F F') ; | |
2678 | E(longcomplex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F F') ; | |
2679 | E(complex32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F F') ; | |
2680 | E(complex64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F') ; | |
2681 | E(complex96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F') ; | |
2682 | E(complex128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F F') ; | |
2683 | E(ctype , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F') ; | |
2684 | E(rec , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F') ; | |
2685 | E(array , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F') ; | |
2686 | E(procedure , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T') ; | |
2687 | ||
2688 | (* Comparison compatibility *) | |
2689 | ||
2690 | ||
2691 | (* | |
2692 | 1 p w | |
2693 | ||
2694 | 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 | |
2695 | 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 | |
2696 | 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 | |
2697 | 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 | |
2698 | 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 | |
2699 | 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 | |
2700 | s r n t a a r e a 8 x o m x x x x | |
2701 | t l r d a l m p 3 6 9 1 | |
2702 | d l p l 2 4 6 2 | |
2703 | l e 8 | |
2704 | e x | |
2705 | x | |
2706 | ------------------------------------------------------------------------------------------------------------ | |
2707 | 2 | |
2708 | P | |
2709 | W | |
2710 | *) | |
2711 | ||
2712 | C(const , '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') ; | |
2713 | C(word , '. 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') ; | |
2714 | C(byte , '. . 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') ; | |
2715 | C(address , '. . . 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') ; | |
2716 | C(chr , '. . . . 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') ; | |
2717 | C(normint , '. . . . . 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') ; | |
2718 | C(shortint , '. . . . . . 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') ; | |
2719 | C(longint , '. . . . . . . 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') ; | |
2720 | C(normcard , '. . . . . . . . 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') ; | |
2721 | C(shortcard , '. . . . . . . . . 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') ; | |
2722 | C(longcard , '. . . . . . . . . . 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') ; | |
2723 | C(pointer , '. . . . . . . . . . . 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') ; | |
2724 | C(enum , '. . . . . . . . . . . . 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') ; | |
2725 | C(real , '. . . . . . . . . . . . . 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') ; | |
2726 | C(shortreal , '. . . . . . . . . . . . . . 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') ; | |
2727 | C(longreal , '. . . . . . . . . . . . . . . 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') ; | |
2728 | C(set , '. . . . . . . . . . . . . . . . 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') ; | |
2729 | C(opaque , '. . . . . . . . . . . . . . . . . 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') ; | |
2730 | C(loc , '. . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; | |
2731 | C(rtype , '. . . . . . . . . . . . . . . . . . . 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') ; | |
2732 | C(ztype , '. . . . . . . . . . . . . . . . . . . . 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') ; | |
2733 | C(int8 , '. . . . . . . . . . . . . . . . . . . . . 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') ; | |
2734 | C(int16 , '. . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2735 | C(int32 , '. . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2736 | C(int64 , '. . . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2737 | C(card8 , '. . . . . . . . . . . . . . . . . . . . . . . . . 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') ; | |
2738 | C(card16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F') ; | |
2739 | C(card32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F') ; | |
2740 | C(card64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F') ; | |
2741 | C(word16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F') ; | |
2742 | C(word32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F') ; | |
2743 | C(word64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F') ; | |
2744 | C(real32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F') ; | |
2745 | C(real64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F') ; | |
2746 | C(real96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F') ; | |
2747 | C(real128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F') ; | |
2748 | C(set8 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F') ; | |
2749 | C(set16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F') ; | |
2750 | C(set32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F') ; | |
2751 | C(complex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F F') ; | |
2752 | C(shortcomplex, '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F F') ; | |
2753 | C(longcomplex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F F') ; | |
2754 | C(complex32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F F') ; | |
2755 | C(complex64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F') ; | |
2756 | C(complex96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F') ; | |
2757 | C(complex128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F F') ; | |
2758 | C(ctype , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F') ; | |
2759 | C(rec , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F') ; | |
2760 | C(array , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F') ; | |
2761 | C(procedure , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T') ; | |
2762 | ||
2763 | END InitCompatibilityMatrices ; | |
2764 | ||
2765 | ||
2766 | END M2Base. |