projects / thirdparty / gcc.git / blame
| Commit | Line | Data |
|---|---|---|
| 1eee94d3 GM |
1 | (* M2Base.mod provides a mechanism to check fundamental types. |
| 2 | ||
| a945c346 | 3 | Copyright (C) 2001-2024 Free Software Foundation, Inc. |
| 1eee94d3 GM |
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 ; | |
| 9fadd8de | 36 | FROM NameKey IMPORT NulName, MakeKey, WriteKey, KeyToCharStar ; |
| 1eee94d3 GM |
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, | |
| 9fadd8de GM |
77 | GetNthParam, IsVarParam, GetNth, GetDimension, |
| 78 | MakeError ; | |
| 1eee94d3 GM |
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 | |
| 9fadd8de GM |
1048 | MetaError1('{%1ad} must be a COMPLEX type', sym) ; |
| 1049 | RETURN RType | |
| 1eee94d3 GM |
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') | |
| 9fadd8de GM |
2002 | END ; |
| 2003 | RETURN MakeError (NearTok, NulName) | |
| 1eee94d3 GM |
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 | ||
| 1eee94d3 GM |
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 | ||
| f8c8aebc GM |
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 | |
| 1eee94d3 GM |
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 | |
| f8c8aebc | 2558 | -------------------------------------------------------------------------------------------------------------- |
| 1eee94d3 GM |
2559 | 2 |
| 2560 | P | |
| 2561 | W | |
| 2562 | *) | |
| f8c8aebc GM |
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') ; | |
| 1eee94d3 GM |
2613 | (* Expression compatibility *) |
| 2614 | ||
| 2615 | ||
| 2616 | (* | |
| 2617 | 1 p w | |
| 2618 | ||
| f8c8aebc GM |
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 | |
| 1eee94d3 GM |
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 | ||
| f8c8aebc GM |
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') ; | |
| 1eee94d3 GM |
2687 | |
| 2688 | (* Comparison compatibility *) | |
| 2689 | ||
| 2690 | ||
| 2691 | (* | |
| 2692 | 1 p w | |
| 2693 | ||
| f8c8aebc GM |
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 | |
| 1eee94d3 GM |
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 | ||
| f8c8aebc GM |
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') ; | |
| 1eee94d3 GM |
2762 | |
| 2763 | END InitCompatibilityMatrices ; | |
| 2764 | ||
| 2765 | ||
| 2766 | END M2Base. |