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 charConst = digit { digit } ( "C" | "c" ) . 81 82 PRODUCTIONS 83 M2 84 = Unit "." . 85 (* Units: program modules compile fully; DEFINITION and 86 IMPLEMENTATION modules parse + check now but lower in step 4 87 (each ends with one 230); same for nested local modules. *) 88 Unit 89 = DefUnit 90 | ImplUnit 91 | ProgModule . 92 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION 93 and one program (last) into one image. Units share the symbol 94 table; imports materialize exported names. *) 95 DefUnit (. VAR m1, m2, pn: SymTab.Name; .) 96 = "DEFINITION" "MODULE" 97 GetIdent (. IF NOT SymTab.BeginDef(m1) THEN 98 SemError(200) END; 99 QbeGen.SetModule(m1); .) 100 ";" 101 { Import } 102 { ConstBlock | TypeBlock | VarBlock 103 | ProcHeading ";" (. SymTab.CloseProc; 104 QbeGen.AbortFunc; .) } 105 "END" 106 GetIdent (. IF NOT SymTab.Equal(m1, m2) THEN 107 SemError(202) END; 108 SymTab.EndUnit; .) . 109 ImplUnit (. VAR m1, m2: SymTab.Name; .) 110 = "IMPLEMENTATION" "MODULE" 111 GetIdent (. IF NOT SymTab.BeginImpl(m1) THEN 112 SemError(201) END; 113 QbeGen.SetModule(m1); .) 114 ";" 115 { Import } 116 DeclSeq 117 [ "BEGIN" (. QbeGen.BeginInit(m1); .) 118 [ StatSeq ] (. QbeGen.EndInit; .) ] 119 "END" 120 GetIdent (. IF NOT SymTab.Equal(m1, m2) THEN 121 SemError(202) END; 122 SymTab.EndUnit; .) . 123 ProgModule (. VAR m1, m2: SymTab.Name; .) 124 = "MODULE" 125 GetIdent (. IF NOT SymTab.BeginProg(m1) THEN 126 SemError(200) END; 127 QbeGen.SetModule(m1); .) 128 [ Priority ] 129 ";" 130 { Import } 131 DeclSeq 132 [ "BEGIN" (. QbeGen.BeginBody; .) 133 [ StatSeq ] ] 134 "END" 135 GetIdent (. IF NOT SymTab.Equal(m1, m2) THEN 136 SemError(202) END; 137 QbeGen.EndModule(m1); 138 SymTab.EndUnit; .) . 139 DeclSeq 140 = { ConstBlock | TypeBlock | VarBlock | ProcDecl ";" 141 | NestedModule ";" | ClassItem ";" } . 142 (* Local module, Wirth form. Declarations lower like top-level ones 143 (same QBE module prefix); a BEGIN body becomes an init function 144 that main calls; the EXPORT list is hoisted into the enclosing 145 scope at END. *) 146 NestedModule (. VAR m1, m2: SymTab.Name; 147 expNames: ARRAY [0 .. 63] OF SymTab.Name; 148 expCount, k: CARDINAL; .) 149 = "MODULE" 150 GetIdent (. IF NOT SymTab.Enter(m1, 151 SymTab.KindModule) THEN 152 SemError(200) END; 153 SymTab.PushScope; 154 expCount := 0; .) 155 [ Priority ] 156 ";" 157 { Import } 158 [ "EXPORT" [ "QUALIFIED" ] 159 GetIdent (. INC(expCount); .) 160 { "," GetIdent 161 (. INC(expCount); .) } 162 ";" ] 163 DeclSeq 164 [ "BEGIN" (. QbeGen.BeginInit(m1); .) 165 [ StatSeq ] (. QbeGen.EndInit; .) ] 166 "END" 167 GetIdent (. IF NOT SymTab.Equal(m1, m2) THEN 168 SemError(202) END; 169 k := 0; 170 WHILE k < expCount DO 171 SymTab.ExportUp(expNames[k]); 172 INC(k) 173 END; 174 SymTab.PopScope; .) . 175 Priority 176 = "[" integer "]" (. SemError(230); .) . 177 (* Imports (4.3): FROM materializes the names (unqualified use); 178 plain IMPORT only demands the module exists — qualified `L.x` 179 materializes on first use (Design). *) 180 (* Unknown modules stay unchecked stubs (legacy, so hand-written 181 import lines don't fail); a known module's missing export is 182 201. *) 183 Import (. VAR n: SymTab.Name; .) 184 = "FROM" 185 GetIdent 186 "IMPORT" 187 ImpList ";" 188 | "IMPORT" 189 ImpModList ";" . 190 ImpList (. VAR n: SymTab.Name; .) 191 = ImpName 192 { "," ImpName } . 193 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are 194 accepted and ignored: the built-in applies regardless. *) 195 ImpName (. VAR n: SymTab.Name; .) 196 = GetIdent (. IF SymTab.ModKnown(mod) 197 AND NOT SymTab.ImportFrom(mod, n) THEN 198 SemError(201) END; .) 199 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN" 200 | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP" 201 | "INC" | "DEC" ) . 202 ImpModList (. VAR n: SymTab.Name; .) 203 = GetIdent 204 { "," GetIdent } . 205 (* Opaque TYPE declarations (definition modules). The targetless 206 alias resolves to InvalidType until step 4 completes it. *) 207 (* Scalar-phase TYPEs: named types, integer subranges, enumerations. 208 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231. 209 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *) 210 TypeBlock 211 = "TYPE" (. SymTab.BeginTypeBlock; .) 212 { TypeItem ";" | ClassItem ";" } 213 (. SymTab.EndTypeBlock; .) . 214 TypeItem (. VAR n: SymTab.Name; 215 t, op: SymTab.TypeIndex; .) 216 = GetIdent (. op := SymTab.OpaqueBase(n); 217 IF op = SymTab.InvalidType THEN 218 IF NOT SymTab.Enter(n, 219 SymTab.KindType) THEN 220 SemError(200) END 221 END; .) 222 ( "=" Type (. IF op # SymTab.InvalidType THEN 223 SymTab.SetTarget(op, t) 224 ELSE SymTab.SetSymType(n, t) 225 END; .) 226 | (. IF op # SymTab.InvalidType THEN 227 (* stays opaque *) 228 ELSIF NOT isDef THEN 229 SemError(231) 230 ELSE SymTab.SetSymType(n, 231 SymTab.NewAlias()) END; .) ) . 232 Type 233 = TypeIdent 234 | Subrange 235 | Enum 236 | ArrayType 237 | SetType 238 | RecordType 239 | PointerType 240 | ProcType . 241 PointerType (. VAR base: SymTab.TypeIndex; .) 242 = "POINTER" "TO" Type(. t := SymTab.NewPtr(base); .) . 243 (* Procedure types (step 8.5): PROCEDURE (params): result. Values 244 are code pointers; params are collected into the descriptor. *) 245 ProcType (. VAR res, pt: SymTab.TypeIndex; 246 isV: BOOLEAN; .) 247 = "PROCEDURE" (. res := SymTab.InvalidType; 248 t := SymTab.NewProcType(res); .) 249 [ "(" [ ProcTypeSection { ";" ProcTypeSection } ] ")" ] 250 [ ":" TypeIdent (. SymTab.SetProcTypeRes(t, res); .) ] . 251 ProcTypeSection (. VAR pt: SymTab.TypeIndex; 252 isV: BOOLEAN; 253 cnt, k: CARDINAL; 254 names: ARRAY [0 .. 15] OF SymTab.Name; .) 255 = (. isV := FALSE; cnt := 0; .) 256 [ "VAR" (. isV := TRUE; .) ] 257 GetIdent (. INC(cnt); .) 258 { "," GetIdent (. INC(cnt); .) } 259 ( ":" Type (. k := 0; 260 WHILE k < cnt DO 261 SymTab.ProcTypeAdd(t, isV, pt); 262 INC(k) 263 END; .) 264 | (. (* type-only parameter list: 265 each name is a type (GNU 266 shorthand used by the 267 Coco/R scanner frame) *) 268 k := 0; 269 WHILE k < cnt DO 270 IF SymTab.Lookup(names[k]) 271 AND ((SymTab.SymKind(names[k]) = SymTab.KindType) 272 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN 273 pt := SymTab.SymType(names[k]) 274 ELSE SemError(201); 275 pt := SymTab.InvalidType 276 END; 277 SymTab.ProcTypeAdd(t, isV, pt); 278 INC(k) 279 END; .) ) . 280 (* Arrays: "OF" without bounds is an open formal (allowed only 281 where allowOpen); "[lo..hi, ...]" nests bounded levels inside 282 out. Bounds are folded literals (int/char); anything else 230. 283 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *) 284 ArrayType 285 (. VAR elem: SymTab.TypeIndex; 286 ok: BOOLEAN; 287 bnds, bndh: ARRAY [0 .. 7] OF INTEGER; 288 nb, k: CARDINAL; .) 289 = "ARRAY" 290 ( "OF" Type (. IF NOT allowOpen THEN 291 SemError(230) END; 292 t := SymTab.NewOpenArray(elem); .) 293 | "[" (. SymTab.BoundBegin; ok := TRUE; .) 294 BoundPair 295 { "," BoundPair } 296 "]" (. (* snapshot before the element 297 type, which reuses the bound 298 buffer for a nested ARRAY *) 299 nb := SymTab.BoundCount(); 300 k := 0; 301 WHILE k < nb DO 302 bnds[k] := SymTab.BoundLo(k); 303 bndh[k] := SymTab.BoundHi(k); 304 INC(k) 305 END; .) 306 "OF" Type 307 (. IF ok THEN 308 k := nb; 309 WHILE k > 0 DO 310 DEC(k); 311 elem := SymTab.NewArrayB( 312 elem, bnds[k], bndh[k]) 313 END; 314 t := elem 315 ELSE t := SymTab.InvalidType 316 END; .) ) . 317 BoundPair (. VAR tlo, thi: SymTab.TypeIndex; 318 qlo, qhi: QbeGen.QVal; 319 lo, hi: INTEGER; 320 cl, cl2: INTEGER; .) 321 = Expr ".." Expr 322 (. IF (tlo = SymTab.InvalidType) 323 OR (thi = SymTab.InvalidType) THEN 324 ok := FALSE 325 ELSE cl := SymTab.ClassOf(tlo); 326 cl2 := SymTab.ClassOf(thi); 327 IF ((cl # SymTab.ClInt) 328 AND (cl # SymTab.ClChar)) 329 OR ((cl2 # SymTab.ClInt) 330 AND (cl2 # SymTab.ClChar)) THEN 331 SemError(230); ok := FALSE 332 ELSIF NOT SymTab.ConstInt(qlo, lo) 333 OR NOT SymTab.ConstInt(qhi, hi) 334 OR (lo > hi) THEN 335 SemError(230); ok := FALSE 336 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN 337 SemError(230); ok := FALSE 338 END; 339 END; .) . 340 (* Sets: multi-word masks over bases ≤ 256 values (bool, char, 341 bounded subranges; enums wait for ordinals, INTEGER is 342 unbounded). Literals are SET OF [0..255]; assignment and 343 comparison across suitable bases are lenient (masks over min 344 words + zero-check extras), out-of-span literals are 222. *) 345 SetType (. VAR base: SymTab.TypeIndex; 346 blo, bhi, bspan: INTEGER; 347 bcls: INTEGER; .) 348 = "SET" "OF" Type 349 (. IF base = SymTab.InvalidType THEN 350 t := SymTab.InvalidType 351 ELSE bcls := 352 SymTab.ClassOf(base); 353 IF bcls = SymTab.ClBool THEN 354 blo := 0; bspan := 2 355 ELSIF bcls = SymTab.ClChar THEN 356 blo := 0; bspan := 256 357 ELSIF SymTab.SubBounds(base, 358 blo, bhi) THEN 359 bspan := bhi - blo + 1 360 ELSE bspan := 0 END; 361 IF (bspan <= 0) 362 OR (bspan > 256) THEN 363 SemError(230); 364 t := SymTab.InvalidType 365 ELSE t := SymTab.NewSet(base) 366 END 367 END; .) . 368 (* Records: flat blobs; array fields are pointers to static 369 descriptors (locked amendment), nested records inline. Field 370 offsets static and declaration-ordered. *) 371 RecordType (. VAR t2: SymTab.TypeIndex; .) 372 = "RECORD" (. t := SymTab.NewRecord(); .) 373 [ RecField { ";" [ RecField ] } ] 374 "END" . 375 RecField (. VAR n: SymTab.Name; 376 t2: SymTab.TypeIndex; .) 377 = RecIdents ":" Type(. SymTab.FixPendingF(rec, t2); .) . 378 RecIdents (. VAR n: SymTab.Name; .) 379 = GetIdent (. IF NOT SymTab.FieldPending(rec, 380 n) THEN 381 SemError(200) END; .) 382 { "," GetIdent (. IF NOT SymTab.FieldPending(rec, 383 n) THEN 384 SemError(200) END; .) } . 385 TypeIdent (. VAR n, qid: SymTab.Name; 386 k: INTEGER; 387 dotted: BOOLEAN; .) 388 = GetIdent (. dotted := FALSE; 389 IF NOT SymTab.Lookup(n) THEN 390 k := -1; 391 t := SymTab.ForwardType(n); 392 IF t = SymTab.InvalidType THEN 393 SemError(201) 394 END 395 ELSE k := SymTab.SymKind(n); 396 IF (k = SymTab.KindType) 397 OR (k = SymTab.KindPredef) THEN 398 t := SymTab.SymType(n) 399 ELSE t := SymTab.InvalidType 400 END 401 END; .) 402 [ "." GetIdent (. dotted := TRUE; 403 IF k = SymTab.KindModule THEN 404 t := SymTab.QualType(n, qid); 405 IF t = SymTab.InvalidType THEN 406 SemError(201) 407 END 408 ELSE SemError(221); 409 t := SymTab.InvalidType 410 END; .) ] 411 (. IF NOT dotted THEN 412 IF (k = SymTab.KindModule) 413 OR ((k # SymTab.KindType) 414 AND (k # SymTab.KindPredef) 415 AND (k # SymTab.KindImport) 416 AND (k # -1)) THEN 417 SemError(221) 418 END 419 END; .) . 420 Subrange (. VAR tlo, thi: SymTab.TypeIndex; 421 qlo, qhi: QbeGen.QVal; 422 lo, hi: INTEGER; .) 423 = "[" Expr ".." Expr 424 (. IF (tlo = SymTab.InvalidType) 425 OR (thi = SymTab.InvalidType) THEN 426 t := SymTab.InvalidType 427 ELSIF (SymTab.ClassOf(tlo) # 428 SymTab.ClInt) 429 OR (SymTab.ClassOf(thi) # 430 SymTab.ClInt) THEN 431 SemError(230); 432 t := SymTab.InvalidType 433 ELSIF NOT SymTab.ConstInt(qlo, lo) 434 OR NOT SymTab.ConstInt(qhi, hi) 435 OR (lo > hi) THEN 436 SemError(230); 437 t := SymTab.InvalidType 438 ELSE t := SymTab.NewSubR(lo, hi) 439 END; .) 440 "]" . 441 Enum (. VAR n: SymTab.Name; .) 442 = "(" (. t := SymTab.NewEnum(); .) 443 GetIdent (. IF NOT SymTab.Enter(n, 444 SymTab.KindConst) THEN 445 SemError(200) END; 446 SymTab.SetSymType(n, t); .) 447 { "," GetIdent (. IF NOT SymTab.Enter(n, 448 SymTab.KindConst) THEN 449 SemError(200) END; 450 SymTab.SetSymType(n, t); .) } 451 ")" . 452 (* Clarion-form classes (docs/OOP.txt): declaration + single 453 inheritance + IMPLEMENTATION blocks. Scopes and member checks 454 now; lowering (vtable, dispatch, THIS) later — one 230 per 455 class/impl block. Methods end with ";" per the Table example 456 (not "," as in the sketch). No underscores in identifiers. *) 457 (* Single CLASS item in both loops: separating declaration from 458 IMPLEMENTATION at the loop level needs 2-token lookahead 459 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do. 460 The second token decides after CLASS is consumed. A misplaced 461 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the 462 whole unit ends 230 until lowering). *) 463 ClassItem 464 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) . 465 ClassRest (. VAR cn, m2, pn: SymTab.Name; 466 ct: SymTab.TypeIndex; .) 467 = GetIdent (. IF NOT SymTab.Enter(cn, 468 SymTab.KindType) THEN 469 SemError(200) END; 470 ct := SymTab.NewClass(); 471 SymTab.SetSymType(cn, ct); 472 SymTab.PushClassScope(ct); .) 473 [ Parents ] 474 ";" 475 { ClassField ";" } 476 { MethodHeading ";" (. SymTab.CloseProc; 477 QbeGen.AbortFunc; .) } 478 "END" 479 GetIdent (. IF NOT SymTab.Equal(cn, m2) THEN 480 SemError(202) END; 481 SymTab.PopScope; 482 SemError(230); .) . 483 Parents (. VAR p: SymTab.Name; .) 484 = "(" Parent1 485 { "," GetIdent

(. SemError(230); .) } 486 ")" . 487 Parent1 (. VAR p: SymTab.Name; 488 pt: SymTab.TypeIndex; .) 489 = GetIdent

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