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