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 NOT 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 NOT 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 NOT 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 NOT SymTab.Equal(m1, m2) THEN 120 SemError(202) END; 121 SymTab.EndUnit; .) . 122 ProgModule (. VAR m1, m2: SymTab.Name; .) 123 = "MODULE" 124 GetIdent (. IF NOT 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 NOT 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 NOT 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 NOT 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 = ImpName 184 { "," ImpName } . 185 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are 186 accepted and ignored: the built-in applies regardless. *) 187 ImpName (. VAR n: SymTab.Name; .) 188 = GetIdent (. IF SymTab.ModKnown(mod) 189 AND NOT SymTab.ImportFrom(mod, n) THEN 190 SemError(201) END; .) 191 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN" 192 | "CHR" | "ORD" | "VAL" | "ABS" | "INC" | "DEC" ) . 193 ImpModList (. VAR n: SymTab.Name; .) 194 = GetIdent 195 { "," GetIdent } . 196 (* Opaque TYPE declarations (definition modules). The targetless 197 alias resolves to InvalidType until step 4 completes it. *) 198 (* Scalar-phase TYPEs: named types, integer subranges, enumerations. 199 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231. 200 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *) 201 TypeBlock 202 = "TYPE" (. SymTab.BeginTypeBlock; .) 203 { TypeItem ";" | ClassItem ";" } 204 (. SymTab.EndTypeBlock; .) . 205 TypeItem (. VAR n: SymTab.Name; 206 t, op: SymTab.TypeIndex; .) 207 = GetIdent (. op := SymTab.OpaqueBase(n); 208 IF op = SymTab.InvalidType THEN 209 IF NOT SymTab.Enter(n, 210 SymTab.KindType) THEN 211 SemError(200) END 212 END; .) 213 ( "=" Type (. IF op # SymTab.InvalidType THEN 214 SymTab.SetTarget(op, t) 215 ELSE SymTab.SetSymType(n, t) 216 END; .) 217 | (. IF op # SymTab.InvalidType THEN 218 (* stays opaque *) 219 ELSIF NOT isDef THEN 220 SemError(231) 221 ELSE SymTab.SetSymType(n, 222 SymTab.NewAlias()) END; .) ) . 223 Type 224 = TypeIdent 225 | Subrange 226 | Enum 227 | ArrayType 228 | SetType 229 | RecordType 230 | PointerType . 231 PointerType (. VAR base: SymTab.TypeIndex; .) 232 = "POINTER" "TO" Type(. t := SymTab.NewPtr(base); .) . 233 (* Arrays: "OF" without bounds is an open formal (allowed only 234 where allowOpen); "[lo..hi, ...]" nests bounded levels inside 235 out. Bounds are folded literals (int/char); anything else 230. 236 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *) 237 ArrayType 238 (. VAR elem: SymTab.TypeIndex; 239 ok: BOOLEAN; .) 240 = "ARRAY" 241 ( "OF" Type (. IF NOT allowOpen THEN 242 SemError(230) END; 243 t := SymTab.NewOpenArray(elem); .) 244 | "[" (. SymTab.BoundBegin; ok := TRUE; .) 245 BoundPair 246 { "," BoundPair } 247 "]" "OF" Type 248 (. IF ok THEN 249 t := SymTab.NestArray(elem) 250 ELSE t := SymTab.InvalidType 251 END; .) ) . 252 BoundPair (. VAR tlo, thi: SymTab.TypeIndex; 253 qlo, qhi: QbeGen.QVal; 254 lo, hi: INTEGER; 255 cl, cl2: INTEGER; .) 256 = Expr ".." Expr 257 (. IF (tlo = SymTab.InvalidType) 258 OR (thi = SymTab.InvalidType) THEN 259 ok := FALSE 260 ELSE cl := SymTab.ClassOf(tlo); 261 cl2 := SymTab.ClassOf(thi); 262 IF ((cl # SymTab.ClInt) 263 AND (cl # SymTab.ClChar)) 264 OR ((cl2 # SymTab.ClInt) 265 AND (cl2 # SymTab.ClChar)) THEN 266 SemError(230); ok := FALSE 267 ELSIF NOT SymTab.ConstInt(qlo, lo) 268 OR NOT SymTab.ConstInt(qhi, hi) 269 OR (lo > hi) THEN 270 SemError(230); ok := FALSE 271 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN 272 SemError(230); ok := FALSE 273 END; 274 END; .) . 275 (* Sets: multi-word masks over bases ≤ 256 values (bool, char, 276 bounded subranges; enums wait for ordinals, INTEGER is 277 unbounded). Literals are SET OF [0..255]; assignment and 278 comparison across suitable bases are lenient (masks over min 279 words + zero-check extras), out-of-span literals are 222. *) 280 SetType (. VAR base: SymTab.TypeIndex; 281 blo, bhi, bspan: INTEGER; 282 bcls: INTEGER; .) 283 = "SET" "OF" Type 284 (. IF base = SymTab.InvalidType THEN 285 t := SymTab.InvalidType 286 ELSE bcls := 287 SymTab.ClassOf(base); 288 IF bcls = SymTab.ClBool THEN 289 blo := 0; bspan := 2 290 ELSIF bcls = SymTab.ClChar THEN 291 blo := 0; bspan := 256 292 ELSIF SymTab.SubBounds(base, 293 blo, bhi) THEN 294 bspan := bhi - blo + 1 295 ELSE bspan := 0 END; 296 IF (bspan <= 0) 297 OR (bspan > 256) THEN 298 SemError(230); 299 t := SymTab.InvalidType 300 ELSE t := SymTab.NewSet(base) 301 END 302 END; .) . 303 (* Records: flat blobs; array fields are pointers to static 304 descriptors (locked amendment), nested records inline. Field 305 offsets static and declaration-ordered. *) 306 RecordType (. VAR t2: SymTab.TypeIndex; .) 307 = "RECORD" (. t := SymTab.NewRecord(); .) 308 [ RecField { ";" [ RecField ] } ] 309 "END" . 310 RecField (. VAR n: SymTab.Name; 311 t2: SymTab.TypeIndex; .) 312 = RecIdents ":" Type(. SymTab.FixPendingF(rec, t2); .) . 313 RecIdents (. VAR n: SymTab.Name; .) 314 = GetIdent (. IF NOT SymTab.FieldPending(rec, 315 n) THEN 316 SemError(200) END; .) 317 { "," GetIdent (. IF NOT SymTab.FieldPending(rec, 318 n) THEN 319 SemError(200) END; .) } . 320 TypeIdent (. VAR n, qid: SymTab.Name; 321 k: INTEGER; 322 dotted: BOOLEAN; .) 323 = GetIdent (. dotted := FALSE; 324 IF NOT SymTab.Lookup(n) THEN 325 k := -1; 326 t := SymTab.ForwardType(n); 327 IF t = SymTab.InvalidType THEN 328 SemError(201) 329 END 330 ELSE k := SymTab.SymKind(n); 331 IF (k = SymTab.KindType) 332 OR (k = SymTab.KindPredef) THEN 333 t := SymTab.SymType(n) 334 ELSE t := SymTab.InvalidType 335 END 336 END; .) 337 [ "." GetIdent (. dotted := TRUE; 338 IF k = SymTab.KindModule THEN 339 t := SymTab.QualType(n, qid); 340 IF t = SymTab.InvalidType THEN 341 SemError(201) 342 END 343 ELSE SemError(221); 344 t := SymTab.InvalidType 345 END; .) ] 346 (. IF NOT dotted THEN 347 IF (k = SymTab.KindModule) 348 OR ((k # SymTab.KindType) 349 AND (k # SymTab.KindPredef) 350 AND (k # SymTab.KindImport) 351 AND (k # -1)) THEN 352 SemError(221) 353 END 354 END; .) . 355 Subrange (. VAR tlo, thi: SymTab.TypeIndex; 356 qlo, qhi: QbeGen.QVal; 357 lo, hi: INTEGER; .) 358 = "[" Expr ".." Expr 359 (. IF (tlo = SymTab.InvalidType) 360 OR (thi = SymTab.InvalidType) THEN 361 t := SymTab.InvalidType 362 ELSIF (SymTab.ClassOf(tlo) # 363 SymTab.ClInt) 364 OR (SymTab.ClassOf(thi) # 365 SymTab.ClInt) THEN 366 SemError(230); 367 t := SymTab.InvalidType 368 ELSIF NOT SymTab.ConstInt(qlo, lo) 369 OR NOT SymTab.ConstInt(qhi, hi) 370 OR (lo > hi) THEN 371 SemError(230); 372 t := SymTab.InvalidType 373 ELSE t := SymTab.NewSubR(lo, hi) 374 END; .) 375 "]" . 376 Enum (. VAR n: SymTab.Name; .) 377 = "(" (. t := SymTab.NewEnum(); .) 378 GetIdent (. IF NOT SymTab.Enter(n, 379 SymTab.KindConst) THEN 380 SemError(200) END; 381 SymTab.SetSymType(n, t); .) 382 { "," GetIdent (. IF NOT SymTab.Enter(n, 383 SymTab.KindConst) THEN 384 SemError(200) END; 385 SymTab.SetSymType(n, t); .) } 386 ")" . 387 (* Clarion-form classes (docs/OOP.txt): declaration + single 388 inheritance + IMPLEMENTATION blocks. Scopes and member checks 389 now; lowering (vtable, dispatch, THIS) later — one 230 per 390 class/impl block. Methods end with ";" per the Table example 391 (not "," as in the sketch). No underscores in identifiers. *) 392 (* Single CLASS item in both loops: separating declaration from 393 IMPLEMENTATION at the loop level needs 2-token lookahead 394 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do. 395 The second token decides after CLASS is consumed. A misplaced 396 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the 397 whole unit ends 230 until lowering). *) 398 ClassItem 399 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) . 400 ClassRest (. VAR cn, m2, pn: SymTab.Name; 401 ct: SymTab.TypeIndex; .) 402 = GetIdent (. IF NOT SymTab.Enter(cn, 403 SymTab.KindType) THEN 404 SemError(200) END; 405 ct := SymTab.NewClass(); 406 SymTab.SetSymType(cn, ct); 407 SymTab.PushClassScope(ct); .) 408 [ Parents ] 409 ";" 410 { ClassField ";" } 411 { MethodHeading ";" (. SymTab.CloseProc; 412 QbeGen.AbortFunc; .) } 413 "END" 414 GetIdent (. IF NOT SymTab.Equal(cn, m2) THEN 415 SemError(202) END; 416 SymTab.PopScope; 417 SemError(230); .) . 418 Parents (. VAR p: SymTab.Name; .) 419 = "(" Parent1 420 { "," GetIdent

(. SemError(230); .) } 421 ")" . 422 Parent1 (. VAR p: SymTab.Name; 423 pt: SymTab.TypeIndex; .) 424 = GetIdent

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