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