Coco/R - Compiler-Compiler V1.53 Released by Pat Terry 17 September 2002 Source file: M2.atg Grammar Tests: Deletable symbols: MapTail FieldListSequence DeclSeq Undefined nonterminals: -- none -- Unreachable nonterminals: -- none -- Circular derivations: -- none -- Underivable nonterminals: -- none -- LL(1) conditions: LL(1) error in MapTail: "[" is the start & successor of a deletable structure LL(1) error in MapTail: "(" is the start & successor of a deletable structure LL(1) error in SimExpr: "+" is the start & successor of a deletable structure LL(1) error in SimExpr: "-" is the start & successor of a deletable structure LL(1) error in CaseAlt: ident is the start & successor of a deletable structure LL(1) error in Design2: "[" is the start & successor of a deletable structure LL(1) error in Design2: "(" is the start & successor of a deletable structure LL(1) error in ReturnStat: ident is the start & successor of a deletable structure LL(1) error in ReturnStat: integer is the start & successor of a deletable structure LL(1) error in ReturnStat: real is the start & successor of a deletable structure LL(1) error in ReturnStat: string is the start & successor of a deletable structure LL(1) error in ReturnStat: "[" is the start & successor of a deletable structure LL(1) error in ReturnStat: "(" is the start & successor of a deletable structure LL(1) error in ReturnStat: "+" is the start & successor of a deletable structure LL(1) error in ReturnStat: "-" is the start & successor of a deletable structure LL(1) error in ReturnStat: "{" is the start & successor of a deletable structure LL(1) error in ReturnStat: "NOT" is the start & successor of a deletable structure LL(1) error in ReturnStat: "~" is the start & successor of a deletable structure LL(1) error in DesignStat: "(" is the start of several alternatives. LL(1) error in ClassRest: "BEGIN" is the start of several alternatives. LL(1) error in FieldList: ident is the start of several alternatives. LL(1) error in ArrayType: "[" is the start of several alternatives. LL(1) error in StatSeq: ";" is the start & successor of a deletable structure LL(1) error in StatSeq: ident is the start & successor of a deletable structure LL(1) error in VarBlock: ident is the start & successor of a deletable structure LL(1) error in TypeBlock: ident is the start & successor of a deletable structure LL(1) error in TypeBlock: "CLASS" is the start & successor of a deletable structure LL(1) error in ConstBlock: ident is the start & successor of a deletable structure Listing: 1 COMPILER M2 2 (* ============================================================================= 3 TopSpeed Modula-2 V3 - COMPLETE GRAMMAR (Coco/R .atg form) 4 5 Historical JPI/Clarion V3 dialect, reconstructed from the real TS-V3 6 corpus (TABLE/GWINM2P/GWINC2M/BYTEFIDD/CLUB/RS/Modbase) + the shipped 7 CR.MOD reserved words + PIM/ISO Modula-2 reference forms. 8 9 This ATG is the deliverable of the "complete V3 grammar" work item. 10 It intentionally DIVERGES from the modern m2compiler-V3 subset's 11 locked rules where the corpus proves the original dialect differed: 12 13 - identifiers carry '_' and '@' (Graph._VGA, ct__@Fssssi) 14 - '&' = AND , '~' = NOT , '<>' = '#' (all accepted) 15 - literal suffixes H (hex), C (char), B (base-8/octal), 16 plus 0x/0X hex-prefix forms 17 - `::=` constant alias form (GCoord::=INTEGER) 18 - anchored type subranges (SHORTINT[-1..1]) 19 - qualified type/designator idents (Client.ClientRec, t2.Root, 20 p^.Left, S1[sp1], Graph.GetVideoConfig(vc)) 21 - full composite types: ARRAY (fixed + open), RECORD + variants, 22 SET OF (range/base/enum forms), POINTER TO, PROCEDURE types 23 - statements: WITH, IN, IS, set constructors {}, shifts << >>, 24 procedure/function call statements 25 - Clarion-form classes with multi-parent CLAUSE (extra parent = 230) 26 27 Constructs the current scalar backend cannot lower yet PARSE fully 28 and end with the standard SemError(230) "not supported yet" marker, 29 exactly like M2.atg's parse-now/lower-later discipline. Semantic 30 error codes reused from the V1/V2/Test2 family: 31 200 duplicate, 201 undeclared, 202 module name mismatch, 32 210 bad assignment, 211 bad arithmetic, 212 boolean operand, 33 213 incompatible comparison, 214 boolean cond required, 34 220 FOR needs integer var/bounds, 221 not a type name, 35 222 set operand mismatch, 230 not supported yet, 36 231 opaque type outside definition, 232 bad RETURN. 37 38 LL(1) notes (accepted as benign, verified correct codegen): 39 - TypeBlock's CLASS/CLASS IMPLEMENTATION 2-token lookahead 40 - variant-record CASE labels sharing first-sets with field 41 identifier lists (classic Modula-2 ambiguity). 42 ============================================================================= *) 43 44 IMPORT SymTab, QbeGen; 45 46 CHARACTERS 47 eol = CHR(13) . 48 lf = CHR(10) . 49 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" . 50 digit = "0123456789" . 51 octDigit = "01234567" . 52 hexDigit = digit + "ABCDEFabcdef" . 53 noQuote1 = ANY - "'" - eol . 54 noQuote2 = ANY - '"' - eol . 55 56 IGNORE CHR(9) .. CHR(13) 57 58 COMMENTS FROM "(*" TO "*)" NESTED 59 COMMENTS FROM "//" TO lf 60 61 TOKENS 62 (* V3 identifier: classic letters/digits PLUS '_' and '@' which the 63 shipped code uses freely (Graph._VGA, _Find, ct__@Fssssi). *) 64 ident = ( letter | "_" ) { letter | digit | "_" | "@" } . 65 (* Numbers. V3 kept the PIM qualified forms: trailing H = hex, 66 trailing C = character constant (hex value), trailing B = base-8 67 (the Modbase date code needs 60B = 48 = ORD('0'), i.e. octal 60); 68 modern 0x/0X hex-prefix also accepted (TS Dev Guide). The 69 CONTEXT("..") clause keeps `1..10` an integer + range operator 70 rather than the start of a real `1. ...`. *) 71 integer = digit { digit } 72 | digit { digit } CONTEXT("..") 73 | digit { digit } ( "B" | "b" ) 74 | digit { hexDigit } ( "H" | "h" ) 75 | digit { hexDigit } ( "C" | "c" ) 76 | "0x" hexDigit { hexDigit } 77 | "0X" hexDigit { hexDigit } . 78 real = digit { digit } "." { digit } 79 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] . 80 string = "'" { noQuote1 } "'" 81 | '"' { noQuote2 } '"' . 82 83 PRODUCTIONS 84 M2 85 = Unit "." . 86 87 (* Units: program modules compile fully; DEFINITION and 88 IMPLEMENTATION modules parse + check now but lower in step 4 89 (each ends with one 230); same for nested local modules. *) 90 Unit 91 = DefUnit 92 | ImplUnit 93 | ProgModule . 94 DefUnit (. VAR m1, m2, pn: SymTab.Name; .) 95 = "DEFINITION" "MODULE" 96 GetIdent (. SymTab.Init; QbeGen.OpenModule(m1); 97 IF ~SymTab.Enter(m1, 98 SymTab.KindModule) THEN 99 SemError(200) END; .) 100 ";" 101 { Import } 102 { ConstBlock | TypeBlock | VarBlock 103 | ConstDecl ";" (. (* manifest const, no CONST *) .) 104 | ProcHeading ";" (. SymTab.CloseProc; .) 105 | ClassItem ";" } 106 "END" 107 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 108 SemError(202) END; .) 109 (. QbeGen.CloseModule; 110 SemError(230); 111 SymTab.PrintTable; .) . 112 ImplUnit (. VAR m1, m2: SymTab.Name; .) 113 = "IMPLEMENTATION" "MODULE" 114 GetIdent (. SymTab.Init; QbeGen.OpenModule(m1); 115 IF ~SymTab.Enter(m1, 116 SymTab.KindModule) THEN 117 SemError(200) END; .) 118 ";" 119 { Import } 120 DeclSeq 121 [ "BEGIN" (. QbeGen.BeginBody; .) 122 [ StatSeq ] ] 123 "END" 124 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 125 SemError(202) END; .) 126 (. QbeGen.CloseModule; 127 SemError(230); 128 SymTab.PrintTable; .) . 129 ProgModule (. VAR m1, m2: SymTab.Name; .) 130 = "MODULE" 131 GetIdent (. SymTab.Init; QbeGen.OpenModule(m1); 132 IF ~SymTab.Enter(m1, 133 SymTab.KindModule) THEN 134 SemError(200) END; .) 135 [ Priority ] 136 ";" 137 { Import } 138 DeclSeq 139 [ "BEGIN" (. QbeGen.BeginBody; .) 140 [ StatSeq ] ] 141 "END" 142 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 143 SemError(202) END; .) 144 (. QbeGen.EndModule(m1); 145 SymTab.PrintTable; .) . 146 DeclSeq 147 = { ConstBlock | TypeBlock | VarBlock 148 | ConstDecl ";" (. (* manifest const, no CONST *) .) 149 | [ "INLINE" ] ProcDecl ";" 150 | NestedModule ";" | ClassItem ";" 151 | "LABEL" LabelList ";" } . 152 LabelList (. VAR nm: SymTab.Name; .) 153 = GetIdent (. SemError(230); .) 154 { "," GetIdent (. SemError(230); .) } . 155 (* Local module, Wirth form. Parses + checks fully (own scope); 156 lowering waits for step 4, marked by one 230 at END. *) 157 NestedModule (. VAR m1, m2: SymTab.Name; .) 158 = "MODULE" 159 GetIdent (. IF ~SymTab.Enter(m1, 160 SymTab.KindModule) THEN 161 SemError(200) END; 162 SymTab.PushScope; .) 163 [ Priority ] 164 ";" 165 { Import } 166 [ Export ] 167 DeclSeq 168 [ "BEGIN" 169 [ StatSeq ] ] 170 "END" 171 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 172 SemError(202) END; 173 SymTab.PopScope; 174 SemError(230); .) . 175 Priority 176 = "[" integer "]" (. SemError(230); .) . 177 Export (. VAR nm: SymTab.Name; .) 178 = "EXPORT" (* names wire up in step 4 *) 179 [ "QUALIFIED" ] 180 GetIdent 181 { "," GetIdent } 182 ";" . 183 Import (. VAR n: SymTab.Name; .) 184 = "FROM" 185 GetIdent (. IF ~SymTab.Enter(n, 186 SymTab.KindImport) THEN 187 SemError(200) END; .) 188 "IMPORT" 189 ImpList ";" 190 | "IMPORT" 191 ImpList ";" . 192 ImpList (. VAR n: SymTab.Name; .) 193 = GetIdent (. IF ~SymTab.Enter(n, 194 SymTab.KindImport) THEN 195 SemError(200) END; .) 196 { "," 197 GetIdent (. IF ~SymTab.Enter(n, 198 SymTab.KindImport) THEN 199 SemError(200) END; .) } . 200 201 (* Opaque "TYPE T;" needs isDef (definition units); elsewhere 231. *) 202 TypeBlock 203 = "TYPE" { TypeItem ";" | ClassItem ";" } . 204 TypeItem (. VAR n: SymTab.Name; 205 t: SymTab.TypeIndex; .) 206 = GetIdent (. IF ~SymTab.Enter(n, 207 SymTab.KindType) THEN 208 SemError(200) END; .) 209 ( "=" Type (. SymTab.SetSymType(n, t); .) 210 | (. IF ~isDef THEN 211 SemError(231) END; 212 SymTab.SetSymType(n, 213 SymTab.NewAlias()); .) ) . 214 215 (* V3 TYPE surface. Start-symbols are all distinct: 216 ident (named / anchored subrange), '[' (bare subrange), 217 '(' (enum) , ARRAY , RECORD , SET , POINTER , PROCEDURE . *) 218 Type 219 = TypeIdent2 [ "[" 220 SubrangeRest (. (* anchored subrange: 221 SHORTINT[-1..1], 222 SHORTCARD[0..7] *) .) 223 "]" ] 224 | "[" SubrangeRest "]" 225 | Enum 226 | ArrayType 227 | RecordType 228 | SetType 229 | PointerType 230 | "VIRTUAL" "POINTER" TypeIdent2 (. SemError(230); .) 231 | ProcType . 232 233 (* Qualified type ident: Client.ClientRec, SYSTEM.WORD. *) 234 TypeIdent2 (. VAR n: SymTab.Name; 235 k: INTEGER; .) 236 = GetIdent (. IF ~SymTab.Lookup(n) THEN 237 SemError(201); 238 t := SymTab.InvalidType 239 ELSE k := SymTab.SymKind(n); 240 IF (k = SymTab.KindType) 241 OR (k = SymTab.KindPredef) THEN 242 t := SymTab.SymType(n) 243 ELSIF k = SymTab.KindImport THEN 244 t := SymTab.InvalidType 245 ELSE SemError(221); 246 t := SymTab.InvalidType 247 END 248 END; .) 249 { "." GetIdent (. SemError(230); 250 t := SymTab.InvalidType; .) } . 251 252 (* '[' Expr '..' Expr ']' (bare or anchored). Folds literal bounds 253 into a NewSubR subrange; anything else parses but lowers later. *) 254 SubrangeRest 255 (. VAR tlo, thi: SymTab.TypeIndex; 256 qlo, qhi: QbeGen.QVal; 257 lo, hi: INTEGER; .) 258 = Expr ".." Expr 259 (. IF (tlo = SymTab.InvalidType) 260 OR (thi = SymTab.InvalidType) THEN 261 t := SymTab.InvalidType 262 ELSIF (SymTab.ClassOf(tlo) # 263 SymTab.ClInt) 264 OR (SymTab.ClassOf(thi) # 265 SymTab.ClInt) THEN 266 SemError(230); 267 t := SymTab.InvalidType 268 ELSIF ~SymTab.ConstInt(qlo, lo) 269 OR ~SymTab.ConstInt(qhi, hi) 270 OR (lo > hi) THEN 271 SemError(230); 272 t := SymTab.InvalidType 273 ELSE t := SymTab.NewSubR(lo, hi) 274 END; .) . 275 Enum (. VAR n: SymTab.Name; .) 276 = "(" (. t := SymTab.NewEnum(); .) 277 GetIdent (. IF ~SymTab.Enter(n, 278 SymTab.KindConst) THEN 279 SemError(200) END; 280 SymTab.SetSymType(n, t); .) 281 { "," GetIdent (. IF ~SymTab.Enter(n, 282 SymTab.KindConst) THEN 283 SemError(200) END; 284 SymTab.SetSymType(n, t); .) } 285 ")" . 286 287 (* ARRAY [lo..hi] OF T / ARRAY OF T (open formal) / multi bound *) 288 ArrayType (. VAR e: SymTab.TypeIndex; 289 i: CARDINAL; .) 290 = "ARRAY" 291 ( "[" Bound { "," Bound } "]" (. t := SymTab.InvalidType; .) 292 | Bound (. t := SymTab.InvalidType; .) 293 | (. t := SymTab.InvalidType; .) ) 294 "OF" Type (. t := SymTab.NewOpenArray(e); 295 SemError(230); .) . 296 Bound (. VAR t: SymTab.TypeIndex; 297 q: QbeGen.QVal; .) 298 = Expr [ ".." Expr ] (. SemError(230); .) . 299 300 (* RECORD with field lists and tagless/tagged variant CASE. 301 FieldListSequence is the classic PIM form: fields separated by 302 ';', alternatives by '|', optional ELSE. The label-vs-field 303 first-set overlap is the known benign LL(1) advisory. *) 304 RecordType 305 (. VAR n: SymTab.Name; 306 rt: SymTab.TypeIndex; .) 307 = "RECORD" (. rt := SymTab.NewRecord(); 308 t := rt; .) 309 FieldListSequence 310 "END" (. SemError(230); .) . 311 FieldListSequence 312 = [ FieldList { ";" [ FieldList ] } ] . 313 FieldList (. VAR tag: SymTab.Name; 314 ti: SymTab.TypeIndex; .) 315 = "CASE" (. SemError(230); .) 316 ( GetIdent ":" (. (* named selector *) .) 317 | ":" (. (* anonymous selector *) .) 318 | (. (* no selector *) .) ) 319 Type 320 "OF" VariantList 321 "END" 322 | FieldIdents . 323 FieldIdents (. VAR n: SymTab.Name; 324 t: SymTab.TypeIndex; .) 325 = GetIdent (. IF ~SymTab.FieldPending(rec, n) 326 THEN SemError(200) END; .) 327 { "," GetIdent (. IF ~SymTab.FieldPending(rec, n) 328 THEN SemError(200) END; .) } 329 ":" Type (. SymTab.FixPendingF(rec, t); .) . 330 VariantList 331 = [ "|" ] Variant { "|" [ Variant ] } 332 [ "ELSE" FieldListSequence ] . 333 Variant 334 = VariantLabels ":" (. SymTab.PushScope; .) 335 FieldListSequence (. SymTab.PopScope; .) . 336 VariantLabels 337 = VariantLabel { "," VariantLabel } . 338 VariantLabel (. VAR t1, t2: SymTab.TypeIndex; 339 q1, q2: QbeGen.QVal; .) 340 = Expr (. SemError(230); .) 341 [ ".." Expr (. SemError(230); .) ] . 342 343 (* SET OF base: SHORTCARD[0..7], [0..31], CHAR, Direction, 344 (RShift, LShift, Ctrl, ...) *) 345 SetType (. VAR b: SymTab.TypeIndex; .) 346 = "SET" "OF" 347 ( TypeIdent2 (. t := SymTab.NewSet(b); 348 SemError(230); .) 349 | "[" SubrangeRest "]" (. t := SymTab.NewSet(b); 350 SemError(230); .) 351 | Enum (. t := SymTab.NewSet(b); 352 SemError(230); .) ) . 353 PointerType (. VAR b: SymTab.TypeIndex; .) 354 = "POINTER" "TO" Type (. t := SymTab.NewPtr(b); 355 SemError(230); .) . 356 (* PROCEDURE type: Action = PROCEDURE(ElementPtr); IPROC = 357 PROCEDURE(); CompareProc = PROCEDURE(ADDRESS,ADDRESS,CARDINAL) 358 : CompareType; *) 359 ProcType (. VAR b: SymTab.TypeIndex; .) 360 = "PROCEDURE" (. t := SymTab.InvalidType; 361 SemError(230); .) 362 [ "(" [ ProcTypeParam { "," 363 ProcTypeParam } ] ")" ] 364 [ ":" TypeIdent2 (. SemError(230); .) ] . 365 ProcTypeParam (. VAR b: SymTab.TypeIndex; .) 366 = [ "VAR" ] Type (. SemError(230); .) . 367 368 (* Clarion-form classes (docs/OOP.txt): declaration + (single or 369 multiple) parent clause + IMPLEMENTATION blocks. Scopes and 370 member checks now; lowering (vtable, dispatch, THIS) later — 371 one 230 per class/impl block. Methods end with ";" per the 372 Table example. *) 373 (* Single CLASS item in both loops: separating declaration from 374 IMPLEMENTATION at the loop level needs 2-token lookahead 375 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do. 376 The second token decides after CLASS is consumed. *) 377 ClassItem 378 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) . 379 ClassRest (. VAR cn, m2, pn, q: SymTab.Name; 380 ct: SymTab.TypeIndex; .) 381 = GetIdent (. IF ~SymTab.Enter(cn, 382 SymTab.KindType) THEN 383 SemError(200) END; 384 ct := SymTab.NewClass(); 385 SymTab.SetSymType(cn, ct); 386 SymTab.PushClassScope(ct); .) 387 [ Parents ] 388 ";" 389 { ClassField ";" } 390 (* V3 class methods: pure declaration (';' only), FORWARD, or a 391 fully bodied method whose body starts with BEGIN (the corpus 392 form). Each bodied/FORWARD method owns its trailing ';'. *) 393 { MethodHeading ";" 394 ( "FORWARD" (. SymTab.MarkFwd; 395 SymTab.CloseProc; .) 396 ";" 397 | "BEGIN" [ StatSeq ] "END" 398 GetIdent (. IF ~SymTab.Equal(pn, q) THEN 399 SemError(202) END; 400 SymTab.CloseProc; 401 SemError(230); .) 402 ";" 403 | (. SymTab.CloseProc; .) ) } 404 [ "BEGIN" (. SemError(230); .) 405 [ StatSeq ] ] 406 "END" 407 GetIdent (. IF ~SymTab.Equal(cn, m2) THEN 408 SemError(202) END; 409 SymTab.PopScope; 410 SemError(230); .) . 411 (* V3 class header may list several parents 412 (CLASS GenElem (Element, Base2);); this grammar accepts the 413 list and rejects every parent after the first at 230 — the 414 current backend lowers single inheritance only. *) 415 Parents (. VAR p: SymTab.Name; .) 416 = "(" Parent1 417 { "," GetIdent

(. SemError(230); .) } 418 ")" . 419 Parent1 (. VAR p: SymTab.Name; 420 pt: SymTab.TypeIndex; .) 421 = GetIdent

