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