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, TYPEs and procedures (value/VAR params, functions, 8 open array formals with fixed actuals); use as M.x / M.P(args); 9 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.KindModule THEN 328 t := SymTab.InvalidType 329 ELSIF (SymTab.SymKind(n) # 330 SymTab.KindType) 331 & (SymTab.SymKind(n) # 332 SymTab.KindPredef) 333 & (SymTab.SymKind(n) # 334 SymTab.KindImport) THEN 335 SemError(221); 336 t := SymTab.InvalidType 337 ELSE t := SymTab.SymType(n) END; .) 338 { "." 339 GetIdent (. IF SymTab.SymKind(n) 340 = SymTab.KindModule THEN 341 IF SymTab.ExpKind(n, m) 342 = SymTab.KindType THEN 343 t := SymTab.ExpType(n, m) 344 ELSE 345 IF SymTab.ExpKind(n, m) = -1 THEN 346 SemError(201) 347 ELSE SemError(221) 348 END; 349 t := SymTab.InvalidType 350 END 351 ELSE 352 t := SymTab.InvalidType 353 END; .) } . 354 355 (* Types: ProcedureType removed; subrange factored for LL(1) *) 356 Type 357 = SimpleType | ArrayType | RecordType 358 | SetType | PointerType . 359 SimpleType 360 (. VAR t1, t2: SymTab.TypeIndex; 361 lx1, lx2: MGen.LitStr; 362 vD: BOOLEAN; 363 vnD: SymTab.Name; 364 loI, hiI: INTEGER; 365 lok, hik: BOOLEAN; .) 366 = QualIdent [ "[" 367 (. MGen.NoEmitEnter; lok := FALSE; hik := FALSE; 368 loI := 0; hiI := -1; .) 369 ConstExpr (. IF (t1 # SymTab.InvalidType) 370 & (SymTab.ClassOf(t1) # 371 SymTab.ClInt) 372 & (SymTab.ClassOf(t1) # 373 SymTab.ClChar) 374 & (SymTab.ClassOf(t1) # 375 SymTab.ClEnum) THEN 376 SemError(224) END; .) 377 ".." 378 ConstExpr (. IF (t2 # SymTab.InvalidType) 379 & (SymTab.ClassOf(t2) # 380 SymTab.ClInt) 381 & (SymTab.ClassOf(t2) # 382 SymTab.ClChar) 383 & (SymTab.ClassOf(t2) # 384 SymTab.ClEnum) THEN 385 SemError(224) END; .) 386 "]" 387 (. IF (t1 # SymTab.InvalidType) 388 & (t2 # SymTab.InvalidType) THEN 389 IF MGen.IsLit(lx1) THEN 390 IF SymTab.ClassOf(t1) 391 = SymTab.ClChar THEN 392 loI := MGen.CharOrd(lx1); 393 lok := TRUE 394 ELSIF MGen.ParseInt(lx1, loI) THEN 395 lok := TRUE 396 END 397 END; 398 IF MGen.IsLit(lx2) THEN 399 IF SymTab.ClassOf(t2) 400 = SymTab.ClChar THEN 401 hiI := MGen.CharOrd(lx2); 402 hik := TRUE 403 ELSIF MGen.ParseInt(lx2, hiI) THEN 404 hik := TRUE 405 END 406 END 407 END; 408 IF lok & hik THEN 409 t := SymTab.NewSubB(t1, loI, hiI) 410 ELSE 411 t := SymTab.NewSub(t1); 412 IF (t1 # SymTab.InvalidType) 413 & (t2 # SymTab.InvalidType) THEN 414 SemError(230) 415 END 416 END; 417 MGen.NoEmitExit; .) ] 418 | "[" (. MGen.NoEmitEnter; lok := FALSE; 419 hik := FALSE; loI := 0; hiI := -1; .) 420 ConstExpr (. IF (t1 # SymTab.InvalidType) 421 & (SymTab.ClassOf(t1) # 422 SymTab.ClInt) 423 & (SymTab.ClassOf(t1) # 424 SymTab.ClChar) 425 & (SymTab.ClassOf(t1) # 426 SymTab.ClEnum) THEN 427 SemError(224) END; .) 428 ".." 429 ConstExpr (. IF (t2 # SymTab.InvalidType) 430 & (SymTab.ClassOf(t2) # 431 SymTab.ClInt) 432 & (SymTab.ClassOf(t2) # 433 SymTab.ClChar) 434 & (SymTab.ClassOf(t2) # 435 SymTab.ClEnum) THEN 436 SemError(224) END; .) 437 "]" (. IF (t1 # SymTab.InvalidType) 438 & (t2 # SymTab.InvalidType) THEN 439 IF MGen.IsLit(lx1) THEN 440 IF SymTab.ClassOf(t1) 441 = SymTab.ClChar THEN 442 loI := MGen.CharOrd(lx1); 443 lok := TRUE 444 ELSIF MGen.ParseInt(lx1, 445 loI) THEN 446 lok := TRUE 447 END 448 END; 449 IF MGen.IsLit(lx2) THEN 450 IF SymTab.ClassOf(t2) 451 = SymTab.ClChar THEN 452 hiI := MGen.CharOrd(lx2); 453 hik := TRUE 454 ELSIF MGen.ParseInt(lx2, 455 hiI) THEN 456 hik := TRUE 457 END 458 END 459 END; 460 IF lok & hik THEN 461 t := SymTab.NewSubB(t1, loI, hiI) 462 ELSE 463 t := SymTab.NewSub(t1); 464 IF (t1 # SymTab.InvalidType) 465 & (t2 # SymTab.InvalidType) THEN 466 SemError(230) 467 END 468 END; 469 MGen.NoEmitExit; .) 470 | Enum . 471 Enum 472 (. VAR n: SymTab.Name; 473 ord: INTEGER; .) 474 = "(" (. t := SymTab.NewEnum(); 475 ord := 0; .) 476 GetIdent (. IF ~SymTab.Enter(n, 477 SymTab.KindConst) 478 THEN SemError(200) END; 479 SymTab.SetSymType(n, t); 480 SymTab.EnumAdd(t); 481 MGen.DeclConstInt(n, ord); 482 INC(ord); .) 483 { "," 484 GetIdent (. IF ~SymTab.Enter(n, 485 SymTab.KindConst) 486 THEN SemError(200) END; 487 SymTab.SetSymType(n, t); 488 SymTab.EnumAdd(t); 489 MGen.DeclConstInt(n, ord); 490 INC(ord); .) } 491 ")" . 492 ArrayType 493 (. VAR s, s2, e: SymTab.TypeIndex; 494 idx: ARRAY [0 .. 7] OF 495 SymTab.TypeIndex; 496 nc, kk: CARDINAL; 497 loA, hiA: INTEGER; 498 isOpenA: BOOLEAN; .) 499 = "ARRAY" 500 [ SimpleType (. IF (s # SymTab.InvalidType) 501 & (SymTab.ClassOf(s) # 502 SymTab.ClInt) 503 & (SymTab.ClassOf(s) # 504 SymTab.ClChar) 505 & (SymTab.ClassOf(s) # 506 SymTab.ClEnum) THEN 507 SemError(224) END; 508 nc := 0; isOpenA := FALSE; 509 idx[nc] := s; INC(nc); .) 510 { "," 511 SimpleType (. IF (s2 # SymTab.InvalidType) 512 & (SymTab.ClassOf(s2) # 513 SymTab.ClInt) 514 & (SymTab.ClassOf(s2) # 515 SymTab.ClChar) 516 & (SymTab.ClassOf(s2) # 517 SymTab.ClEnum) THEN 518 SemError(224) END; 519 IF nc <= HIGH(idx) THEN 520 idx[nc] := s2; INC(nc) 521 END; .) } 522 | (. nc := 0; isOpenA := TRUE; .) ] 523 "OF" 524 Type (. IF isOpenA THEN 525 t := SymTab.NewOpen(e) 526 ELSE 527 t := e; 528 kk := nc; 529 WHILE kk > 0 DO 530 DEC(kk); 531 loA := SymTab.TypeLo(idx[kk]); 532 hiA := SymTab.TypeHi(idx[kk]); 533 IF SymTab.TypeLen(idx[kk]) = 0 THEN 534 IF idx[kk] 535 # SymTab.InvalidType THEN 536 SemError(230) 537 END; 538 loA := 0; hiA := -1 539 END; 540 t := SymTab.NewArrayB(t, 541 loA, hiA) 542 END 543 END; .) . 544 RecordType 545 = "RECORD" (. t := SymTab.NewRecord(); .) 546 FieldSeq 547 "END" . 548 FieldSeq 549 = Field { ";" 550 Field } . 551 Field 552 (. VAR et: SymTab.TypeIndex; .) 553 = [ FieldIdents ":" 554 Type (. IF (et # SymTab.InvalidType) 555 & SymTab.IsOpen(et) THEN 556 SemError(230) 557 END; 558 SymTab.FixPendingF(rt, et); .) ] . 559 FieldIdents 560 (. VAR n: SymTab.Name; .) 561 = GetIdent (. IF ~SymTab.FieldPending(rt, n) 562 THEN SemError(200) END .) 563 { "," 564 GetIdent (. IF ~SymTab.FieldPending(rt, n) 565 THEN SemError(200) END .) } . 566 SetType 567 (. VAR s: SymTab.TypeIndex; .) 568 = "SET" 569 "OF" 570 SimpleType (. IF (s # SymTab.InvalidType) 571 & (SymTab.ClassOf(s) # 572 SymTab.ClInt) 573 & (SymTab.ClassOf(s) # 574 SymTab.ClChar) 575 & (SymTab.ClassOf(s) # 576 SymTab.ClEnum) THEN 577 SemError(224) END; 578 t := SymTab.NewSet(s); .) . 579 PointerType 580 (. VAR b: SymTab.TypeIndex; .) 581 = "POINTER" 582 "TO" 583 Type (. t := SymTab.NewPtr(b); .) . 584 585 (* Statements: RETURN added; calls via AssignOrCall *) 586 StatSeq = Stat { ";" 587 Stat } . 588 Stat (. VAR lx: INTEGER; .) 589 = [ AssignOrCall | IfStat | CaseStat | WhileStat 590 | RepeatStat | LoopStat | ForStat | WithStat | ReturnStat 591 | NewStat | DispStat | WriteIntStat | WriteStrStat 592 | "EXIT" (. IF MGen.TopLoop(lx) THEN 593 MGen.Jmp(lx) 594 ELSE SemError(230) END; .) ] . 595 AssignOrCall (. VAR dt, et: SymTab.TypeIndex; 596 dk: INTEGER; 597 bn: SymTab.Name; 598 lxD, lxe: MGen.LitStr; 599 vE: BOOLEAN; 600 vnE: SymTab.Name; 601 sfx: BOOLEAN; 602 okC: BOOLEAN; 603 isR, conv, 604 storable, pushedDst, 605 pushedFld: BOOLEAN; 606 dstBytes, srcBytes: CARDINAL; 607 elemDt: SymTab.TypeIndex; 608 modBare: INTEGER; .) 609 = (. sfx := FALSE; pushedDst := FALSE; 610 pushedFld := FALSE; .) 611 DesignHead 612 DesignTail 613 ( ":=" 614 (. storable := 615 (dk = SymTab.KindVar) 616 OR (dk = SymTab.KindParam) 617 OR (dk = SymTab.KindVarPar); 618 IF (dk = SymTab.KindField) 619 & (~sfx) 620 & (dt # SymTab.InvalidType) THEN 621 MGen.WithAddr(bn); 622 pushedFld := TRUE 623 END; 624 IF storable & ~sfx 625 & (dt # SymTab.InvalidType) 626 & ((SymTab.ClassOf(dt) 627 = SymTab.ClArray) 628 OR (SymTab.ClassOf(dt) 629 = SymTab.ClRecord)) THEN 630 MGen.PushAddr(bn); 631 pushedDst := TRUE 632 ELSIF ((dk = SymTab.KindVar) 633 OR (dk 634 = SymTab.KindParam) 635 OR (dk 636 = SymTab.KindVarPar) 637 OR (dk 638 = SymTab.KindField)) 639 & sfx 640 & (dt # SymTab.InvalidType) 641 & ((SymTab.ClassOf(dt) 642 = SymTab.ClArray) 643 OR (SymTab.ClassOf(dt) 644 = SymTab.ClRecord)) THEN 645 pushedDst := TRUE 646 END; 647 IF storable & ~sfx 648 & ~pushedDst THEN 649 IF (dt # SymTab.InvalidType) 650 & (SymTab.TypeSlots(dt) 651 > 1) THEN 652 ELSE MGen.StoreSetup(bn) 653 END 654 END; .) 655 Expr (. IF (dt # SymTab.InvalidType) 656 & (dk # SymTab.KindVar) 657 & (dk # SymTab.KindParam) 658 & (dk # SymTab.KindVarPar) 659 & (dk # SymTab.KindField) 660 & (dk # SymTab.KindImport) THEN 661 SemError(210) 662 ELSIF pushedDst THEN 663 IF et = SymTab.InvalidType THEN 664 MGen.Drop; MGen.Drop 665 ELSIF (SymTab.ClassOf(dt) 666 = SymTab.ClArray) 667 & (SymTab.ClassOf( 668 SymTab.ArrayElem(dt)) 669 = SymTab.ClChar) 670 & (SymTab.ClassOf(et) 671 = SymTab.ClStr) THEN 672 srcBytes := 673 MGen.StrLenOf(lxe) + 1; 674 dstBytes := 675 SymTab.TypeSlots(dt) * 8; 676 IF srcBytes > dstBytes THEN 677 SemError(210); 678 MGen.Drop; MGen.Drop 679 ELSE 680 MGen.PushBytes(srcBytes); 681 MGen.CopyBlock 682 END 683 ELSIF ~SymTab.Assignable(et, 684 dt) THEN 685 SemError(210); 686 MGen.Drop; MGen.Drop 687 ELSE 688 dstBytes := 689 SymTab.TypeSlots(dt) * 8; 690 MGen.PushBytes(dstBytes); 691 MGen.CopyBlock 692 END 693 ELSIF pushedFld THEN 694 IF et = SymTab.InvalidType THEN 695 MGen.Drop; MGen.Drop 696 ELSIF (SymTab.TypeSlots(dt) > 1) THEN 697 IF (SymTab.ClassOf(dt) 698 = SymTab.ClArray) 699 & (SymTab.ClassOf( 700 SymTab.ArrayElem(dt)) 701 = SymTab.ClChar) 702 & (SymTab.ClassOf(et) 703 = SymTab.ClStr) THEN 704 srcBytes := 705 MGen.StrLenOf(lxe) + 1; 706 dstBytes := 707 SymTab.TypeSlots(dt) * 8; 708 IF srcBytes > dstBytes THEN 709 SemError(210); 710 MGen.Drop; MGen.Drop 711 ELSE 712 MGen.PushBytes(srcBytes); 713 MGen.CopyBlock 714 END 715 ELSIF ~SymTab.Assignable(et, 716 dt) THEN 717 SemError(210); 718 MGen.Drop; MGen.Drop 719 ELSE 720 dstBytes := 721 SymTab.TypeSlots(dt) * 8; 722 MGen.PushBytes(dstBytes); 723 MGen.CopyBlock 724 END 725 ELSE 726 IF ~SymTab.Assignable(et, 727 dt) THEN 728 SemError(210); 729 MGen.Drop; MGen.Drop 730 ELSE 731 isR := 732 (SymTab.ClassOf(dt) 733 = SymTab.ClReal); 734 conv := isR 735 & SymTab.IsIntFamily(et); 736 IF conv THEN 737 MGen.IntToReal 738 END; 739 IF (SymTab.ClassOf(dt) 740 = SymTab.ClChar) 741 OR (SymTab.ClassOf(dt) 742 = SymTab.ClBool) THEN 743 MGen.StoreByte 744 ELSE MGen.StoreIndir0 745 END 746 END 747 END 748 ELSIF (dt # SymTab.InvalidType) 749 & ~sfx 750 & (SymTab.TypeSlots(dt) > 1) THEN 751 IF ~SymTab.Assignable(et, dt) THEN 752 SemError(210) 753 ELSE SemError(230) 754 END 755 ELSIF ~SymTab.Assignable(et, dt) THEN 756 SemError(210) END; 757 IF dk = SymTab.KindImport THEN 758 SemError(230) 759 END; 760 isR := (dt # SymTab.InvalidType) 761 & ~pushedDst 762 & ~pushedFld 763 & (SymTab.ClassOf(dt) 764 = SymTab.ClReal); 765 conv := isR 766 & SymTab.IsIntFamily(et); 767 IF pushedDst THEN 768 ELSIF pushedFld THEN 769 ELSIF (dt # SymTab.InvalidType) 770 & sfx THEN 771 IF conv THEN 772 MGen.IntToReal 773 END; 774 IF (SymTab.ClassOf(dt) 775 = SymTab.ClChar) 776 OR (SymTab.ClassOf(dt) 777 = SymTab.ClBool) THEN 778 MGen.StoreByte 779 ELSE MGen.StoreIndir0 780 END 781 ELSIF storable & ~sfx THEN 782 IF (dt # SymTab.InvalidType) 783 & (SymTab.TypeSlots(dt) 784 > 1) THEN 785 MGen.Drop 786 ELSE 787 IF conv THEN 788 MGen.IntToReal 789 END; 790 MGen.StoreFinish(bn) 791 END 792 ELSE MGen.Drop 793 END; .) 794 | CallTail 795 | (. IF (SymTab.SymKind(bn) 796 = SymTab.KindModule) 797 & sfx 798 & (SymTab.StrLen(lxD) > 0) THEN 799 modBare := SymTab.ExpProc(bn, 800 lxD); 801 IF modBare < 0 THEN 802 IF SymTab.ExpKind(bn, 803 lxD) # -1 THEN 804 SemError(233) 805 END 806 ELSIF SymTab.ProcNParByNum( 807 modBare) # 0 THEN 808 SemError(233) 809 ELSE 810 MGen.CallProc(modBare); 811 IF SymTab.ProcRetByNum( 812 modBare) 813 # SymTab.InvalidType THEN 814 MGen.Drop 815 END 816 END 817 ELSE 818 MGen.ActBegin(bn); 819 IF MGen.ActEnd(bn, FALSE, 820 FALSE) # 0 THEN 821 SemError(233) 822 END 823 END; .) ) . 824 CallTail 826 (. VAR t: SymTab.TypeIndex; 827 lx: MGen.LitStr; 828 v: BOOLEAN; 829 vn: SymTab.Name; 830 isModP: BOOLEAN; 831 modPNum: INTEGER; 832 modErr: BOOLEAN; .) 833 = "(" (. ok := FALSE; modErr := FALSE; 834 isModP := 835 (SymTab.SymKind(pn) 836 = SymTab.KindModule) 837 & sfx 838 & (SymTab.StrLen(exp) > 0); 839 IF hasDead THEN MGen.Drop END; 840 IF isModP THEN 841 modPNum := SymTab.ExpProc(pn, 842 exp); 843 IF modPNum < 0 THEN 844 IF SymTab.ExpKind(pn, 845 exp) # -1 THEN 846 SemError(233) 847 END; 848 modErr := TRUE 849 ELSIF inExpr 850 & (SymTab.ProcRetByNum( 851 modPNum) 852 = SymTab.InvalidType) 853 THEN 854 SemError(233); 855 modErr := TRUE 856 END; 857 MGen.ActBeginNum(modPNum) 858 ELSE 859 MGen.ActBegin(pn) 860 END; .) 861 [ Expr (. IF isModP THEN 862 IF ~modErr 863 & (MGen.ActValue(t, v, vn) 864 # 0) THEN 865 SemError(233); 866 modErr := TRUE 867 END 868 ELSIF MGen.ActValue(t, v, vn) # 0 THEN 869 SemError(233) 870 END; .) 871 { "," Expr (. IF isModP THEN 872 IF ~modErr 873 & (MGen.ActValue(t, v, vn) 874 # 0) THEN 875 SemError(233); 876 modErr := TRUE 877 END 878 ELSIF MGen.ActValue(t, v, vn) # 0 THEN 879 SemError(233) 880 END; .) } ] 881 ")" (. IF isModP THEN 882 IF ~modErr THEN 883 IF MGen.ActEndNum(modPNum, 884 inExpr) # 0 THEN 885 SemError(233) 886 ELSE ok := TRUE 887 END 888 END 889 ELSIF MGen.ActEnd(pn, sfx, 890 inExpr) # 0 891 THEN SemError(233) 892 ELSE ok := TRUE 893 END; .) . 894 IfStat (. VAR t: SymTab.TypeIndex; 895 lxC: MGen.LitStr; 896 vC: BOOLEAN; 897 vnC: SymTab.Name; 898 elseL, endL: INTEGER; 899 hasElse: BOOLEAN; .) 900 = "IF" 901 Expr (. IF ~SymTab.BoolCheck(t) THEN 902 SemError(214) END; 903 elseL := MGen.NewLabel(); 904 endL := MGen.NewLabel(); 905 MGen.Jz(elseL); 906 hasElse := FALSE; .) 907 "THEN" 908 StatSeq 909 { "ELSIF" (. MGen.Jmp(endL); 910 MGen.DefLabel(elseL); .) 911 Expr (. IF ~SymTab.BoolCheck(t) THEN 912 SemError(214) END; 913 elseL := MGen.NewLabel(); 914 MGen.Jz(elseL); .) 915 "THEN" 916 StatSeq } 917 [ "ELSE" (. MGen.Jmp(endL); 918 MGen.DefLabel(elseL); 919 hasElse := TRUE; .) 920 StatSeq ] 921 "END" (. IF ~hasElse THEN 922 MGen.DefLabel(elseL) 923 END; 924 MGen.DefLabel(endL); .) . 925 CaseStat (. VAR st: SymTab.TypeIndex; 926 lxS: MGen.LitStr; 927 vS: BOOLEAN; 928 vnS: SymTab.Name; 929 tmp, endL: INTEGER; .) 930 = "CASE" 931 Expr (. tmp := MGen.TempGlobal(); 932 MGen.StoreTemp(tmp); 933 endL := MGen.NewLabel(); .) 934 "OF" 935 Case { "|" 936 Case } 937 [ "ELSE" 938 StatSeq ] 939 "END" (. MGen.DefLabel(endL); .) . 940 Case 941 (. VAR lB, lN: INTEGER; .) 942 = [ LabelList ":" (. MGen.DefLabel(lB); .) 943 StatSeq (. MGen.Jmp(endL); 944 MGen.DefLabel(lN); .) ] . 945 LabelList 947 = (. lB := MGen.NewLabel(); 948 lN := MGen.NewLabel(); .) 949 Labels { "," 950 Labels } 951 (. MGen.Jmp(lN); .) . 952 Labels 953 (. VAR t, t2: SymTab.TypeIndex; 954 lx1, lx2: MGen.LitStr; 955 v1, v2: BOOLEAN; 956 vn1, vn2: SymTab.Name; 957 ta, tb, chunk: INTEGER; 958 r, hasRange: BOOLEAN; .) 959 = ConstExpr (. IF ~SymTab.EqCheck(t, sel) THEN 960 SemError(213) END; 961 r := (SymTab.ClassOf(sel) 962 = SymTab.ClReal) 963 & (SymTab.ClassOf(t) 964 = SymTab.ClReal); 965 ta := MGen.TempGlobal(); 966 MGen.StoreTemp(ta); 967 hasRange := FALSE; .) 968 [ ".." 969 ConstExpr (. IF ~SymTab.EqCheck(t2, sel) THEN 970 SemError(213) END; 971 tb := MGen.TempGlobal(); 972 MGen.StoreTemp(tb); 973 hasRange := TRUE; .) ] 974 (. IF hasRange THEN 975 MGen.LoadTemp(tmp); 976 MGen.LoadTemp(ta); 977 IF r THEN MGen.RealGe 978 ELSE MGen.IGe END; 979 MGen.LoadTemp(tmp); 980 MGen.LoadTemp(tb); 981 IF r THEN MGen.RealLe 982 ELSE MGen.ILe END; 983 MGen.And 984 ELSE 985 MGen.LoadTemp(tmp); 986 MGen.LoadTemp(ta); 987 IF r THEN MGen.RealEq 988 ELSE MGen.Eq END 989 END; 990 chunk := MGen.NewLabel(); 991 MGen.Jz(chunk); 992 MGen.Jmp(bodyL); 993 MGen.DefLabel(chunk); .) . 994 WhileStat (. VAR t: SymTab.TypeIndex; 995 lxC: MGen.LitStr; 996 vC: BOOLEAN; 997 vnC: SymTab.Name; 998 topL, endL: INTEGER; .) 999 = "WHILE" (. topL := MGen.NewLabel(); 1000 endL := MGen.NewLabel(); 1001 MGen.DefLabel(topL); .) 1002 Expr (. IF ~SymTab.BoolCheck(t) THEN 1003 SemError(214) END; 1004 MGen.Jz(endL); .) 1005 "DO" 1006 StatSeq 1007 "END" (. MGen.Jmp(topL); 1008 MGen.DefLabel(endL); .) . 1009 RepeatStat (. VAR t: SymTab.TypeIndex; 1010 lxC: MGen.LitStr; 1011 vC: BOOLEAN; 1012 vnC: SymTab.Name; 1013 topL: INTEGER; .) 1014 = "REPEAT" (. topL := MGen.NewLabel(); 1015 MGen.DefLabel(topL); .) 1016 StatSeq 1017 "UNTIL" 1018 Expr (. IF ~SymTab.BoolCheck(t) THEN 1019 SemError(214) END; 1020 MGen.Jz(topL); .) . 1021 LoopStat (. VAR topL, exitL: INTEGER; .) 1022 = "LOOP" (. topL := MGen.NewLabel(); 1023 exitL := MGen.NewLabel(); 1024 MGen.DefLabel(topL); 1025 MGen.PushLoop(exitL); .) 1026 StatSeq 1027 "END" (. MGen.Jmp(topL); 1028 MGen.DefLabel(exitL); 1029 MGen.PopLoop; .) . 1030 ForStat (. VAR n, lv: SymTab.Name; 1031 fk: INTEGER; 1032 lo, hi: SymTab.TypeIndex; 1033 lxLo, lxHi: MGen.LitStr; 1034 vLo, vHi: BOOLEAN; 1035 vnLo, vnHi: SymTab.Name; 1036 byV, ht: INTEGER; 1037 lTop, lChk, lEnd: INTEGER; 1038 neg, storable: BOOLEAN; .) 1039 = "FOR" 1040 GetIdent (. IF ~SymTab.Lookup(n) THEN 1041 SemError(201); 1042 fk := -1 1043 ELSIF (SymTab.SymKind(n) # 1044 SymTab.KindVar) 1045 & (SymTab.SymKind(n) # 1046 SymTab.KindParam) 1047 & (SymTab.SymKind(n) # 1048 SymTab.KindVarPar) 1049 & (SymTab.SymKind(n) # 1050 SymTab.KindField) THEN 1051 SemError(220); 1052 fk := -1 1053 ELSIF (SymTab.SymType(n) # 1054 SymTab.InvalidType) 1055 & ~SymTab.IsIntFamily( 1056 SymTab.SymType(n)) THEN 1057 SemError(220); 1058 fk := -1 1059 ELSE 1060 fk := SymTab.SymKind(n) 1061 END; 1062 MGen.CopyName(n, lv); 1063 storable := (fk = SymTab.KindVar) 1064 OR (fk = SymTab.KindParam) 1065 OR (fk = SymTab.KindVarPar); 1066 IF storable THEN 1067 MGen.StoreSetup(lv) 1068 END; .) 1069 ":=" 1070 Expr (. IF (lo # SymTab.InvalidType) 1071 & ~SymTab.IsIntFamily(lo) THEN 1072 SemError(220) END; 1073 IF storable THEN 1074 MGen.StoreFinish(lv) 1075 ELSE MGen.Drop 1076 END; .) 1077 "TO" 1078 Expr (. IF (hi # SymTab.InvalidType) 1079 & ~SymTab.IsIntFamily(hi) THEN 1080 SemError(220) END; 1081 ht := MGen.TempGlobal(); 1082 MGen.StoreTemp(ht); 1083 byV := 1; neg := FALSE; .) 1084 [ "BY" 1085 ByLit (. neg := byV < 0; .) ] 1086 "DO" (. lTop := MGen.NewLabel(); 1087 lChk := MGen.NewLabel(); 1088 lEnd := MGen.NewLabel(); 1089 MGen.Jmp(lChk); 1090 MGen.DefLabel(lTop); .) 1091 StatSeq 1092 "END" (. MGen.PushVar(lv); 1093 MGen.PushInt(byV); 1094 MGen.Add; 1095 IF storable THEN 1096 MGen.StoreFinish(lv) 1097 ELSE MGen.Drop 1098 END; 1099 MGen.DefLabel(lChk); 1100 MGen.PushVar(lv); 1101 MGen.LoadTemp(ht); 1102 IF neg THEN MGen.IGe 1103 ELSE MGen.ILe END; 1104 MGen.Jz(lEnd); 1105 MGen.Jmp(lTop); 1106 MGen.DefLabel(lEnd); .) . 1107 ByLit (. VAR s: ARRAY [0 .. 255] OF CHAR; .) 1108 = integer (. LexString(s); 1109 IF ~MGen.ParseInt(s, v) THEN 1110 v := 1 1111 END; .) 1112 | "-" integer (. LexString(s); 1113 IF MGen.ParseInt(s, v) THEN 1114 v := -v 1115 ELSE v := -1 1116 END; .) . 1117 WithStat (. VAR dt: SymTab.TypeIndex; 1118 dk: INTEGER; 1119 bnW: SymTab.Name; 1120 lxW: MGen.LitStr; 1121 sfxW: BOOLEAN; 1122 pushed: BOOLEAN; .) 1123 = "WITH" 1124 DesignHead 1125 DesignTail 1126 (. pushed := FALSE; 1127 IF dt = SymTab.InvalidType THEN 1128 IF sfxW THEN MGen.Drop END 1129 ELSIF SymTab.ClassOf(dt) 1130 # SymTab.ClRecord THEN 1131 SemError(215); 1132 IF sfxW THEN MGen.Drop END 1133 ELSE 1134 IF ~sfxW THEN 1135 IF (dk 1136 = SymTab.KindVar) 1137 OR (dk 1138 = SymTab.KindParam) 1139 OR (dk 1140 = SymTab.KindVarPar) THEN 1141 MGen.PushAddr(bnW) 1142 ELSIF dk 1143 = SymTab.KindField THEN 1144 MGen.WithAddr(bnW) 1145 ELSE MGen.PushInt(0) 1146 END 1147 END; 1148 MGen.WithEnter(dt); 1149 pushed := 1150 SymTab.PushRecord(dt); 1151 IF ~pushed THEN 1152 SemError(215) 1153 END 1154 END; .) 1155 "DO" 1156 StatSeq 1157 "END" (. IF pushed THEN 1158 SymTab.PopScope; 1159 MGen.WithExit 1160 END; .) . 1161 ReturnStat (. VAR t: SymTab.TypeIndex; 1162 lx: MGen.LitStr; 1163 v: BOOLEAN; 1164 vn: SymTab.Name; 1165 hasE, doRet, conv: BOOLEAN; .) 1166 = "RETURN" (. hasE := FALSE; .) 1167 [ Expr (. hasE := TRUE; 1168 doRet := FALSE; 1169 IF ~SymTab.InProc() THEN 1170 SemError(232) 1171 ELSIF ~SymTab.InFunction() THEN 1172 SemError(232) 1173 ELSIF ~SymTab.Assignable( 1174 t, SymTab.CurRet()) THEN 1175 SemError(232) 1176 ELSE doRet := TRUE 1177 END; 1178 conv := doRet 1179 & SymTab.IsIntFamily(t) 1180 & (SymTab.ClassOf( 1181 SymTab.CurRet()) 1182 = SymTab.ClReal); 1183 IF doRet THEN 1184 IF conv THEN 1185 MGen.IntToReal 1186 END; 1187 MGen.Leave( 1188 SymTab.CurNPar(), TRUE) 1189 ELSE MGen.Drop 1190 END; .) ] 1191 (. IF ~hasE THEN 1192 IF ~SymTab.InProc() THEN 1193 SemError(232) 1194 ELSIF SymTab.InFunction() THEN 1195 SemError(232) 1196 ELSE MGen.Leave( 1197 SymTab.CurNPar(), FALSE) 1198 END 1199 END; .) . 1200 NewStat (. VAR dt: SymTab.TypeIndex; 1201 dk: INTEGER; 1202 bnN: SymTab.Name; 1203 lxN: MGen.LitStr; 1204 sfxN: BOOLEAN; 1205 baseT: SymTab.TypeIndex; 1206 slN: CARDINAL; .) 1207 = "NEW" 1208 "(" DesignHead 1209 DesignTail 1210 ")" (. IF dt = SymTab.InvalidType THEN 1211 IF sfxN THEN MGen.Drop END 1212 ELSIF SymTab.ClassOf(dt) 1213 # SymTab.ClPtr THEN 1214 SemError(219); 1215 IF sfxN THEN MGen.Drop END 1216 ELSE 1217 baseT := SymTab.PtrBase(dt); 1218 slN := SymTab.TypeSlots(baseT); 1219 IF slN = 0 THEN 1220 SemError(230); 1221 slN := 1 1222 END; 1223 IF ~sfxN THEN 1224 IF (dk = SymTab.KindVar) 1225 OR (dk 1226 = SymTab.KindParam) 1227 OR (dk 1228 = SymTab.KindVarPar) THEN 1229 MGen.PushAddr(bnN) 1230 ELSIF dk 1231 = SymTab.KindField THEN 1232 MGen.WithAddr(bnN) 1233 ELSE MGen.PushInt(0) 1234 END 1235 END; 1236 MGen.PushBytes(slN * 8); 1237 MGen.AllocOp 1238 END; .) . 1239 DispStat (. VAR dt: SymTab.TypeIndex; 1240 dk: INTEGER; 1241 bnD: SymTab.Name; 1242 lxD: MGen.LitStr; 1243 sfxD: BOOLEAN; 1244 baseT: SymTab.TypeIndex; 1245 slD: CARDINAL; .) 1246 = "DISPOSE" 1247 "(" DesignHead 1248 DesignTail 1249 ")" (. IF dt = SymTab.InvalidType THEN 1250 IF sfxD THEN MGen.Drop END 1251 ELSIF SymTab.ClassOf(dt) 1252 # SymTab.ClPtr THEN 1253 SemError(219); 1254 IF sfxD THEN MGen.Drop END 1255 ELSE 1256 baseT := SymTab.PtrBase(dt); 1257 slD := SymTab.TypeSlots(baseT); 1258 IF slD = 0 THEN 1259 SemError(230); 1260 slD := 1 1261 END; 1262 IF ~sfxD THEN 1263 IF (dk = SymTab.KindVar) 1264 OR (dk 1265 = SymTab.KindParam) 1266 OR (dk 1267 = SymTab.KindVarPar) THEN 1268 MGen.PushAddr(bnD) 1269 ELSIF dk 1270 = SymTab.KindField THEN 1271 MGen.WithAddr(bnD) 1272 ELSE MGen.PushInt(0) 1273 END 1274 END; 1275 MGen.PushBytes(slD * 8); 1276 MGen.DeallocOp 1277 END; .) . 1278 WriteIntStat (. VAR t: SymTab.TypeIndex; 1279 lx: MGen.LitStr; 1280 v: BOOLEAN; 1281 vn: SymTab.Name; .) 1282 = "WriteInt" 1283 "(" Expr ")" (. IF t = SymTab.InvalidType THEN 1284 MGen.Drop 1285 ELSIF ~SymTab.IsIntFamily(t) THEN 1286 SemError(210); 1287 MGen.Drop 1288 ELSE 1289 MGen.CallPrint 1290 END; .) . 1291 WriteStrStat (. VAR t: SymTab.TypeIndex; 1292 lx: MGen.LitStr; 1293 v: BOOLEAN; 1294 vn: SymTab.Name; .) 1295 = "WriteString" 1296 "(" Expr ")" (. IF t = SymTab.InvalidType THEN 1297 MGen.Drop 1298 ELSIF (SymTab.ClassOf(t) 1299 = SymTab.ClStr) THEN 1300 MGen.PushInt(1); 1301 MGen.SysCall 1302 ELSIF (SymTab.ClassOf(t) 1303 = SymTab.ClArray) 1304 & (SymTab.ClassOf( 1305 SymTab.ArrayElem(t)) 1306 = SymTab.ClChar) THEN 1307 MGen.PushInt(1); 1308 MGen.SysCall 1309 ELSE 1310 SemError(210); 1311 MGen.Drop 1312 END; .) . 1313 1314 (* Expressions: Designator without ActualParameters (calls use 1315 CallTail). Each expression synthesizes its SymTab type in t, 1316 the source text in lx for single literals ("" otherwise), and 1317 whether it is a plain variable (v/vn) for VAR actuals. 1318 Values travel on the MC64 stack. *) 1319 DesignHead 1321 (. VAR n: SymTab.Name; 1322 cls: INTEGER; .) 1323 = GetIdent (. MGen.CopyName(n, bn); 1324 lx[0] := 0C; 1325 IF ~SymTab.Lookup(n) THEN 1326 SemError(201); 1327 t := SymTab.InvalidType; k := -1; 1328 IF doLoad THEN 1329 MGen.PushInt(0) 1330 END 1331 ELSE 1332 t := SymTab.SymType(n); 1333 k := SymTab.SymKind(n); 1334 IF k = SymTab.KindConst THEN 1335 IF SymTab.Equal(n, "TRUE") THEN 1336 t := SymTab.BoolType(); 1337 MGen.CopyName("TRUE", lx); 1338 IF doLoad THEN 1339 MGen.PushInt(1) 1340 END 1341 ELSIF SymTab.Equal(n, 1342 "FALSE") THEN 1343 t := SymTab.BoolType(); 1344 MGen.CopyName("FALSE", lx); 1345 IF doLoad THEN 1346 MGen.PushInt(0) 1347 END 1348 ELSE 1349 cls := 1350 SymTab.ClassOf(t); 1351 IF (t # 1352 SymTab.InvalidType) 1353 & (cls # SymTab.ClStr) 1354 & ((cls = SymTab.ClInt) 1355 OR (cls = SymTab.ClReal) 1356 OR (cls = SymTab.ClBool) 1357 OR (cls = SymTab.ClChar) 1358 OR (cls 1359 = SymTab.ClEnum)) THEN 1360 IF doLoad THEN 1361 MGen.LoadVar(n) 1362 END 1363 ELSIF doLoad THEN 1364 MGen.PushInt(0) 1365 END 1366 END 1367 ELSIF (k = SymTab.KindVar) 1368 OR (k = SymTab.KindParam) 1369 OR (k 1370 = SymTab.KindVarPar) THEN 1371 cls := SymTab.ClassOf(t); 1372 IF (cls = SymTab.ClInt) 1373 OR (cls = SymTab.ClReal) 1374 OR (cls = SymTab.ClBool) 1375 OR (cls = SymTab.ClChar) 1376 OR (cls 1377 = SymTab.ClEnum) 1378 OR (cls 1379 = SymTab.ClSet) 1380 OR (cls 1381 = SymTab.ClPtr) THEN 1382 IF doLoad THEN 1383 MGen.PushVar(n) 1384 END 1385 ELSIF (cls 1386 = SymTab.ClArray) 1387 OR (cls 1388 = SymTab.ClRecord) THEN 1389 IF doLoad THEN 1390 MGen.PushAddr(n) 1391 END 1392 ELSIF t 1393 = SymTab.InvalidType THEN 1394 IF doLoad THEN 1395 MGen.PushInt(0) 1396 END 1397 ELSE SemError(230); 1398 IF doLoad THEN 1399 MGen.PushInt(0) 1400 END 1401 END 1402 ELSE 1403 IF doLoad THEN 1404 IF k = SymTab.KindField THEN 1405 MGen.WithAddr(n); 1406 cls := SymTab.ClassOf(t); 1407 IF (t 1408 = SymTab.InvalidType) 1409 OR (cls 1410 = SymTab.ClArray) 1411 OR (cls 1412 = SymTab.ClRecord) THEN 1413 ELSE 1414 IF (cls 1415 = SymTab.ClChar) 1416 OR (cls 1417 = SymTab.ClBool) THEN 1418 MGen.LoadByte 1419 ELSE MGen.LoadIndir 1420 END 1421 END 1422 ELSE MGen.PushInt(0) 1423 END 1424 END; 1425 IF k = SymTab.KindField THEN 1426 ELSIF k 1427 = SymTab.KindImport THEN 1428 SemError(230) 1429 END 1430 END 1431 END; .) . 1432 DesignTail 1435 (. VAR m: SymTab.Name; 1436 it: SymTab.TypeIndex; 1437 lxI: MGen.LitStr; 1438 vI: BOOLEAN; 1439 vnI: SymTab.Name; 1440 loA: INTEGER; 1441 elemT: SymTab.TypeIndex; 1442 esl, ebytes: CARDINAL; 1443 firstT: BOOLEAN; 1444 clsI: INTEGER; 1445 qM: SymTab.Name; .) 1446 = (. sfx := FALSE; .) 1447 { "." (. firstT := ~sfx; 1448 sfx := TRUE; lx[0] := 0C; 1449 IF ~doLoad & firstT THEN 1450 IF (k = SymTab.KindVar) 1451 OR (k = SymTab.KindParam) 1452 OR (k 1453 = SymTab.KindVarPar) THEN 1454 MGen.PushAddr(bn) 1455 ELSIF k 1456 = SymTab.KindField THEN 1457 MGen.WithAddr(bn) 1458 ELSIF k 1459 = SymTab.KindModule THEN 1460 ELSE MGen.PushInt(0) 1461 END 1462 END; .) 1463 GetIdent (. IF (k = SymTab.KindModule) THEN 1464 IF SymTab.ExpKind(bn, m) = -1 THEN 1465 SemError(201); 1466 MGen.CopyName(m, lx); 1467 t := SymTab.InvalidType; 1468 IF doLoad THEN 1469 MGen.Drop; MGen.PushInt(0) 1470 ELSIF firstT THEN 1471 ELSE MGen.Drop 1472 END 1473 ELSIF SymTab.ExpKind(bn, m) 1474 = SymTab.KindProc THEN 1475 MGen.CopyName(m, lx); 1476 t := SymTab.InvalidType; 1477 IF doLoad THEN 1478 MGen.Drop; MGen.PushInt(0) 1479 ELSIF firstT THEN 1480 ELSE MGen.Drop 1481 END 1482 ELSE 1483 t := SymTab.ExpType(bn, m); 1484 k := SymTab.ExpKind(bn, m); 1485 SymTab.ExpQual(bn, m, qM); 1486 IF doLoad THEN 1487 MGen.Drop; 1488 MGen.GlobalAddr(qM) 1489 ELSE 1490 IF firstT THEN 1491 ELSE MGen.Drop 1492 END; 1493 MGen.GlobalAddr(qM) 1494 END 1495 END 1496 ELSIF t = SymTab.InvalidType THEN 1497 IF ~doLoad & firstT THEN 1498 MGen.Drop 1499 ELSIF doLoad THEN 1500 MGen.Drop; MGen.PushInt(0) 1501 END 1502 ELSIF SymTab.ClassOf(t) # 1503 SymTab.ClRecord THEN 1504 SemError(215); 1505 t := SymTab.InvalidType; 1506 IF doLoad THEN 1507 MGen.Drop; MGen.PushInt(0) 1508 ELSIF firstT THEN 1509 MGen.Drop 1510 END 1511 ELSIF ~SymTab.FieldExists(t, m) THEN 1512 SemError(216); 1513 t := SymTab.InvalidType; 1514 IF doLoad THEN 1515 MGen.Drop; MGen.PushInt(0) 1516 ELSIF firstT THEN 1517 MGen.Drop 1518 END 1519 ELSE 1520 loA := SymTab.FieldOffset(t, m); 1521 elemT := SymTab.FieldType(t, m); 1522 IF loA < 0 THEN 1523 SemError(216); 1524 t := SymTab.InvalidType; 1525 IF doLoad THEN 1526 MGen.Drop; MGen.PushInt(0) 1527 ELSIF firstT THEN 1528 MGen.Drop 1529 END 1530 ELSE 1531 MGen.FieldAdd( 1532 VAL(CARDINAL, loA)); 1533 t := elemT 1534 END 1535 END; .) 1536 | "[" (. firstT := ~sfx; 1537 sfx := TRUE; lx[0] := 0C; 1538 IF ~doLoad & firstT THEN 1539 IF (k = SymTab.KindVar) 1540 OR (k = SymTab.KindParam) 1541 OR (k 1542 = SymTab.KindVarPar) THEN 1543 MGen.PushAddr(bn) 1544 ELSIF k 1545 = SymTab.KindField THEN 1546 MGen.WithAddr(bn) 1547 ELSE MGen.PushInt(0) 1548 END 1549 END; .) 1550 Expr (. IF t = SymTab.InvalidType THEN 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 ELSIF SymTab.ClassOf(t) # 1560 SymTab.ClArray THEN 1561 SemError(217); 1562 t := SymTab.InvalidType; 1563 MGen.Drop; 1564 IF doLoad THEN 1565 MGen.Drop; MGen.PushInt(0) 1566 ELSE 1567 IF ~firstT THEN 1568 ELSE MGen.Drop 1569 END 1570 END 1571 ELSE 1572 clsI := SymTab.ClassOf(it); 1573 IF (it 1574 # SymTab.InvalidType) 1575 & (clsI # SymTab.ClInt) 1576 & (clsI # SymTab.ClChar) 1577 & (clsI # SymTab.ClEnum) 1578 & (clsI 1579 # SymTab.ClBool) THEN 1580 SemError(218); 1581 t := SymTab.InvalidType; 1582 MGen.Drop; 1583 IF doLoad THEN 1584 MGen.Drop; MGen.PushInt(0) 1585 ELSE 1586 IF ~firstT THEN 1587 ELSE MGen.Drop 1588 END 1589 END 1590 ELSE 1591 loA := SymTab.ArrayLo(t); 1592 elemT := SymTab.ArrayElem(t); 1593 esl := SymTab.TypeSlots(elemT); 1594 IF esl = 0 THEN 1595 SemError(230); 1596 esl := 1 1597 END; 1598 IF (SymTab.ClassOf(elemT) 1599 = SymTab.ClChar) 1600 OR (SymTab.ClassOf(elemT) 1601 = SymTab.ClBool) THEN 1602 ebytes := 1 1603 ELSE ebytes := esl * 8 1604 END; 1605 MGen.IdxScale(loA, ebytes); 1606 t := elemT 1607 END 1608 END; .) 1609 { "," 1610 Expr (. IF t = SymTab.InvalidType THEN 1611 MGen.Drop; 1612 IF doLoad THEN 1613 MGen.Drop; MGen.PushInt(0); 1614 t := SymTab.InvalidType 1615 END 1616 ELSIF SymTab.ClassOf(t) # 1617 SymTab.ClArray THEN 1618 SemError(217); 1619 t := SymTab.InvalidType; 1620 MGen.Drop; 1621 IF doLoad THEN 1622 MGen.Drop; MGen.PushInt(0) 1623 END 1624 ELSE 1625 clsI := SymTab.ClassOf(it); 1626 IF (it 1627 # SymTab.InvalidType) 1628 & (clsI # SymTab.ClInt) 1629 & (clsI # SymTab.ClChar) 1630 & (clsI # SymTab.ClEnum) 1631 & (clsI 1632 # SymTab.ClBool) THEN 1633 SemError(218); 1634 t := SymTab.InvalidType; 1635 MGen.Drop; 1636 IF doLoad THEN 1637 MGen.Drop; MGen.PushInt(0) 1638 END 1639 ELSE 1640 loA := SymTab.ArrayLo(t); 1641 elemT := SymTab.ArrayElem(t); 1642 esl := SymTab.TypeSlots(elemT); 1643 IF esl = 0 THEN 1644 SemError(230); 1645 esl := 1 1646 END; 1647 IF (SymTab.ClassOf(elemT) 1648 = SymTab.ClChar) 1649 OR (SymTab.ClassOf(elemT) 1650 = SymTab.ClBool) THEN 1651 ebytes := 1 1652 ELSE ebytes := esl * 8 1653 END; 1654 MGen.IdxScale(loA, ebytes); 1655 t := elemT 1656 END 1657 END; .) } 1658 "]" 1659 | "^" (. firstT := ~sfx; 1660 sfx := TRUE; lx[0] := 0C; 1661 IF ~doLoad & firstT THEN 1662 IF (k = SymTab.KindVar) 1663 OR (k = SymTab.KindParam) 1664 OR (k 1665 = SymTab.KindVarPar) THEN 1666 MGen.PushAddr(bn) 1667 ELSIF k 1668 = SymTab.KindField THEN 1669 MGen.WithAddr(bn) 1670 ELSE MGen.PushInt(0) 1671 END 1672 END; .) 1673 (. IF t = SymTab.InvalidType THEN 1674 IF doLoad THEN 1675 MGen.Drop; MGen.PushInt(0) 1676 ELSIF firstT THEN 1677 MGen.Drop 1678 END 1679 ELSIF SymTab.ClassOf(t) # 1680 SymTab.ClPtr THEN 1681 SemError(219); 1682 t := SymTab.InvalidType; 1683 IF doLoad THEN 1684 MGen.Drop; MGen.PushInt(0) 1685 ELSIF firstT THEN 1686 MGen.Drop 1687 END 1688 ELSE 1689 elemT := SymTab.PtrBase(t); 1690 t := elemT; 1691 IF doLoad THEN 1692 IF ~(firstT 1693 & ((k 1694 = SymTab.KindVar) 1695 OR (k 1696 = SymTab.KindParam) 1697 OR (k 1698 = SymTab.KindVarPar))) 1699 THEN 1700 MGen.LoadIndir 1701 END 1702 ELSE 1703 MGen.LoadIndir 1704 END 1705 END; .) } . 1706 Expr 1708 (. VAR t2: SymTab.TypeIndex; 1709 tc, op: INTEGER; 1710 lx2: MGen.LitStr; 1711 v2: BOOLEAN; 1712 vn2: SymTab.Name; 1713 r: BOOLEAN; .) 1714 = SimExpr [ Rel SimExpr 1715 (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 1716 IF op = SymTab.OpIn THEN 1717 IF SymTab.InCheck(t, t2) THEN 1718 t := SymTab.BoolType(); 1719 MGen.BitIn 1720 ELSE SemError(222); 1721 t := SymTab.InvalidType; 1722 MGen.Drop; MGen.Drop; MGen.PushInt(0) 1723 END 1724 ELSIF (t # SymTab.InvalidType) 1725 & (t2 # SymTab.InvalidType) 1726 & (SymTab.ClassOf(t) = SymTab.ClArray) 1727 & (SymTab.ClassOf(t2) = SymTab.ClArray) 1728 & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar) 1729 & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar) 1730 & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN 1731 t := SymTab.BoolType(); 1732 MGen.PushBytes(SymTab.TypeSlots(t) * 8); 1733 MGen.PushBytes(SymTab.TypeSlots(t2) * 8); 1734 MGen.StrComp; 1735 IF op = SymTab.OpEq THEN MGen.Or; MGen.Not 1736 ELSIF (op = SymTab.OpNeq1) 1737 OR (op = SymTab.OpNeq2) THEN MGen.Or 1738 ELSIF op = SymTab.OpLt THEN 1739 MGen.Swap; MGen.Drop 1740 ELSIF op = SymTab.OpLe THEN 1741 MGen.Drop; MGen.Not 1742 ELSIF op = SymTab.OpGt THEN 1743 MGen.Drop 1744 ELSE 1745 MGen.Swap; MGen.Drop; MGen.Not 1746 END 1747 ELSIF (t # SymTab.InvalidType) 1748 & (t2 # SymTab.InvalidType) 1749 & ((SymTab.ClassOf(t) = SymTab.ClArray) 1750 OR (SymTab.ClassOf(t) = SymTab.ClRecord) 1751 OR (SymTab.ClassOf(t2) = SymTab.ClArray) 1752 OR (SymTab.ClassOf(t2) = SymTab.ClRecord)) THEN 1753 SemError(213); t := SymTab.InvalidType; 1754 MGen.Drop; MGen.Drop; MGen.PushInt(0) 1755 ELSE 1756 tc := SymTab.ClassOf(t); 1757 IF SymTab.RelCheck(t, t2, op) THEN 1758 t := SymTab.BoolType() 1759 ELSE SemError(213); t := SymTab.InvalidType END; 1760 IF t # SymTab.InvalidType THEN 1761 r := tc = SymTab.ClReal; 1762 IF r THEN 1763 IF op = SymTab.OpEq THEN MGen.RealEq 1764 ELSIF (op = SymTab.OpNeq1) 1765 OR (op = SymTab.OpNeq2) THEN MGen.RealNe 1766 ELSIF op = SymTab.OpLt THEN MGen.RealLt 1767 ELSIF op = SymTab.OpLe THEN MGen.RealLe 1768 ELSIF op = SymTab.OpGt THEN MGen.RealGt 1769 ELSE MGen.RealGe END 1770 ELSE 1771 IF op = SymTab.OpEq THEN MGen.Eq 1772 ELSIF (op = SymTab.OpNeq1) 1773 OR (op = SymTab.OpNeq2) THEN MGen.Neq 1774 ELSIF op = SymTab.OpLt THEN MGen.ILt 1775 ELSIF op = SymTab.OpLe THEN MGen.ILe 1776 ELSIF op = SymTab.OpGt THEN MGen.IGt 1777 ELSE MGen.IGe END 1778 END 1779 ELSE MGen.Drop; MGen.Drop; MGen.PushInt(0) 1780 END 1781 END; .) ] . 1782 Rel 1783 = "=" (. op := SymTab.OpEq; .) 1784 | "#" (. op := SymTab.OpNeq1; .) 1785 | "<>" (. op := SymTab.OpNeq2; .) 1786 | "<" (. op := SymTab.OpLt; .) 1787 | "<=" (. op := SymTab.OpLe; .) 1788 | ">" (. op := SymTab.OpGt; .) 1789 | ">=" (. op := SymTab.OpGe; .) 1790 | "IN" (. op := SymTab.OpIn; .) . 1791 SimExpr 1793 (. VAR t2, res2: SymTab.TypeIndex; 1794 op: INTEGER; 1795 lx2: MGen.LitStr; 1796 v2: BOOLEAN; 1797 vn2: SymTab.Name; 1798 neg, isR: BOOLEAN; .) 1799 = (. neg := FALSE; .) 1800 [ "+" | "-" (. neg := TRUE; .) ] 1801 Term (. IF neg THEN 1802 v := FALSE; 1803 MGen.ClrStash(); 1804 IF MGen.IsLit(lx) THEN 1805 MGen.NegFold(lx, lx) 1806 ELSE lx[0] := 0C 1807 END; 1808 IF SymTab.ClassOf(t) 1809 = SymTab.ClReal THEN 1810 MGen.NegReal 1811 ELSE MGen.NegInt 1812 END 1813 END; .) 1814 { AddOp Term 1815 (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 1816 IF op = SymTab.OpOr THEN 1817 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN 1818 t := SymTab.BoolType() 1819 ELSE SemError(212); t := SymTab.InvalidType END; 1820 MGen.Or 1821 ELSIF (t # SymTab.InvalidType) 1822 & (t2 # SymTab.InvalidType) 1823 & (SymTab.ClassOf(t) = SymTab.ClSet) 1824 & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN 1825 IF op = SymTab.OpAdd THEN 1826 MGen.Or 1827 ELSE 1828 MGen.PushBits(0FFFFFFFFFFFFFFFFH); 1829 MGen.BitXor; 1830 MGen.And 1831 END 1832 ELSE 1833 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2 1834 ELSE SemError(211); t := SymTab.InvalidType END; 1835 isR := (t # SymTab.InvalidType) 1836 & (SymTab.ClassOf(t) = SymTab.ClReal); 1837 IF op = SymTab.OpAdd THEN 1838 IF isR THEN MGen.RealAdd ELSE MGen.Add END 1839 ELSE 1840 IF isR THEN MGen.RealSub ELSE MGen.Sub END 1841 END 1842 END; .) } . 1843 AddOp 1844 = "+" (. op := SymTab.OpAdd; .) 1845 | "-" (. op := SymTab.OpSub; .) 1846 | "OR" (. op := SymTab.OpOr; .) . 1847 Term 1849 (. VAR t2, res2: SymTab.TypeIndex; 1850 op: INTEGER; 1851 lx2: MGen.LitStr; 1852 v2: BOOLEAN; 1853 vn2: SymTab.Name; 1854 isR: BOOLEAN; 1855 mt: INTEGER; .) 1856 = Fact { MulOp Fact 1857 (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 1858 IF op = SymTab.OpAnd THEN 1859 IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN 1860 t := SymTab.BoolType() 1861 ELSE SemError(212); t := SymTab.InvalidType END; 1862 MGen.And 1863 ELSIF (op = SymTab.OpTimes) 1864 & (t # SymTab.InvalidType) 1865 & (t2 # SymTab.InvalidType) 1866 & (SymTab.ClassOf(t) = SymTab.ClSet) 1867 & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN 1868 MGen.And 1869 ELSE 1870 IF SymTab.ArithCheck(t, t2, 1871 (op = SymTab.OpDiv) OR (op = SymTab.OpMod), 1872 res2) THEN t := res2 1873 ELSE SemError(211); t := SymTab.InvalidType END; 1874 isR := (t # SymTab.InvalidType) 1875 & (SymTab.ClassOf(t) = SymTab.ClReal); 1876 IF op = SymTab.OpTimes THEN 1877 IF isR THEN MGen.RealMul ELSE MGen.MulU END 1878 ELSIF op = SymTab.OpSlash THEN 1879 IF isR THEN MGen.RealDiv ELSE MGen.DivI END 1880 ELSIF op = SymTab.OpDiv THEN 1881 MGen.DivI 1882 ELSE 1883 mt := MGen.TempGlobal(); 1884 MGen.ModI(mt) 1885 END 1886 END; .) } . 1887 MulOp 1888 = "*" (. op := SymTab.OpTimes; .) 1889 | "/" (. op := SymTab.OpSlash; .) 1890 | "DIV" (. op := SymTab.OpDiv; .) 1891 | "MOD" (. op := SymTab.OpMod; .) 1892 | "AND" (. op := SymTab.OpAnd; .) 1893 | "&" (. op := SymTab.OpAnd; .) . 1894 Fact 1896 (. VAR s: ARRAY [0 .. 255] OF CHAR; 1897 t2, et, dt, st: SymTab.TypeIndex; 1898 dk: INTEGER; 1899 bnF: SymTab.Name; 1900 lxD, lx2: MGen.LitStr; 1901 v2: BOOLEAN; 1902 vn2: SymTab.Name; 1903 vi: INTEGER; 1904 c: CARDINAL; 1905 b: LONGCARD; 1906 sfxF: BOOLEAN; 1907 okF: BOOLEAN; .) 1908 = integer (. LexString(s); 1909 MGen.CopyName(s, lx); 1910 v := FALSE; MGen.ClrStash(); 1911 IF MGen.ParseInt(s, vi) THEN 1912 MGen.PushInt(vi) 1913 ELSIF MGen.ParseCard(s, c) THEN 1914 MGen.PushBits( 1915 VAL(LONGCARD, c)) 1916 ELSE MGen.PushInt(0) 1917 END; 1918 t := SymTab.IntType(); .) 1919 | real (. LexString(s); 1920 MGen.CopyName(s, lx); 1921 v := FALSE; MGen.ClrStash(); 1922 IF MGen.ParseReal(s, b) THEN 1923 MGen.PushBits(b) 1924 ELSE MGen.PushBits(0H) 1925 END; 1926 t := SymTab.RealType(); .) 1927 | string (. LexString(s); 1928 v := FALSE; MGen.ClrStash(); 1929 IF SymTab.StrLen(s) <= 3 THEN 1930 t := SymTab.CharType(); 1931 MGen.CopyName(s, lx); 1932 MGen.PushInt( 1933 MGen.CharOrd(s)) 1934 ELSE t := SymTab.NewStr(); 1935 MGen.CopyName(s, lx); 1936 MGen.EmitString(s) 1937 END; .) 1938 | "HIGH" 1939 "(" DesignHead 1940 DesignTail 1941 ")" (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 1942 IF dt = SymTab.InvalidType THEN 1943 IF sfxF THEN MGen.Drop END; 1944 MGen.PushInt(0); 1945 t := SymTab.InvalidType 1946 ELSIF SymTab.ClassOf(dt) 1947 # SymTab.ClArray THEN 1948 SemError(217); 1949 IF sfxF THEN MGen.Drop END; 1950 MGen.PushInt(0); 1951 t := SymTab.InvalidType 1952 ELSIF SymTab.IsOpen(dt) THEN 1953 IF sfxF THEN MGen.Drop END; 1954 IF (dk = SymTab.KindParam) 1955 OR (dk 1956 = SymTab.KindVarPar) THEN 1957 IF SymTab.CurDepth() 1958 = SymTab.SymDepth(bnF) THEN 1959 MGen.LoadLocal( 1960 SymTab.SymSlot(bnF) + 1) 1961 ELSE 1962 MGen.FrameAddr( 1963 SymTab.SymSlot(bnF) + 1, 1964 VAL(CARDINAL, 1965 SymTab.CurDepth() - 1 1966 - SymTab.SymDepth(bnF))); 1967 MGen.LoadIndir 1968 END; 1969 MGen.PushInt(1); 1970 MGen.Sub; 1971 t := SymTab.IntType() 1972 ELSE 1973 MGen.PushInt(0); 1974 t := SymTab.InvalidType 1975 END 1976 ELSE 1977 IF sfxF THEN MGen.Drop END; 1978 MGen.PushInt( 1979 SymTab.ArrayHi(dt)); 1980 t := SymTab.IntType() 1981 END; .) 1982 | DesignHead 1983 DesignTail 1984 (. t := dt; 1985 MGen.CopyName(lxD, lx); 1986 IF sfxF 1987 & (t # SymTab.InvalidType) 1988 & MGen.ActIsVarNext() 1989 & ((dk = SymTab.KindVar) 1990 OR (dk 1991 = SymTab.KindParam) 1992 OR (dk 1993 = SymTab.KindVarPar) 1994 OR (dk 1995 = SymTab.KindField)) 1996 & (SymTab.SymKind(bnF) 1997 # SymTab.KindModule) 1998 & (SymTab.ClassOf(t) 1999 # SymTab.ClChar) 2000 & (SymTab.ClassOf(t) 2001 # SymTab.ClBool) THEN 2002 MGen.StashAddr() 2003 END; 2004 IF sfxF 2005 & (t # SymTab.InvalidType) 2006 & (SymTab.ClassOf(t) 2007 # SymTab.ClArray) 2008 & (SymTab.ClassOf(t) 2009 # SymTab.ClRecord) THEN 2010 IF (SymTab.ClassOf(t) 2011 = SymTab.ClChar) 2012 OR (SymTab.ClassOf(t) 2013 = SymTab.ClBool) THEN 2014 MGen.LoadByte 2015 ELSE MGen.LoadIndir 2016 END 2017 END; 2018 v := ~sfxF 2019 & ((dk = SymTab.KindVar) 2020 OR (dk = SymTab.KindParam) 2021 OR (dk 2022 = SymTab.KindVarPar)); 2023 MGen.CopyName(bnF, vn); .) 2024 [ CallTail 2025 (. IF okF THEN 2026 IF SymTab.SymKind(bnF) 2027 = SymTab.KindProc THEN 2028 t := SymTab.ProcRet(bnF) 2029 ELSIF (SymTab.SymKind(bnF) 2030 = SymTab.KindModule) 2031 & sfxF 2032 & (SymTab.StrLen(lxD) > 0) 2033 & (SymTab.ExpProc(bnF, 2034 lxD) >= 0) THEN 2035 t := SymTab.ProcRetByNum( 2036 SymTab.ExpProc(bnF, 2037 lxD)) 2038 ELSE 2039 t := SymTab.InvalidType 2040 END 2041 ELSE t := SymTab.InvalidType 2042 END; 2043 lx[0] := 0C; v := FALSE; 2044 MGen.ClrStash(); .) ] 2045 | "(" 2046 Expr ")" (. t := et; .) 2047 | ( "NOT" | "~" ) 2048 Fact (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 2049 IF SymTab.BoolCheck(t2) THEN 2050 t := SymTab.BoolType() 2051 ELSE SemError(212); 2052 t := SymTab.InvalidType END; 2053 MGen.Not; .) 2054 | SetLit (. lx[0] := 0C; v := FALSE; MGen.ClrStash(); 2055 t := st; .) . 2056 SetLit 2057 (. VAR first, et: SymTab.TypeIndex; 2058 lxE, lxE2: MGen.LitStr; 2059 vE, vE2: BOOLEAN; 2060 vnE, vnE2: SymTab.Name; 2061 hasR: BOOLEAN; .) 2062 = "{" 2063 (. MGen.PushInt(0); 2064 t := SymTab.SetFor(SymTab.IntType()); .) 2065 [ Elem (. first := et; 2066 t := SymTab.SetFor(et); 2067 MGen.ClrStash(); 2068 IF hasR THEN 2069 MGen.PushInt(1); MGen.Add; 2070 MGen.FieldMask 2071 ELSE MGen.Power2 END; 2072 MGen.Or; .) 2073 { "," 2074 Elem (. IF ~SymTab.SetElemCheck(first, et) THEN 2075 SemError(222) END; 2076 MGen.ClrStash(); 2077 IF hasR THEN 2078 MGen.PushInt(1); MGen.Add; 2079 MGen.FieldMask 2080 ELSE MGen.Power2 END; 2081 MGen.Or; .) } ] 2082 "}" . 2083 Elem 2085 (. VAR t2: SymTab.TypeIndex; 2086 vD, vD2: BOOLEAN; 2087 vnD, vnD2: SymTab.Name; .) 2088 = Expr (. hasR := FALSE; 2089 lx2[0] := 0C; .) 2090 [ ".." 2091 Expr (. IF ~SymTab.SetElemCheck(t, t2) THEN 2092 SemError(222) END; 2093 hasR := TRUE; .) ] . 2094 2095 GetIdent 2096 = ident (. LexName(n); .) . 2097 2098 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)