(. IF ~SymTab.Lookup(p) THEN 422 SemError(201) 423 ELSE pt := SymTab.SymType(p); 424 IF SymTab.ClassOf(pt) # 425 SymTab.ClClass THEN 426 SemError(230) 427 ELSE SymTab.SetParent(ct, pt) 428 END 429 END; .) . 430 ClassField (. VAR n, rhs: SymTab.Name; 431 t: SymTab.TypeIndex; .) 432 = GetIdent 433 ( "=" GetIdent (. IF ~SymTab.Enter(n, 434 SymTab.KindConst) THEN 435 SemError(200) END; 436 IF SymTab.Lookup(rhs) THEN 437 SymTab.SetSymType(n, 438 SymTab.SymType(rhs)) 439 END; .) 440 | (. IF ~SymTab.FieldPending(ct, 441 n) THEN 442 SemError(200) END; .) 443 { "," GetIdent (. IF ~SymTab.FieldPending(ct, 444 n) THEN 445 SemError(200) END; .) } 446 ":" TypeIdent2 (. SymTab.FixPendingF(ct, t); .) ) . 447 MethodHeading (. VAR wantVirt: BOOLEAN; .) 448 = (. wantVirt := FALSE; .) 449 [ "VIRTUAL" (. wantVirt := TRUE; .) ] 450 ProcHeading (. IF wantVirt THEN 451 SymTab.MarkVirtual END; .) . 452 ClassImplRest (. VAR cn, m2: SymTab.Name; 453 ct: SymTab.TypeIndex; .) 454 = GetIdent (. IF ~SymTab.Lookup(cn) THEN 455 SemError(201); 456 ct := SymTab.InvalidType 457 ELSE ct := SymTab.SymType(cn); 458 IF SymTab.ClassOf(ct) # 459 SymTab.ClClass THEN 460 SemError(230); 461 ct := SymTab.InvalidType 462 END 463 END; 464 IF ct # 465 SymTab.InvalidType THEN 466 IF ~SymTab.PushClassMembers( 467 ct) THEN 468 SemError(230) END 469 END; .) 470 ";" { MethodImpl ";" } 471 [ "BEGIN" (. QbeGen.BeginBody; .) 472 [ StatSeq ] ] 473 "END" 474 GetIdent (. IF ~SymTab.Equal(cn, m2) THEN 475 SemError(202) END; 476 SymTab.PopScope; 477 SemError(230); .) . 478 MethodImpl (. VAR pn: SymTab.Name; .) 479 = MethodHeading ";" 480 (. IF (ct # 481 SymTab.InvalidType) 482 & ~SymTab.MethodExists(ct, 483 pn) THEN 484 SemError(201) END; .) 485 ( "FORWARD" (. SymTab.MarkFwd; 486 SymTab.CloseProc; .) 487 | Block (. SymTab.CloseProc; 488 SemError(230); .) ) . 489 490 (* E1) double-colon constant alias: Name ::= Expr ; 491 GCoord::=INTEGER; TXBuffer ::= IOBase; *) 492 ConstBlock 493 = "CONST" { ConstDecl ";" } . 494 ConstDecl (. VAR n: SymTab.Name; 495 t: SymTab.TypeIndex; 496 qv: QbeGen.QVal; 497 cls: INTEGER; .) 498 = GetIdent (. IF ~SymTab.Enter(n, 499 SymTab.KindConst) THEN 500 SemError(200) END; .) 501 ( "::=" (. SemError(230); .) 502 Expr (. SymTab.SetSymType(n, t); 503 QbeGen.DeclConst(n, "0", 504 SymTab.InvalidType); .) 505 | "=" 506 Expr (. SymTab.SetSymType(n, t); 507 cls := SymTab.ClassOf(t); 508 IF cls = SymTab.ClStr THEN 509 SemError(230) 510 ELSIF ~QbeGen.IsImm(qv) THEN 511 SemError(230) END; 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 (* V3 VAR types may be composites; the scalar phase lowers the 521 integer/char/bool/real family and reports 230 for the rest. *) 522 Type (. cls := SymTab.ClassOf(t); 523 IF (t # SymTab.InvalidType) 524 & (cls # SymTab.ClInt) 525 & (cls # SymTab.ClBool) 526 & (cls # SymTab.ClChar) 527 & (cls # SymTab.ClReal) THEN 528 SemError(230) END; 529 i := 0; 530 WHILE i < SymTab.PendCount() DO 531 SymTab.PendName(i, nm); 532 QbeGen.DeclVar(nm, t); 533 INC(i) 534 END; 535 IF NOT SymTab.FixPending(t) THEN END; .) . 536 VarIdents (. VAR n: SymTab.Name; 537 t: SymTab.TypeIndex; 538 q: QbeGen.QVal; .) 539 = GetIdent (. IF ~SymTab.EnterPending(n, 540 SymTab.KindVar) THEN 541 SemError(200) END; .) 542 [ "[" Expr (. SemError(230); .) 543 [ ":" Expr (. SemError(230); .) ] 544 "]" ] 545 { "," 546 GetIdent (. IF ~SymTab.EnterPending(n, 547 SymTab.KindVar) THEN 548 SemError(200) END; .) 549 [ "[" Expr (. SemError(230); .) 550 [ ":" Expr (. SemError(230); .) ] 551 "]" ] } . 552 ParIdents (. VAR n: SymTab.Name; .) 553 = GetIdent (. IF ~SymTab.EnterParam(n, isV) THEN 554 SemError(200) END; .) 555 { "," GetIdent (. IF ~SymTab.EnterParam(n, isV) THEN 556 SemError(200) END; .) } . 557 558 (* Procedure headings enter now (scopes, params, result); bodies 559 parse + check with one 230 at END (lowering = step 4). 560 FORWARD marks; the body heading re-enters (signature compare 561 tightens in step 4). *) 562 ProcHeading (. VAR t: SymTab.TypeIndex; .) 563 = "PROCEDURE" 564 GetIdent (. IF ~SymTab.EnterProc(pn) THEN 565 IF ~SymTab.ReenterProc(pn) THEN 566 SemError(200) END 567 END; .) 568 [ FormalParams ] 569 [ ":" TypeIdent2 (. IF NOT SymTab.SetProcRes(t) THEN END; .) ] . 570 FormalParams 571 = "(" [ ParamSection { ";" ParamSection } ] ")" . 572 ParamSection (. VAR t: SymTab.TypeIndex; 573 isV: BOOLEAN; .) 574 = (. isV := FALSE; .) 575 [ "VAR" (. isV := TRUE; .) ] 576 ParIdents ":" Type (. IF NOT SymTab.FixPending(t) THEN END; .) . 577 ProcDecl (. VAR pn, assem: SymTab.Name; 578 at: SymTab.TypeIndex; 579 ak: INTEGER; 580 aq: QbeGen.QVal; .) 581 = ProcHeading 582 ( ";" 583 ( "FORWARD" (. SymTab.MarkFwd; 584 SymTab.CloseProc; .) 585 | "IN" GetIdent (. SymTab.CloseProc; 586 SemError(230); .) 587 | Block (. SymTab.CloseProc; 588 SemError(230); .) ) 589 | "=" Design (. SymTab.CloseProc; 590 SemError(230); .) 591 "(" [ ActualParams ] ")" ) . 592 Block (. VAR m2: SymTab.Name; .) 593 = DeclSeq 594 [ "BEGIN" 595 [ StatSeq ] ] 596 "END" 597 GetIdent (. IF ~SymTab.Equal(pn, m2) THEN 598 SemError(202) END; .) . 599 StatSeq 600 = Statement { ";" [ Statement ] } . 601 602 (* Statements. Assignments and procedure/function calls both start 603 with a designator, so they share one factored production: after 604 the designator, ':=' selects assignment, '(' a call, anything 605 else is a parameterless procedure-call statement. *) 606 Statement (. VAR lx: QbeGen.QVal; 607 lqn: SymTab.Name; .) 608 = DesignStat 609 | IfStat 610 | WhileStat 611 | RepeatStat 612 | LoopStat 613 | ForStat 614 | CaseStat 615 | WithStat 616 | ReturnStat 617 | "GOTO" GetIdent (. SemError(230); .) 618 | "EXIT" (. IF QbeGen.TopLoop(lx) THEN 619 QbeGen.Jmp(lx) 620 ELSE SemError(230) END; .) . 621 DesignStat (. VAR dt, et: SymTab.TypeIndex; 622 dk: INTEGER; 623 qd, qe, qt: QbeGen.QVal; 624 qn: SymTab.Name; 625 isR, conv: BOOLEAN; .) 626 = Design2 627 ( ":=" Expr (. IF (dt # SymTab.InvalidType) 628 & (dk # SymTab.KindVar) 629 & (dk # SymTab.KindParam) THEN 630 SemError(210) 631 ELSIF ~SymTab.Assignable(et, 632 dt) THEN 633 SemError(210) END; 634 isR := (dt # 635 SymTab.InvalidType) 636 & (SymTab.ClassOf(dt) 637 = SymTab.ClReal); 638 conv := isR 639 & SymTab.IsIntFamily(et); 640 IF ((dk = SymTab.KindVar) 641 OR (dk = SymTab.KindParam)) 642 & (dt # SymTab.InvalidType) 643 & (et # SymTab.InvalidType) THEN 644 IF conv THEN 645 QbeGen.ConvIR(qe, qt); 646 QbeGen.StoreVar(qn, qt, TRUE) 647 ELSE 648 QbeGen.StoreVar(qn, qe, isR) 649 END 650 END; .) 651 | "(" [ ActualParams ] ")" (. SemError(230); .) 652 | (. SemError(230); .) ) . 653 ActualParams (. VAR t: SymTab.TypeIndex; 654 q: QbeGen.QVal; .) 655 = Expr { "," Expr } . 656 IfStat (. VAR t: SymTab.TypeIndex; 657 q, lThen, lElse, lEnd: 658 QbeGen.QVal; 659 hasElse: BOOLEAN; .) 660 = "IF" (. hasElse := FALSE; .) 661 Expr (. IF ~SymTab.BoolCheck(t) THEN 662 SemError(214) END; 663 QbeGen.NewLabel(lThen); 664 QbeGen.NewLabel(lElse); 665 QbeGen.NewLabel(lEnd); 666 QbeGen.Jnz(q, lThen, lElse); 667 QbeGen.EmitLabel(lThen); .) 668 "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .) 669 { "ELSIF" (. QbeGen.EmitLabel(lElse); 670 QbeGen.NewLabel(lElse); .) 671 Expr (. IF ~SymTab.BoolCheck(t) THEN 672 SemError(214) END; 673 QbeGen.NewLabel(lThen); 674 QbeGen.Jnz(q, lThen, lElse); 675 QbeGen.EmitLabel(lThen); .) 676 "THEN" [ StatSeq ] (. QbeGen.Jmp(lEnd); .) } 677 [ "ELSE" (. QbeGen.EmitLabel(lElse); 678 hasElse := TRUE; .) 679 [ StatSeq ] ] 680 "END" (. IF hasElse THEN 681 QbeGen.EmitLabel(lEnd) 682 ELSE QbeGen.EmitLabel(lElse); 683 QbeGen.EmitLabel(lEnd) 684 END; .) . 685 WhileStat (. VAR t: SymTab.TypeIndex; 686 q, lTop, lBody, lEnd: 687 QbeGen.QVal; .) 688 = "WHILE" (. QbeGen.NewLabel(lTop); 689 QbeGen.NewLabel(lBody); 690 QbeGen.NewLabel(lEnd); 691 QbeGen.EmitLabel(lTop); .) 692 Expr (. IF ~SymTab.BoolCheck(t) THEN 693 SemError(214) END; 694 QbeGen.Jnz(q, lBody, lEnd); 695 QbeGen.EmitLabel(lBody); .) 696 "DO" [ StatSeq ] (. QbeGen.Jmp(lTop); .) 697 "END" (. QbeGen.EmitLabel(lEnd); .) . 698 RepeatStat (. VAR t: SymTab.TypeIndex; 699 q, lTop, lEnd: QbeGen.QVal; .) 700 = "REPEAT" (. QbeGen.NewLabel(lTop); 701 QbeGen.NewLabel(lEnd); 702 QbeGen.EmitLabel(lTop); .) 703 [ StatSeq ] 704 "UNTIL" Expr (. IF ~SymTab.BoolCheck(t) THEN 705 SemError(214) END; 706 QbeGen.Jnz(q, lEnd, lTop); 707 QbeGen.EmitLabel(lEnd); .) . 708 LoopStat (. VAR lTop, lEnd: QbeGen.QVal; .) 709 = "LOOP" (. QbeGen.NewLabel(lTop); 710 QbeGen.NewLabel(lEnd); 711 QbeGen.PushLoop(lEnd); 712 QbeGen.EmitLabel(lTop); .) 713 [ StatSeq ] 714 "END" (. QbeGen.Jmp(lTop); 715 QbeGen.PopLoop; 716 QbeGen.EmitLabel(lEnd); .) . 717 (* FOR with static-sign BY (literal, non-zero; 220 otherwise). 718 Runtime direction would need a compare-select; the literal 719 sign picks cslew/csegew at "DO" time. *) 720 ForStat (. VAR lv: SymTab.Name; 721 tlo, thi, tby: 722 SymTab.TypeIndex; 723 qlo, qhi, qby, qt, qk, qb: 724 QbeGen.QVal; 725 lTop, lBody, lEnd: 726 QbeGen.QVal; 727 by: INTEGER; 728 ok: BOOLEAN; .) 729 = "FOR" (. by := 1; .) 730 GetIdent (. ok := SymTab.Lookup(lv); 731 IF ~ok THEN 732 SemError(201) 733 ELSIF (SymTab.SymKind(lv) # 734 SymTab.KindVar) 735 & (SymTab.SymKind(lv) # 736 SymTab.KindParam) THEN 737 SemError(220); ok := FALSE 738 ELSIF ~SymTab.IsIntFamily( 739 SymTab.SymType(lv)) THEN 740 SemError(220); ok := FALSE 741 END; .) 742 ":=" Expr (. IF ~SymTab.IsIntFamily(tlo) THEN 743 SemError(220); ok := FALSE 744 END; .) 745 "TO" Expr (. IF ~SymTab.IsIntFamily(thi) THEN 746 SemError(220); ok := FALSE 747 END; .) 748 [ "BY" Expr (. IF (tby # 749 SymTab.InvalidType) 750 & ~SymTab.IsIntFamily(tby) THEN 751 SemError(220); ok := FALSE 752 END; 753 IF ~SymTab.ConstInt(qby, by) THEN 754 SemError(230); by := 1 755 ELSIF by = 0 THEN 756 SemError(220); by := 1 757 END; .) ] 758 "DO" (. IF ok THEN 759 QbeGen.StoreVar(lv, qlo, 760 FALSE) END; 761 QbeGen.NewLabel(lTop); 762 QbeGen.NewLabel(lBody); 763 QbeGen.NewLabel(lEnd); 764 QbeGen.EmitLabel(lTop); 765 QbeGen.LoadVar(lv, FALSE, qt); 766 QbeGen.NewTemp(qk); 767 IF by > 0 THEN 768 QbeGen.Op3("cslew", qk, 769 qt, qhi, FALSE) 770 ELSE QbeGen.Op3("csgew", qk, 771 qt, qhi, FALSE) 772 END; 773 QbeGen.Jnz(qk, lBody, lEnd); 774 QbeGen.EmitLabel(lBody); .) 775 [ StatSeq ] 776 "END" (. IF ok THEN 777 QbeGen.LoadVar(lv, FALSE, 778 qt); 779 QbeGen.IntStr(by, qb); 780 QbeGen.NewTemp(qk); 781 QbeGen.Op3("add", qk, 782 qt, qb, FALSE); 783 QbeGen.StoreVar(lv, qk, 784 FALSE) END; 785 QbeGen.Jmp(lTop); 786 QbeGen.EmitLabel(lEnd); .) . 787 CaseStat (. VAR tsel: SymTab.TypeIndex; 788 qsel, lEnd: QbeGen.QVal; .) 789 = "CASE" Expr (. QbeGen.NewLabel(lEnd); .) 790 "OF" [ "|" ] 791 { CaseAlt 792 [ ";" ] [ "|" ] } 793 [ "ELSE" [ StatSeq ] ] 794 "END" (. QbeGen.EmitLabel(lEnd); .) . 795 (* Compare-chain lowering: each alternative ends its match-tests 796 with "jmp lAfter", so the no-match fallthrough skips the body: 797 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd; 798 lAfter:". Falls into the next alternative, ELSE, or END. *) 799 CaseAlt (. VAR lBody, lAfter: QbeGen.QVal; .) 801 = (. QbeGen.NewLabel(lBody); 802 QbeGen.NewLabel(lAfter); .) 803 CaseLabel 804 { "," CaseLabel } 805 ":" (. QbeGen.Jmp(lAfter); 806 QbeGen.EmitLabel(lBody); .) 807 [ StatSeq (. QbeGen.Jmp(lEnd); .) ] 808 (. QbeGen.EmitLabel(lAfter); .) . 809 CaseLabel (. VAR t2, t3: SymTab.TypeIndex; 811 q2, q3, qc, qd, qe: 812 QbeGen.QVal; 813 lNext: QbeGen.QVal; .) 814 = Expr (. IF (t2 # 815 SymTab.InvalidType) 816 & (tsel # 817 SymTab.InvalidType) 818 & ~SymTab.EqCheck(t2, 819 tsel) THEN 820 SemError(213) END; 821 IF ~QbeGen.IsImm(q2) THEN 822 SemError(230); 823 QbeGen.CopyOp("0", q2) 824 END; 825 QbeGen.NewLabel(lNext); 826 QbeGen.Cmp(SymTab.OpEq, 827 qsel, q2, qc, FALSE); 828 QbeGen.Jnz(qc, lBody, lNext); 829 QbeGen.EmitLabel(lNext); .) 830 [ ".." Expr (. IF (t3 # 831 SymTab.InvalidType) 832 & (tsel # 833 SymTab.InvalidType) 834 & ~SymTab.EqCheck(t3, 835 tsel) THEN 836 SemError(213) END; 837 IF ~QbeGen.IsImm(q3) THEN 838 SemError(230); 839 QbeGen.CopyOp("0", q3) 840 END; 841 QbeGen.Cmp(SymTab.OpGe, 842 qsel, q2, qc, FALSE); 843 QbeGen.Cmp(SymTab.OpLe, 844 qsel, q3, qd, FALSE); 845 QbeGen.NewTemp(qe); 846 QbeGen.Op3("and", qe, qc, qd, 847 FALSE); 848 QbeGen.NewLabel(lNext); 849 QbeGen.Jnz(qe, lBody, lNext); 850 QbeGen.EmitLabel(lNext); .) ] . 851 ReturnStat (. VAR t: SymTab.TypeIndex; 852 q: QbeGen.QVal; 853 res: SymTab.TypeIndex; 854 hadE: BOOLEAN; .) 855 = "RETURN" (. hadE := FALSE; .) 856 [ Expr (. hadE := TRUE; .) ] 857 (. IF ~SymTab.InProc() THEN 858 SemError(232) 859 ELSE res := SymTab.CurRes(); 860 IF ~hadE THEN 861 IF res # 862 SymTab.InvalidType THEN 863 SemError(232) END 864 ELSIF (res = 865 SymTab.InvalidType) 866 OR (t # 867 SymTab.InvalidType) 868 & ~SymTab.Assignable(t, 869 res) THEN 870 SemError(232) 871 END 872 END; .) . 873 (* WITH pushes the record's fields as an inner scope (classic 874 short-hand member access); record lowering is still 230. *) 875 WithStat (. VAR t: SymTab.TypeIndex; 876 k: INTEGER; 877 q: QbeGen.QVal; 878 qn: SymTab.Name; .) 879 = "WITH" Design2 (. IF ~SymTab.PushRecord(t) THEN 880 SemError(230) END; .) 881 "DO" [ StatSeq ] 882 "END" (. SymTab.PopScope; 883 SemError(230); .) . 884 885 (* Designators (E3): simple names behave exactly like the scalar 886 phase; '.' '^' '[' selector chains parse and report one 230 887 (member/pointer/array lowering arrives with step 3). *) 888 Design 890 (. VAR n: SymTab.Name; 891 cls: INTEGER; .) 892 = GetIdent (. QbeGen.CopyOp(n, qn); 893 IF ~SymTab.Lookup(n) THEN 894 SemError(201); 895 t := SymTab.InvalidType; 896 k := -1; 897 QbeGen.CopyOp("0", q) 898 ELSE 899 t := SymTab.SymType(n); 900 k := SymTab.SymKind(n); 901 IF k = SymTab.KindConst THEN 902 IF SymTab.Equal(n, 903 "TRUE") THEN 904 t := SymTab.BoolType(); 905 QbeGen.CopyOp("1", q) 906 ELSIF SymTab.Equal(n, 907 "FALSE") THEN 908 t := SymTab.BoolType(); 909 QbeGen.CopyOp("0", q) 910 ELSE 911 cls := SymTab.ClassOf(t); 912 IF (t # SymTab.InvalidType) 913 & ((cls = SymTab.ClInt) 914 OR (cls = SymTab.ClChar) 915 OR (cls = SymTab.ClReal)) THEN 916 QbeGen.LoadVar(n, 917 cls = SymTab.ClReal, q) 918 ELSE 919 IF t # SymTab.InvalidType 920 THEN SemError(230) 921 END; 922 QbeGen.CopyOp("0", q) 923 END 924 END 925 ELSIF (k = SymTab.KindVar) 926 OR (k = SymTab.KindParam) THEN 927 cls := SymTab.ClassOf(t); 928 IF (cls = SymTab.ClInt) 929 OR (cls = SymTab.ClBool) 930 OR (cls = SymTab.ClChar) 931 OR (cls = SymTab.ClReal) THEN 932 QbeGen.LoadVar(n, 933 cls = SymTab.ClReal, q) 934 ELSE SemError(230); 935 QbeGen.CopyOp("0", q) 936 END 937 ELSE QbeGen.CopyOp("0", q); 938 IF (k = SymTab.KindImport) 939 OR (k = SymTab.KindProc) 940 OR (k = SymTab.KindField) THEN 941 SemError(230) 942 END 943 END 944 END; .) . 945 Design2 947 = Design 948 { "." GetIdent (. SemError(230); 949 t := SymTab.InvalidType; .) 950 | "^" (. SemError(230); 951 t := SymTab.InvalidType; .) 952 | "[" ExprList "]" (. SemError(230); 953 t := SymTab.InvalidType; .) 954 | "(" [ ActualParams ] ")" (. SemError(230); 955 t := SymTab.InvalidType; .) } . 956 ExprList (. VAR t: SymTab.TypeIndex; 957 q: QbeGen.QVal; .) 958 = Expr { "," Expr } . 959 960 (* Expressions. After SimExpr the optional suffix is decided by a 961 distinct first token: relation (= # <> < <= > >=), IN, or IS. *) 962 Expr 963 (. VAR t2: SymTab.TypeIndex; 964 op: INTEGER; 965 q2, qt: QbeGen.QVal; 966 isR: BOOLEAN; .) 967 = SimExpr 968 [ Rel SimExpr 969 (. IF SymTab.RelCheck(t, t2, op) THEN 970 isR := SymTab.ClassOf(t) = SymTab.ClReal; 971 t := SymTab.BoolType() 972 ELSE SemError(213); t := SymTab.InvalidType; 973 isR := FALSE END; 974 IF t # SymTab.InvalidType THEN 975 QbeGen.Cmp(op, q, q2, qt, isR); 976 QbeGen.CopyOp(qt, q) 977 ELSE QbeGen.CopyOp("0", q) 978 END; .) 979 | "IN" SimExpr (. IF ~SymTab.InCheck(t, t2) THEN 980 SemError(222) END; 981 SemError(230); 982 QbeGen.CopyOp("0", q); 983 t := SymTab.InvalidType; .) 984 | "IS" TypeIdent2 (. SemError(213); 985 SemError(230); 986 QbeGen.CopyOp("0", q); 987 t := SymTab.InvalidType; .) ] . 988 (* V3 relations keep both PIM '#" and the '<>' alias. *) 989 Rel 990 = "=" (. op := SymTab.OpEq; .) 991 | "#" (. op := SymTab.OpNeq1; .) 992 | "<>" (. op := SymTab.OpNeq1; .) 993 | "<" (. op := SymTab.OpLt; .) 994 | "<=" (. op := SymTab.OpLe; .) 995 | ">" (. op := SymTab.OpGt; .) 996 | ">=" (. op := SymTab.OpGe; .) . 997 SimExpr 998 (. VAR t2, res2: SymTab.TypeIndex; 999 op: INTEGER; 1000 q2, qt: QbeGen.QVal; 1001 neg, isR: BOOLEAN; .) 1002 = (. neg := FALSE; .) 1003 [ "+" | "-" (. neg := TRUE; .) ] 1004 Term (. IF neg THEN 1005 IF QbeGen.IsImm(q) THEN 1006 QbeGen.NegFold(q, q) 1007 ELSE QbeGen.NewTemp(qt); 1008 QbeGen.NegQ(q, qt, 1009 SymTab.ClassOf(t) 1010 = SymTab.ClReal); 1011 QbeGen.CopyOp(qt, q) 1012 END 1013 END; .) 1014 { AddOp Term 1015 (. IF op = SymTab.OpOr THEN 1016 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN 1017 t := SymTab.BoolType() 1018 ELSE SemError(212); t := SymTab.InvalidType END; 1019 IF t # SymTab.InvalidType THEN 1020 QbeGen.NewTemp(qt); 1021 QbeGen.Op3("or", qt, q, q2, FALSE); 1022 QbeGen.CopyOp(qt, q) 1023 ELSE QbeGen.CopyOp("0", q) 1024 END 1025 ELSE 1026 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN 1027 t := res2 1028 ELSE SemError(211); t := SymTab.InvalidType END; 1029 isR := SymTab.ClassOf(t) = SymTab.ClReal; 1030 IF t # SymTab.InvalidType THEN 1031 QbeGen.NewTemp(qt); 1032 IF op = SymTab.OpAdd THEN 1033 QbeGen.Op3("add", qt, q, q2, isR) 1034 ELSE 1035 QbeGen.Op3("sub", qt, q, q2, isR) 1036 END; 1037 QbeGen.CopyOp(qt, q) 1038 ELSE QbeGen.CopyOp("0", q) 1039 END 1040 END; .) } . 1041 AddOp 1042 = "+" (. op := SymTab.OpAdd; .) 1043 | "-" (. op := SymTab.OpSub; .) 1044 | "OR" (. op := SymTab.OpOr; .) . 1045 (* Term holds multiplication, AND (word or '&'), and the V3 shift 1046 operators << >>. MulOp start symbols are all distinct. *) 1047 Term 1048 (. VAR t2, res2: SymTab.TypeIndex; 1049 op: INTEGER; 1050 q2, qt: QbeGen.QVal; 1051 isR: BOOLEAN; .) 1052 = Fact { MulOp Fact 1053 (. IF (op = SymTab.OpAnd) THEN 1054 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN 1055 t := SymTab.BoolType() 1056 ELSE SemError(212); t := SymTab.InvalidType END; 1057 IF t # SymTab.InvalidType THEN 1058 QbeGen.NewTemp(qt); 1059 QbeGen.Op3("and", qt, q, q2, FALSE); 1060 QbeGen.CopyOp(qt, q) 1061 ELSE QbeGen.CopyOp("0", q) 1062 END 1063 ELSIF (op = 10) OR (op = 11) THEN 1064 (* << and >> : V3 word shifts; QBE shl/sar. *) 1065 IF ~SymTab.IsIntFamily(t) OR ~SymTab.IsIntFamily(t2) THEN 1066 SemError(211); t := SymTab.InvalidType END; 1067 IF t # SymTab.InvalidType THEN 1068 QbeGen.NewTemp(qt); 1069 IF op = 10 THEN QbeGen.Op3("shl", qt, q, q2, FALSE) 1070 ELSE QbeGen.Op3("sar", qt, q, q2, FALSE) END; 1071 QbeGen.CopyOp(qt, q) 1072 ELSE QbeGen.CopyOp("0", q) 1073 END 1074 ELSE 1075 IF SymTab.ArithCheck(t, t2, 1076 (op = SymTab.OpDiv) OR (op = SymTab.OpMod), 1077 res2) THEN t := res2 1078 ELSE SemError(211); t := SymTab.InvalidType END; 1079 isR := SymTab.ClassOf(t) = SymTab.ClReal; 1080 IF t # SymTab.InvalidType THEN 1081 QbeGen.NewTemp(qt); 1082 IF op = SymTab.OpTimes THEN 1083 QbeGen.Op3("mul", qt, q, q2, isR) 1084 ELSIF (op = SymTab.OpDiv) 1085 OR (op = SymTab.OpSlash) THEN 1086 QbeGen.Op3("div", qt, q, q2, isR) 1087 ELSE 1088 QbeGen.Op3("rem", qt, q, q2, isR) 1089 END; 1090 QbeGen.CopyOp(qt, q) 1091 ELSE QbeGen.CopyOp("0", q) 1092 END 1093 END; .) } . 1094 MulOp 1095 = "*" (. op := SymTab.OpTimes; .) 1096 | "/" (. op := SymTab.OpSlash; .) 1097 | "DIV" (. op := SymTab.OpDiv; .) 1098 | "MOD" (. op := SymTab.OpMod; .) 1099 | "AND" (. op := SymTab.OpAnd; .) 1100 | "&" (. op := SymTab.OpAnd; .) 1101 | "<<" (. op := 10; .) 1102 | ">>" (. op := 11; .) . 1103 Fact 1104 (. VAR s: ARRAY [0 .. 255] OF CHAR; 1105 et, dt, t2, b: 1106 SymTab.TypeIndex; 1107 dk: INTEGER; 1108 qd, q2: QbeGen.QVal; 1109 qn: SymTab.Name; 1110 isCh: BOOLEAN; .) 1111 = integer (. LexString(s); 1112 QbeGen.NormLit(s, q, isCh); 1113 IF isCh THEN 1114 t := SymTab.CharType() 1115 ELSE t := SymTab.IntType() 1116 END; .) 1117 | real (. LexString(s); 1118 QbeGen.NormReal(s, q); 1119 t := SymTab.RealType(); .) 1120 | string (. LexString(s); 1121 IF SymTab.StrLen(s) <= 3 THEN 1122 t := SymTab.CharType(); 1123 QbeGen.IntStr( 1124 QbeGen.CharVal(s), q) 1125 ELSE t := SymTab.NewStr(); 1126 SemError(230); 1127 QbeGen.CopyOp("0", q) 1128 END; .) 1129 | "{" [ SetItems ] "}" (. SemError(230); 1130 QbeGen.CopyOp("0", q); 1131 t := SymTab.InvalidType; .) 1132 | "[" Expr ":" Expr 1133 (. SemError(230); 1134 QbeGen.CopyOp("0", q); 1135 t := SymTab.InvalidType; .) 1136 [ TypeIdent2 ] "]" 1137 MapTail 1138 | Design2 (. t := dt; 1139 QbeGen.CopyOp(qd, q); .) 1140 | "(" Expr ")" (. t := et; .) 1141 | "NOT" Fact (. IF SymTab.BoolCheck(t2) THEN 1142 t := SymTab.BoolType() 1143 ELSE SemError(212); 1144 t := SymTab.InvalidType END; 1145 IF t # SymTab.InvalidType THEN 1146 QbeGen.NotQ(q2, q) 1147 ELSE QbeGen.CopyOp("0", q) 1148 END; .) 1149 | "~" Fact (. IF SymTab.BoolCheck(t2) THEN 1150 t := SymTab.BoolType() 1151 ELSE SemError(212); 1152 t := SymTab.InvalidType END; 1153 IF t # SymTab.InvalidType THEN 1154 QbeGen.NotQ(q2, q) 1155 ELSE QbeGen.CopyOp("0", q) 1156 END; .) . 1157 MapTail (* suffix chain after a mapped-array 1158 constructor: deref, field or 1159 subscript, like a designator. *) 1160 (. VAR mq: SymTab.Name; 1161 et: SymTab.TypeIndex; 1162 q2: QbeGen.QVal; .) 1163 = { "." GetIdent (. SemError(230); .) 1164 | "^" (. SemError(230); .) 1165 | "[" Expr "]" (. SemError(230); .) 1166 | "(" [ ActualParams ] ")" (. SemError(230); .) } . 1167 SetItems 1168 = SetItem { "," SetItem } . 1169 SetItem (. VAR t1, t2: SymTab.TypeIndex; 1170 q1, q2: QbeGen.QVal; .) 1171 = Expr (. SemError(230); .) 1172 [ ".." Expr (. SemError(230); .) ] . 1173 GetIdent 1174 = ident (. LexName(n); .) . 1175 1176 END M2. 0 errors Statistics: nr of terminals: 83 (limit 400) nr of non-terminals: 79 (limit 210) nr of pragmas: 0 (limit 417) nr of symbolnodes: 162 (limit 500) nr of graphnodes: 880 (limit 1500) nr of conditionsets: 12 (limit 100) nr of charactersets: 23 (limit 250)