Coco/R - Compiler-Compiler V1.53 Released by Pat Terry 17 September 2002 Source file: M2c.atg Grammar Tests: Deletable symbols: Case DesignTail Stat Field FieldSeq StatSeq Undefined nonterminals: -- none -- Unreachable nonterminals: -- none -- Circular derivations: -- none -- Underivable nonterminals: -- none -- LL(1) conditions: LL(1) error in ArrayType: "OF" is the start & successor of a deletable structure Listing: 1 COMPILER M2c 2 (* Modula-2 program modules with procedures and composites, MC64 backend 3 (see MGen for details). Step 11 adds separate compilation units 4 (DEFINITION / IMPLEMENTATION / IMPORT) into a single image: 5 6 - session: M2c f1.def f2.mod ... prog.mod — definition files, 7 then implementations, then exactly one program module; 8 one .MC4 image, one .LST per input, fail-fast on the 9 first bad file. SymTab.Init + MGen.OpenModule run once in the 10 driver; the program unit sets the image name (SetModName). 11 - DEFINITION MODULE L: CONST/TYPE/VAR + procedure headings only; 12 everything declared is exported (export tables + in-memory 13 interface side table); VAR/CONST allocate their global slots 14 once ("L.x"); proc headings reserve numbers via the forward 15 machinery. No nested MODULEs, no BEGIN. 16 - IMPLEMENTATION MODULE L: needs its definition (201); re-enters 17 the interface implicitly (redeclared exports are 200 18 duplicates); headings match via ReuseProc/VerifyProc (231); 19 private decls allowed; every heading needs its body (231); 20 optional BEGIN init runs at startup in file order. 21 - IMPORT L validates a known definition (201); FROM L IMPORT x 22 materializes real alias symbols (types/consts/vars share the 23 definition's descriptors and globals via GlobAlias; procs 24 share the number, so call checking is unchanged). Ghost 25 names are 201, bad kinds 221, duplicates 200. 26 - caps (phase): 8 definitions, 32 interface names each, 27 64 FROM-aliases; still one image, depCount 0 (no multi-.MC4, 28 no circular imports, no opaque types). 29 30 Older notes (steps 1-10): 31 - program module only, no DEFINITION / IMPLEMENTATION split 32 - local MODULEs (single-file, no nesting): EXPORT of VARs, CONSTs, 33 TYPEs and procedures (value/VAR params, functions, open array 34 formals with fixed actuals); use as M.x / M.P(args); optional 35 BEGIN..END init bodies run at startup in declaration order; 36 no PRIORITY 37 - procedures: declarations (nested), value and VAR parameters, 38 functions with RETURN, recursion, FORWARD headings; 39 no procedure types/variables, no cones 40 - composites (Phase 3): fixed ARRAYs (bounds, 1D/multi-D indexing, 41 unchecked, byte-packed CHAR/BOOLEAN), RECORDs (field offsets, 42 .field, WITH incl. nested), SETs (+ union, - difference, 43 * intersection, inclusive .. ranges), POINTERs (NEW/DISPOSE via 44 VM ALLOCATE, ^, NIL), strings (ARRAY OF CHAR literal assign). 45 Open arrays deferred; whole array/record copy deferred except 46 string literals; VAR actuals must be simple (no a[i]/p^/fields 47 as VAR actuals, 233); value composite params rejected (230); 48 composite function returns rejected (unchecked, avoid wrong LEAVE). 49 - statements: assignment, procedure call, IF, CASE, WHILE, 50 REPEAT, LOOP/EXIT, FOR, WITH, RETURN, NEW, DISPOSE 51 - symbol table (SymTab) with static type checking: error codes 52 200/201/202 and 210-224 (as before), plus 231 (procedure 53 forward mismatch or missing body), 232 (bad RETURN), 233 54 (invalid procedure call); same lenient rules (single pass, 55 declare-before-use, except POINTER bases may be same-scope 56 aliases with structural pointer compatibility in Assignable; 57 INTEGER, CARDINAL and subranges form one 58 integer family; no mixed INTEGER/REAL arithmetic; INTEGER 59 assigns to REAL; 1-character literal is CHAR; InvalidType 60 suppresses follow-on errors) 61 - backend (MGen): single-module MC64 image .MC4, 62 runnable with mcint. Procedures take table entries 1..N 63 (0 = module body), run with ENTER frames, called via ED 64 (global), EC (directly nested) or EE (display walk); actuals 65 evaluate left-to-right into temps, then push reversed. 66 Lowered: scalar + composite globals/frame vars (multi-slot, 67 byte sizes, field/element offsets), CONST literals, 68 SET masks with literals/ranges/IN/=/#/+-/*; full scalar + 69 composite expressions (scaled indexing via IdxScale, field 70 via FieldAdd, deref via 41H/60H, byte ops 0DH/1DH for CHAR); 71 control flow via E0/E1 jumps; composite assign via 72 StoreIndir0/StoreByte (scalar elems) and copy_block (strings). 73 The rest parses and type-checks 74 but gets error 230: open arrays, whole array/record copy 75 (except string literals), value composite params/returns, 76 non-literal CONST expressions and BY steps, 77 EXIT outside LOOP, imported names used as values. 78 - test convention (the language has no I/O): a global 79 VAR ExitCode : INTEGER; 80 is printed as decimal + CRLF through an embedded helper; 81 without it the program just ends. 82 - known semantic edges: INTEGER DIV/MOD truncate toward zero; 83 CARDINAL past MAXINT compares as signed; AND/OR are eager; 84 REAL widens to binary64; unchecked ARRAY indexing (no DA/DB); 85 NIL dereference reads 0 (no static check, no VM trap yet); 86 CHAR/BOOLEAN arrays byte-packed (1 byte/elem, slots over- 87 allocated 8x); at most 64 procedures, 64 actuals 88 per call, 16 names per FP-section, 8-deep nested calls, 89 8-deep WITH, 1024 slots max per type. *) 90 91 IMPORT SymTab, MGen; 92 93 CHARACTERS 94 eol = CHR(13) . 95 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" . 96 digit = "0123456789" . 97 hexDigit = digit + "ABCDEF" . 98 noQuote1 = ANY - "'" - eol . 99 noQuote2 = ANY - '"' - eol . 100 101 IGNORE CHR(9) .. CHR(13) 102 103 COMMENTS 104 FROM "(*" TO "*)" NESTED 105 106 TOKENS 107 ident = letter { letter | digit } . 108 integer = digit { digit } 109 | digit { digit } CONTEXT("..") 110 | digit { hexDigit } "H" . 111 real = digit { digit } "." { digit } 112 [ "E" [ "+" | "-" ] digit { digit } ] . 113 string = "'" { noQuote1 } "'" 114 | '"' { noQuote2 } '"' . 115 116 PRODUCTIONS 117 (* NOTE: Coco/R numbers tokens by first occurrence; M2c.mod's Msg 118 table is regenerated from M2c.err on every build (via 119 compiler.frm). After grammar edits, rebuild and check that 120 the messages still name the right tokens. *) 121 M2c 122 = Unit . 123 Unit 124 = DefUnit | ImplUnit | ProgUnit . 125 Import (. VAR n: SymTab.Name; .) 126 = "FROM" 127 GetIdent (. IF ~SymTab.IsDefMod(n) THEN 128 SemError(201) 129 END; .) 130 "IMPORT" 131 ImpItem { "," ImpItem } ";" 132 | "IMPORT" 133 GetIdent (. IF ~SymTab.IsDefMod(n) THEN 134 SemError(201) 135 END; .) 136 { "," 137 GetIdent (. IF ~SymTab.IsDefMod(n) THEN 138 SemError(201) 139 END; .) } ";" . 140 ImpItem (. VAR a: SymTab.Name; 141 k: INTEGER; .) 142 = GetIdent (. IF ~SymTab.ImpBind(mod, a) THEN 143 SemError(201) 144 ELSE 145 k := SymTab.ExpKind(mod, a); 146 IF k = SymTab.KindType THEN 147 IF ~SymTab.Enter(a, k) THEN 148 SemError(200); 149 SymTab.ImpUnbind(a) 150 ELSE 151 SymTab.SetSymType(a, 152 SymTab.ExpType(mod, a)) 153 END 154 ELSIF (k = SymTab.KindConst) 155 OR (k = SymTab.KindVar) THEN 156 IF ~SymTab.Enter(a, k) THEN 157 SemError(200); 158 SymTab.ImpUnbind(a) 159 ELSE 160 SymTab.SetSymType(a, 161 SymTab.ExpType(mod, a)) 162 END 163 ELSIF k = SymTab.KindProc THEN 164 IF ~SymTab.EnterImpProc(a, 165 SymTab.ExpProc(mod, a)) THEN 166 SemError(200); 167 SymTab.ImpUnbind(a) 168 END 169 ELSE 170 SemError(221); 171 SymTab.ImpUnbind(a) 172 END 173 END; .) . 174 Block (. VAR began: BOOLEAN; .) 175 = (. began := FALSE; .) 176 { Declaration } 177 [ "BEGIN" (. began := TRUE; 178 IF isProc THEN 179 MGen.ProcEntry( 180 SymTab.CurProc(), 181 SymTab.ProcNLocals()) 182 ELSE MGen.BeginBody 183 END; .) 184 StatSeq ] 185 "END" (. IF isProc THEN 186 IF ~began THEN 187 MGen.ProcEntry( 188 SymTab.CurProc(), 189 SymTab.ProcNLocals()) 190 END; 191 IF SymTab.InFunction() THEN 192 MGen.PushInt(0) 193 END; 194 MGen.Leave(SymTab.CurNPar(), 195 SymTab.InFunction()) 196 END; .) . 197 Declaration = "CONST" 198 { 199 ConstDecl ";" } 200 | "TYPE" 201 { 202 TypeDecl ";" } 203 | "VAR" 204 { 205 VarDecl ";" } 206 | ProcedureDecl ";" 207 | ModuleDecl ";" . 208 ConstDecl (. VAR n: SymTab.Name; 209 t: SymTab.TypeIndex; 210 lx: MGen.LitStr; 211 cls: INTEGER; .) 212 = GetIdent (. IF ~SymTab.Enter(n, SymTab.KindConst) 213 THEN SemError(200) END .) 214 "=" (. MGen.NoEmitEnter; .) 215 ConstExpr (. SymTab.SetSymType(n, t); 216 cls := SymTab.ClassOf(t); 217 IF cls = SymTab.ClStr THEN 218 SemError(230) 219 ELSIF ~MGen.IsLit(lx) THEN 220 SemError(230) 221 END; 222 MGen.DeclConst(n, lx, t); 223 MGen.NoEmitExit; .) . 224 ConstExpr 225 (. VAR vD: BOOLEAN; 226 vnD: SymTab.Name; .) 227 = Expr . 228 TypeDecl (. VAR n: SymTab.Name; 229 t0, t1: SymTab.TypeIndex; .) 230 = GetIdent (. IF ~SymTab.Enter(n, SymTab.KindType) 231 THEN SemError(200) END; 232 t0 := SymTab.NewAlias(); 233 SymTab.SetSymType(n, t0); .) 234 "=" 235 Type (. IF t1 = t0 THEN SemError(223); 236 SymTab.SetTarget(t0, 237 SymTab.InvalidType) 238 ELSE SymTab.SetTarget(t0, t1) END; .) . 239 VarDecl (. VAR t: SymTab.TypeIndex; 240 i: CARDINAL; 241 nm: SymTab.Name; 242 cls: INTEGER; 243 sl: CARDINAL; .) 244 = VarIdents ":" 245 Type (. cls := SymTab.ClassOf(t); 246 IF (cls # SymTab.ClInt) 247 & (cls # SymTab.ClReal) 248 & (cls # SymTab.ClBool) 249 & (cls # SymTab.ClChar) 250 & (cls # SymTab.ClEnum) 251 & (cls # SymTab.ClSet) 252 & (cls # SymTab.ClArray) 253 & (cls # SymTab.ClRecord) 254 & (cls # SymTab.ClPtr) THEN 255 SemError(230) 256 END; 257 sl := SymTab.TypeSlots(t); 258 IF sl = 0 THEN 259 SemError(230); 260 sl := 1 261 END; 262 i := 0; 263 WHILE i < SymTab.PendCount() DO 264 SymTab.PendName(i, nm); 265 IF SymTab.SymDepth(nm) = 0 THEN 266 MGen.DeclVarSized(nm, sl) 267 END; 268 INC(i) 269 END; 270 SymTab.FixPending(t); .) . 271 VarIdents (. VAR n: SymTab.Name; .) 272 = GetIdent (. IF ~SymTab.EnterPending(n, 273 SymTab.KindVar) 274 THEN SemError(200) END .) 275 { "," 276 GetIdent (. IF ~SymTab.EnterPending(n, 277 SymTab.KindVar) 278 THEN SemError(200) END .) } . 279 ProcedureDecl (. VAR n, m: SymTab.Name; 280 rt: SymTab.TypeIndex; 281 hasR, ok: BOOLEAN; 282 endL: INTEGER; .) 283 = "PROCEDURE" (. hasR := FALSE; .) 284 GetIdent (. IF SymTab.IsForward(n) THEN 285 SymTab.ReuseProc(n) 286 ELSIF ~SymTab.EnterProc(n) THEN 287 SemError(200) 288 END; 289 SymTab.OpenProcScope; 290 endL := MGen.NewLabel(); 291 MGen.Jmp(endL); .) 292 [ "(" FormalParams ")" ] 293 [ ":" QualIdent (. hasR := TRUE; .) ] 294 (. IF hasR THEN 295 ok := SymTab.SetProcRet(rt) 296 ELSE 297 ok := SymTab.SetProcRet( 298 SymTab.InvalidType) 299 END; 300 IF ~ok THEN SemError(231) END; 301 IF ~SymTab.VerifyProc() THEN 302 SemError(231) 303 END; .) 304 ";" 305 ( Block GetIdent (. IF ~SymTab.Equal(n, m) THEN 306 SemError(202) END; 307 MGen.DefLabel(endL); 308 SymTab.CloseProc; .) 309 | "FORWARD" (. SymTab.SetForward; 310 SymTab.CloseProc; 311 MGen.DefLabel(endL); .) ) . 312 ModuleDecl (. VAR n, m, e: SymTab.Name; 313 noMod, enterOk, 314 hasInit: BOOLEAN; 315 initL, initN: INTEGER; .) 316 = "MODULE" (. noMod := SymTab.InProc() 317 OR SymTab.InModule(); 318 enterOk := FALSE; 319 hasInit := FALSE; .) 320 GetIdent (. IF noMod THEN 321 SemError(230) 322 ELSIF ~SymTab.EnterModule(n) THEN 323 SemError(200) 324 ELSE 325 enterOk := TRUE 326 END; .) 327 [ "EXPORT" 328 GetIdent (. IF ~noMod & enterOk THEN 329 IF ~SymTab.ModuleAddExp(e) THEN 330 SemError(200) 331 END 332 END; .) 333 { "," GetIdent (. IF ~noMod & enterOk THEN 334 IF ~SymTab.ModuleAddExp(e) THEN 335 SemError(200) 336 END 337 END; .) } ] 338 ";" 339 { Declaration } 340 [ "BEGIN" (. hasInit := TRUE; 341 IF ~noMod & enterOk THEN 342 initL := MGen.NewLabel(); 343 MGen.Jmp(initL); 344 initN := MGen.ModInitBegin(); 345 IF initN < 0 THEN 346 SemError(230) 347 END 348 END; .) 349 StatSeq ] 350 "END" 351 GetIdent (. IF ~SymTab.Equal(n, m) THEN 352 SemError(202) 353 END; 354 IF hasInit & ~noMod & enterOk THEN 355 MGen.ModInitEnd(initN); 356 MGen.DefLabel(initL) 357 END; 358 IF ~noMod & enterOk THEN 359 IF ~SymTab.ExitModule() THEN 360 SemError(201) 361 END 362 END; .) . 363 FormalParams = FPSection { ";" FPSection } . 364 FPSection (. VAR isV: BOOLEAN; 365 nn, i: CARDINAL; 366 pn: ARRAY [0 .. 15] OF SymTab.Name; 367 n: SymTab.Name; 368 t: SymTab.TypeIndex; .) 369 = (. isV := FALSE; nn := 0; .) 370 [ "VAR" (. isV := TRUE; .) ] 371 GetIdent (. IF nn <= HIGH(pn) THEN 372 MGen.CopyName(n, pn[nn]) 373 END; 374 INC(nn); .) 375 { "," GetIdent (. IF nn <= HIGH(pn) THEN 376 MGen.CopyName(n, pn[nn]) 377 END; 378 INC(nn); .) } 379 ":" Type (. IF ~isV 380 & (t # SymTab.InvalidType) 381 & (SymTab.TypeSlots(t) > 1) THEN 382 SemError(230) 383 END; 384 i := 0; 385 WHILE i < nn DO 386 IF i <= HIGH(pn) THEN 387 IF ~SymTab.EnterParam( 388 pn[i], isV, t) THEN 389 SemError(200) 390 END 391 END; 392 INC(i) 393 END; .) . 394 QualIdent 395 (. VAR n, m: SymTab.Name; .) 396 = GetIdent (. IF ~SymTab.Lookup(n) THEN 397 SemError(201); 398 t := SymTab.InvalidType 399 ELSIF SymTab.SymKind(n) 400 = SymTab.KindModule THEN 401 t := SymTab.InvalidType 402 ELSIF (SymTab.SymKind(n) # 403 SymTab.KindType) 404 & (SymTab.SymKind(n) # 405 SymTab.KindPredef) 406 & (SymTab.SymKind(n) # 407 SymTab.KindImport) THEN 408 SemError(221); 409 t := SymTab.InvalidType 410 ELSE t := SymTab.SymType(n) END; .) 411 { "." 412 GetIdent (. IF SymTab.SymKind(n) 413 = SymTab.KindModule THEN 414 IF SymTab.ExpKind(n, m) 415 = SymTab.KindType THEN 416 t := SymTab.ExpType(n, m) 417 ELSIF SymTab.SelfKind(n, m) 418 = SymTab.KindType THEN 419 t := SymTab.SymType(m) 420 ELSE 421 IF SymTab.ExpKind(n, m) < 0 THEN 422 IF SymTab.SelfKind(n, m) < 0 THEN 423 SemError(201) 424 ELSE SemError(221) 425 END 426 ELSE SemError(221) 427 END; 428 t := SymTab.InvalidType 429 END 430 ELSE 431 t := SymTab.InvalidType 432 END; .) } . 433 434 (* Types: ProcedureType removed; subrange factored for LL(1) *) 435 Type 436 = SimpleType | ArrayType | RecordType 437 | SetType | PointerType . 438 SimpleType 439 (. VAR t1, t2: SymTab.TypeIndex; 440 lx1, lx2: MGen.LitStr; 441 vD: BOOLEAN; 442 vnD: SymTab.Name; 443 loI, hiI: INTEGER; 444 lok, hik: BOOLEAN; .) 445 = QualIdent [ "[" 446 (. MGen.NoEmitEnter; lok := FALSE; hik := FALSE; 447 loI := 0; hiI := -1; .) 448 ConstExpr (. IF (t1 # SymTab.InvalidType) 449 & (SymTab.ClassOf(t1) # 450 SymTab.ClInt) 451 & (SymTab.ClassOf(t1) # 452 SymTab.ClChar) 453 & (SymTab.ClassOf(t1) # 454 SymTab.ClEnum) THEN 455 SemError(224) END; .) 456 ".." 457 ConstExpr (. IF (t2 # SymTab.InvalidType) 458 & (SymTab.ClassOf(t2) # 459 SymTab.ClInt) 460 & (SymTab.ClassOf(t2) # 461 SymTab.ClChar) 462 & (SymTab.ClassOf(t2) # 463 SymTab.ClEnum) THEN 464 SemError(224) END; .) 465 "]" 466 (. IF (t1 # SymTab.InvalidType) 467 & (t2 # SymTab.InvalidType) THEN 468 IF MGen.IsLit(lx1) THEN 469 IF SymTab.ClassOf(t1) 470 = SymTab.ClChar THEN 471 loI := MGen.CharOrd(lx1); 472 lok := TRUE 473 ELSIF MGen.ParseInt(lx1, loI) THEN 474 lok := TRUE 475 END 476 END; 477 IF MGen.IsLit(lx2) THEN 478 IF SymTab.ClassOf(t2) 479 = SymTab.ClChar THEN 480 hiI := MGen.CharOrd(lx2); 481 hik := TRUE 482 ELSIF MGen.ParseInt(lx2, hiI) THEN 483 hik := TRUE 484 END 485 END 486 END; 487 IF lok & hik THEN 488 t := SymTab.NewSubB(t1, loI, hiI) 489 ELSE 490 t := SymTab.NewSub(t1); 491 IF (t1 # SymTab.InvalidType) 492 & (t2 # SymTab.InvalidType) THEN 493 SemError(230) 494 END 495 END; 496 MGen.NoEmitExit; .) ] 497 | "[" (. MGen.NoEmitEnter; lok := FALSE; 498 hik := FALSE; loI := 0; hiI := -1; .) 499 ConstExpr (. IF (t1 # SymTab.InvalidType) 500 & (SymTab.ClassOf(t1) # 501 SymTab.ClInt) 502 & (SymTab.ClassOf(t1) # 503 SymTab.ClChar) 504 & (SymTab.ClassOf(t1) # 505 SymTab.ClEnum) THEN 506 SemError(224) END; .) 507 ".." 508 ConstExpr (. IF (t2 # SymTab.InvalidType) 509 & (SymTab.ClassOf(t2) # 510 SymTab.ClInt) 511 & (SymTab.ClassOf(t2) # 512 SymTab.ClChar) 513 & (SymTab.ClassOf(t2) # 514 SymTab.ClEnum) THEN 515 SemError(224) END; .) 516 "]" (. IF (t1 # SymTab.InvalidType) 517 & (t2 # SymTab.InvalidType) THEN 518 IF MGen.IsLit(lx1) THEN 519 IF SymTab.ClassOf(t1) 520 = SymTab.ClChar THEN 521 loI := MGen.CharOrd(lx1); 522 lok := TRUE 523 ELSIF MGen.ParseInt(lx1, 524 loI) THEN 525 lok := TRUE 526 END 527 END; 528 IF MGen.IsLit(lx2) THEN 529 IF SymTab.ClassOf(t2) 530 = SymTab.ClChar THEN 531 hiI := MGen.CharOrd(lx2); 532 hik := TRUE 533 ELSIF MGen.ParseInt(lx2, 534 hiI) THEN 535 hik := TRUE 536 END 537 END 538 END; 539 IF lok & hik THEN 540 t := SymTab.NewSubB(t1, loI, hiI) 541 ELSE 542 t := SymTab.NewSub(t1); 543 IF (t1 # SymTab.InvalidType) 544 & (t2 # SymTab.InvalidType) THEN 545 SemError(230) 546 END 547 END; 548 MGen.NoEmitExit; .) 549 | Enum . 550 Enum 551 (. VAR n: SymTab.Name; 552 ord: INTEGER; .) 553 = "(" (. t := SymTab.NewEnum(); 554 ord := 0; .) 555 GetIdent (. IF ~SymTab.Enter(n, 556 SymTab.KindConst) 557 THEN SemError(200) END; 558 SymTab.SetSymType(n, t); 559 SymTab.EnumAdd(t); 560 MGen.DeclConstInt(n, ord); 561 INC(ord); .) 562 { "," 563 GetIdent (. IF ~SymTab.Enter(n, 564 SymTab.KindConst) 565 THEN SemError(200) END; 566 SymTab.SetSymType(n, t); 567 SymTab.EnumAdd(t); 568 MGen.DeclConstInt(n, ord); 569 INC(ord); .) } 570 ")" . 571 ArrayType 572 (. VAR s, s2, e: SymTab.TypeIndex; 573 idx: ARRAY [0 .. 7] OF 574 SymTab.TypeIndex; 575 nc, kk: CARDINAL; 576 loA, hiA: INTEGER; 577 isOpenA: BOOLEAN; .) 578 = "ARRAY" 579 [ SimpleType (. IF (s # SymTab.InvalidType) 580 & (SymTab.ClassOf(s) # 581 SymTab.ClInt) 582 & (SymTab.ClassOf(s) # 583 SymTab.ClChar) 584 & (SymTab.ClassOf(s) # 585 SymTab.ClEnum) THEN 586 SemError(224) END; 587 nc := 0; isOpenA := FALSE; 588 idx[nc] := s; INC(nc); .) 589 { "," 590 SimpleType (. IF (s2 # SymTab.InvalidType) 591 & (SymTab.ClassOf(s2) # 592 SymTab.ClInt) 593 & (SymTab.ClassOf(s2) # 594 SymTab.ClChar) 595 & (SymTab.ClassOf(s2) # 596 SymTab.ClEnum) THEN 597 SemError(224) END; 598 IF nc <= HIGH(idx) THEN 599 idx[nc] := s2; INC(nc) 600 END; .) } 601 | (. nc := 0; isOpenA := TRUE; .) ] 602 "OF" 603 Type (. IF isOpenA THEN 604 t := SymTab.NewOpen(e) 605 ELSE 606 t := e; 607 kk := nc; 608 WHILE kk > 0 DO 609 DEC(kk); 610 loA := SymTab.TypeLo(idx[kk]); 611 hiA := SymTab.TypeHi(idx[kk]); 612 IF SymTab.TypeLen(idx[kk]) = 0 THEN 613 IF idx[kk] 614 # SymTab.InvalidType THEN 615 SemError(230) 616 END; 617 loA := 0; hiA := -1 618 END; 619 t := SymTab.NewArrayB(t, 620 loA, hiA) 621 END 622 END; .) . 623 RecordType 624 = "RECORD" (. t := SymTab.NewRecord(); .) 625 FieldSeq 626 "END" . 627 FieldSeq 628 = Field { ";" 629 Field } . 630 Field 631 (. VAR et: SymTab.TypeIndex; .) 632 = [ FieldIdents ":" 633 Type (. IF (et # SymTab.InvalidType) 634 & SymTab.IsOpen(et) THEN 635 SemError(230) 636 END; 637 SymTab.FixPendingF(rt, et); .) ] . 638 FieldIdents 639 (. VAR n: SymTab.Name; .) 640 = GetIdent (. IF ~SymTab.FieldPending(rt, n) 641 THEN SemError(200) END .) 642 { "," 643 GetIdent (. IF ~SymTab.FieldPending(rt, n) 644 THEN SemError(200) END .) } . 645 SetType 646 (. VAR s: SymTab.TypeIndex; .) 647 = "SET" 648 "OF" 649 SimpleType (. IF (s # SymTab.InvalidType) 650 & (SymTab.ClassOf(s) # 651 SymTab.ClInt) 652 & (SymTab.ClassOf(s) # 653 SymTab.ClChar) 654 & (SymTab.ClassOf(s) # 655 SymTab.ClEnum) THEN 656 SemError(224) END; 657 t := SymTab.NewSet(s); .) . 658 PointerType 659 (. VAR b: SymTab.TypeIndex; .) 660 = "POINTER" 661 "TO" 662 Type (. t := SymTab.NewPtr(b); .) . 663 664 (* Statements: RETURN added; calls via AssignOrCall *) 665 StatSeq = Stat { ";" 666 Stat } . 667 Stat (. VAR lx: INTEGER; .) 668 = [ AssignOrCall | IfStat | CaseStat | WhileStat 669 | RepeatStat | LoopStat | ForStat | WithStat | ReturnStat 670 | NewStat | DispStat | WriteIntStat | WriteStrStat 671 | "EXIT" (. IF MGen.TopLoop(lx) THEN 672 MGen.Jmp(lx) 673 ELSE SemError(230) END; .) ] . 674 AssignOrCall (. VAR dt, et: SymTab.TypeIndex; 675 dk: INTEGER; 676 bn: SymTab.Name; 677 lxD, lxe: MGen.LitStr; 678 vE: BOOLEAN; 679 vnE: SymTab.Name; 680 sfx: BOOLEAN; 681 okC: BOOLEAN; 682 isR, conv, 683 storable, pushedDst, 684 pushedFld: BOOLEAN; 685 dstBytes, srcBytes: CARDINAL; 686 elemDt: SymTab.TypeIndex; 687 modBare: INTEGER; .) 688 = (. sfx := FALSE; pushedDst := FALSE; 689 pushedFld := FALSE; .) 690 DesignHead 691 DesignTail 692 ( ":=" 693 (. storable := 694 (dk = SymTab.KindVar) 695 OR (dk = SymTab.KindParam) 696 OR (dk = SymTab.KindVarPar); 697 IF (dk = SymTab.KindField) 698 & (~sfx) 699 & (dt # SymTab.InvalidType) THEN 700 MGen.WithAddr(bn); 701 pushedFld := TRUE 702 END; 703 IF storable & ~sfx 704 & (dt # SymTab.InvalidType) 705 & ((SymTab.ClassOf(dt) 706 = SymTab.ClArray) 707 OR (SymTab.ClassOf(dt) 708 = SymTab.ClRecord)) THEN 709 MGen.PushAddr(bn); 710 pushedDst := TRUE 711 ELSIF ((dk = SymTab.KindVar) 712 OR (dk 713 = SymTab.KindParam) 714 OR (dk 715 = SymTab.KindVarPar) 716 OR (dk 717 = SymTab.KindField)) 718 & sfx 719 & (dt # SymTab.InvalidType) 720 & ((SymTab.ClassOf(dt) 721 = SymTab.ClArray) 722 OR (SymTab.ClassOf(dt) 723 = SymTab.ClRecord)) THEN 724 pushedDst := TRUE 725 END; 726 IF storable & ~sfx 727 & ~pushedDst THEN 728 IF (dt # SymTab.InvalidType) 729 & (SymTab.TypeSlots(dt) 730 > 1) THEN 731 ELSE MGen.StoreSetup(bn) 732 END 733 END; .) 734 Expr (. IF (dt # SymTab.InvalidType) 735 & (dk # SymTab.KindVar) 736 & (dk # SymTab.KindParam) 737 & (dk # SymTab.KindVarPar) 738 & (dk # SymTab.KindField) 739 & (dk # SymTab.KindImport) THEN 740 SemError(210) 741 ELSIF pushedDst THEN 742 IF et = SymTab.InvalidType THEN 743 MGen.Drop; MGen.Drop 744 ELSIF (SymTab.ClassOf(dt) 745 = SymTab.ClArray) 746 & (SymTab.ClassOf( 747 SymTab.ArrayElem(dt)) 748 = SymTab.ClChar) 749 & (SymTab.ClassOf(et) 750 = SymTab.ClStr) THEN 751 srcBytes := 752 MGen.StrLenOf(lxe) + 1; 753 dstBytes := 754 SymTab.TypeSlots(dt) * 8; 755 IF srcBytes > dstBytes THEN 756 SemError(210); 757 MGen.Drop; MGen.Drop 758 ELSE 759 MGen.PushBytes(srcBytes); 760 MGen.CopyBlock 761 END 762 ELSIF ~SymTab.Assignable(et, 763 dt) THEN 764 SemError(210); 765 MGen.Drop; MGen.Drop 766 ELSE 767 dstBytes := 768 SymTab.TypeSlots(dt) * 8; 769 MGen.PushBytes(dstBytes); 770 MGen.CopyBlock 771 END 772 ELSIF pushedFld THEN 773 IF et = SymTab.InvalidType THEN 774 MGen.Drop; MGen.Drop 775 ELSIF (SymTab.TypeSlots(dt) > 1) THEN 776 IF (SymTab.ClassOf(dt) 777 = SymTab.ClArray) 778 & (SymTab.ClassOf( 779 SymTab.ArrayElem(dt)) 780 = SymTab.ClChar) 781 & (SymTab.ClassOf(et) 782 = SymTab.ClStr) THEN 783 srcBytes := 784 MGen.StrLenOf(lxe) + 1; 785 dstBytes := 786 SymTab.TypeSlots(dt) * 8; 787 IF srcBytes > dstBytes THEN 788 SemError(210); 789 MGen.Drop; MGen.Drop 790 ELSE 791 MGen.PushBytes(srcBytes); 792 MGen.CopyBlock 793 END 794 ELSIF ~SymTab.Assignable(et, 795 dt) THEN 796 SemError(210); 797 MGen.Drop; MGen.Drop 798 ELSE 799 dstBytes := 800 SymTab.TypeSlots(dt) * 8; 801 MGen.PushBytes(dstBytes); 802 MGen.CopyBlock 803 END 804 ELSE 805 IF ~SymTab.Assignable(et, 806 dt) THEN 807 SemError(210); 808 MGen.Drop; MGen.Drop 809 ELSE 810 isR := 811 (SymTab.ClassOf(dt) 812 = SymTab.ClReal); 813 conv := isR 814 & SymTab.IsIntFamily(et); 815 IF conv THEN 816 MGen.IntToReal 817 END; 818 IF (SymTab.ClassOf(dt) 819 = SymTab.ClChar) 820 OR (SymTab.ClassOf(dt) 821 = SymTab.ClBool) THEN 822 MGen.StoreByte 823 ELSE MGen.StoreIndir0 824 END 825 END 826 END 827 ELSIF (dt # SymTab.InvalidType) 828 & ~sfx 829 & (SymTab.TypeSlots(dt) > 1) THEN 830 IF ~SymTab.Assignable(et, dt) THEN 831 SemError(210) 832 ELSE SemError(230) 833 END 834 ELSIF ~SymTab.Assignable(et, dt) THEN 835 SemError(210) END; 836 IF dk = SymTab.KindImport THEN 837 SemError(230) 838 END; 839 isR := (dt # SymTab.InvalidType) 840 & ~pushedDst 841 & ~pushedFld 842 & (SymTab.ClassOf(dt) 843 = SymTab.ClReal); 844 conv := isR 845 & SymTab.IsIntFamily(et); 846 IF pushedDst THEN 847 ELSIF pushedFld THEN 848 ELSIF (dt # SymTab.InvalidType) 849 & sfx THEN 850 IF conv THEN 851 MGen.IntToReal 852 END; 853 IF (SymTab.ClassOf(dt) 854 = SymTab.ClChar) 855 OR (SymTab.ClassOf(dt) 856 = SymTab.ClBool) THEN 857 MGen.StoreByte 858 ELSE MGen.StoreIndir0 859 END 860 ELSIF storable & ~sfx THEN 861 IF (dt # SymTab.InvalidType) 862 & (SymTab.TypeSlots(dt) 863 > 1) THEN 864 MGen.Drop 865 ELSE 866 IF conv THEN 867 MGen.IntToReal 868 END; 869 MGen.StoreFinish(bn) 870 END 871 ELSE MGen.Drop 872 END; .) 873 | CallTail 874 | (. IF (SymTab.SymKind(bn) 875 = SymTab.KindModule) 876 & sfx 877 & (SymTab.StrLen(lxD) > 0) THEN 878 modBare := SymTab.ExpProc(bn, 879 lxD); 880 IF modBare < 0 THEN 881 IF SymTab.ExpKind(bn, 882 lxD) # -1 THEN 883 SemError(233) 884 END 885 ELSIF SymTab.ProcNParByNum( 886 modBare) # 0 THEN 887 SemError(233) 888 ELSE 889 MGen.CallProc(modBare); 890 IF SymTab.ProcRetByNum( 891 modBare) 892 # SymTab.InvalidType THEN 893 MGen.Drop 894 END 895 END 896 ELSE 897 MGen.ActBegin(bn); 898 IF MGen.ActEnd(bn, FALSE, 899 FALSE) # 0 THEN 900 SemError(233) 901 END 902 END; .) ) . 903 CallTail 905 (. VAR t: SymTab.TypeIndex; 906 lx: MGen.LitStr; 907 v: BOOLEAN; 908 vn: SymTab.Name; 909 isModP: BOOLEAN; 910 modPNum: INTEGER; 911 modErr: BOOLEAN; .) 912 = "(" (. ok := FALSE; modErr := FALSE; 913 isModP := 914 (SymTab.SymKind(pn) 915 = SymTab.KindModule) 916 & sfx 917 & (SymTab.StrLen(exp) > 0); 918 IF hasDead THEN MGen.Drop END; 919 IF isModP THEN 920 modPNum := SymTab.ExpProc(pn, 921 exp); 922 IF (modPNum < 0) 923 & (SymTab.SelfKind(pn, 924 exp) 925 = SymTab.KindProc) THEN 926 modPNum := 927 SymTab.ProcNum(exp) 928 END; 929 IF modPNum < 0 THEN 930 IF SymTab.ExpKind(pn, 931 exp) # -1 THEN 932 SemError(233) 933 END; 934 modErr := TRUE 935 ELSIF inExpr 936 & (SymTab.ProcRetByNum( 937 modPNum) 938 = SymTab.InvalidType) 939 THEN 940 SemError(233); 941 modErr := TRUE 942 END; 943 MGen.ActBeginNum(modPNum) 944 ELSE 945 MGen.ActBegin(pn) 946 END; .) 947 [ Expr (. IF isModP THEN 948 IF ~modErr 949 & (MGen.ActValue(t, v, vn) 950 # 0) THEN 951 SemError(233); 952 modErr := TRUE 953 END 954 ELSIF MGen.ActValue(t, v, vn) # 0 THEN 955 SemError(233) 956 END; .) 957 { "," Expr (. IF isModP THEN 958 IF ~modErr 959 & (MGen.ActValue(t, v, vn) 960 # 0) THEN 961 SemError(233); 962 modErr := TRUE 963 END 964 ELSIF MGen.ActValue(t, v, vn) # 0 THEN 965 SemError(233) 966 END; .) } ] 967 ")" (. IF isModP THEN 968 IF ~modErr THEN 969 IF MGen.ActEndNum(modPNum, 970 inExpr) # 0 THEN 971 SemError(233) 972 ELSE ok := TRUE 973 END 974 END 975 ELSIF MGen.ActEnd(pn, sfx, 976 inExpr) # 0 977 THEN SemError(233) 978 ELSE ok := TRUE 979 END; .) . 980 IfStat (. VAR t: SymTab.TypeIndex; 981 lxC: MGen.LitStr; 982 vC: BOOLEAN; 983 vnC: SymTab.Name; 984 elseL, endL: INTEGER; 985 hasElse: BOOLEAN; .) 986 = "IF" 987 Expr (. IF ~SymTab.BoolCheck(t) THEN 988 SemError(214) END; 989 elseL := MGen.NewLabel(); 990 endL := MGen.NewLabel(); 991 MGen.Jz(elseL); 992 hasElse := FALSE; .) 993 "THEN" 994 StatSeq 995 { "ELSIF" (. MGen.Jmp(endL); 996 MGen.DefLabel(elseL); .) 997 Expr (. IF ~SymTab.BoolCheck(t) THEN 998 SemError(214) END; 999 elseL := MGen.NewLabel(); 1000 MGen.Jz(elseL); .) 1001 "THEN" 1002 StatSeq } 1003 [ "ELSE" (. MGen.Jmp(endL); 1004 MGen.DefLabel(elseL); 1005 hasElse := TRUE; .) 1006 StatSeq ] 1007 "END" (. IF ~hasElse THEN 1008 MGen.DefLabel(elseL) 1009 END; 1010 MGen.DefLabel(endL); .) . 1011 CaseStat (. VAR st: SymTab.TypeIndex; 1012 lxS: MGen.LitStr; 1013 vS: BOOLEAN; 1014 vnS: SymTab.Name; 1015 tmp, endL: INTEGER; .) 1016 = "CASE" 1017 Expr (. tmp := MGen.TempGlobal(); 1018 MGen.StoreTemp(tmp); 1019 endL := MGen.NewLabel(); .) 1020 "OF" 1021 Case { "|" 1022 Case } 1023 [ "ELSE" 1024 StatSeq ] 1025 "END" (. MGen.DefLabel(endL); .) . 1026 Case 1027 (. VAR lB, lN: INTEGER; .) 1028 = [ LabelList ":" (. MGen.DefLabel(lB); .) 1029 StatSeq (. MGen.Jmp(endL); 1030 MGen.DefLabel(lN); .) ] . 1031 LabelList 1033 = (. lB := MGen.NewLabel(); 1034 lN := MGen.NewLabel(); .) 1035 Labels { "," 1036 Labels } 1037 (. MGen.Jmp(lN); .) . 1038 Labels 1039 (. VAR t, t2: SymTab.TypeIndex; 1040 lx1, lx2: MGen.LitStr; 1041 v1, v2: BOOLEAN; 1042 vn1, vn2: SymTab.Name; 1043 ta, tb, chunk: INTEGER; 1044 r, hasRange: BOOLEAN; .) 1045 = ConstExpr (. IF ~SymTab.EqCheck(t, sel) THEN 1046 SemError(213) END; 1047 r := (SymTab.ClassOf(sel) 1048 = SymTab.ClReal) 1049 & (SymTab.ClassOf(t) 1050 = SymTab.ClReal); 1051 ta := MGen.TempGlobal(); 1052 MGen.StoreTemp(ta); 1053 hasRange := FALSE; .) 1054 [ ".." 1055 ConstExpr (. IF ~SymTab.EqCheck(t2, sel) THEN 1056 SemError(213) END; 1057 tb := MGen.TempGlobal(); 1058 MGen.StoreTemp(tb); 1059 hasRange := TRUE; .) ] 1060 (. IF hasRange THEN 1061 MGen.LoadTemp(tmp); 1062 MGen.LoadTemp(ta); 1063 IF r THEN MGen.RealGe 1064 ELSE MGen.IGe END; 1065 MGen.LoadTemp(tmp); 1066 MGen.LoadTemp(tb); 1067 IF r THEN MGen.RealLe 1068 ELSE MGen.ILe END; 1069 MGen.And 1070 ELSE 1071 MGen.LoadTemp(tmp); 1072 MGen.LoadTemp(ta); 1073 IF r THEN MGen.RealEq 1074 ELSE MGen.Eq END 1075 END; 1076 chunk := MGen.NewLabel(); 1077 MGen.Jz(chunk); 1078 MGen.Jmp(bodyL); 1079 MGen.DefLabel(chunk); .) . 1080 WhileStat (. VAR t: SymTab.TypeIndex; 1081 lxC: MGen.LitStr; 1082 vC: BOOLEAN; 1083 vnC: SymTab.Name; 1084 topL, endL: INTEGER; .) 1085 = "WHILE" (. topL := MGen.NewLabel(); 1086 endL := MGen.NewLabel(); 1087 MGen.DefLabel(topL); .) 1088 Expr (. IF ~SymTab.BoolCheck(t) THEN 1089 SemError(214) END; 1090 MGen.Jz(endL); .) 1091 "DO" 1092 StatSeq 1093 "END" (. MGen.Jmp(topL); 1094 MGen.DefLabel(endL); .) . 1095 RepeatStat (. VAR t: SymTab.TypeIndex; 1096 lxC: MGen.LitStr; 1097 vC: BOOLEAN; 1098 vnC: SymTab.Name; 1099 topL: INTEGER; .) 1100 = "REPEAT" (. topL := MGen.NewLabel(); 1101 MGen.DefLabel(topL); .) 1102 StatSeq 1103 "UNTIL" 1104 Expr (. IF ~SymTab.BoolCheck(t) THEN 1105 SemError(214) END; 1106 MGen.Jz(topL); .) . 1107 LoopStat (. VAR topL, exitL: INTEGER; .) 1108 = "LOOP" (. topL := MGen.NewLabel(); 1109 exitL := MGen.NewLabel(); 1110 MGen.DefLabel(topL); 1111 MGen.PushLoop(exitL); .) 1112 StatSeq 1113 "END" (. MGen.Jmp(topL); 1114 MGen.DefLabel(exitL); 1115 MGen.PopLoop; .) . 1116 ForStat (. VAR n, lv: SymTab.Name; 1117 fk: INTEGER; 1118 lo, hi: SymTab.TypeIndex; 1119 lxLo, lxHi: MGen.LitStr; 1120 vLo, vHi: BOOLEAN; 1121 vnLo, vnHi: SymTab.Name; 1122 byV, ht: INTEGER; 1123 lTop, lChk, lEnd: INTEGER; 1124 neg, storable: BOOLEAN; .) 1125 = "FOR" 1126 GetIdent (. IF ~SymTab.Lookup(n) THEN 1127 SemError(201); 1128 fk := -1 1129 ELSIF (SymTab.SymKind(n) # 1130 SymTab.KindVar) 1131 & (SymTab.SymKind(n) # 1132 SymTab.KindParam) 1133 & (SymTab.SymKind(n) # 1134 SymTab.KindVarPar) 1135 & (SymTab.SymKind(n) # 1136 SymTab.KindField) THEN 1137 SemError(220); 1138 fk := -1 1139 ELSIF (SymTab.SymType(n) # 1140 SymTab.InvalidType) 1141 & ~SymTab.IsIntFamily( 1142 SymTab.SymType(n)) THEN 1143 SemError(220); 1144 fk := -1 1145 ELSE 1146 fk := SymTab.SymKind(n) 1147 END; 1148 MGen.CopyName(n, lv); 1149 storable := (fk = SymTab.KindVar) 1150 OR (fk = SymTab.KindParam) 1151 OR (fk = SymTab.KindVarPar); 1152 IF storable THEN 1153 MGen.StoreSetup(lv) 1154 END; .) 1155 ":=" 1156 Expr (. IF (lo # SymTab.InvalidType) 1157 & ~SymTab.IsIntFamily(lo) THEN 1158 SemError(220) END; 1159 IF storable THEN 1160 MGen.StoreFinish(lv) 1161 ELSE MGen.Drop 1162 END; .) 1163 "TO" 1164 Expr (. IF (hi # SymTab.InvalidType) 1165 & ~SymTab.IsIntFamily(hi) THEN 1166 SemError(220) END; 1167 ht := MGen.TempGlobal(); 1168 MGen.StoreTemp(ht); 1169 byV := 1; neg := FALSE; .) 1170 [ "BY" 1171 ByLit (. neg := byV < 0; .) ] 1172 "DO" (. lTop := MGen.NewLabel(); 1173 lChk := MGen.NewLabel(); 1174 lEnd := MGen.NewLabel(); 1175 MGen.Jmp(lChk); 1176 MGen.DefLabel(lTop); .) 1177 StatSeq 1178 "END" (. MGen.PushVar(lv); 1179 MGen.PushInt(byV); 1180 MGen.Add; 1181 IF storable THEN 1182 MGen.StoreFinish(lv) 1183 ELSE MGen.Drop 1184 END; 1185 MGen.DefLabel(lChk); 1186 MGen.PushVar(lv); 1187 MGen.LoadTemp(ht); 1188 IF neg THEN MGen.IGe 1189 ELSE MGen.ILe END; 1190 MGen.Jz(lEnd); 1191 MGen.Jmp(lTop); 1192 MGen.DefLabel(lEnd); .) . 1193 ByLit (. VAR s: ARRAY [0 .. 255] OF CHAR; .) 1194 = integer (. LexString(s); 1195 IF ~MGen.ParseInt(s, v) THEN 1196 v := 1 1197 END; .) 1198 | "-" integer (. LexString(s); 1199 IF MGen.ParseInt(s, v) THEN 1200 v := -v 1201 ELSE v := -1 1202 END; .) . 1203 WithStat (. VAR dt: SymTab.TypeIndex; 1204 dk: INTEGER; 1205 bnW: SymTab.Name; 1206 lxW: MGen.LitStr; 1207 sfxW: BOOLEAN; 1208 pushed: BOOLEAN; .) 1209 = "WITH" 1210 DesignHead 1211 DesignTail 1212 (. pushed := FALSE; 1213 IF dt = SymTab.InvalidType THEN 1214 IF sfxW THEN MGen.Drop END 1215 ELSIF SymTab.ClassOf(dt) 1216 # SymTab.ClRecord THEN 1217 SemError(215); 1218 IF sfxW THEN MGen.Drop END 1219 ELSE 1220 IF ~sfxW THEN 1221 IF (dk 1222 = SymTab.KindVar) 1223 OR (dk 1224 = SymTab.KindParam) 1225 OR (dk 1226 = SymTab.KindVarPar) THEN 1227 MGen.PushAddr(bnW) 1228 ELSIF dk 1229 = SymTab.KindField THEN 1230 MGen.WithAddr(bnW) 1231 ELSE MGen.PushInt(0) 1232 END 1233 END; 1234 MGen.WithEnter(dt); 1235 pushed := 1236 SymTab.PushRecord(dt); 1237 IF ~pushed THEN 1238 SemError(215) 1239 END 1240 END; .) 1241 "DO" 1242 StatSeq 1243 "END" (. IF pushed THEN 1244 SymTab.PopScope; 1245 MGen.WithExit 1246 END; .) . 1247 ReturnStat (. VAR t: SymTab.TypeIndex; 1248 lx: MGen.LitStr; 1249 v: BOOLEAN; 1250 vn: SymTab.Name; 1251 hasE, doRet, conv: BOOLEAN; .) 1252 = "RETURN" (. hasE := FALSE; .) 1253 [ Expr (. hasE := TRUE; 1254 doRet := FALSE; 1255 IF ~SymTab.InProc() THEN 1256 SemError(232) 1257 ELSIF ~SymTab.InFunction() THEN 1258 SemError(232) 1259 ELSIF ~SymTab.Assignable( 1260 t, SymTab.CurRet()) THEN 1261 SemError(232) 1262 ELSE doRet := TRUE 1263 END; 1264 conv := doRet 1265 & SymTab.IsIntFamily(t) 1266 & (SymTab.ClassOf( 1267 SymTab.CurRet()) 1268 = SymTab.ClReal); 1269 IF doRet THEN 1270 IF conv THEN 1271 MGen.IntToReal 1272 END; 1273 MGen.Leave( 1274 SymTab.CurNPar(), TRUE) 1275 ELSE MGen.Drop 1276 END; .) ] 1277 (. IF ~hasE THEN 1278 IF ~SymTab.InProc() THEN 1279 SemError(232) 1280 ELSIF SymTab.InFunction() THEN 1281 SemError(232) 1282 ELSE MGen.Leave( 1283 SymTab.CurNPar(), FALSE) 1284 END 1285 END; .) . 1286 NewStat (. VAR dt: SymTab.TypeIndex; 1287 dk: INTEGER; 1288 bnN: SymTab.Name; 1289 lxN: MGen.LitStr; 1290 sfxN: BOOLEAN; 1291 baseT: SymTab.TypeIndex; 1292 slN: CARDINAL; .) 1293 = "NEW" 1294 "(" DesignHead 1295 DesignTail 1296 ")" (. IF dt = SymTab.InvalidType THEN 1297 IF sfxN THEN MGen.Drop END 1298 ELSIF SymTab.ClassOf(dt) 1299 # SymTab.ClPtr THEN 1300 SemError(219); 1301 IF sfxN THEN MGen.Drop END 1302 ELSE 1303 baseT := SymTab.PtrBase(dt); 1304 slN := SymTab.TypeSlots(baseT); 1305 IF slN = 0 THEN 1306 SemError(230); 1307 slN := 1 1308 END; 1309 IF ~sfxN THEN 1310 IF (dk = SymTab.KindVar) 1311 OR (dk 1312 = SymTab.KindParam) 1313 OR (dk 1314 = SymTab.KindVarPar) THEN 1315 MGen.PushAddr(bnN) 1316 ELSIF dk 1317 = SymTab.KindField THEN 1318 MGen.WithAddr(bnN) 1319 ELSE MGen.PushInt(0) 1320 END 1321 END; 1322 MGen.PushBytes(slN * 8); 1323 MGen.AllocOp 1324 END; .) . 1325 DispStat (. VAR dt: SymTab.TypeIndex; 1326 dk: INTEGER; 1327 bnD: SymTab.Name; 1328 lxD: MGen.LitStr; 1329 sfxD: BOOLEAN; 1330 baseT: SymTab.TypeIndex; 1331 slD: CARDINAL; .) 1332 = "DISPOSE" 1333 "(" DesignHead 1334 DesignTail 1335 ")" (. IF dt = SymTab.InvalidType THEN 1336 IF sfxD THEN MGen.Drop END 1337 ELSIF SymTab.ClassOf(dt) 1338 # SymTab.ClPtr THEN 1339 SemError(219); 1340 IF sfxD THEN MGen.Drop END 1341 ELSE 1342 baseT := SymTab.PtrBase(dt); 1343 slD := SymTab.TypeSlots(baseT); 1344 IF slD = 0 THEN 1345 SemError(230); 1346 slD := 1 1347 END; 1348 IF ~sfxD THEN 1349 IF (dk = SymTab.KindVar) 1350 OR (dk 1351 = SymTab.KindParam) 1352 OR (dk 1353 = SymTab.KindVarPar) THEN 1354 MGen.PushAddr(bnD) 1355 ELSIF dk 1356 = SymTab.KindField THEN 1357 MGen.WithAddr(bnD) 1358 ELSE MGen.PushInt(0) 1359 END 1360 END; 1361 MGen.PushBytes(slD * 8); 1362 MGen.DeallocOp 1363 END; .) . 1364 WriteIntStat (. VAR t: SymTab.TypeIndex; 1365 lx: MGen.LitStr; 1366 v: BOOLEAN; 1367 vn: SymTab.Name; .) 1368 = "WriteInt" 1369 "(" Expr ")" (. IF t = SymTab.InvalidType THEN 1370 MGen.Drop 1371 ELSIF ~SymTab.IsIntFamily(t) THEN 1372 SemError(210); 1373 MGen.Drop 1374 ELSE 1375 MGen.CallPrint 1376 END; .) . 1377 WriteStrStat (. VAR t: SymTab.TypeIndex; 1378 lx: MGen.LitStr; 1379 v: BOOLEAN; 1380 vn: SymTab.Name; .) 1381 = "WriteString" 1382 "(" Expr ")" (. IF t = SymTab.InvalidType THEN 1383 MGen.Drop 1384 ELSIF (SymTab.ClassOf(t) 1385 = SymTab.ClStr) THEN 1386 MGen.PushInt(1); 1387 MGen.SysCall 1388 ELSIF (SymTab.ClassOf(t) 1389 = SymTab.ClArray) 1390 & (SymTab.ClassOf( 1391 SymTab.ArrayElem(t)) 1392 = SymTab.ClChar) THEN 1393 MGen.PushInt(1); 1394 MGen.SysCall 1395 ELSE 1396 SemError(210); 1397 MGen.Drop 1398 END; .) . 1399 1400 (* Expressions: Designator without ActualParameters (calls use 1401 CallTail). Each expression synthesizes its SymTab type in t, 1402 the source text in lx for single literals ("" otherwise), and 1403 whether it is a plain variable (v/vn) for VAR actuals. 1404 Values travel on the MC64 stack. *) 1405 DesignHead 1407 (. VAR n: SymTab.Name; 1408 cls: INTEGER; .) 1409 = GetIdent (. MGen.CopyName(n, bn); 1410 lx[0] := 0C; 1411 IF ~SymTab.Lookup(n) THEN 1412 SemError(201); 1413 t := SymTab.InvalidType; k := -1; 1414 IF doLoad THEN 1415 MGen.PushInt(0) 1416 END 1417 ELSE 1418 t := SymTab.SymType(n); 1419 k := SymTab.SymKind(n); 1420 IF k = SymTab.KindConst THEN 1421 IF SymTab.Equal(n, "TRUE") THEN 1422 t := SymTab.BoolType(); 1423 MGen.CopyName("TRUE", lx); 1424 IF doLoad THEN 1425 MGen.PushInt(1) 1426 END 1427 ELSIF SymTab.Equal(n, 1428 "FALSE") THEN 1429 t := SymTab.BoolType(); 1430 MGen.CopyName("FALSE", lx); 1431 IF doLoad THEN 1432 MGen.PushInt(0) 1433 END 1434 ELSE 1435 cls := 1436 SymTab.ClassOf(t); 1437 IF (t # 1438 SymTab.InvalidType) 1439 & (cls # SymTab.ClStr) 1440 & ((cls = SymTab.ClInt) 1441 OR (cls = SymTab.ClReal) 1442 OR (cls = SymTab.ClBool) 1443 OR (cls = SymTab.ClChar) 1444 OR (cls 1445 = SymTab.ClEnum)) THEN 1446 IF doLoad THEN 1447 MGen.LoadVar(n) 1448 END 1449 ELSIF doLoad THEN 1450 MGen.PushInt(0) 1451 END 1452 END 1453 ELSIF (k = SymTab.KindVar) 1454 OR (k = SymTab.KindParam) 1455 OR (k 1456 = SymTab.KindVarPar) THEN 1457 cls := SymTab.ClassOf(t); 1458 IF (cls = SymTab.ClInt) 1459 OR (cls = SymTab.ClReal) 1460 OR (cls = SymTab.ClBool) 1461 OR (cls = SymTab.ClChar) 1462 OR (cls 1463 = SymTab.ClEnum) 1464 OR (cls 1465 = SymTab.ClSet) 1466 OR (cls 1467 = SymTab.ClPtr) THEN 1468 IF doLoad THEN 1469 MGen.PushVar(n) 1470 END 1471 ELSIF (cls 1472 = SymTab.ClArray) 1473 OR (cls 1474 = SymTab.ClRecord) THEN 1475 IF doLoad THEN 1476 MGen.PushAddr(n) 1477 END 1478 ELSIF t 1479 = SymTab.InvalidType THEN 1480 IF doLoad THEN 1481 MGen.PushInt(0) 1482 END 1483 ELSE SemError(230); 1484 IF doLoad THEN 1485 MGen.PushInt(0) 1486 END 1487 END 1488 ELSE 1489 IF doLoad THEN 1490 IF k = SymTab.KindField THEN 1491 MGen.WithAddr(n); 1492 cls := SymTab.ClassOf(t); 1493 IF (t 1494 = SymTab.InvalidType) 1495 OR (cls 1496 = SymTab.ClArray) 1497 OR (cls 1498 = SymTab.ClRecord) THEN 1499 ELSE 1500 IF (cls 1501 = SymTab.ClChar) 1502 OR (cls 1503 = SymTab.ClBool) THEN 1504 MGen.LoadByte 1505 ELSE MGen.LoadIndir 1506 END 1507 END 1508 ELSE MGen.PushInt(0) 1509 END 1510 END; 1511 IF k = SymTab.KindField THEN 1512 ELSIF k 1513 = SymTab.KindImport THEN 1514 SemError(230) 1515 END 1516 END 1517 END; .) . 1518 DesignTail 1521 (. VAR m: SymTab.Name; 1522 it: SymTab.TypeIndex; 1523 lxI: MGen.LitStr; 1524 vI: BOOLEAN; 1525 vnI: SymTab.Name; 1526 loA: INTEGER; 1527 elemT: SymTab.TypeIndex; 1528 esl, ebytes: CARDINAL; 1529 firstT: BOOLEAN; 1530 clsI: INTEGER; 1531 sk: INTEGER; 1532 qM: SymTab.Name; .) 1533 = (. sfx := FALSE; .) 1534 { "." (. firstT := ~sfx; 1535 sfx := TRUE; lx[0] := 0C; 1536 IF ~doLoad & firstT THEN 1537 IF (k = SymTab.KindVar) 1538 OR (k = SymTab.KindParam) 1539 OR (k 1540 = SymTab.KindVarPar) THEN 1541 MGen.PushAddr(bn) 1542 ELSIF k 1543 = SymTab.KindField THEN 1544 MGen.WithAddr(bn) 1545 ELSIF k 1546 = SymTab.KindModule THEN 1547 ELSE MGen.PushInt(0) 1548 END 1549 END; .) 1550 GetIdent (. IF (k = SymTab.KindModule) THEN 1551 IF SymTab.ExpKind(bn, m) = -1 THEN 1552 sk := SymTab.SelfKind(bn, m); 1553 IF sk = SymTab.KindProc THEN 1554 MGen.CopyName(m, lx); 1555 t := SymTab.InvalidType; 1556 IF doLoad THEN 1557 MGen.Drop; MGen.PushInt(0) 1558 ELSIF firstT THEN 1559 ELSE MGen.Drop 1560 END 1561 ELSIF sk # -1 THEN 1562 t := SymTab.SymType(m); 1563 k := sk; 1564 SymTab.SelfQual(m, qM); 1565 IF doLoad THEN 1566 MGen.Drop; 1567 MGen.GlobalAddr(qM) 1568 ELSE 1569 IF firstT THEN 1570 ELSE MGen.Drop 1571 END; 1572 MGen.GlobalAddr(qM) 1573 END 1574 ELSE 1575 SemError(201); 1576 MGen.CopyName(m, lx); 1577 t := SymTab.InvalidType; 1578 IF doLoad THEN 1579 MGen.Drop; MGen.PushInt(0) 1580 ELSIF firstT THEN 1581 ELSE MGen.Drop 1582 END 1583 END 1584 ELSIF SymTab.ExpKind(bn, m) 1585 = SymTab.KindProc THEN 1586 MGen.CopyName(m, lx); 1587 t := SymTab.InvalidType; 1588 IF doLoad THEN 1589 MGen.Drop; MGen.PushInt(0) 1590 ELSIF firstT THEN 1591 ELSE MGen.Drop 1592 END 1593 ELSE 1594 t := SymTab.ExpType(bn, m); 1595 k := SymTab.ExpKind(bn, m); 1596 SymTab.ExpQual(bn, m, qM); 1597 IF doLoad THEN 1598 MGen.Drop; 1599 MGen.GlobalAddr(qM) 1600 ELSE 1601 IF firstT THEN 1602 ELSE MGen.Drop 1603 END; 1604 MGen.GlobalAddr(qM) 1605 END 1606 END 1607 ELSIF t = SymTab.InvalidType THEN 1608 IF ~doLoad & firstT THEN 1609 MGen.Drop 1610 ELSIF doLoad THEN 1611 MGen.Drop; MGen.PushInt(0) 1612 END 1613 ELSIF SymTab.ClassOf(t) # 1614 SymTab.ClRecord THEN 1615 SemError(215); 1616 t := SymTab.InvalidType; 1617 IF doLoad THEN 1618 MGen.Drop; MGen.PushInt(0) 1619 ELSIF firstT THEN 1620 MGen.Drop 1621 END 1622 ELSIF ~SymTab.FieldExists(t, m) THEN 1623 SemError(216); 1624 t := SymTab.InvalidType; 1625 IF doLoad THEN 1626 MGen.Drop; MGen.PushInt(0) 1627 ELSIF firstT THEN 1628 MGen.Drop 1629 END 1630 ELSE 1631 loA := SymTab.FieldOffset(t, m); 1632 elemT := SymTab.FieldType(t, m); 1633 IF loA < 0 THEN 1634 SemError(216); 1635 t := SymTab.InvalidType; 1636 IF doLoad THEN 1637 MGen.Drop; MGen.PushInt(0) 1638 ELSIF firstT THEN 1639 MGen.Drop 1640 END 1641 ELSE 1642 MGen.FieldAdd( 1643 VAL(CARDINAL, loA)); 1644 t := elemT 1645 END 1646 END; .) 1647 | "[" (. firstT := ~sfx; 1648 sfx := TRUE; lx[0] := 0C; 1649 IF ~doLoad & firstT THEN 1650 IF (k = SymTab.KindVar) 1651 OR (k = SymTab.KindParam) 1652 OR (k 1653 = SymTab.KindVarPar) THEN 1654 MGen.PushAddr(bn) 1655 ELSIF k 1656 = SymTab.KindField THEN 1657 MGen.WithAddr(bn) 1658 ELSE MGen.PushInt(0) 1659 END 1660 END; .) 1661 Expr (. IF t = SymTab.InvalidType THEN 1662 MGen.Drop; 1663 IF doLoad THEN 1664 MGen.Drop; MGen.PushInt(0) 1665 ELSE 1666 IF ~firstT THEN 1667 ELSE MGen.Drop 1668 END 1669 END 1670 ELSIF SymTab.ClassOf(t) # 1671 SymTab.ClArray THEN 1672 SemError(217); 1673 t := SymTab.InvalidType; 1674 MGen.Drop; 1675 IF doLoad THEN 1676 MGen.Drop; MGen.PushInt(0) 1677 ELSE 1678 IF ~firstT THEN 1679 ELSE MGen.Drop 1680 END 1681 END 1682 ELSE 1683 clsI := SymTab.ClassOf(it); 1684 IF (it 1685 # SymTab.InvalidType) 1686 & (clsI # SymTab.ClInt) 1687 & (clsI # SymTab.ClChar) 1688 & (clsI # SymTab.ClEnum) 1689 & (clsI 1690 # SymTab.ClBool) THEN 1691 SemError(218); 1692 t := SymTab.InvalidType; 1693 MGen.Drop; 1694 IF doLoad THEN 1695 MGen.Drop; MGen.PushInt(0) 1696 ELSE 1697 IF ~firstT THEN 1698 ELSE MGen.Drop 1699 END 1700 END 1701 ELSE 1702 loA := SymTab.ArrayLo(t); 1703 elemT := SymTab.ArrayElem(t); 1704 esl := SymTab.TypeSlots(elemT); 1705 IF esl = 0 THEN 1706 SemError(230); 1707 esl := 1 1708 END; 1709 IF (SymTab.ClassOf(elemT) 1710 = SymTab.ClChar) 1711 OR (SymTab.ClassOf(elemT) 1712 = SymTab.ClBool) THEN 1713 ebytes := 1 1714 ELSE ebytes := esl * 8 1715 END; 1716 MGen.IdxScale(loA, ebytes); 1717 t := elemT 1718 END 1719 END; .) 1720 { "," 1721 Expr (. IF t = SymTab.InvalidType THEN 1722 MGen.Drop; 1723 IF doLoad THEN 1724 MGen.Drop; MGen.PushInt(0); 1725 t := SymTab.InvalidType 1726 END 1727 ELSIF SymTab.ClassOf(t) # 1728 SymTab.ClArray THEN 1729 SemError(217); 1730 t := SymTab.InvalidType; 1731 MGen.Drop; 1732 IF doLoad THEN 1733 MGen.Drop; MGen.PushInt(0) 1734 END 1735 ELSE 1736 clsI := SymTab.ClassOf(it); 1737 IF (it 1738 # SymTab.InvalidType) 1739 & (clsI # SymTab.ClInt) 1740 & (clsI # SymTab.ClChar) 1741 & (clsI # SymTab.ClEnum) 1742 & (clsI 1743 # SymTab.ClBool) THEN 1744 SemError(218); 1745 t := SymTab.InvalidType; 1746 MGen.Drop; 1747 IF doLoad THEN 1748 MGen.Drop; MGen.PushInt(0) 1749 END 1750 ELSE 1751 loA := SymTab.ArrayLo(t); 1752 elemT := SymTab.ArrayElem(t); 1753 esl := SymTab.TypeSlots(elemT); 1754 IF esl = 0 THEN 1755 SemError(230); 1756 esl := 1 1757 END; 1758 IF (SymTab.ClassOf(elemT) 1759 = SymTab.ClChar) 1760 OR (SymTab.ClassOf(elemT) 1761 = SymTab.ClBool) THEN 1762 ebytes := 1 1763 ELSE ebytes := esl * 8 1764 END; 1765 MGen.IdxScale(loA, ebytes); 1766 t := elemT 1767 END 1768 END; .) } 1769 "]" 1770 | "^" (. firstT := ~sfx; 1771 sfx := TRUE; lx[0] := 0C; 1772 IF ~doLoad & firstT THEN 1773 IF (k = SymTab.KindVar) 1774 OR (k = SymTab.KindParam) 1775 OR (k 1776 = SymTab.KindVarPar) THEN 1777 MGen.PushAddr(bn) 1778 ELSIF k 1779 = SymTab.KindField THEN 1780 MGen.WithAddr(bn) 1781 ELSE MGen.PushInt(0) 1782 END 1783 END; .) 1784 (. IF t = SymTab.InvalidType THEN 1785 IF doLoad THEN 1786 MGen.Drop; MGen.PushInt(0) 1787 ELSIF firstT THEN 1788 MGen.Drop 1789 END 1790 ELSIF SymTab.ClassOf(t) # 1791 SymTab.ClPtr THEN 1792 SemError(219); 1793 t := SymTab.InvalidType; 1794 IF doLoad THEN 1795 MGen.Drop; MGen.PushInt(0) 1796 ELSIF firstT THEN 1797 MGen.Drop 1798 END 1799 ELSE 1800 elemT := SymTab.PtrBase(t); 1801 t := elemT; 1802 IF doLoad THEN 1803 IF ~(firstT 1804 & ((k 1805 = SymTab.KindVar) 1806 OR (k 1807 = SymTab.KindParam) 1808 OR (k 1809 = SymTab.KindVarPar))) 1810 THEN 1811 MGen.LoadIndir 1812 END 1813 ELSE 1814 MGen.LoadIndir 1815 END 1816 END; .) } . 1817 Expr 1819 (. VAR t2: SymTab.TypeIndex; 1820 tc, op: INTEGER; 1821 lx2: MGen.LitStr; 1822 v2: BOOLEAN; 1823 vn2: SymTab.Name; 1824 r: BOOLEAN; .) 1825 = SimExpr [ Rel SimExpr 1826 (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 1827 IF op = SymTab.OpIn THEN 1828 IF SymTab.InCheck(t, t2) THEN 1829 t := SymTab.BoolType(); 1830 MGen.BitIn 1831 ELSE SemError(222); 1832 t := SymTab.InvalidType; 1833 MGen.Drop; MGen.Drop; MGen.PushInt(0) 1834 END 1835 ELSIF (t # SymTab.InvalidType) 1836 & (t2 # SymTab.InvalidType) 1837 & (SymTab.ClassOf(t) = SymTab.ClArray) 1838 & (SymTab.ClassOf(t2) = SymTab.ClArray) 1839 & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar) 1840 & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar) 1841 & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN 1842 t := SymTab.BoolType(); 1843 MGen.PushBytes(SymTab.TypeSlots(t) * 8); 1844 MGen.PushBytes(SymTab.TypeSlots(t2) * 8); 1845 MGen.StrComp; 1846 IF op = SymTab.OpEq THEN MGen.Or; MGen.Not 1847 ELSIF (op = SymTab.OpNeq1) 1848 OR (op = SymTab.OpNeq2) THEN MGen.Or 1849 ELSIF op = SymTab.OpLt THEN 1850 MGen.Swap; MGen.Drop 1851 ELSIF op = SymTab.OpLe THEN 1852 MGen.Drop; MGen.Not 1853 ELSIF op = SymTab.OpGt THEN 1854 MGen.Drop 1855 ELSE 1856 MGen.Swap; MGen.Drop; MGen.Not 1857 END 1858 ELSIF (t # SymTab.InvalidType) 1859 & (t2 # SymTab.InvalidType) 1860 & ((SymTab.ClassOf(t) = SymTab.ClArray) 1861 OR (SymTab.ClassOf(t) = SymTab.ClRecord) 1862 OR (SymTab.ClassOf(t2) = SymTab.ClArray) 1863 OR (SymTab.ClassOf(t2) = SymTab.ClRecord)) THEN 1864 SemError(213); t := SymTab.InvalidType; 1865 MGen.Drop; MGen.Drop; MGen.PushInt(0) 1866 ELSE 1867 tc := SymTab.ClassOf(t); 1868 IF SymTab.RelCheck(t, t2, op) THEN 1869 t := SymTab.BoolType() 1870 ELSE SemError(213); t := SymTab.InvalidType END; 1871 IF t # SymTab.InvalidType THEN 1872 r := tc = SymTab.ClReal; 1873 IF r THEN 1874 IF op = SymTab.OpEq THEN MGen.RealEq 1875 ELSIF (op = SymTab.OpNeq1) 1876 OR (op = SymTab.OpNeq2) THEN MGen.RealNe 1877 ELSIF op = SymTab.OpLt THEN MGen.RealLt 1878 ELSIF op = SymTab.OpLe THEN MGen.RealLe 1879 ELSIF op = SymTab.OpGt THEN MGen.RealGt 1880 ELSE MGen.RealGe END 1881 ELSE 1882 IF op = SymTab.OpEq THEN MGen.Eq 1883 ELSIF (op = SymTab.OpNeq1) 1884 OR (op = SymTab.OpNeq2) THEN MGen.Neq 1885 ELSIF op = SymTab.OpLt THEN MGen.ILt 1886 ELSIF op = SymTab.OpLe THEN MGen.ILe 1887 ELSIF op = SymTab.OpGt THEN MGen.IGt 1888 ELSE MGen.IGe END 1889 END 1890 ELSE MGen.Drop; MGen.Drop; MGen.PushInt(0) 1891 END 1892 END; .) ] . 1893 Rel 1894 = "=" (. op := SymTab.OpEq; .) 1895 | "#" (. op := SymTab.OpNeq1; .) 1896 | "<>" (. op := SymTab.OpNeq2; .) 1897 | "<" (. op := SymTab.OpLt; .) 1898 | "<=" (. op := SymTab.OpLe; .) 1899 | ">" (. op := SymTab.OpGt; .) 1900 | ">=" (. op := SymTab.OpGe; .) 1901 | "IN" (. op := SymTab.OpIn; .) . 1902 SimExpr 1904 (. VAR t2, res2: SymTab.TypeIndex; 1905 op: INTEGER; 1906 lx2: MGen.LitStr; 1907 v2: BOOLEAN; 1908 vn2: SymTab.Name; 1909 neg, isR: BOOLEAN; .) 1910 = (. neg := FALSE; .) 1911 [ "+" | "-" (. neg := TRUE; .) ] 1912 Term (. IF neg THEN 1913 v := FALSE; 1914 MGen.ClrStash(); 1915 IF MGen.IsLit(lx) THEN 1916 MGen.NegFold(lx, lx) 1917 ELSE lx[0] := 0C 1918 END; 1919 IF SymTab.ClassOf(t) 1920 = SymTab.ClReal THEN 1921 MGen.NegReal 1922 ELSE MGen.NegInt 1923 END 1924 END; .) 1925 { AddOp Term 1926 (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 1927 IF op = SymTab.OpOr THEN 1928 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN 1929 t := SymTab.BoolType() 1930 ELSE SemError(212); t := SymTab.InvalidType END; 1931 MGen.Or 1932 ELSIF (t # SymTab.InvalidType) 1933 & (t2 # SymTab.InvalidType) 1934 & (SymTab.ClassOf(t) = SymTab.ClSet) 1935 & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN 1936 IF op = SymTab.OpAdd THEN 1937 MGen.Or 1938 ELSE 1939 MGen.PushBits(0FFFFFFFFFFFFFFFFH); 1940 MGen.BitXor; 1941 MGen.And 1942 END 1943 ELSE 1944 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2 1945 ELSE SemError(211); t := SymTab.InvalidType END; 1946 isR := (t # SymTab.InvalidType) 1947 & (SymTab.ClassOf(t) = SymTab.ClReal); 1948 IF op = SymTab.OpAdd THEN 1949 IF isR THEN MGen.RealAdd ELSE MGen.Add END 1950 ELSE 1951 IF isR THEN MGen.RealSub ELSE MGen.Sub END 1952 END 1953 END; .) } . 1954 AddOp 1955 = "+" (. op := SymTab.OpAdd; .) 1956 | "-" (. op := SymTab.OpSub; .) 1957 | "OR" (. op := SymTab.OpOr; .) . 1958 Term 1960 (. VAR t2, res2: SymTab.TypeIndex; 1961 op: INTEGER; 1962 lx2: MGen.LitStr; 1963 v2: BOOLEAN; 1964 vn2: SymTab.Name; 1965 isR: BOOLEAN; 1966 mt: INTEGER; .) 1967 = Fact { MulOp Fact 1968 (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 1969 IF op = SymTab.OpAnd THEN 1970 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN 1971 t := SymTab.BoolType() 1972 ELSE SemError(212); t := SymTab.InvalidType END; 1973 MGen.And 1974 ELSIF (op = SymTab.OpTimes) 1975 & (t # SymTab.InvalidType) 1976 & (t2 # SymTab.InvalidType) 1977 & (SymTab.ClassOf(t) = SymTab.ClSet) 1978 & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN 1979 MGen.And 1980 ELSE 1981 IF SymTab.ArithCheck(t, t2, 1982 (op = SymTab.OpDiv) OR (op = SymTab.OpMod), 1983 res2) THEN t := res2 1984 ELSE SemError(211); t := SymTab.InvalidType END; 1985 isR := (t # SymTab.InvalidType) 1986 & (SymTab.ClassOf(t) = SymTab.ClReal); 1987 IF op = SymTab.OpTimes THEN 1988 IF isR THEN MGen.RealMul ELSE MGen.MulU END 1989 ELSIF op = SymTab.OpSlash THEN 1990 IF isR THEN MGen.RealDiv ELSE MGen.DivI END 1991 ELSIF op = SymTab.OpDiv THEN 1992 MGen.DivI 1993 ELSE 1994 mt := MGen.TempGlobal(); 1995 MGen.ModI(mt) 1996 END 1997 END; .) } . 1998 MulOp 1999 = "*" (. op := SymTab.OpTimes; .) 2000 | "/" (. op := SymTab.OpSlash; .) 2001 | "DIV" (. op := SymTab.OpDiv; .) 2002 | "MOD" (. op := SymTab.OpMod; .) 2003 | "AND" (. op := SymTab.OpAnd; .) 2004 | "&" (. op := SymTab.OpAnd; .) . 2005 Fact 2007 (. VAR s: ARRAY [0 .. 255] OF CHAR; 2008 t2, et, dt, st: SymTab.TypeIndex; 2009 dk: INTEGER; 2010 bnF: SymTab.Name; 2011 lxD, lx2: MGen.LitStr; 2012 v2: BOOLEAN; 2013 vn2: SymTab.Name; 2014 vi, mpF: INTEGER; 2015 c: CARDINAL; 2016 b: LONGCARD; 2017 sfxF: BOOLEAN; 2018 okF: BOOLEAN; .) 2019 = integer (. LexString(s); 2020 MGen.CopyName(s, lx); 2021 v := FALSE; MGen.ClrStash(); 2022 IF MGen.ParseInt(s, vi) THEN 2023 MGen.PushInt(vi) 2024 ELSIF MGen.ParseCard(s, c) THEN 2025 MGen.PushBits( 2026 VAL(LONGCARD, c)) 2027 ELSE MGen.PushInt(0) 2028 END; 2029 t := SymTab.IntType(); .) 2030 | real (. LexString(s); 2031 MGen.CopyName(s, lx); 2032 v := FALSE; MGen.ClrStash(); 2033 IF MGen.ParseReal(s, b) THEN 2034 MGen.PushBits(b) 2035 ELSE MGen.PushBits(0H) 2036 END; 2037 t := SymTab.RealType(); .) 2038 | string (. LexString(s); 2039 v := FALSE; MGen.ClrStash(); 2040 IF SymTab.StrLen(s) <= 3 THEN 2041 t := SymTab.CharType(); 2042 MGen.CopyName(s, lx); 2043 MGen.PushInt( 2044 MGen.CharOrd(s)) 2045 ELSE t := SymTab.NewStr(); 2046 MGen.CopyName(s, lx); 2047 MGen.EmitString(s) 2048 END; .) 2049 | "HIGH" 2050 "(" DesignHead 2051 DesignTail 2052 ")" (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 2053 IF dt = SymTab.InvalidType THEN 2054 IF sfxF THEN MGen.Drop END; 2055 MGen.PushInt(0); 2056 t := SymTab.InvalidType 2057 ELSIF SymTab.ClassOf(dt) 2058 # SymTab.ClArray THEN 2059 SemError(217); 2060 IF sfxF THEN MGen.Drop END; 2061 MGen.PushInt(0); 2062 t := SymTab.InvalidType 2063 ELSIF SymTab.IsOpen(dt) THEN 2064 IF sfxF THEN MGen.Drop END; 2065 IF (dk = SymTab.KindParam) 2066 OR (dk 2067 = SymTab.KindVarPar) THEN 2068 IF SymTab.CurDepth() 2069 = SymTab.SymDepth(bnF) THEN 2070 MGen.LoadLocal( 2071 SymTab.SymSlot(bnF) + 1) 2072 ELSE 2073 MGen.FrameAddr( 2074 SymTab.SymSlot(bnF) + 1, 2075 VAL(CARDINAL, 2076 SymTab.CurDepth() - 1 2077 - SymTab.SymDepth(bnF))); 2078 MGen.LoadIndir 2079 END; 2080 MGen.PushInt(1); 2081 MGen.Sub; 2082 t := SymTab.IntType() 2083 ELSE 2084 MGen.PushInt(0); 2085 t := SymTab.InvalidType 2086 END 2087 ELSE 2088 IF sfxF THEN MGen.Drop END; 2089 MGen.PushInt( 2090 SymTab.ArrayHi(dt)); 2091 t := SymTab.IntType() 2092 END; .) 2093 | DesignHead 2094 DesignTail 2095 (. t := dt; 2096 MGen.CopyName(lxD, lx); 2097 IF sfxF 2098 & (t # SymTab.InvalidType) 2099 & MGen.ActIsVarNext() 2100 & ((dk = SymTab.KindVar) 2101 OR (dk 2102 = SymTab.KindParam) 2103 OR (dk 2104 = SymTab.KindVarPar) 2105 OR (dk 2106 = SymTab.KindField)) 2107 & (SymTab.SymKind(bnF) 2108 # SymTab.KindModule) 2109 & (SymTab.ClassOf(t) 2110 # SymTab.ClChar) 2111 & (SymTab.ClassOf(t) 2112 # SymTab.ClBool) THEN 2113 MGen.StashAddr() 2114 END; 2115 IF sfxF 2116 & (t # SymTab.InvalidType) 2117 & (SymTab.ClassOf(t) 2118 # SymTab.ClArray) 2119 & (SymTab.ClassOf(t) 2120 # SymTab.ClRecord) THEN 2121 IF (SymTab.ClassOf(t) 2122 = SymTab.ClChar) 2123 OR (SymTab.ClassOf(t) 2124 = SymTab.ClBool) THEN 2125 MGen.LoadByte 2126 ELSE MGen.LoadIndir 2127 END 2128 END; 2129 v := ~sfxF 2130 & ((dk = SymTab.KindVar) 2131 OR (dk = SymTab.KindParam) 2132 OR (dk 2133 = SymTab.KindVarPar)); 2134 MGen.CopyName(bnF, vn); .) 2135 [ CallTail 2136 (. IF okF THEN 2137 IF SymTab.SymKind(bnF) 2138 = SymTab.KindProc THEN 2139 t := SymTab.ProcRet(bnF) 2140 ELSIF (SymTab.SymKind(bnF) 2141 = SymTab.KindModule) 2142 & sfxF 2143 & (SymTab.StrLen(lxD) > 0) THEN 2144 mpF := SymTab.ExpProc(bnF, 2145 lxD); 2146 IF (mpF < 0) 2147 & (SymTab.SelfKind(bnF, 2148 lxD) 2149 = SymTab.KindProc) THEN 2150 mpF := SymTab.ProcNum(lxD) 2151 END; 2152 IF mpF >= 0 THEN 2153 t := SymTab.ProcRetByNum(mpF) 2154 ELSE 2155 t := SymTab.InvalidType 2156 END 2157 ELSE 2158 t := SymTab.InvalidType 2159 END 2160 ELSE t := SymTab.InvalidType 2161 END; 2162 lx[0] := 0C; v := FALSE; 2163 MGen.ClrStash(); .) ] 2164 | "(" 2165 Expr ")" (. t := et; .) 2166 | ( "NOT" | "~" ) 2167 Fact (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 2168 IF SymTab.BoolCheck(t2) THEN 2169 t := SymTab.BoolType() 2170 ELSE SemError(212); 2171 t := SymTab.InvalidType END; 2172 MGen.Not; .) 2173 | SetLit (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 2174 t := st; .) . 2175 SetLit 2176 (. VAR first, et: SymTab.TypeIndex; 2177 lxE, lxE2: MGen.LitStr; 2178 vE, vE2: BOOLEAN; 2179 vnE, vnE2: SymTab.Name; 2180 hasR: BOOLEAN; .) 2181 = "{" 2182 (. MGen.PushInt(0); 2183 t := SymTab.SetFor(SymTab.IntType()); .) 2184 [ Elem (. first := et; 2185 t := SymTab.SetFor(et); 2186 MGen.ClrStash(); 2187 IF hasR THEN 2188 MGen.PushInt(1); MGen.Add; 2189 MGen.FieldMask 2190 ELSE MGen.Power2 END; 2191 MGen.Or; .) 2192 { "," 2193 Elem (. IF ~SymTab.SetElemCheck(first, et) THEN 2194 SemError(222) END; 2195 MGen.ClrStash(); 2196 IF hasR THEN 2197 MGen.PushInt(1); MGen.Add; 2198 MGen.FieldMask 2199 ELSE MGen.Power2 END; 2200 MGen.Or; .) } ] 2201 "}" . 2202 Elem 2204 (. VAR t2: SymTab.TypeIndex; 2205 vD, vD2: BOOLEAN; 2206 vnD, vnD2: SymTab.Name; .) 2207 = Expr (. hasR := FALSE; 2208 lx2[0] := 0C; .) 2209 [ ".." 2210 Expr (. IF ~SymTab.SetElemCheck(t, t2) THEN 2211 SemError(222) END; 2212 hasR := TRUE; .) ] . 2213 2214 GetIdent 2215 = ident (. LexName(n); .) . 2216 2217 (* ---- step-11 separate compilation units (at end: the DEFINITION 2218 and IMPLEMENTATION keywords take fresh token numbers, leaving 2219 every existing token — and M2c.mod's messages — untouched) ---- *) 2220 DefUnit (. VAR m1, m2: SymTab.Name; .) 2221 = "DEFINITION" "MODULE" 2222 GetIdent (. IF ~SymTab.EnterModule(m1) THEN 2223 SemError(200) 2224 END; .) 2225 ";" 2226 { Import } 2227 { DefDecl } 2228 "END" 2229 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 2230 SemError(202) 2231 END; 2232 IF ~SymTab.ExitDefinition() THEN 2233 SemError(230) 2234 END; .) 2235 "." . 2236 DefDecl 2237 = "CONST" { ConstDecl ";" } 2238 | "TYPE" { TypeDecl ";" } 2239 | "VAR" { VarDecl ";" } 2240 | DefProcHead . 2241 DefProcHead (. VAR n: SymTab.Name; 2242 rt: SymTab.TypeIndex; 2243 hasR, ok: BOOLEAN; .) 2244 = "PROCEDURE" (. hasR := FALSE; .) 2245 GetIdent (. IF ~SymTab.EnterProc(n) THEN 2246 SemError(200) 2247 END; 2248 SymTab.OpenProcScope; .) 2249 [ "(" FormalParams ")" ] 2250 [ ":" QualIdent (. hasR := TRUE; .) ] 2251 (. IF hasR THEN 2252 ok := SymTab.SetProcRet(rt) 2253 ELSE 2254 ok := SymTab.SetProcRet( 2255 SymTab.InvalidType) 2256 END; 2257 IF ~ok THEN SemError(231) END; 2258 IF ~SymTab.VerifyProc() THEN 2259 SemError(231) 2260 END; 2261 SymTab.SetForward; 2262 SymTab.CloseProc; .) 2263 ";" . 2264 ImplUnit (. VAR m1, m2: SymTab.Name; 2265 hasInit: BOOLEAN; 2266 initL, initN: INTEGER; .) 2267 = "IMPLEMENTATION" "MODULE" 2268 GetIdent (. hasInit := FALSE; 2269 IF ~SymTab.OpenImplementation(m1) 2270 THEN 2271 SemError(201) 2272 END; .) 2273 ";" 2274 { Import } 2275 { Declaration } 2276 [ "BEGIN" (. hasInit := TRUE; 2277 initL := MGen.NewLabel(); 2278 MGen.Jmp(initL); 2279 initN := MGen.ModInitBegin(); 2280 IF initN < 0 THEN 2281 SemError(230) 2282 END; .) 2283 StatSeq ] 2284 "END" 2285 GetIdent (. IF ~SymTab.Equal(m1, m2) THEN 2286 SemError(202) 2287 END; 2288 IF hasInit THEN 2289 MGen.ModInitEnd(initN); 2290 MGen.DefLabel(initL) 2291 END; 2292 IF ~SymTab.CloseImplementation() 2293 THEN 2294 SemError(231) 2295 END; .) . 2296 ProgUnit (. VAR m1, m2: SymTab.Name; .) 2297 = "MODULE" 2298 GetIdent (. IF ~SymTab.NoteProgram() THEN 2299 SemError(230) 2300 END; 2301 MGen.SetModName(m1); 2302 IF ~SymTab.Enter(m1, 2303 SymTab.KindModule) 2304 THEN SemError(200) END; .) 2305 ";" 2306 { Import } Block GetIdent 2307 (. IF ~SymTab.Equal(m1, m2) 2308 THEN SemError(202) END; .) 2309 "." (. IF SymTab.AnyForward() THEN 2310 SemError(231) 2311 END; 2312 MGen.EndModule; 2313 SymTab.PrintTable; .) . 2314 2315 END M2c. 0 errors Statistics: nr of terminals: 78 (limit 400) nr of non-terminals: 63 (limit 210) nr of pragmas: 0 (limit 422) nr of symbolnodes: 141 (limit 500) nr of graphnodes: 643 (limit 1500) nr of conditionsets: 7 (limit 100) nr of charactersets: 9 (limit 250)