Coco/R - Compiler-Compiler V1.53 Released by Pat Terry 17 September 2002 Source file: M2.atg Grammar Tests: Deletable symbols: DeclSeq Undefined nonterminals: -- none -- Unreachable nonterminals: -- none -- Circular derivations: -- none -- Underivable nonterminals: -- none -- LL(1) conditions: LL(1) error in TypeBlock: "CLASS" is the start & successor of a deletable structure Listing: 1 COMPILER M2 2 (* Step 1 — minimal integer pipeline (m2compiler-V3). 3 Subset: program MODULE + CONST (literal) + VAR INTEGER + 4 assignment + integer expressions (+ - * DIV MOD, leading sign, 5 parens). Fresh QBE backend (QbeGen) to gen_ssa/.ssa; 6 assemble with qbe, link with cc. 7 8 Test convention: a global VAR ExitCode : INTEGER makes generated 9 $main return its value as the process exit code, else return 0. 10 11 Semantic errors reuse the V1/V2/Test2 family: 200 duplicate, 12 201 undeclared, 202 module name mismatch, 210 bad assignment, 13 211 bad arithmetic, 221 not a type, 230 not supported yet, 14 231 opaque type outside definition. 15 Scalar-phase TYPEs (named, integer subrange, enum) check fully; 16 composite forms wait for step 3. Procedure headings (formals, 17 result, FORWARD) enter scopes now; bodies parse + check with one 18 230 at END (lowering = step 4). 19 Statements: assignment, IF/ELSIF/ELSE, WHILE, REPEAT/UNTIL, 20 LOOP/EXIT (230 outside LOOP), FOR/TO/static-sign-BY, full CASE 21 (labels, ranges, ELSE; compare-chain), RETURN with 232 checks 22 (outside proc / value mismatch / missing value). WITH waits for 23 records (step 3). Boolean connectives are eager (or/and/xor); 24 relations yield 0/1 via cXXw. 25 Clarion-form classes (docs/OOP.txt): CLASS decl + single 26 inheritance + CLASS IMPLEMENTATION blocks, methods with ";" 27 (per the Table example, not the sketch's ","), VIRTUAL flagged. 28 Scopes and member checks now; lowering later (one 230 per 29 class/impl block). Classic identifiers: no underscores, so the 30 Table example's _names stay lexically out of reach. 31 Step 3.1 arrays: "ARRAY [lo..hi, ...] OF T" (folded literal 32 bounds, int/char) and open "ARRAY OF T" formals; index suffixes 33 with per-level checks (217/218, trap on breach via $abort); 34 whole-array ":=" with runtime count check + blit; string 35 literals lower as descriptors (1-char stays CHAR, empty works); 36 array/string "=" is 213 (no built-in whole comparison). 37 Step 3.3 sets: multi-word masks (no header, static words) over 38 bases ≤ 256 values; literals are SET OF [0..255] (222 on 39 out-of-span); + - * / as or/and/xor-not, IN with span trap, 40 =/# word-wise (lenient cross-base); CASE labels reject sets. 41 Step 3.4 records: flat blobs; array fields are pointers to static 42 descriptors (locked amendment — one layout per type); nested 43 records inline; static declaration-order offsets; field chains 44 mix with indexes; WITH pushes fields + bases (215/216); 45 whole-record deep copy; record/set/class "=" is 213. 46 Step 3.6 pointers: vars (l), NIL as a real type (FNil — assignment 47 and =/# work, everything else 210-214/222), ^ deref with sfx 48 discipline (address flows, load at use; chains compose), 49 pointer =/# via ceql/cnel (< > etc. are 213), NEW/DISPOSE as 50 builtin statements via extern malloc/free (recursive skeleton 51 init; DISPOSE shallow and nils, deviating from Wirth-undefined); 52 nil-deref is raw (no check). *) 53 54 IMPORT SymTab, QbeGen; 55 56 CHARACTERS 57 eol = CHR(13) . 58 lf = CHR(10) . 59 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" . 60 digit = "0123456789" . 61 hexDigit = digit + "ABCDEFabcdef" . 62 noQuote1 = ANY - "'" - eol . 63 noQuote2 = ANY - '"' - eol . 64 65 IGNORE CHR(9) .. CHR(13) 66 67 COMMENTS FROM "(*" TO "*)" NESTED 68 COMMENTS FROM "//" TO lf 69 70 TOKENS 71 ident = letter { letter | digit } . 72 integer = digit { digit } 73 | digit { digit } CONTEXT("..") 74 | "0x" hexDigit { hexDigit } 75 | "0X" hexDigit { hexDigit } . 76 real = digit { digit } "." { digit } 77 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] . 78 string = "'" { noQuote1 } "'" 79 | '"' { noQuote2 } '"' . 80 81 PRODUCTIONS 82 M2 83 = Unit "." . 84 (* Units: program modules compile fully; DEFINITION and 85 IMPLEMENTATION modules parse + check now but lower in step 4 86 (each ends with one 230); same for nested local modules. *) 87 Unit 88 = DefUnit 89 | ImplUnit 90 | ProgModule . 91 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION 92 and one program (last) into one image. Units share the symbol 93 table; imports materialize exported names. *) 94 DefUnit (. VAR m1, m2, pn: SymTab.Name; .) 95 = "DEFINITION" "MODULE" 96 GetIdent (. IF ~SymTab.BeginDef(m1) THEN 97 SemError(200) END; 98 QbeGen.SetModule(m1); .) 99 ";" 100 { Import } 101 { ConstBlock | TypeBlock | VarBlock 102 | ProcHeading ";" (. SymTab.CloseProc; 103 QbeGen.AbortFunc; .) } 104 "END" 105 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 106 SemError(202) END; 107 SymTab.EndUnit; .) . 108 ImplUnit (. VAR m1, m2: SymTab.Name; .) 109 = "IMPLEMENTATION" "MODULE" 110 GetIdent (. IF ~SymTab.BeginImpl(m1) THEN 111 SemError(201) END; 112 QbeGen.SetModule(m1); .) 113 ";" 114 { Import } 115 DeclSeq 116 [ "BEGIN" (. QbeGen.BeginInit(m1); .) 117 [ StatSeq ] (. QbeGen.EndInit; .) ] 118 "END" 119 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 120 SemError(202) END; 121 SymTab.EndUnit; .) . 122 ProgModule (. VAR m1, m2: SymTab.Name; .) 123 = "MODULE" 124 GetIdent (. IF ~SymTab.BeginProg(m1) THEN 125 SemError(200) END; 126 QbeGen.SetModule(m1); .) 127 [ Priority ] 128 ";" 129 { Import } 130 DeclSeq 131 [ "BEGIN" (. QbeGen.BeginBody; .) 132 [ StatSeq ] ] 133 "END" 134 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 135 SemError(202) END; 136 QbeGen.EndModule(m1); 137 SymTab.EndUnit; .) . 138 DeclSeq 139 = { ConstBlock | TypeBlock | VarBlock | ProcDecl ";" 140 | NestedModule ";" | ClassItem ";" } . 141 (* Local module, Wirth form. Parses + checks fully (own scope); 142 lowering waits for step 4, marked by one 230 at END. *) 143 NestedModule (. VAR m1, m2: SymTab.Name; .) 144 = "MODULE" 145 GetIdent (. IF ~SymTab.Enter(m1, 146 SymTab.KindModule) THEN 147 SemError(200) END; 148 SymTab.PushScope; .) 149 [ Priority ] 150 ";" 151 { Import } 152 [ Export ] 153 DeclSeq 154 [ "BEGIN" 155 [ StatSeq ] ] 156 "END" 157 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 158 SemError(202) END; 159 SymTab.PopScope; 160 SemError(230); .) . 161 Priority 162 = "[" integer "]" (. SemError(230); .) . 163 Export (. VAR nm: SymTab.Name; .) 164 = "EXPORT" (* names wire up in step 4 *) 165 [ "QUALIFIED" ] 166 GetIdent 167 { "," GetIdent } 168 ";" . 169 (* Imports (4.3): FROM materializes the names (unqualified use); 170 plain IMPORT only demands the module exists — qualified `L.x` 171 materializes on first use (Design). *) 172 (* Unknown modules stay unchecked stubs (legacy, so hand-written 173 import lines don't fail); a known module's missing export is 174 201. *) 175 Import (. VAR n: SymTab.Name; .) 176 = "FROM" 177 GetIdent 178 "IMPORT" 179 ImpList ";" 180 | "IMPORT" 181 ImpModList ";" . 182 ImpList (. VAR n: SymTab.Name; .) 183 = GetIdent (. IF SymTab.ModKnown(mod) 184 & ~SymTab.ImportFrom(mod, n) THEN 185 SemError(201) END; .) 186 { "," 187 GetIdent (. IF SymTab.ModKnown(mod) 188 & ~SymTab.ImportFrom(mod, n) THEN 189 SemError(201) END; .) } . 190 ImpModList (. VAR n: SymTab.Name; .) 191 = GetIdent 192 { "," GetIdent } . 193 (* Opaque TYPE declarations (definition modules). The targetless 194 alias resolves to InvalidType until step 4 completes it. *) 195 (* Scalar-phase TYPEs: named types, integer subranges, enumerations. 196 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231. 197 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *) 198 TypeBlock 199 = "TYPE" { TypeItem ";" | ClassItem ";" } . 200 TypeItem (. VAR n: SymTab.Name; 201 t, op: SymTab.TypeIndex; .) 202 = GetIdent (. op := SymTab.OpaqueBase(n); 203 IF op = SymTab.InvalidType THEN 204 IF ~SymTab.Enter(n, 205 SymTab.KindType) THEN 206 SemError(200) END 207 END; .) 208 ( "=" Type (. IF op # SymTab.InvalidType THEN 209 SymTab.SetTarget(op, t) 210 ELSE SymTab.SetSymType(n, t) 211 END; .) 212 | (. IF op # SymTab.InvalidType THEN 213 (* stays opaque *) 214 ELSIF ~isDef THEN 215 SemError(231) 216 ELSE SymTab.SetSymType(n, 217 SymTab.NewAlias()) END; .) ) . 218 Type 219 = TypeIdent 220 | Subrange 221 | Enum 222 | ArrayType 223 | SetType 224 | RecordType 225 | PointerType . 226 PointerType (. VAR base: SymTab.TypeIndex; .) 227 = "POINTER" "TO" Type(. t := SymTab.NewPtr(base); .) . 228 (* Arrays: "OF" without bounds is an open formal (allowed only 229 where allowOpen); "[lo..hi, ...]" nests bounded levels inside 230 out. Bounds are folded literals (int/char); anything else 230. 231 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *) 232 ArrayType 233 (. VAR elem: SymTab.TypeIndex; 234 ok: BOOLEAN; .) 235 = "ARRAY" 236 ( "OF" Type (. IF ~allowOpen THEN 237 SemError(230) END; 238 t := SymTab.NewOpenArray(elem); .) 239 | "[" (. SymTab.BoundBegin; ok := TRUE; .) 240 BoundPair 241 { "," BoundPair } 242 "]" "OF" Type 243 (. IF ok THEN 244 t := SymTab.NestArray(elem) 245 ELSE t := SymTab.InvalidType 246 END; .) ) . 247 BoundPair (. VAR tlo, thi: SymTab.TypeIndex; 248 qlo, qhi: QbeGen.QVal; 249 lo, hi: INTEGER; 250 cl, cl2: INTEGER; .) 251 = Expr ".." Expr 252 (. IF (tlo = SymTab.InvalidType) 253 OR (thi = SymTab.InvalidType) THEN 254 ok := FALSE 255 ELSE cl := SymTab.ClassOf(tlo); 256 cl2 := SymTab.ClassOf(thi); 257 IF ((cl # SymTab.ClInt) 258 & (cl # SymTab.ClChar)) 259 OR ((cl2 # SymTab.ClInt) 260 & (cl2 # SymTab.ClChar)) THEN 261 SemError(230); ok := FALSE 262 ELSIF ~SymTab.ConstInt(qlo, lo) 263 OR ~SymTab.ConstInt(qhi, hi) 264 OR (lo > hi) THEN 265 SemError(230); ok := FALSE 266 ELSIF ~SymTab.BoundAdd(lo, hi) THEN 267 SemError(230); ok := FALSE 268 END; 269 END; .) . 270 (* Sets: multi-word masks over bases ≤ 256 values (bool, char, 271 bounded subranges; enums wait for ordinals, INTEGER is 272 unbounded). Literals are SET OF [0..255]; assignment and 273 comparison across suitable bases are lenient (masks over min 274 words + zero-check extras), out-of-span literals are 222. *) 275 SetType (. VAR base: SymTab.TypeIndex; 276 blo, bhi, bspan: INTEGER; 277 bcls: INTEGER; .) 278 = "SET" "OF" Type 279 (. IF base = SymTab.InvalidType THEN 280 t := SymTab.InvalidType 281 ELSE bcls := 282 SymTab.ClassOf(base); 283 IF bcls = SymTab.ClBool THEN 284 blo := 0; bspan := 2 285 ELSIF bcls = SymTab.ClChar THEN 286 blo := 0; bspan := 256 287 ELSIF SymTab.SubBounds(base, 288 blo, bhi) THEN 289 bspan := bhi - blo + 1 290 ELSE bspan := 0 END; 291 IF (bspan <= 0) 292 OR (bspan > 256) THEN 293 SemError(230); 294 t := SymTab.InvalidType 295 ELSE t := SymTab.NewSet(base) 296 END 297 END; .) . 298 (* Records: flat blobs; array fields are pointers to static 299 descriptors (locked amendment), nested records inline. Field 300 offsets static and declaration-ordered. *) 301 RecordType (. VAR t2: SymTab.TypeIndex; .) 302 = "RECORD" (. t := SymTab.NewRecord(); .) 303 [ RecField { ";" RecField } ] 304 "END" . 305 RecField (. VAR n: SymTab.Name; 306 t2: SymTab.TypeIndex; .) 307 = RecIdents ":" Type(. SymTab.FixPendingF(rec, t2); .) . 308 RecIdents (. VAR n: SymTab.Name; .) 309 = GetIdent (. IF ~SymTab.FieldPending(rec, 310 n) THEN 311 SemError(200) END; .) 312 { "," GetIdent (. IF ~SymTab.FieldPending(rec, 313 n) THEN 314 SemError(200) END; .) } . 315 TypeIdent (. VAR n: SymTab.Name; 316 k: INTEGER; .) 317 = GetIdent (. IF ~SymTab.Lookup(n) THEN 318 SemError(201); 319 t := SymTab.InvalidType 320 ELSE k := SymTab.SymKind(n); 321 IF (k = SymTab.KindType) 322 OR (k = SymTab.KindPredef) THEN 323 t := SymTab.SymType(n) 324 ELSIF k = SymTab.KindImport THEN 325 t := SymTab.InvalidType 326 ELSE SemError(221); 327 t := SymTab.InvalidType 328 END 329 END; .) . 330 Subrange (. VAR tlo, thi: SymTab.TypeIndex; 331 qlo, qhi: QbeGen.QVal; 332 lo, hi: INTEGER; .) 333 = "[" Expr ".." Expr 334 (. IF (tlo = SymTab.InvalidType) 335 OR (thi = SymTab.InvalidType) THEN 336 t := SymTab.InvalidType 337 ELSIF (SymTab.ClassOf(tlo) # 338 SymTab.ClInt) 339 OR (SymTab.ClassOf(thi) # 340 SymTab.ClInt) THEN 341 SemError(230); 342 t := SymTab.InvalidType 343 ELSIF ~SymTab.ConstInt(qlo, lo) 344 OR ~SymTab.ConstInt(qhi, hi) 345 OR (lo > hi) THEN 346 SemError(230); 347 t := SymTab.InvalidType 348 ELSE t := SymTab.NewSubR(lo, hi) 349 END; .) 350 "]" . 351 Enum (. VAR n: SymTab.Name; .) 352 = "(" (. t := SymTab.NewEnum(); .) 353 GetIdent (. IF ~SymTab.Enter(n, 354 SymTab.KindConst) THEN 355 SemError(200) END; 356 SymTab.SetSymType(n, t); .) 357 { "," GetIdent (. IF ~SymTab.Enter(n, 358 SymTab.KindConst) THEN 359 SemError(200) END; 360 SymTab.SetSymType(n, t); .) } 361 ")" . 362 (* Clarion-form classes (docs/OOP.txt): declaration + single 363 inheritance + IMPLEMENTATION blocks. Scopes and member checks 364 now; lowering (vtable, dispatch, THIS) later — one 230 per 365 class/impl block. Methods end with ";" per the Table example 366 (not "," as in the sketch). No underscores in identifiers. *) 367 (* Single CLASS item in both loops: separating declaration from 368 IMPLEMENTATION at the loop level needs 2-token lookahead 369 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do. 370 The second token decides after CLASS is consumed. A misplaced 371 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the 372 whole unit ends 230 until lowering). *) 373 ClassItem 374 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) . 375 ClassRest (. VAR cn, m2, pn: SymTab.Name; 376 ct: SymTab.TypeIndex; .) 377 = GetIdent (. IF ~SymTab.Enter(cn, 378 SymTab.KindType) THEN 379 SemError(200) END; 380 ct := SymTab.NewClass(); 381 SymTab.SetSymType(cn, ct); 382 SymTab.PushClassScope(ct); .) 383 [ Parents ] 384 ";" 385 { ClassField ";" } 386 { MethodHeading ";" (. SymTab.CloseProc; 387 QbeGen.AbortFunc; .) } 388 "END" 389 GetIdent (. IF ~SymTab.Equal(cn, m2) THEN 390 SemError(202) END; 391 SymTab.PopScope; 392 SemError(230); .) . 393 Parents (. VAR p: SymTab.Name; .) 394 = "(" Parent1 395 { "," GetIdent

(. SemError(230); .) } 396 ")" . 397 Parent1 (. VAR p: SymTab.Name; 398 pt: SymTab.TypeIndex; .) 399 = GetIdent

(. IF ~SymTab.Lookup(p) THEN 400 SemError(201) 401 ELSE pt := SymTab.SymType(p); 402 IF SymTab.ClassOf(pt) # 403 SymTab.ClClass THEN 404 SemError(230) 405 ELSE SymTab.SetParent(ct, pt) 406 END 407 END; .) . 408 ClassField (. VAR n, rhs: SymTab.Name; 409 t: SymTab.TypeIndex; .) 410 = GetIdent 411 ( "=" GetIdent (. IF ~SymTab.Enter(n, 412 SymTab.KindConst) THEN 413 SemError(200) END; 414 IF SymTab.Lookup(rhs) THEN 415 SymTab.SetSymType(n, 416 SymTab.SymType(rhs)) 417 END; .) 418 | (. IF ~SymTab.FieldPending(ct, 419 n) THEN 420 SemError(200) END; .) 421 { "," GetIdent (. IF ~SymTab.FieldPending(ct, 422 n) THEN 423 SemError(200) END; .) } 424 ":" Type (. SymTab.FixPendingF(ct, t); .) ) . 425 MethodHeading (. VAR wantVirt: BOOLEAN; .) 426 = (. wantVirt := FALSE; .) 427 [ "VIRTUAL" (. wantVirt := TRUE; .) ] 428 ProcHeading (. IF wantVirt THEN 429 SymTab.MarkVirtual END; .) . 430 ClassImplRest (. VAR cn, m2: SymTab.Name; 431 ct: SymTab.TypeIndex; .) 432 = GetIdent (. IF ~SymTab.Lookup(cn) THEN 433 SemError(201); 434 ct := SymTab.InvalidType 435 ELSE ct := SymTab.SymType(cn); 436 IF SymTab.ClassOf(ct) # 437 SymTab.ClClass THEN 438 SemError(230); 439 ct := SymTab.InvalidType 440 END 441 END; 442 IF ct # 443 SymTab.InvalidType THEN 444 IF ~SymTab.PushClassMembers( 445 ct) THEN 446 SemError(230) END 447 END; .) 448 ";" { MethodImpl ";" } 449 [ "BEGIN" 450 [ StatSeq ] ] 451 "END" 452 GetIdent (. IF ~SymTab.Equal(cn, m2) THEN 453 SemError(202) END; 454 SymTab.PopScope; 455 SemError(230); .) . 456 MethodImpl (. VAR pn: SymTab.Name; .) 457 = (. QbeGen.SetNoEmit(TRUE); .) 458 MethodHeading ";" 459 (. IF (ct # 460 SymTab.InvalidType) 461 & ~SymTab.MethodExists(ct, 462 pn) THEN 463 SemError(201) END; .) 464 ( "FORWARD" (. SymTab.MarkFwd; 465 SymTab.CloseProc; .) 466 | Block (. SymTab.CloseProc; .) ) 467 (. QbeGen.AbortFunc; 468 QbeGen.SetNoEmit(FALSE); 469 SemError(230); .) . 470 ConstBlock 471 = "CONST" { ConstDecl ";" } . 472 ConstDecl (. VAR n: SymTab.Name; 473 t: SymTab.TypeIndex; 474 qv: QbeGen.QVal; 475 cls: INTEGER; .) 476 = GetIdent (. IF ~SymTab.Enter(n, 477 SymTab.KindConst) THEN 478 SemError(200) END; .) 479 "=" 480 Expr (. SymTab.SetSymType(n, t); 481 cls := SymTab.ClassOf(t); 482 IF cls = SymTab.ClStr THEN 483 SemError(230) 484 ELSIF ~QbeGen.IsImm(qv) THEN 485 SemError(230) END; 486 QbeGen.DeclConst(n, qv, t); .) . 487 VarBlock 488 = "VAR" { VarDecl ";" } . 489 VarDecl (. VAR nm: SymTab.Name; 490 t: SymTab.TypeIndex; 491 i: CARDINAL; 492 cls: INTEGER; .) 493 = VarIdents ":" 494 Type (. cls := SymTab.ClassOf(t); 495 IF (t # SymTab.InvalidType) 496 & (cls # SymTab.ClInt) 497 & (cls # SymTab.ClBool) 498 & (cls # SymTab.ClChar) 499 & (cls # SymTab.ClReal) 500 & (cls # SymTab.ClArray) 501 & (cls # SymTab.ClSet) 502 & (cls # SymTab.ClRecord) 503 & (cls # SymTab.ClPtr) THEN 504 SemError(230) END; 505 IF QbeGen.LocFull() THEN 506 SemError(233) END; 507 i := 0; 508 WHILE i < SymTab.PendCount() DO 509 SymTab.PendName(i, nm); 510 QbeGen.DeclVar(nm, t); 511 INC(i) 512 END; 513 SymTab.FixPending(t); .) . 514 VarIdents (. VAR n: SymTab.Name; .) 515 = GetIdent (. IF ~SymTab.EnterPending(n, 516 SymTab.KindVar) THEN 517 SemError(200) END; .) 518 { "," 519 GetIdent (. IF ~SymTab.EnterPending(n, 520 SymTab.KindVar) THEN 521 SemError(200) END; .) } . 522 ParIdents (. VAR n: SymTab.Name; .) 523 = GetIdent (. IF ~SymTab.EnterParam(n, isV) THEN 524 SemError(200) END; .) 525 { "," GetIdent (. IF ~SymTab.EnterParam(n, isV) THEN 526 SemError(200) END; .) } . 527 (* Procedure headings enter scopes/params/result and buffer the 528 QBE header; bodies lower to functions (4.1, module level only). 529 FORWARD marks; the body heading re-enters (signature compare 530 deferred). Nested procedures parse + check, lowering = 4.2. *) 531 ProcHeading (. VAR t: SymTab.TypeIndex; 532 mg: QbeGen.QVal; .) 533 = "PROCEDURE" 534 GetIdent (. IF ~SymTab.EnterProc(pn) THEN 535 IF ~SymTab.ReenterProc(pn) THEN 536 IF ~SymTab.ResumeProc(pn) THEN 537 SemError(200) END 538 END 539 END; 540 QbeGen.Mangled(pn, 541 SymTab.ProcUid(pn), mg); 542 QbeGen.BeginFunc(mg); .) 543 [ FormalParams ] 544 [ ":" TypeIdent (. SymTab.SetProcRes(t); 545 QbeGen.SetFuncRes(t); 546 IF (t # 547 SymTab.InvalidType) 548 & ((SymTab.ClassOf(t) 549 = SymTab.ClArray) 550 OR (SymTab.ClassOf(t) 551 = SymTab.ClRecord) 552 OR (SymTab.ClassOf(t) 553 = SymTab.ClSet) 554 OR (SymTab.ClassOf(t) 555 = SymTab.ClClass)) THEN 556 SemError(230) END; .) ] . 557 FormalParams 558 = "(" [ ParamSection { ";" ParamSection } ] ")" . 559 ParamSection (. VAR t: SymTab.TypeIndex; 560 nm: SymTab.Name; 561 i: CARDINAL; 562 isV: BOOLEAN; .) 563 = (. isV := FALSE; .) 564 [ "VAR" (. isV := TRUE; .) ] 565 ParIdents ":" Type (. i := 0; 566 WHILE i < SymTab.PendCount() DO 567 SymTab.PendName(i, nm); 568 IF ~QbeGen.FuncParam(nm, 569 isV, t) THEN 570 SemError(233) END; 571 INC(i) 572 END; 573 SymTab.FixPending(t); 574 IF ~isV 575 & SymTab.IsOpenArray(t) THEN 576 SemError(230) END; .) . 577 (* Nested procedures lower like top-level ones (4.2): the 578 static link gives them their parent's frame. Methods keep 579 parse-now/230-later. *) 580 ProcDecl (. VAR pn: SymTab.Name; .) 581 = ProcHeading ";" 582 ( "FORWARD" (. SymTab.MarkFwd; 583 SymTab.CloseProc; 584 QbeGen.AbortFunc; .) 585 | "EXTERNAL" (. SymTab.MarkExternal(""); 586 SymTab.CloseProc; 587 QbeGen.AbortFunc; .) 588 | (. QbeGen.EndFuncHeader; .) 589 Block (. SymTab.CloseProc; 590 QbeGen.EndFunc( 591 SymTab.ProcRes(pn)); .) ) . 592 Block (. VAR m2: SymTab.Name; .) 593 = DeclSeq 594 [ "BEGIN" 595 [ StatSeq ] ] 596 "END" 597 GetIdent (. IF ~SymTab.Equal(pn, m2) THEN 598 SemError(202) END; .) . 599 StatSeq 600 = Statement { ";" Statement } . 601 Statement (. VAR lx: QbeGen.QVal; .) 602 = AssOrCall 603 | IfStat 604 | WhileStat 605 | RepeatStat 606 | LoopStat 607 | ForStat 608 | CaseStat 609 | WithStat 610 | ReturnStat 611 | NewStat 612 | DisposeStat 613 | "EXIT" (. IF QbeGen.TopLoop(lx) THEN 614 QbeGen.Jmp(lx) 615 ELSE SemError(230) END; .) . 616 (* NEW/DISPOSE as builtin statements (no call syntax until step 4). 617 Targets are pointer designators; DISPOSE nils afterwards (safer 618 than Wirth-undefined; documented). DISPOSE is shallow. *) 619 NewStat (. VAR dt: SymTab.TypeIndex; 620 dk: INTEGER; 621 qd, qm: QbeGen.QVal; 622 qn: SymTab.Name; 623 sfx: BOOLEAN; 624 bt: SymTab.TypeIndex; .) 625 = "NEW" "(" Design ")" 626 (. IF dt = SymTab.InvalidType THEN 627 ELSIF (dk # SymTab.KindVar) 628 & (dk # SymTab.KindParam) 629 & (dk # SymTab.KindField) THEN 630 SemError(210) 631 ELSIF SymTab.ClassOf(dt) # 632 SymTab.ClPtr THEN 633 SemError(219) 634 ELSE bt := SymTab.PtrBase(dt); 635 IF bt # 636 SymTab.InvalidType THEN 637 QbeGen.NewHeap(bt, qm); 638 QbeGen.InitHeap(qm, bt); 639 IF sfx 640 OR (dk = 641 SymTab.KindField) THEN 642 QbeGen.ElemStore(qd, qm, 643 dt) 644 ELSE QbeGen.StorePtr(qn, 645 qm) 646 END 647 END 648 END; .) . 649 DisposeStat (. VAR dt: SymTab.TypeIndex; 650 dk: INTEGER; 651 qd, qv: QbeGen.QVal; 652 qn: SymTab.Name; 653 sfx: BOOLEAN; .) 654 = "DISPOSE" "(" Design ")" 655 (. IF dt = SymTab.InvalidType THEN 656 ELSIF (dk # SymTab.KindVar) 657 & (dk # SymTab.KindParam) 658 & (dk # SymTab.KindField) THEN 659 SemError(210) 660 ELSIF SymTab.ClassOf(dt) # 661 SymTab.ClPtr THEN 662 SemError(219) 663 ELSE 664 IF sfx 665 OR (dk = 666 SymTab.KindField) THEN 667 QbeGen.ElemLoad(qd, dt, 668 qv) 669 ELSE QbeGen.LoadPtr(qn, qv) 670 END; 671 QbeGen.FreeHeap(qv); 672 IF sfx 673 OR (dk = 674 SymTab.KindField) THEN 675 QbeGen.ElemStore(qd, "0", 676 dt) 677 ELSE QbeGen.StorePtr(qn, 678 "0") 679 END 680 END; .) . 681 (* WITH pushes each record's fields (inner wins) plus its base 682 address; field designators resolve through both stacks. *) 683 WithStat (. VAR nW: CARDINAL; .) 684 = "WITH" (. nW := 0; .) 685 WithItem { "," WithItem } 686 "DO" StatSeq "END" 687 (. WHILE nW > 0 DO 688 SymTab.PopScope; 689 QbeGen.PopWith; 690 DEC(nW) 691 END; .) . 692 WithItem (. VAR dt: SymTab.TypeIndex; 693 dk: INTEGER; 694 qd, qe: QbeGen.QVal; 695 qn: SymTab.Name; 696 sfx: BOOLEAN; .) 697 = Design 698 (. IF dt = SymTab.InvalidType THEN 699 ELSIF (SymTab.ClassOf(dt) # 700 SymTab.ClRecord) 701 & (SymTab.ClassOf(dt) # 702 SymTab.ClClass) THEN 703 SemError(215) 704 ELSIF SymTab.PushRecord(dt) THEN 705 QbeGen.PushWith(qd); 706 INC(nW) 707 END; .) . 708 (* Assignment or procedure-statement call (4.1, module level). 709 Bare `P;` is a syntax error; function-as-statement is 233. *) 710 AssOrCall (. VAR dt, et: SymTab.TypeIndex; 711 dk: INTEGER; 712 qd, qe, qt: QbeGen.QVal; 713 qn: SymTab.Name; 714 ct2, res0: SymTab.TypeIndex; 715 q2, mg0: QbeGen.QVal; 716 isR, conv: BOOLEAN; 717 called, sfx: BOOLEAN; .) 718 = Design 719 ( ":=" 720 Expr (. IF (dt # SymTab.InvalidType) 721 & (dk # SymTab.KindVar) 722 & (dk # SymTab.KindParam) 723 & (dk # SymTab.KindField) THEN 724 SemError(210) 725 ELSIF ~SymTab.Assignable(et, 726 dt) THEN 727 SemError(210) 728 ELSIF (dt # SymTab.InvalidType) 729 & (SymTab.ClassOf(dt) = 730 SymTab.ClClass) THEN 731 SemError(230) END; 732 isR := (dt # 733 SymTab.InvalidType) 734 & (SymTab.ClassOf(dt) 735 = SymTab.ClReal); 736 conv := isR 737 & SymTab.IsIntFamily(et); 738 IF ((dk = SymTab.KindVar) 739 OR (dk = SymTab.KindParam) 740 OR (dk = SymTab.KindField)) 741 & (dt # SymTab.InvalidType) 742 & (et # SymTab.InvalidType) 743 & (SymTab.ClassOf(dt) # 744 SymTab.ClClass) THEN 745 IF sfx 746 OR (dk = SymTab.KindField) THEN 747 IF SymTab.ClassOf(dt) = 748 SymTab.ClArray THEN 749 QbeGen.CopyArray(qd, qe, 750 dt) 751 ELSIF SymTab.ClassOf(dt) = 752 SymTab.ClSet THEN 753 QbeGen.CopySet(qd, qe, 754 SymTab.SetWords(dt), 755 SymTab.SetWords(et)) 756 ELSIF SymTab.ClassOf(dt) = 757 SymTab.ClRecord THEN 758 QbeGen.CopyRecord(qd, qe, 759 dt) 760 ELSIF conv THEN 761 QbeGen.ConvIR(qe, qt); 762 QbeGen.ElemStore(qd, qt, 763 dt) 764 ELSE QbeGen.ElemStore(qd, qe, 765 dt) 766 END 767 ELSIF SymTab.ClassOf(dt) = 768 SymTab.ClArray THEN 769 QbeGen.CopyArray(qd, qe, dt) 770 ELSIF SymTab.ClassOf(dt) = 771 SymTab.ClSet THEN 772 QbeGen.CopySet(qd, qe, 773 SymTab.SetWords(dt), 774 SymTab.SetWords(et)) 775 ELSIF SymTab.ClassOf(dt) = 776 SymTab.ClRecord THEN 777 QbeGen.CopyRecord(qd, qe, dt) 778 ELSIF SymTab.ClassOf(dt) = 779 SymTab.ClPtr THEN 780 QbeGen.StorePtr(qn, qe) 781 ELSIF conv THEN 782 QbeGen.ConvIR(qe, qt); 783 QbeGen.StoreVar(qn, qt, TRUE) 784 ELSE 785 QbeGen.StoreVar(qn, qe, isR) 786 END 787 END; .) 788 | ArgList 789 | (* bare `P;`: proper parameterless 790 procedure call; anything else 791 here is 233 (was a bare syntax 792 error before 4.2) *) 793 (. IF (dk = SymTab.KindProc) 794 & ~sfx THEN 795 res0 := SymTab.ProcRes(qn); 796 IF res0 # 797 SymTab.InvalidType THEN 798 SemError(233) 799 ELSIF SymTab.ProcNPar(qn) # 800 0 THEN 801 SemError(233) 802 ELSE QbeGen.Mangled(qn, 803 SymTab.ProcUid(qn), mg0); 804 QbeGen.CallBegin(mg0, 805 res0, 806 SymTab.ProcDepthOf(qn), 807 SymTab.IsExternal(qn)); 808 QbeGen.CallEnd(FALSE, q2) 809 END 810 ELSE SemError(233) 811 END; .) ) . 812 (* Actual-parameter list shared by statement and expression calls. 813 want selects CallEnd's result handling; t/q carry the call 814 value (statement calls discard). Arity/type failures are 233; 815 evaluation code still emits so the .ssa stays assembleable. *) 816 ArgList (. VAR i: CARDINAL; 819 res: SymTab.TypeIndex; 820 mg: QbeGen.QVal; 821 ok: BOOLEAN; .) 822 = "(" (. called := TRUE; 823 res := SymTab.ProcRes(pn); 824 ok := TRUE; 825 IF SymTab.SymKind(pn) # 826 SymTab.KindProc THEN 827 SemError(233); ok := FALSE 828 ELSE QbeGen.Mangled(pn, 829 SymTab.ProcUid(pn), mg); 830 QbeGen.CallBegin(mg, res, 831 SymTab.ProcDepthOf(pn), 832 SymTab.IsExternal(pn)) 833 END; 834 i := 0; .) 835 [ ActParam (. INC(i); .) 836 { "," ActParam (. INC(i); .) } ] 837 ")" (. IF ok THEN 838 IF i # 839 SymTab.ProcNPar(pn) THEN 840 SemError(233); ok := FALSE 841 END 842 END; 843 IF ~ok THEN 844 t := SymTab.InvalidType; 845 QbeGen.CopyOp("0", q) 846 ELSIF want THEN 847 IF res = 848 SymTab.InvalidType THEN 849 SemError(233); 850 t := SymTab.InvalidType; 851 QbeGen.CopyOp("0", q) 852 ELSE t := res; 853 QbeGen.CallEnd(TRUE, q) 854 END 855 ELSE 856 IF res # 857 SymTab.InvalidType THEN 858 SemError(233) 859 END; 860 t := SymTab.InvalidType; 861 QbeGen.CopyOp("0", q); 862 QbeGen.CallEnd(FALSE, q) 863 END; .) . 864 (* One actual: VAR formals take recorded designator addresses 865 (233 otherwise); value formals take converted expressions. *) 866 ActParam(. VAR at, ft: SymTab.TypeIndex; 867 qe, qa, qt: QbeGen.QVal; 868 isV, conv: BOOLEAN; .) 869 = Expr (. ft := SymTab.ParamType(pn, i); 870 isV := SymTab.ParamIsVar(pn, i); 871 IF (at = SymTab.InvalidType) 872 OR (ft = 873 SymTab.InvalidType) THEN 874 ELSIF isV THEN 875 IF ~QbeGen.AddrOfVal(qe, 876 qa) THEN 877 SemError(233) 878 ELSIF ~SymTab.VarParamOk(at, 879 ft) THEN 880 SemError(233) 881 ELSIF ~QbeGen.CallArg(qa, 882 "l") THEN 883 SemError(233) 884 END 885 ELSE 886 IF ~SymTab.Assignable(at, 887 ft) THEN 888 SemError(233) 889 ELSE 890 conv := (SymTab.ClassOf( 891 ft) = SymTab.ClReal) 892 & SymTab.IsIntFamily(at); 893 IF conv THEN 894 QbeGen.ConvIR(qe, qt); 895 IF ~QbeGen.CallArg(qt, 896 "d") THEN 897 SemError(233) 898 END 899 ELSIF ~QbeGen.CallArg(qe, 900 QbeGen.ArgClass(ft)) THEN 901 SemError(233) 902 END 903 END 904 END; .) . 905 IfStat (. VAR t: SymTab.TypeIndex; 906 q, lThen, lElse, lEnd: 907 QbeGen.QVal; 908 hasElse: BOOLEAN; .) 909 = "IF" (. hasElse := FALSE; .) 910 Expr (. IF ~SymTab.BoolCheck(t) THEN 911 SemError(214) END; 912 QbeGen.NewLabel(lThen); 913 QbeGen.NewLabel(lElse); 914 QbeGen.NewLabel(lEnd); 915 QbeGen.Jnz(q, lThen, lElse); 916 QbeGen.EmitLabel(lThen); .) 917 "THEN" StatSeq (. QbeGen.Jmp(lEnd); .) 918 { "ELSIF" (. QbeGen.EmitLabel(lElse); 919 QbeGen.NewLabel(lElse); .) 920 Expr (. IF ~SymTab.BoolCheck(t) THEN 921 SemError(214) END; 922 QbeGen.NewLabel(lThen); 923 QbeGen.Jnz(q, lThen, lElse); 924 QbeGen.EmitLabel(lThen); .) 925 "THEN" StatSeq (. QbeGen.Jmp(lEnd); .) } 926 [ "ELSE" (. QbeGen.EmitLabel(lElse); 927 hasElse := TRUE; .) 928 StatSeq ] 929 "END" (. IF hasElse THEN 930 QbeGen.EmitLabel(lEnd) 931 ELSE QbeGen.EmitLabel(lElse); 932 QbeGen.EmitLabel(lEnd) 933 END; .) . 934 WhileStat (. VAR t: SymTab.TypeIndex; 935 q, lTop, lBody, lEnd: 936 QbeGen.QVal; .) 937 = "WHILE" (. QbeGen.NewLabel(lTop); 938 QbeGen.NewLabel(lBody); 939 QbeGen.NewLabel(lEnd); 940 QbeGen.EmitLabel(lTop); .) 941 Expr (. IF ~SymTab.BoolCheck(t) THEN 942 SemError(214) END; 943 QbeGen.Jnz(q, lBody, lEnd); 944 QbeGen.EmitLabel(lBody); .) 945 "DO" StatSeq (. QbeGen.Jmp(lTop); .) 946 "END" (. QbeGen.EmitLabel(lEnd); .) . 947 RepeatStat (. VAR t: SymTab.TypeIndex; 948 q, lTop, lEnd: QbeGen.QVal; .) 949 = "REPEAT" (. QbeGen.NewLabel(lTop); 950 QbeGen.NewLabel(lEnd); 951 QbeGen.EmitLabel(lTop); .) 952 StatSeq 953 "UNTIL" Expr (. IF ~SymTab.BoolCheck(t) THEN 954 SemError(214) END; 955 QbeGen.Jnz(q, lEnd, lTop); 956 QbeGen.EmitLabel(lEnd); .) . 957 LoopStat (. VAR lTop, lEnd: QbeGen.QVal; .) 958 = "LOOP" (. QbeGen.NewLabel(lTop); 959 QbeGen.NewLabel(lEnd); 960 QbeGen.PushLoop(lEnd); 961 QbeGen.EmitLabel(lTop); .) 962 StatSeq 963 "END" (. QbeGen.Jmp(lTop); 964 QbeGen.PopLoop; 965 QbeGen.EmitLabel(lEnd); .) . 966 (* FOR with static-sign BY (literal, non-zero; 220 otherwise). 967 Runtime direction would need a compare-select; the literal 968 sign picks cslew/csegew at "DO" time. *) 969 ForStat (. VAR lv: SymTab.Name; 970 tlo, thi, tby: 971 SymTab.TypeIndex; 972 qlo, qhi, qby, qt, qk, qb: 973 QbeGen.QVal; 974 lTop, lBody, lEnd: 975 QbeGen.QVal; 976 by: INTEGER; 977 ok: BOOLEAN; .) 978 = "FOR" (. by := 1; .) 979 GetIdent (. ok := SymTab.Lookup(lv); 980 IF ~ok THEN 981 SemError(201) 982 ELSIF (SymTab.SymKind(lv) # 983 SymTab.KindVar) 984 & (SymTab.SymKind(lv) # 985 SymTab.KindParam) THEN 986 SemError(220); ok := FALSE 987 ELSIF ~SymTab.IsIntFamily( 988 SymTab.SymType(lv)) THEN 989 SemError(220); ok := FALSE 990 END; .) 991 ":=" Expr (. IF ~SymTab.IsIntFamily(tlo) THEN 992 SemError(220); ok := FALSE 993 END; .) 994 "TO" Expr (. IF ~SymTab.IsIntFamily(thi) THEN 995 SemError(220); ok := FALSE 996 END; .) 997 [ "BY" Expr (. IF (tby # 998 SymTab.InvalidType) 999 & ~SymTab.IsIntFamily(tby) THEN 1000 SemError(220); ok := FALSE 1001 END; 1002 IF ~SymTab.ConstInt(qby, by) THEN 1003 SemError(230); by := 1 1004 ELSIF by = 0 THEN 1005 SemError(220); by := 1 1006 END; .) ] 1007 "DO" (. IF ok THEN 1008 QbeGen.StoreVar(lv, qlo, 1009 FALSE) END; 1010 QbeGen.NewLabel(lTop); 1011 QbeGen.NewLabel(lBody); 1012 QbeGen.NewLabel(lEnd); 1013 QbeGen.EmitLabel(lTop); 1014 QbeGen.LoadVar(lv, FALSE, qt); 1015 QbeGen.NewTemp(qk); 1016 IF by > 0 THEN 1017 QbeGen.Op3("cslew", qk, 1018 qt, qhi, FALSE) 1019 ELSE QbeGen.Op3("csgew", qk, 1020 qt, qhi, FALSE) 1021 END; 1022 QbeGen.Jnz(qk, lBody, lEnd); 1023 QbeGen.EmitLabel(lBody); .) 1024 StatSeq 1025 "END" (. IF ok THEN 1026 QbeGen.LoadVar(lv, FALSE, 1027 qt); 1028 QbeGen.IntStr(by, qb); 1029 QbeGen.NewTemp(qk); 1030 QbeGen.Op3("add", qk, 1031 qt, qb, FALSE); 1032 QbeGen.StoreVar(lv, qk, 1033 FALSE) END; 1034 QbeGen.Jmp(lTop); 1035 QbeGen.EmitLabel(lEnd); .) . 1036 CaseStat (. VAR tsel: SymTab.TypeIndex; 1037 qsel, lEnd: QbeGen.QVal; .) 1038 = "CASE" Expr (. QbeGen.NewLabel(lEnd); .) 1039 "OF" CaseAlt 1040 { "|" CaseAlt } 1041 [ "ELSE" StatSeq ] 1042 "END" (. QbeGen.EmitLabel(lEnd); .) . 1043 (* Compare-chain lowering: each alternative ends its match-tests 1044 with "jmp lAfter", so the no-match fallthrough skips the body: 1045 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd; 1046 lAfter:". Falls into the next alternative, ELSE, or END. *) 1047 CaseAlt (. VAR lBody, lAfter: QbeGen.QVal; .) 1049 = (. QbeGen.NewLabel(lBody); 1050 QbeGen.NewLabel(lAfter); .) 1051 CaseLabel 1052 { "," CaseLabel } 1053 ":" (. QbeGen.Jmp(lAfter); 1054 QbeGen.EmitLabel(lBody); .) 1055 StatSeq (. QbeGen.Jmp(lEnd); 1056 QbeGen.EmitLabel(lAfter); .) . 1057 CaseLabel (. VAR t2, t3: SymTab.TypeIndex; 1059 q2, q3, qc, qd, qe: 1060 QbeGen.QVal; 1061 lNext: QbeGen.QVal; .) 1062 = Expr (. IF (t2 # 1063 SymTab.InvalidType) 1064 & (tsel # 1065 SymTab.InvalidType) 1066 & ((SymTab.ClassOf(t2) = 1067 SymTab.ClSet) 1068 OR (SymTab.ClassOf(tsel) = 1069 SymTab.ClSet)) THEN 1070 SemError(230) 1071 ELSIF (t2 # 1072 SymTab.InvalidType) 1073 & (tsel # 1074 SymTab.InvalidType) 1075 & ~SymTab.EqCheck(t2, 1076 tsel) THEN 1077 SemError(213) END; 1078 IF ~QbeGen.IsImm(q2) THEN 1079 SemError(230); 1080 QbeGen.CopyOp("0", q2) 1081 END; 1082 QbeGen.NewLabel(lNext); 1083 QbeGen.Cmp(SymTab.OpEq, 1084 qsel, q2, qc, FALSE); 1085 QbeGen.Jnz(qc, lBody, lNext); 1086 QbeGen.EmitLabel(lNext); .) 1087 [ ".." Expr (. IF (t3 # 1088 SymTab.InvalidType) 1089 & (tsel # 1090 SymTab.InvalidType) 1091 & ~SymTab.EqCheck(t3, 1092 tsel) THEN 1093 SemError(213) END; 1094 IF ~QbeGen.IsImm(q3) THEN 1095 SemError(230); 1096 QbeGen.CopyOp("0", q3) 1097 END; 1098 QbeGen.Cmp(SymTab.OpGe, 1099 qsel, q2, qc, FALSE); 1100 QbeGen.Cmp(SymTab.OpLe, 1101 qsel, q3, qd, FALSE); 1102 QbeGen.NewTemp(qe); 1103 QbeGen.Op3("and", qe, qc, qd, 1104 FALSE); 1105 QbeGen.NewLabel(lNext); 1106 QbeGen.Jnz(qe, lBody, lNext); 1107 QbeGen.EmitLabel(lNext); .) ] . 1108 ReturnStat (. VAR t: SymTab.TypeIndex; 1109 q, qt: QbeGen.QVal; 1110 res: SymTab.TypeIndex; 1111 hadE, conv: BOOLEAN; .) 1112 = "RETURN" (. hadE := FALSE; .) 1113 [ Expr (. hadE := TRUE; .) ] 1114 (. conv := FALSE; 1115 IF ~SymTab.InProc() THEN 1116 SemError(232) 1117 ELSE res := SymTab.CurRes(); 1118 IF ~hadE THEN 1119 IF res # 1120 SymTab.InvalidType THEN 1121 SemError(232) 1122 ELSE QbeGen.EmitRet(q, 1123 FALSE) 1124 END 1125 ELSIF (res = 1126 SymTab.InvalidType) 1127 OR (t # 1128 SymTab.InvalidType) 1129 & ~SymTab.Assignable(t, 1130 res) THEN 1131 SemError(232) 1132 ELSE 1133 conv := (SymTab.ClassOf( 1134 res) = SymTab.ClReal) 1135 & SymTab.IsIntFamily(t); 1136 IF conv THEN 1137 QbeGen.ConvIR(q, qt); 1138 QbeGen.EmitRet(qt, TRUE) 1139 ELSE QbeGen.EmitRet(q, TRUE) 1140 END 1141 END 1142 END; .) . 1143 (* Designator: scalar loads, array addresses, and index suffixes. 1144 Each index descends one level (bounds-checked, trap on breach); 1145 nested levels reload the inner descriptor address. q ends as the 1146 value (scalars), the descriptor address (plain arrays), or the 1147 element address (indexed); sfx marks the indexed form. *) 1148 Design 1150 (. VAR n, fn, mal: SymTab.Name; 1151 cls: INTEGER; 1152 curT, it, eT, bt: 1153 SymTab.TypeIndex; 1154 iq, ql, qlo, qhi, qe: 1155 QbeGen.QVal; 1156 lo, hi: INTEGER; 1157 fo: INTEGER; 1158 isOpen: BOOLEAN; 1159 qb: QbeGen.QVal; .) 1160 = GetIdent (. QbeGen.CopyOp(n, qn); 1161 sfx := FALSE; 1162 IF ~SymTab.Lookup(n) THEN 1163 SemError(201); 1164 t := SymTab.InvalidType; 1165 k := -1; 1166 QbeGen.CopyOp("0", q) 1167 ELSE 1168 t := SymTab.SymType(n); 1169 k := SymTab.SymKind(n); 1170 IF k = SymTab.KindConst THEN 1171 IF SymTab.Equal(n, 1172 "TRUE") THEN 1173 t := SymTab.BoolType(); 1174 QbeGen.CopyOp("1", q) 1175 ELSIF SymTab.Equal(n, 1176 "FALSE") THEN 1177 t := SymTab.BoolType(); 1178 QbeGen.CopyOp("0", q) 1179 ELSIF SymTab.Equal(n, 1180 "NIL") THEN 1181 QbeGen.CopyOp("0", q) 1182 ELSE 1183 cls := 1184 SymTab.ClassOf(t); 1185 IF (t # 1186 SymTab.InvalidType) 1187 & ((cls = SymTab.ClInt) 1188 OR (cls 1189 = SymTab.ClChar) 1190 OR (cls 1191 = SymTab.ClReal) 1192 OR (cls 1193 = SymTab.ClNil)) THEN 1194 IF cls = SymTab.ClNil THEN 1195 QbeGen.CopyOp("0", q) 1196 ELSE 1197 QbeGen.LoadVar(n, 1198 cls = SymTab.ClReal, 1199 q) 1200 END 1201 ELSE 1202 IF t # 1203 SymTab.InvalidType THEN 1204 SemError(230) 1205 END; 1206 QbeGen.CopyOp("0", q) 1207 END 1208 END 1209 ELSIF (k = SymTab.KindVar) 1210 OR (k = SymTab.KindParam) THEN 1211 cls := 1212 SymTab.ClassOf(t); 1213 IF (cls = SymTab.ClInt) 1214 OR (cls = SymTab.ClBool) 1215 OR (cls = SymTab.ClChar) 1216 OR (cls 1217 = SymTab.ClReal) THEN 1218 QbeGen.LoadVar(n, 1219 cls = SymTab.ClReal, q) 1220 ELSIF cls = SymTab.ClPtr THEN 1221 QbeGen.LoadPtr(n, q) 1222 ELSIF (cls 1223 = SymTab.ClArray) 1224 OR (cls 1225 = SymTab.ClSet) 1226 OR (cls 1227 = SymTab.ClRecord) 1228 OR (cls 1229 = SymTab.ClClass) THEN 1230 QbeGen.AddrOf(n, q) 1231 ELSE SemError(230); 1232 QbeGen.CopyOp("0", q) 1233 END 1234 ELSE QbeGen.CopyOp("0", q); 1235 IF k = SymTab.KindImport THEN 1236 SemError(230) 1237 ELSIF k = 1238 SymTab.KindProc THEN 1239 (* bare procedure name: 1240 a following ArgList 1241 makes it a call; 1242 otherwise Fact 1243 reports 230 *) 1244 ELSE 1245 IF k = SymTab.KindField THEN 1246 IF QbeGen.TopWith(qb) THEN 1247 fo := 1248 SymTab.FieldOffset( 1249 SymTab.FieldOwner(n), 1250 n); 1251 QbeGen.FieldAddr(qb, 1252 fo, q); 1253 sfx := TRUE 1254 ELSE SemError(230); 1255 QbeGen.CopyOp("0", q) 1256 END 1257 END 1258 END 1259 END 1260 END; .) 1261 { "[" Expr 1262 (. IF t = SymTab.InvalidType THEN 1263 ELSIF SymTab.ClassOf(t) # 1264 SymTab.ClArray THEN 1265 SemError(217); 1266 t := SymTab.InvalidType 1267 ELSIF ~SymTab.IsIntFamily(it) 1268 & (SymTab.ClassOf(it) # 1269 SymTab.ClChar) THEN 1270 SemError(218); 1271 t := SymTab.InvalidType 1272 ELSE 1273 QbeGen.WidenIndex(iq, ql); 1274 isOpen := 1275 SymTab.IsOpenArray(t); 1276 IF isOpen THEN 1277 QbeGen.CopyOp("0", qlo); 1278 QbeGen.OpenHi(q, qhi) 1279 ELSE 1280 lo := SymTab.ArrayLo(t); 1281 hi := SymTab.ArrayHi(t); 1282 QbeGen.IntStr(lo, qlo); 1283 QbeGen.IntStr(hi, qhi) 1284 END; 1285 QbeGen.CheckRange(ql, qlo, 1286 qhi); 1287 eT := SymTab.ArrayElem(t); 1288 QbeGen.ElemAddr(q, ql, qlo, 1289 t, qe); 1290 IF SymTab.ClassOf(eT) = 1291 SymTab.ClArray THEN 1292 QbeGen.ElemLoad(qe, eT, q) 1293 ELSE QbeGen.CopyOp(qe, q) 1294 END; 1295 t := eT; sfx := TRUE 1296 END; .) 1297 { "," Expr 1298 (. IF t = SymTab.InvalidType THEN 1299 ELSIF SymTab.ClassOf(t) # 1300 SymTab.ClArray THEN 1301 SemError(217); 1302 t := SymTab.InvalidType 1303 ELSIF ~SymTab.IsIntFamily(it) 1304 & (SymTab.ClassOf(it) # 1305 SymTab.ClChar) THEN 1306 SemError(218); 1307 t := SymTab.InvalidType 1308 ELSE 1309 QbeGen.WidenIndex(iq, ql); 1310 isOpen := 1311 SymTab.IsOpenArray(t); 1312 IF isOpen THEN 1313 QbeGen.CopyOp("0", qlo); 1314 QbeGen.OpenHi(q, qhi) 1315 ELSE 1316 lo := SymTab.ArrayLo(t); 1317 hi := SymTab.ArrayHi(t); 1318 QbeGen.IntStr(lo, qlo); 1319 QbeGen.IntStr(hi, qhi) 1320 END; 1321 QbeGen.CheckRange(ql, qlo, 1322 qhi); 1323 eT := SymTab.ArrayElem(t); 1324 QbeGen.ElemAddr(q, ql, qlo, 1325 t, qe); 1326 IF SymTab.ClassOf(eT) = 1327 SymTab.ClArray THEN 1328 QbeGen.ElemLoad(qe, eT, q) 1329 ELSE QbeGen.CopyOp(qe, q) 1330 END; 1331 t := eT; sfx := TRUE 1332 END; .) } 1333 "]" 1334 | "." GetIdent 1335 (. IF k = SymTab.KindModule THEN 1336 (* qualified L.x: materialize 1337 the export, then load it *) 1338 IF ~SymTab.MaterializeAlias(n, 1339 fn, mal) THEN 1340 SemError(201); 1341 t := SymTab.InvalidType; 1342 QbeGen.CopyOp("0", q) 1343 ELSE 1344 QbeGen.CopyOp(mal, qn); 1345 t := SymTab.SymType(mal); 1346 k := SymTab.SymKind(mal); 1347 sfx := FALSE; 1348 IF k = SymTab.KindProc THEN 1349 (* call: ArgList supplies 1350 the value *) 1351 QbeGen.CopyOp("0", q) 1352 ELSIF ~QbeGen.LoadDesignator( 1353 mal, t, k, q) THEN 1354 SemError(230); 1355 QbeGen.CopyOp("0", q) 1356 END 1357 END 1358 ELSIF t = SymTab.InvalidType THEN 1359 ELSIF (SymTab.ClassOf(t) # 1360 SymTab.ClRecord) 1361 & (SymTab.ClassOf(t) # 1362 SymTab.ClClass) THEN 1363 SemError(215); 1364 t := SymTab.InvalidType 1365 ELSIF ~SymTab.FieldExists(t, 1366 fn) THEN 1367 SemError(216); 1368 t := SymTab.InvalidType 1369 ELSE 1370 fo := SymTab.FieldOffset(t, 1371 fn); 1372 t := SymTab.FieldType(t, fn); 1373 QbeGen.FieldAddr(q, fo, qe); 1374 IF SymTab.ClassOf(t) = 1375 SymTab.ClArray THEN 1376 QbeGen.ElemLoad(qe, t, q) 1377 ELSE QbeGen.CopyOp(qe, q) 1378 END; 1379 sfx := TRUE 1380 END; .) 1381 | "^" 1382 (. IF t = SymTab.InvalidType THEN 1383 ELSIF SymTab.ClassOf(t) # 1384 SymTab.ClPtr THEN 1385 SemError(219); 1386 t := SymTab.InvalidType 1387 ELSE 1388 bt := SymTab.PtrBase(t); 1389 IF bt = SymTab.InvalidType THEN 1390 ELSE 1391 IF sfx THEN 1392 QbeGen.ElemLoad(q, t, 1393 qb); 1394 QbeGen.CopyOp(qb, q) 1395 END; 1396 t := bt; 1397 IF (SymTab.ClassOf(bt) = 1398 SymTab.ClInt) 1399 OR (SymTab.ClassOf(bt) = 1400 SymTab.ClBool) 1401 OR (SymTab.ClassOf(bt) = 1402 SymTab.ClChar) 1403 OR (SymTab.ClassOf(bt) = 1404 SymTab.ClReal) THEN 1405 sfx := TRUE 1406 ELSE sfx := FALSE 1407 END 1408 END 1409 END; .) } . 1410 Expr 1411 (. VAR t2: SymTab.TypeIndex; 1412 op: INTEGER; 1413 q2, qt: QbeGen.QVal; 1414 isR: BOOLEAN; .) 1415 = SimExpr 1416 [ Rel SimExpr 1417 (. IF op = SymTab.OpIn THEN 1418 IF SymTab.InCheck(t, t2) THEN 1419 IF (t = SymTab.InvalidType) 1420 OR (t2 = SymTab.InvalidType) THEN 1421 t := SymTab.BoolType(); QbeGen.CopyOp("0", q) 1422 ELSE 1423 QbeGen.InSet(q, q2, SymTab.SetBaseLo(t2), 1424 SymTab.SetCount(t2), qt); 1425 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q) 1426 END 1427 ELSE SemError(222); t := SymTab.InvalidType; 1428 QbeGen.CopyOp("0", q) 1429 END 1430 ELSIF SymTab.RelCheck(t, t2, op) THEN 1431 IF (t = SymTab.InvalidType) 1432 OR (t2 = SymTab.InvalidType) THEN 1433 t := SymTab.BoolType(); QbeGen.CopyOp("0", q) 1434 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr) 1435 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN 1436 IF (op # SymTab.OpEq) & (op # SymTab.OpNeq1) 1437 & (op # SymTab.OpNeq2) THEN 1438 SemError(213); t := SymTab.InvalidType; 1439 QbeGen.CopyOp("0", q) 1440 ELSE 1441 QbeGen.CmpL(op, q, q2, qt); 1442 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q) 1443 END 1444 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet) 1445 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN 1446 QbeGen.CmpSet(op, q, q2, 1447 SymTab.SetWords(t), SymTab.SetWords(t2), qt); 1448 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q) 1449 ELSE 1450 isR := SymTab.ClassOf(t) = SymTab.ClReal; 1451 t := SymTab.BoolType(); 1452 QbeGen.Cmp(op, q, q2, qt, isR); 1453 QbeGen.CopyOp(qt, q) 1454 END 1455 ELSE SemError(213); t := SymTab.InvalidType; 1456 QbeGen.CopyOp("0", q) 1457 END; .) ] . 1458 Rel 1459 = "=" (. op := SymTab.OpEq; .) 1460 | "#" (. op := SymTab.OpNeq1; .) 1461 | "<" (. op := SymTab.OpLt; .) 1462 | "<=" (. op := SymTab.OpLe; .) 1463 | ">" (. op := SymTab.OpGt; .) 1464 | ">=" (. op := SymTab.OpGe; .) 1465 | "IN" (. op := SymTab.OpIn; .) . 1466 SimExpr 1467 (. VAR t2, res2: SymTab.TypeIndex; 1468 op: INTEGER; 1469 q2, qt: QbeGen.QVal; 1470 neg, isR: BOOLEAN; 1471 lw, rw, mw: CARDINAL; .) 1472 = (. neg := FALSE; .) 1473 [ "+" | "-" (. neg := TRUE; .) ] 1474 Term (. IF neg THEN 1475 IF QbeGen.IsImm(q) THEN 1476 QbeGen.NegFold(q, q) 1477 ELSE QbeGen.NewTemp(qt); 1478 QbeGen.NegQ(q, qt, 1479 SymTab.ClassOf(t) 1480 = SymTab.ClReal); 1481 QbeGen.CopyOp(qt, q) 1482 END 1483 END; .) 1484 { AddOp Term 1485 (. IF op = SymTab.OpOr THEN 1486 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN 1487 t := SymTab.BoolType() 1488 ELSE SemError(212); t := SymTab.InvalidType END; 1489 IF t # SymTab.InvalidType THEN 1490 QbeGen.NewTemp(qt); 1491 QbeGen.Op3("or", qt, q, q2, FALSE); 1492 QbeGen.CopyOp(qt, q) 1493 ELSE QbeGen.CopyOp("0", q) 1494 END 1495 ELSIF (t # SymTab.InvalidType) & (t2 # SymTab.InvalidType) 1496 & (SymTab.ClassOf(t) = SymTab.ClSet) 1497 & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN 1498 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2); 1499 mw := lw; 1500 IF rw > mw THEN mw := rw END; 1501 IF op = SymTab.OpAdd THEN 1502 QbeGen.SetBinOp(0, q, q2, lw, rw, qt) 1503 ELSE 1504 QbeGen.SetBinOp(2, q, q2, lw, rw, qt) 1505 END; 1506 t := SymTab.NewSet( 1507 SymTab.NewSubR(0, 1508 VAL(INTEGER, mw) * 32 - 1)); 1509 QbeGen.CopyOp(qt, q) 1510 ELSE 1511 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN 1512 t := res2 1513 ELSE SemError(211); t := SymTab.InvalidType END; 1514 isR := SymTab.ClassOf(t) = SymTab.ClReal; 1515 IF t # SymTab.InvalidType THEN 1516 QbeGen.NewTemp(qt); 1517 IF op = SymTab.OpAdd THEN 1518 QbeGen.Op3("add", qt, q, q2, isR) 1519 ELSE 1520 QbeGen.Op3("sub", qt, q, q2, isR) 1521 END; 1522 QbeGen.CopyOp(qt, q) 1523 ELSE QbeGen.CopyOp("0", q) 1524 END 1525 END; .) } . 1526 AddOp 1527 = "+" (. op := SymTab.OpAdd; .) 1528 | "-" (. op := SymTab.OpSub; .) 1529 | "OR" (. op := SymTab.OpOr; .) . 1530 Term 1531 (. VAR t2, res2: SymTab.TypeIndex; 1532 op: INTEGER; 1533 q2, qt: QbeGen.QVal; 1534 isR: BOOLEAN; 1535 lw, rw, mw: CARDINAL; .) 1536 = Fact { MulOp Fact 1537 (. IF op = SymTab.OpAnd THEN 1538 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN 1539 t := SymTab.BoolType() 1540 ELSE SemError(212); t := SymTab.InvalidType END; 1541 IF t # SymTab.InvalidType THEN 1542 QbeGen.NewTemp(qt); 1543 QbeGen.Op3("and", qt, q, q2, FALSE); 1544 QbeGen.CopyOp(qt, q) 1545 ELSE QbeGen.CopyOp("0", q) 1546 END 1547 ELSIF (t # SymTab.InvalidType) & (t2 # SymTab.InvalidType) 1548 & (SymTab.ClassOf(t) = SymTab.ClSet) 1549 & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN 1550 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2); 1551 mw := lw; 1552 IF rw > mw THEN mw := rw END; 1553 IF op = SymTab.OpTimes THEN 1554 QbeGen.SetBinOp(1, q, q2, lw, rw, qt) 1555 ELSE 1556 QbeGen.SetBinOp(3, q, q2, lw, rw, qt) 1557 END; 1558 t := SymTab.NewSet( 1559 SymTab.NewSubR(0, 1560 VAL(INTEGER, mw) * 32 - 1)); 1561 QbeGen.CopyOp(qt, q) 1562 ELSE 1563 IF SymTab.ArithCheck(t, t2, 1564 (op = SymTab.OpDiv) OR (op = SymTab.OpMod), 1565 res2) THEN t := res2 1566 ELSE SemError(211); t := SymTab.InvalidType END; 1567 isR := SymTab.ClassOf(t) = SymTab.ClReal; 1568 IF t # SymTab.InvalidType THEN 1569 QbeGen.NewTemp(qt); 1570 IF op = SymTab.OpTimes THEN 1571 QbeGen.Op3("mul", qt, q, q2, isR) 1572 ELSIF (op = SymTab.OpDiv) 1573 OR (op = SymTab.OpSlash) THEN 1574 QbeGen.Op3("div", qt, q, q2, isR) 1575 ELSE 1576 QbeGen.Op3("rem", qt, q, q2, isR) 1577 END; 1578 QbeGen.CopyOp(qt, q) 1579 ELSE QbeGen.CopyOp("0", q) 1580 END 1581 END; .) } . 1582 MulOp 1583 = "*" (. op := SymTab.OpTimes; .) 1584 | "/" (. op := SymTab.OpSlash; .) 1585 | "DIV" (. op := SymTab.OpDiv; .) 1586 | "MOD" (. op := SymTab.OpMod; .) 1587 | "AND" (. op := SymTab.OpAnd; .) . 1588 Fact 1589 (. VAR s: ARRAY [0 .. 255] OF CHAR; 1590 et, dt, t2, st, ct2: 1591 SymTab.TypeIndex; 1592 dk: INTEGER; 1593 qd, q2, sq, qa, qm0, qr: 1594 QbeGen.QVal; 1595 qn: SymTab.Name; 1596 called, isHigh, sfx: 1597 BOOLEAN; .) 1598 = integer (. LexString(s); 1599 QbeGen.NormInt(s, q); 1600 t := SymTab.IntType(); .) 1601 | real (. LexString(s); 1602 QbeGen.NormReal(s, q); 1603 t := SymTab.RealType(); .) 1604 | string (. LexString(s); 1605 IF SymTab.StrLen(s) = 3 THEN 1606 t := SymTab.CharType(); 1607 QbeGen.IntStr( 1608 QbeGen.CharVal(s), q) 1609 ELSE t := SymTab.NewStr(); 1610 QbeGen.DeclStr(s, q); 1611 (* a literal's value IS its 1612 static descriptor address *) 1613 QbeGen.NoteAddr(q, q) 1614 END; .) 1615 | Design (. called := FALSE; 1616 t := dt; 1617 IF sfx THEN 1618 IF dt = 1619 SymTab.InvalidType THEN 1620 QbeGen.CopyOp("0", q) 1621 ELSIF (SymTab.ClassOf(dt) = 1622 SymTab.ClRecord) 1623 OR (SymTab.ClassOf(dt) = 1624 SymTab.ClSet) 1625 OR (SymTab.ClassOf(dt) = 1626 SymTab.ClClass) THEN 1627 QbeGen.CopyOp(qd, q) 1628 ELSE QbeGen.ElemLoad(qd, dt, 1629 q) 1630 END 1631 ELSE QbeGen.CopyOp(qd, q) 1632 END; 1633 IF (dk = SymTab.KindVar) 1634 OR (dk = SymTab.KindParam) 1635 OR (dk = 1636 SymTab.KindField) THEN 1637 IF sfx THEN 1638 QbeGen.NoteAddr(q, qd) 1639 ELSE 1640 QbeGen.AddrOf(qn, qa); 1641 QbeGen.NoteAddr(q, qa) 1642 END 1643 ELSIF sfx 1644 & (dt # 1645 SymTab.InvalidType) 1646 & ((SymTab.ClassOf(dt) = 1647 SymTab.ClArray) 1648 OR (SymTab.ClassOf(dt) = 1649 SymTab.ClSet) 1650 OR (SymTab.ClassOf(dt) = 1651 SymTab.ClRecord)) THEN 1652 QbeGen.NoteAddr(qd, qd) 1653 END; .) 1654 [ ArgList 1655 (. t := ct2; 1656 QbeGen.CopyOp(q2, q); .) ] 1657 (. IF ~called 1658 & (dk = SymTab.KindProc) THEN 1659 (* bare zero-arg function 1660 call (parentheses may be 1661 omitted); a proper or 1662 parameterised proc here 1663 is 230 *) 1664 IF (SymTab.ProcNPar(qn) = 0) 1665 & (SymTab.ProcRes(qn) # 1666 SymTab.InvalidType) THEN 1667 QbeGen.Mangled(qn, 1668 SymTab.ProcUid(qn), qm0); 1669 QbeGen.CallBegin(qm0, 1670 SymTab.ProcRes(qn), 1671 SymTab.ProcDepthOf(qn), 1672 SymTab.IsExternal(qn)); 1673 QbeGen.CallEnd(TRUE, q); 1674 t := SymTab.ProcRes(qn) 1675 ELSE SemError(230) 1676 END 1677 END; .) 1678 | ( "HIGH" (. isHigh := TRUE; .) 1679 | "LEN" (. isHigh := FALSE; .) ) 1680 "(" Design ")" 1681 (. IF dt = SymTab.InvalidType THEN 1682 ELSIF SymTab.ClassOf(dt) # 1683 SymTab.ClArray THEN 1684 SemError(217); 1685 t := SymTab.InvalidType; 1686 QbeGen.CopyOp("0", q) 1687 ELSE 1688 IF isHigh THEN 1689 IF SymTab.IsOpenArray(dt) THEN 1690 QbeGen.OpenHi(qd, qr) 1691 ELSE 1692 QbeGen.IntStr( 1693 SymTab.ArrayHi(dt), qr) 1694 END 1695 ELSE 1696 IF SymTab.IsOpenArray(dt) THEN 1697 QbeGen.LoadCount(qd, qr) 1698 ELSE 1699 QbeGen.IntStr(VAL( 1700 INTEGER, 1701 SymTab.ArrayLen(dt)), 1702 qr) 1703 END 1704 END; 1705 t := SymTab.IntType(); 1706 QbeGen.CopyOp(qr, q) 1707 END; .) 1708 | ( "SIZE" | "TSIZE" ) "(" Design ")" 1709 (. IF dt = SymTab.InvalidType THEN 1710 t := SymTab.InvalidType; 1711 QbeGen.CopyOp("0", q) 1712 ELSE 1713 QbeGen.IntStr(VAL(INTEGER, 1714 SymTab.ObjectSize(dt)), q); 1715 t := SymTab.IntType() 1716 END; .) 1717 | "ADR" "(" Design ")" 1718 (. IF dt = SymTab.InvalidType THEN 1719 t := SymTab.InvalidType; 1720 QbeGen.CopyOp("0", q) 1721 ELSE 1722 IF sfx THEN 1723 QbeGen.CopyOp(qd, q) 1724 ELSIF (dk = SymTab.KindVar) 1725 OR (dk = SymTab.KindParam) THEN 1726 QbeGen.AddrOf(qn, q) 1727 ELSE SemError(230); 1728 QbeGen.CopyOp("0", q) 1729 END; 1730 t := SymTab.AddrType() 1731 END; .) 1732 | "(" Expr ")" (. t := et; .) 1733 | SetLit (. t := st; 1734 QbeGen.CopyOp(sq, q); .) 1735 | "NOT" Fact (. IF SymTab.BoolCheck(t2) THEN 1736 t := SymTab.BoolType() 1737 ELSE SemError(212); 1738 t := SymTab.InvalidType END; 1739 IF t # SymTab.InvalidType THEN 1740 QbeGen.NotQ(q2, q) 1741 ELSE QbeGen.CopyOp("0", q) 1742 END; .) . 1743 (* Set literals are SET OF [0..255] (8 words); elements validated 1744 0..255 statically when foldable (222 otherwise), runtime trap 1745 for computed elements. Ranges always lower via SetRange. *) 1746 SetLit 1747 = "{" (. t := SymTab.NewSet( 1748 SymTab.NewSubR(0, 255)); 1749 QbeGen.NewSetTemp(8, q); 1750 QbeGen.SetZero(q, 8); .) 1751 [ SetElem { "," SetElem } ] 1752 "}" . 1753 SetElem (. VAR et, et2: SymTab.TypeIndex; 1754 qe, q2: QbeGen.QVal; 1755 v, v2: INTEGER; 1756 lo: INTEGER; 1757 span: CARDINAL; 1758 cl, cl2: INTEGER; 1759 hasR: BOOLEAN; .) 1760 = (. hasR := FALSE; .) 1761 Expr 1762 [ ".." Expr (. hasR := TRUE; .) ] 1763 (. lo := SymTab.SetBaseLo(st); 1764 span := SymTab.SetCount(st); 1765 IF (et = SymTab.InvalidType) 1766 OR (hasR & (et2 = 1767 SymTab.InvalidType)) THEN 1768 ELSE cl := 1769 SymTab.ClassOf(et); 1770 IF hasR THEN 1771 cl2 := 1772 SymTab.ClassOf(et2) 1773 ELSE cl2 := SymTab.ClInt 1774 END; 1775 IF ((cl # SymTab.ClInt) 1776 & (cl # SymTab.ClChar) 1777 & (cl # SymTab.ClBool)) 1778 OR (hasR & 1779 ((cl2 1780 # SymTab.ClInt) 1781 & (cl2 1782 # SymTab.ClChar) 1783 & (cl2 1784 # SymTab.ClBool))) THEN 1785 SemError(222) 1786 ELSIF hasR 1787 & SymTab.ConstInt(qe, v) 1788 & SymTab.ConstInt(q2, 1789 v2) 1790 & ((v < lo) 1791 OR (v2 < lo) 1792 OR (v >= lo + 1793 VAL(INTEGER, span)) 1794 OR (v2 >= lo + 1795 VAL(INTEGER, span)) 1796 OR (v > v2)) THEN 1797 SemError(222) 1798 ELSIF hasR THEN 1799 QbeGen.SetRange(sq, qe, q2, 1800 lo, span) 1801 ELSIF SymTab.ConstInt(qe, 1802 v) 1803 & ((v < lo) 1804 OR (v >= lo + 1805 VAL(INTEGER, 1806 span))) THEN 1807 SemError(222) 1808 ELSE QbeGen.SetBit(sq, qe, 1809 lo, span) 1810 END 1811 END; .) . 1812 GetIdent 1813 = ident (. LexName(n); .) . 1814 1815 END M2. 0 errors Statistics: nr of terminals: 81 (limit 400) nr of non-terminals: 73 (limit 210) nr of pragmas: 0 (limit 419) nr of symbolnodes: 154 (limit 500) nr of graphnodes: 696 (limit 1500) nr of conditionsets: 7 (limit 100) nr of charactersets: 11 (limit 250)