|
|
@@ -509,3838 +509,3871 @@ Listing:
|
|
|
485 RETURN (SymTab.ClassOf(t) = SymTab.ClInt)
|
|
|
486 OR (SymTab.ClassOf(t) = SymTab.ClByte)
|
|
|
487 OR (SymTab.ClassOf(t) = SymTab.ClSByte)
|
|
|
- 488 ELSIF cons = 3 THEN RETURN SymTab.ClassOf(t) = SymTab.ClReal
|
|
|
- 489 ELSIF cons = 4 THEN RETURN SymTab.ClassOf(t) = SymTab.ClPtr
|
|
|
- 490 ELSIF cons = 5 THEN
|
|
|
- 491 RETURN (SymTab.ClassOf(t) = SymTab.ClInt)
|
|
|
- 492 OR (SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 493 OR (SymTab.ClassOf(t) = SymTab.ClBool)
|
|
|
- 494 OR (SymTab.ClassOf(t) = SymTab.ClEnum)
|
|
|
- 495 OR (SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 496 OR (SymTab.ClassOf(t) = SymTab.ClByte)
|
|
|
- 497 OR (SymTab.ClassOf(t) = SymTab.ClSByte)
|
|
|
- 498 OR (SymTab.ClassOf(t) = SymTab.ClReal)
|
|
|
- 499 END;
|
|
|
- 500 RETURN TRUE
|
|
|
- 501 END ConsOk;
|
|
|
- 502
|
|
|
- 503 PROCEDURE OrdClass (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
- 504 (* TRUE for scalar ordinal classes (int/char/bool/enum/uchar); a
|
|
|
- 505 conversion between two of these is representation-preserving, so its
|
|
|
- 506 folded value equals the operand's. *)
|
|
|
- 507 VAR c: INTEGER;
|
|
|
- 508 BEGIN
|
|
|
- 509 c := SymTab.ClassOf(t);
|
|
|
- 510 RETURN (c = SymTab.ClInt) OR (c = SymTab.ClChar) OR (c = SymTab.ClBool)
|
|
|
- 511 OR (c = SymTab.ClEnum) OR (c = SymTab.ClUChar)
|
|
|
- 512 OR (c = SymTab.ClByte) OR (c = SymTab.ClSByte)
|
|
|
- 513 END OrdClass;
|
|
|
- 514
|
|
|
- 515 PROCEDURE NoteSpan (pn: SymTab.Name; start: M2S.INT32): BOOLEAN;
|
|
|
- 516 (* Records an outermost body span for the re-parse pass (milestone 2).
|
|
|
- 517 FALSE when the span table is full (an implementation limit): the
|
|
|
- 518 caller then parses the body inline instead of dropping it. *)
|
|
|
- 519 BEGIN
|
|
|
- 520 IF nSpans > HIGH(spanName) THEN RETURN FALSE END;
|
|
|
- 521 CopyNm(pn, spanName[nSpans]);
|
|
|
- 522 spanStart[nSpans] := start;
|
|
|
- 523 spanIdx[nSpans] := SymTab.DeferBody();
|
|
|
- 524 INC(nSpans);
|
|
|
- 525 RETURN TRUE
|
|
|
- 526 END NoteSpan;
|
|
|
- 527
|
|
|
- 528 PROCEDURE Openers (): BOOLEAN;
|
|
|
- 529 (* TRUE when the current token opens a block that must be closed by an
|
|
|
- 530 END (BEGIN is excluded: a block's BEGIN shares the declaration END;
|
|
|
- 531 REPEAT..UNTIL and EXIT/RETURN need no END). *)
|
|
|
- 532 BEGIN
|
|
|
- 533 RETURN TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
- 534 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
- 535 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
- 536 OR TokIs("WITH")
|
|
|
- 537 END Openers;
|
|
|
- 538
|
|
|
- 539 PROCEDURE DeferSkip (pn: SymTab.Name): BOOLEAN;
|
|
|
- 540 (* Phase 1 of the deferral: skip the body starting at the current token
|
|
|
- 541 (the first token after the heading's ';') up to the matching END,
|
|
|
- 542 verify the END's name, and LEAVE the scanner positioned exactly at
|
|
|
- 543 that END (so Block's trailing "END" ident consumes it for real), with
|
|
|
- 544 the span recorded for the re-parse pass. On any inconsistency,
|
|
|
- 545 restore the scanner and return FALSE so the caller parses normally. *)
|
|
|
- 546 VAR depth, guard: CARDINAL;
|
|
|
- 547 nm: SymTab.Name;
|
|
|
- 548 ok: BOOLEAN;
|
|
|
- 549 start, endPos: M2S.INT32;
|
|
|
- 550 BEGIN
|
|
|
- 551 deferredBody := FALSE;
|
|
|
- 552 (* table full (an implementation limit): parse the body inline now,
|
|
|
- 553 before touching the scanner, with a clear error. *)
|
|
|
- 554 IF nSpans > HIGH(spanName) THEN
|
|
|
- 555 SemError(230);
|
|
|
- 556 RETURN FALSE
|
|
|
- 557 END;
|
|
|
- 558 start := M2S.nextPos;
|
|
|
- 559 M2S.PushPos;
|
|
|
- 560 depth := 0; guard := 0; ok := TRUE;
|
|
|
- 561 LOOP
|
|
|
- 562 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
- 563 IF TokIs("END") THEN
|
|
|
- 564 IF depth = 0 THEN EXIT END;
|
|
|
- 565 DEC(depth)
|
|
|
- 566 ELSIF Openers() THEN
|
|
|
- 567 INC(depth)
|
|
|
- 568 END;
|
|
|
- 569 Adv;
|
|
|
- 570 INC(guard);
|
|
|
- 571 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
- 572 END;
|
|
|
- 573 IF ok THEN
|
|
|
- 574 (* sym is the matching END; check the name after it, then seek back
|
|
|
- 575 so Block sees END (its "END" ident then consumes it for real). *)
|
|
|
- 576 endPos := M2S.nextPos;
|
|
|
- 577 Adv;
|
|
|
- 578 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
- 579 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END;
|
|
|
- 580 IF ok THEN
|
|
|
- 581 M2S.SeekTo(endPos); Adv
|
|
|
- 582 END
|
|
|
- 583 END;
|
|
|
- 584 IF ok THEN
|
|
|
- 585 IF NOT NoteSpan(pn, start) THEN
|
|
|
- 586 (* defensive: capacity is checked at entry, so this is unreachable *)
|
|
|
- 587 SemError(230);
|
|
|
- 588 RETURN FALSE
|
|
|
- 589 END;
|
|
|
- 590 spanTy[nSpans - 1] := Lower.CurScopeProc();
|
|
|
- 591 spanNode[nSpans - 1] := curProcNode;
|
|
|
- 592 M2S.DropPos; (* keep the scanner at END; discard the snapshot *)
|
|
|
- 593 deferredBody := TRUE;
|
|
|
- 594 RETURN TRUE
|
|
|
- 595 ELSE
|
|
|
- 596 M2S.PopPos;
|
|
|
- 597 FileIO.WriteString(FileIO.StdOut, "twophase defer mismatch in ");
|
|
|
- 598 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
- 599 FileIO.WriteLn(FileIO.StdOut);
|
|
|
- 600 RETURN FALSE
|
|
|
- 601 END
|
|
|
- 602 END DeferSkip;
|
|
|
- 603
|
|
|
- 604 CHARACTERS
|
|
|
- 605 eol = CHR(13) .
|
|
|
- 606 lf = CHR(10) .
|
|
|
- 607 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
- 608 digit = "0123456789" .
|
|
|
- 609 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
- 610 noQuote1 = ANY - "'" - eol .
|
|
|
- 611 noQuote2 = ANY - '"' - eol .
|
|
|
- 612
|
|
|
- 613 IGNORE CHR(9) .. CHR(13)
|
|
|
- 614
|
|
|
- 615 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
- 616 COMMENTS FROM "//" TO lf
|
|
|
+ 488 OR (SymTab.ClassOf(t) = SymTab.ClWord16)
|
|
|
+ 489 OR (SymTab.ClassOf(t) = SymTab.ClSWord16)
|
|
|
+ 490 ELSIF cons = 3 THEN RETURN SymTab.ClassOf(t) = SymTab.ClReal
|
|
|
+ 491 ELSIF cons = 4 THEN RETURN SymTab.ClassOf(t) = SymTab.ClPtr
|
|
|
+ 492 ELSIF cons = 5 THEN
|
|
|
+ 493 RETURN (SymTab.ClassOf(t) = SymTab.ClInt)
|
|
|
+ 494 OR (SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 495 OR (SymTab.ClassOf(t) = SymTab.ClBool)
|
|
|
+ 496 OR (SymTab.ClassOf(t) = SymTab.ClEnum)
|
|
|
+ 497 OR (SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 498 OR (SymTab.ClassOf(t) = SymTab.ClByte)
|
|
|
+ 499 OR (SymTab.ClassOf(t) = SymTab.ClSByte)
|
|
|
+ 500 OR (SymTab.ClassOf(t) = SymTab.ClWord16)
|
|
|
+ 501 OR (SymTab.ClassOf(t) = SymTab.ClSWord16)
|
|
|
+ 502 OR (SymTab.ClassOf(t) = SymTab.ClReal)
|
|
|
+ 503 END;
|
|
|
+ 504 RETURN TRUE
|
|
|
+ 505 END ConsOk;
|
|
|
+ 506
|
|
|
+ 507 PROCEDURE OrdClass (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
+ 508 (* TRUE for scalar ordinal classes (int/char/bool/enum/uchar); a
|
|
|
+ 509 conversion between two of these is representation-preserving, so its
|
|
|
+ 510 folded value equals the operand's. *)
|
|
|
+ 511 VAR c: INTEGER;
|
|
|
+ 512 BEGIN
|
|
|
+ 513 c := SymTab.ClassOf(t);
|
|
|
+ 514 RETURN (c = SymTab.ClInt) OR (c = SymTab.ClChar) OR (c = SymTab.ClBool)
|
|
|
+ 515 OR (c = SymTab.ClEnum) OR (c = SymTab.ClUChar)
|
|
|
+ 516 OR (c = SymTab.ClByte) OR (c = SymTab.ClSByte)
|
|
|
+ 517 OR (c = SymTab.ClWord16) OR (c = SymTab.ClSWord16)
|
|
|
+ 518 END OrdClass;
|
|
|
+ 519
|
|
|
+ 520 PROCEDURE NoteSpan (pn: SymTab.Name; start: M2S.INT32): BOOLEAN;
|
|
|
+ 521 (* Records an outermost body span for the re-parse pass (milestone 2).
|
|
|
+ 522 FALSE when the span table is full (an implementation limit): the
|
|
|
+ 523 caller then parses the body inline instead of dropping it. *)
|
|
|
+ 524 BEGIN
|
|
|
+ 525 IF nSpans > HIGH(spanName) THEN RETURN FALSE END;
|
|
|
+ 526 CopyNm(pn, spanName[nSpans]);
|
|
|
+ 527 spanStart[nSpans] := start;
|
|
|
+ 528 spanIdx[nSpans] := SymTab.DeferBody();
|
|
|
+ 529 INC(nSpans);
|
|
|
+ 530 RETURN TRUE
|
|
|
+ 531 END NoteSpan;
|
|
|
+ 532
|
|
|
+ 533 PROCEDURE Openers (): BOOLEAN;
|
|
|
+ 534 (* TRUE when the current token opens a block that must be closed by an
|
|
|
+ 535 END (BEGIN is excluded: a block's BEGIN shares the declaration END;
|
|
|
+ 536 REPEAT..UNTIL and EXIT/RETURN need no END). *)
|
|
|
+ 537 BEGIN
|
|
|
+ 538 RETURN TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
+ 539 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
+ 540 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
+ 541 OR TokIs("WITH")
|
|
|
+ 542 END Openers;
|
|
|
+ 543
|
|
|
+ 544 PROCEDURE DeferSkip (pn: SymTab.Name): BOOLEAN;
|
|
|
+ 545 (* Phase 1 of the deferral: skip the body starting at the current token
|
|
|
+ 546 (the first token after the heading's ';') up to the matching END,
|
|
|
+ 547 verify the END's name, and LEAVE the scanner positioned exactly at
|
|
|
+ 548 that END (so Block's trailing "END" ident consumes it for real), with
|
|
|
+ 549 the span recorded for the re-parse pass. On any inconsistency,
|
|
|
+ 550 restore the scanner and return FALSE so the caller parses normally. *)
|
|
|
+ 551 VAR depth, guard: CARDINAL;
|
|
|
+ 552 nm: SymTab.Name;
|
|
|
+ 553 ok: BOOLEAN;
|
|
|
+ 554 start, endPos: M2S.INT32;
|
|
|
+ 555 BEGIN
|
|
|
+ 556 deferredBody := FALSE;
|
|
|
+ 557 (* table full (an implementation limit): parse the body inline now,
|
|
|
+ 558 before touching the scanner, with a clear error. *)
|
|
|
+ 559 IF nSpans > HIGH(spanName) THEN
|
|
|
+ 560 SemError(230);
|
|
|
+ 561 RETURN FALSE
|
|
|
+ 562 END;
|
|
|
+ 563 start := M2S.nextPos;
|
|
|
+ 564 M2S.PushPos;
|
|
|
+ 565 depth := 0; guard := 0; ok := TRUE;
|
|
|
+ 566 LOOP
|
|
|
+ 567 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
+ 568 IF TokIs("END") THEN
|
|
|
+ 569 IF depth = 0 THEN EXIT END;
|
|
|
+ 570 DEC(depth)
|
|
|
+ 571 ELSIF Openers() THEN
|
|
|
+ 572 INC(depth)
|
|
|
+ 573 END;
|
|
|
+ 574 Adv;
|
|
|
+ 575 INC(guard);
|
|
|
+ 576 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
+ 577 END;
|
|
|
+ 578 IF ok THEN
|
|
|
+ 579 (* sym is the matching END; check the name after it, then seek back
|
|
|
+ 580 so Block sees END (its "END" ident then consumes it for real). *)
|
|
|
+ 581 endPos := M2S.nextPos;
|
|
|
+ 582 Adv;
|
|
|
+ 583 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
+ 584 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END;
|
|
|
+ 585 IF ok THEN
|
|
|
+ 586 M2S.SeekTo(endPos); Adv
|
|
|
+ 587 END
|
|
|
+ 588 END;
|
|
|
+ 589 IF ok THEN
|
|
|
+ 590 IF NOT NoteSpan(pn, start) THEN
|
|
|
+ 591 (* defensive: capacity is checked at entry, so this is unreachable *)
|
|
|
+ 592 SemError(230);
|
|
|
+ 593 RETURN FALSE
|
|
|
+ 594 END;
|
|
|
+ 595 spanTy[nSpans - 1] := Lower.CurScopeProc();
|
|
|
+ 596 spanNode[nSpans - 1] := curProcNode;
|
|
|
+ 597 M2S.DropPos; (* keep the scanner at END; discard the snapshot *)
|
|
|
+ 598 deferredBody := TRUE;
|
|
|
+ 599 RETURN TRUE
|
|
|
+ 600 ELSE
|
|
|
+ 601 M2S.PopPos;
|
|
|
+ 602 FileIO.WriteString(FileIO.StdOut, "twophase defer mismatch in ");
|
|
|
+ 603 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
+ 604 FileIO.WriteLn(FileIO.StdOut);
|
|
|
+ 605 RETURN FALSE
|
|
|
+ 606 END
|
|
|
+ 607 END DeferSkip;
|
|
|
+ 608
|
|
|
+ 609 CHARACTERS
|
|
|
+ 610 eol = CHR(13) .
|
|
|
+ 611 lf = CHR(10) .
|
|
|
+ 612 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
+ 613 digit = "0123456789" .
|
|
|
+ 614 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
+ 615 noQuote1 = ANY - "'" - eol .
|
|
|
+ 616 noQuote2 = ANY - '"' - eol .
|
|
|
617
|
|
|
- 618 TOKENS
|
|
|
- 619 ident = ( letter | "_" ) { letter | digit | "_" } .
|
|
|
- 620 integer = digit { digit }
|
|
|
- 621 | digit { digit } CONTEXT("..")
|
|
|
- 622 | "0x" hexDigit { hexDigit }
|
|
|
- 623 | "0X" hexDigit { hexDigit } .
|
|
|
- 624 real = digit { digit } "." { digit }
|
|
|
- 625 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
- 626 string = "'" { noQuote1 } "'"
|
|
|
- 627 | '"' { noQuote2 } '"' .
|
|
|
- 628 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
- 629 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
- 630
|
|
|
- 631 PRODUCTIONS
|
|
|
- 632 M2
|
|
|
- 633 = (. astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
|
|
|
- 634 astImp := AST.NoNode;
|
|
|
- 635 astImpTail := AST.NoNode;
|
|
|
- 636 nSpans := 0;
|
|
|
- 637 SymTab.DeferReset; .)
|
|
|
- 638 Unit "." (. IF SymTab.TypesOverflow() THEN
|
|
|
- 639 SemError(230) (* MaxTypes *)
|
|
|
- 640 END; .) .
|
|
|
- 641 (* Units: program modules compile fully; DEFINITION and
|
|
|
- 642 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
- 643 (each ends with one 230); same for nested local modules. *)
|
|
|
- 644 (* Generics (Increment 1): formal and actual parameters. Formals are
|
|
|
- 645 TYPE parameters only; actuals are type identifiers. *)
|
|
|
- 646 GenericFormals
|
|
|
- 647 = "(" GenericFormal { ";" GenericFormal } ")" .
|
|
|
- 648 GenericFormal (. VAR nm: SymTab.Name; vt: SymTab.TypeIndex;
|
|
|
- 649 names: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
- 650 nn, k: CARDINAL;
|
|
|
- 651 mmod: SymTab.Name;
|
|
|
- 652 quid, qdep: CARDINAL;
|
|
|
- 653 qres: SymTab.TypeIndex;
|
|
|
- 654 qext: BOOLEAN;
|
|
|
- 655 cons: INTEGER;
|
|
|
- 656 cn: SymTab.Name;
|
|
|
- 657 isTypeFormal: BOOLEAN; .)
|
|
|
- 658 = (. nn := 0; .)
|
|
|
- 659 GetIdent<nm> (. k := 0;
|
|
|
- 660 WHILE (k <= HIGH(names[nn])) AND (nm[k] # CHR(0)) DO
|
|
|
- 661 names[nn][k] := nm[k]; INC(k) END;
|
|
|
- 662 names[nn][k] := CHR(0); INC(nn); .)
|
|
|
- 663 { "," GetIdent<nm> (. k := 0;
|
|
|
- 664 WHILE (k <= HIGH(names[nn])) AND (nm[k] # CHR(0)) DO
|
|
|
- 665 names[nn][k] := nm[k]; INC(k) END;
|
|
|
- 666 names[nn][k] := CHR(0); INC(nn); .) }
|
|
|
- 667 ":" (. vt := SymTab.InvalidType; isTypeFormal := FALSE; .)
|
|
|
- 668 ( "TYPE" (. isTypeFormal := TRUE; .)
|
|
|
- 669 [ "(" GetIdent<cn> ")" (. cons := ConsCode(cn); .) ]
|
|
|
- 670 | ProcType<vt> (. isTypeFormal := FALSE; .)
|
|
|
- 671 | TypeIdent<vt> ) (. k := 0;
|
|
|
- 672 WHILE k < nn DO
|
|
|
- 673 IF isTypeFormal THEN
|
|
|
- 674 IF instActive THEN
|
|
|
- 675 (* constraint: a type
|
|
|
- 676 formal needs a type
|
|
|
- 677 actual that satisfies
|
|
|
- 678 the declared constraint *)
|
|
|
- 679 IF InstActualKind(instFk) # 0 THEN
|
|
|
- 680 SemError(233)
|
|
|
- 681 ELSIF NOT ConsOk(cons, InstActualGet(instFk)) THEN
|
|
|
- 682 SemError(233)
|
|
|
- 683 ELSIF NOT SymTab.EnterTypeParamBound(names[k], InstActualGet(instFk)) THEN
|
|
|
- 684 SemError(200) END
|
|
|
- 685 ELSIF NOT SymTab.EnterTypeParam(names[k]) THEN
|
|
|
- 686 SemError(200) END
|
|
|
- 687 ELSIF SymTab.ClassOf(vt) = SymTab.ClProc THEN
|
|
|
- 688 (* procedure formal *)
|
|
|
- 689 IF instActive THEN
|
|
|
- 690 IF InstActualKind(instFk) # 2 THEN
|
|
|
- 691 SemError(233) END;
|
|
|
- 692 InstActualMod(instFk, mmod);
|
|
|
- 693 InstActualVal(instFk, nm);
|
|
|
- 694 IF NOT SymTab.AliasProc(names[k], mmod, nm) THEN
|
|
|
- 695 SemError(201)
|
|
|
- 696 ELSIF SymTab.QualProcInfo(mmod, nm, quid, qdep, qres, qext) THEN
|
|
|
- 697 Lower.AliasProc(names[k], quid, qres, qdep, qext)
|
|
|
- 698 END
|
|
|
- 699 ELSE
|
|
|
- 700 (* template: a callable
|
|
|
- 701 placeholder of the
|
|
|
- 702 formal's proc type *)
|
|
|
- 703 IF NOT SymTab.Enter(names[k], SymTab.KindVar) THEN
|
|
|
- 704 SemError(200) END;
|
|
|
- 705 SymTab.SetSymType(names[k], vt)
|
|
|
- 706 END
|
|
|
- 707 ELSE
|
|
|
- 708 (* constraint: a value
|
|
|
- 709 formal needs a value
|
|
|
- 710 actual *)
|
|
|
- 711 IF instActive AND (InstActualKind(instFk) # 1) THEN
|
|
|
- 712 SemError(233) END;
|
|
|
- 713 IF NOT SymTab.Enter(names[k], SymTab.KindConst) THEN
|
|
|
- 714 SemError(200) END;
|
|
|
- 715 SymTab.SetSymType(names[k], vt);
|
|
|
- 716 IF instActive THEN
|
|
|
- 717 InstActualVal(instFk, nm);
|
|
|
- 718 SymTab.SetSymVal(names[k], nm)
|
|
|
- 719 ELSE SymTab.SetSymVal(names[k], "0")
|
|
|
- 720 END
|
|
|
- 721 END;
|
|
|
- 722 INC(instFk); INC(k)
|
|
|
- 723 END; .) .
|
|
|
- 724 Actuals
|
|
|
- 725 = Actual { "," Actual } .
|
|
|
- 726 Actual (. VAR at: SymTab.TypeIndex;
|
|
|
- 727 nm: SymTab.Name;
|
|
|
- 728 s: ARRAY [0 .. 255] OF CHAR;
|
|
|
- 729 qv: QbeGen.QVal;
|
|
|
- 730 isCh, isV: BOOLEAN;
|
|
|
- 731 aKind: INTEGER;
|
|
|
- 732 amod: SymTab.Name;
|
|
|
- 733 nm2: SymTab.Name;
|
|
|
- 734 qu, qd: CARDINAL;
|
|
|
- 735 qr: SymTab.TypeIndex;
|
|
|
- 736 qe: BOOLEAN;
|
|
|
- 737 k: CARDINAL; .)
|
|
|
- 738 = (. isV := FALSE; at := SymTab.InvalidType;
|
|
|
- 739 nm[0] := CHR(0); nm2[0] := CHR(0);
|
|
|
- 740 aKind := 0; amod[0] := CHR(0); .)
|
|
|
- 741 ( integer (. LexString(s); QbeGen.NormInt(s, qv);
|
|
|
- 742 isV := TRUE; aKind := 1; at := SymTab.IntType();
|
|
|
- 743 CopyNm(qv, nm); .)
|
|
|
- 744 | charConst (. LexString(s); QbeGen.NormLit(s, qv, isCh);
|
|
|
- 745 isV := TRUE; aKind := 1; at := SymTab.CharType();
|
|
|
- 746 CopyNm(qv, nm); .)
|
|
|
- 747 | GetIdent<nm> [ "." GetIdent<nm2> ]
|
|
|
- 748 (. isV := FALSE; at := SymTab.InvalidType;
|
|
|
- 749 aKind := 0; amod[0] := CHR(0);
|
|
|
- 750 IF nm2[0] # CHR(0) THEN
|
|
|
- 751 (* qualified actual Mod.Name:
|
|
|
- 752 a nested instance's type
|
|
|
- 753 (Mod.Type) or a procedure
|
|
|
- 754 (Mod.Proc); no import
|
|
|
- 755 needed *)
|
|
|
- 756 IF SymTab.QualProcInfo(nm, nm2,
|
|
|
- 757 qu, qd, qr, qe) THEN
|
|
|
- 758 aKind := 2
|
|
|
- 759 ELSE at := SymTab.QualType(nm, nm2);
|
|
|
- 760 IF at # SymTab.InvalidType THEN
|
|
|
- 761 aKind := 0
|
|
|
- 762 ELSE SemError(201);
|
|
|
- 763 aKind := 0; at := SymTab.InvalidType
|
|
|
- 764 END
|
|
|
- 765 END;
|
|
|
- 766 CopyNm(nm, amod);
|
|
|
- 767 CopyNm(nm2, nm)
|
|
|
- 768 ELSIF SymTab.Lookup(nm)
|
|
|
- 769 AND ((SymTab.SymKind(nm) = SymTab.KindType)
|
|
|
- 770 OR (SymTab.SymKind(nm) = SymTab.KindPredef)) THEN
|
|
|
- 771 at := SymTab.SymType(nm)
|
|
|
- 772 ELSIF SymTab.Lookup(nm)
|
|
|
- 773 AND (SymTab.SymKind(nm) = SymTab.KindProc) THEN
|
|
|
- 774 aKind := 2; at := SymTab.SymType(nm);
|
|
|
- 775 IF NOT SymTab.SymMod(nm, amod) THEN
|
|
|
- 776 amod[0] := CHR(0) END
|
|
|
+ 618 IGNORE CHR(9) .. CHR(13)
|
|
|
+ 619
|
|
|
+ 620 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
+ 621 COMMENTS FROM "//" TO lf
|
|
|
+ 622
|
|
|
+ 623 TOKENS
|
|
|
+ 624 ident = ( letter | "_" ) { letter | digit | "_" } .
|
|
|
+ 625 integer = digit { digit }
|
|
|
+ 626 | digit { digit } CONTEXT("..")
|
|
|
+ 627 | "0x" hexDigit { hexDigit }
|
|
|
+ 628 | "0X" hexDigit { hexDigit } .
|
|
|
+ 629 real = digit { digit } "." { digit }
|
|
|
+ 630 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
+ 631 string = "'" { noQuote1 } "'"
|
|
|
+ 632 | '"' { noQuote2 } '"' .
|
|
|
+ 633 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
+ 634 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
+ 635
|
|
|
+ 636 PRODUCTIONS
|
|
|
+ 637 M2
|
|
|
+ 638 = (. astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
|
|
|
+ 639 astImp := AST.NoNode;
|
|
|
+ 640 astImpTail := AST.NoNode;
|
|
|
+ 641 nSpans := 0;
|
|
|
+ 642 SymTab.DeferReset; .)
|
|
|
+ 643 Unit "." (. IF SymTab.TypesOverflow() THEN
|
|
|
+ 644 SemError(230) (* MaxTypes *)
|
|
|
+ 645 END; .) .
|
|
|
+ 646 (* Units: program modules compile fully; DEFINITION and
|
|
|
+ 647 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
+ 648 (each ends with one 230); same for nested local modules. *)
|
|
|
+ 649 (* Generics (Increment 1): formal and actual parameters. Formals are
|
|
|
+ 650 TYPE parameters only; actuals are type identifiers. *)
|
|
|
+ 651 GenericFormals
|
|
|
+ 652 = "(" GenericFormal { ";" GenericFormal } ")" .
|
|
|
+ 653 GenericFormal (. VAR nm: SymTab.Name; vt: SymTab.TypeIndex;
|
|
|
+ 654 names: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
+ 655 nn, k: CARDINAL;
|
|
|
+ 656 mmod: SymTab.Name;
|
|
|
+ 657 quid, qdep: CARDINAL;
|
|
|
+ 658 qres: SymTab.TypeIndex;
|
|
|
+ 659 qext: BOOLEAN;
|
|
|
+ 660 cons: INTEGER;
|
|
|
+ 661 cn: SymTab.Name;
|
|
|
+ 662 isTypeFormal: BOOLEAN; .)
|
|
|
+ 663 = (. nn := 0; .)
|
|
|
+ 664 GetIdent<nm> (. k := 0;
|
|
|
+ 665 WHILE (k <= HIGH(names[nn])) AND (nm[k] # CHR(0)) DO
|
|
|
+ 666 names[nn][k] := nm[k]; INC(k) END;
|
|
|
+ 667 names[nn][k] := CHR(0); INC(nn); .)
|
|
|
+ 668 { "," GetIdent<nm> (. k := 0;
|
|
|
+ 669 WHILE (k <= HIGH(names[nn])) AND (nm[k] # CHR(0)) DO
|
|
|
+ 670 names[nn][k] := nm[k]; INC(k) END;
|
|
|
+ 671 names[nn][k] := CHR(0); INC(nn); .) }
|
|
|
+ 672 ":" (. vt := SymTab.InvalidType; isTypeFormal := FALSE; .)
|
|
|
+ 673 ( "TYPE" (. isTypeFormal := TRUE; .)
|
|
|
+ 674 [ "(" GetIdent<cn> ")" (. cons := ConsCode(cn); .) ]
|
|
|
+ 675 | ProcType<vt> (. isTypeFormal := FALSE; .)
|
|
|
+ 676 | TypeIdent<vt> ) (. k := 0;
|
|
|
+ 677 WHILE k < nn DO
|
|
|
+ 678 IF isTypeFormal THEN
|
|
|
+ 679 IF instActive THEN
|
|
|
+ 680 (* constraint: a type
|
|
|
+ 681 formal needs a type
|
|
|
+ 682 actual that satisfies
|
|
|
+ 683 the declared constraint *)
|
|
|
+ 684 IF InstActualKind(instFk) # 0 THEN
|
|
|
+ 685 SemError(233)
|
|
|
+ 686 ELSIF NOT ConsOk(cons, InstActualGet(instFk)) THEN
|
|
|
+ 687 SemError(233)
|
|
|
+ 688 ELSIF NOT SymTab.EnterTypeParamBound(names[k], InstActualGet(instFk)) THEN
|
|
|
+ 689 SemError(200) END
|
|
|
+ 690 ELSIF NOT SymTab.EnterTypeParam(names[k]) THEN
|
|
|
+ 691 SemError(200) END
|
|
|
+ 692 ELSIF SymTab.ClassOf(vt) = SymTab.ClProc THEN
|
|
|
+ 693 (* procedure formal *)
|
|
|
+ 694 IF instActive THEN
|
|
|
+ 695 IF InstActualKind(instFk) # 2 THEN
|
|
|
+ 696 SemError(233) END;
|
|
|
+ 697 InstActualMod(instFk, mmod);
|
|
|
+ 698 InstActualVal(instFk, nm);
|
|
|
+ 699 IF NOT SymTab.AliasProc(names[k], mmod, nm) THEN
|
|
|
+ 700 SemError(201)
|
|
|
+ 701 ELSIF SymTab.QualProcInfo(mmod, nm, quid, qdep, qres, qext) THEN
|
|
|
+ 702 Lower.AliasProc(names[k], quid, qres, qdep, qext)
|
|
|
+ 703 END
|
|
|
+ 704 ELSE
|
|
|
+ 705 (* template: a callable
|
|
|
+ 706 placeholder of the
|
|
|
+ 707 formal's proc type *)
|
|
|
+ 708 IF NOT SymTab.Enter(names[k], SymTab.KindVar) THEN
|
|
|
+ 709 SemError(200) END;
|
|
|
+ 710 SymTab.SetSymType(names[k], vt)
|
|
|
+ 711 END
|
|
|
+ 712 ELSE
|
|
|
+ 713 (* constraint: a value
|
|
|
+ 714 formal needs a value
|
|
|
+ 715 actual *)
|
|
|
+ 716 IF instActive AND (InstActualKind(instFk) # 1) THEN
|
|
|
+ 717 SemError(233) END;
|
|
|
+ 718 IF NOT SymTab.Enter(names[k], SymTab.KindConst) THEN
|
|
|
+ 719 SemError(200) END;
|
|
|
+ 720 SymTab.SetSymType(names[k], vt);
|
|
|
+ 721 IF instActive THEN
|
|
|
+ 722 InstActualVal(instFk, nm);
|
|
|
+ 723 SymTab.SetSymVal(names[k], nm)
|
|
|
+ 724 ELSE SymTab.SetSymVal(names[k], "0")
|
|
|
+ 725 END
|
|
|
+ 726 END;
|
|
|
+ 727 INC(instFk); INC(k)
|
|
|
+ 728 END; .) .
|
|
|
+ 729 Actuals
|
|
|
+ 730 = Actual { "," Actual } .
|
|
|
+ 731 Actual (. VAR at: SymTab.TypeIndex;
|
|
|
+ 732 nm: SymTab.Name;
|
|
|
+ 733 s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ 734 qv: QbeGen.QVal;
|
|
|
+ 735 isCh, isV: BOOLEAN;
|
|
|
+ 736 aKind: INTEGER;
|
|
|
+ 737 amod: SymTab.Name;
|
|
|
+ 738 nm2: SymTab.Name;
|
|
|
+ 739 qu, qd: CARDINAL;
|
|
|
+ 740 qr: SymTab.TypeIndex;
|
|
|
+ 741 qe: BOOLEAN;
|
|
|
+ 742 k: CARDINAL; .)
|
|
|
+ 743 = (. isV := FALSE; at := SymTab.InvalidType;
|
|
|
+ 744 nm[0] := CHR(0); nm2[0] := CHR(0);
|
|
|
+ 745 aKind := 0; amod[0] := CHR(0); .)
|
|
|
+ 746 ( integer (. LexString(s); QbeGen.NormInt(s, qv);
|
|
|
+ 747 isV := TRUE; aKind := 1; at := SymTab.IntType();
|
|
|
+ 748 CopyNm(qv, nm); .)
|
|
|
+ 749 | charConst (. LexString(s); QbeGen.NormLit(s, qv, isCh);
|
|
|
+ 750 isV := TRUE; aKind := 1; at := SymTab.CharType();
|
|
|
+ 751 CopyNm(qv, nm); .)
|
|
|
+ 752 | GetIdent<nm> [ "." GetIdent<nm2> ]
|
|
|
+ 753 (. isV := FALSE; at := SymTab.InvalidType;
|
|
|
+ 754 aKind := 0; amod[0] := CHR(0);
|
|
|
+ 755 IF nm2[0] # CHR(0) THEN
|
|
|
+ 756 (* qualified actual Mod.Name:
|
|
|
+ 757 a nested instance's type
|
|
|
+ 758 (Mod.Type) or a procedure
|
|
|
+ 759 (Mod.Proc); no import
|
|
|
+ 760 needed *)
|
|
|
+ 761 IF SymTab.QualProcInfo(nm, nm2,
|
|
|
+ 762 qu, qd, qr, qe) THEN
|
|
|
+ 763 aKind := 2
|
|
|
+ 764 ELSE at := SymTab.QualType(nm, nm2);
|
|
|
+ 765 IF at # SymTab.InvalidType THEN
|
|
|
+ 766 aKind := 0
|
|
|
+ 767 ELSE SemError(201);
|
|
|
+ 768 aKind := 0; at := SymTab.InvalidType
|
|
|
+ 769 END
|
|
|
+ 770 END;
|
|
|
+ 771 CopyNm(nm, amod);
|
|
|
+ 772 CopyNm(nm2, nm)
|
|
|
+ 773 ELSIF SymTab.Lookup(nm)
|
|
|
+ 774 AND ((SymTab.SymKind(nm) = SymTab.KindType)
|
|
|
+ 775 OR (SymTab.SymKind(nm) = SymTab.KindPredef)) THEN
|
|
|
+ 776 at := SymTab.SymType(nm)
|
|
|
777 ELSIF SymTab.Lookup(nm)
|
|
|
- 778 AND (SymTab.SymKind(nm) = SymTab.KindConst) THEN
|
|
|
- 779 isV := TRUE; aKind := 1; at := SymTab.SymType(nm);
|
|
|
- 780 IF NOT SymTab.GetSymVal(nm, s) THEN s[0] := CHR(0) END;
|
|
|
- 781 CopyNm(s, nm)
|
|
|
- 782 ELSE SemError(201)
|
|
|
- 783 END; .) )
|
|
|
- 784 (. IF refN <= HIGH(refActual) THEN
|
|
|
- 785 IF aKind = 0 THEN
|
|
|
- 786 IF isV THEN refKind[refN] := 1
|
|
|
- 787 ELSE refKind[refN] := 0 END
|
|
|
- 788 ELSE refKind[refN] := aKind END;
|
|
|
- 789 refActual[refN] := at;
|
|
|
- 790 k := 0;
|
|
|
- 791 WHILE (k <= HIGH(refVal[refN])) AND (nm[k] # CHR(0)) DO
|
|
|
- 792 refVal[refN][k] := nm[k]; INC(k) END;
|
|
|
- 793 refVal[refN][k] := CHR(0);
|
|
|
- 794 k := 0;
|
|
|
- 795 WHILE (k <= HIGH(refMod[refN])) AND (amod[k] # CHR(0)) DO
|
|
|
- 796 refMod[refN][k] := amod[k]; INC(k) END;
|
|
|
- 797 refMod[refN][k] := CHR(0);
|
|
|
- 798 INC(refN)
|
|
|
- 799 END; .) .
|
|
|
- 800 Unit
|
|
|
- 801 = (. isGen := FALSE;
|
|
|
- 802 allowDefer := FALSE;
|
|
|
- 803 allowFwdType := FALSE;
|
|
|
- 804 repassing := FALSE; .)
|
|
|
- 805 [ "GENERIC" (. isGen := TRUE; .) ]
|
|
|
- 806 ( DefUnit | ImplUnit | ProgModule ) .
|
|
|
- 807 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
- 808 and one program (last) into one image. Units share the symbol
|
|
|
- 809 table; imports materialize exported names. *)
|
|
|
- 810 DefUnit (. VAR m1, m2, pn: SymTab.Name;
|
|
|
- 811 g: SymTab.Name;
|
|
|
- 812 astSeq, astTail, astProc: AST.Node; .)
|
|
|
- 813 = (. refN := 0; refSeen := FALSE; .)
|
|
|
- 814 "DEFINITION" "MODULE"
|
|
|
- 815 [ "FOR" string ] (* ISO foreign module: FOR "C" *)
|
|
|
- 816 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
- 817 IF instActive THEN
|
|
|
- 818 IF NOT SymTab.Reenter(m1,
|
|
|
- 819 SymTab.UnitDef) THEN
|
|
|
- 820 SemError(200) END
|
|
|
- 821 ELSIF NOT SymTab.BeginDef(m1) THEN
|
|
|
- 822 SemError(200) END;
|
|
|
- 823 QbeGen.SetModule(m1);
|
|
|
- 824 CopyNm(m1, unitName);
|
|
|
- 825 unitWasGen := isGen
|
|
|
- 826 AND NOT instActive;
|
|
|
- 827 unitWasDef := TRUE; .)
|
|
|
- 828 [ GenericFormals ]
|
|
|
- 829 ( ";"
|
|
|
- 830 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 831 astImp, astImpTail, astDecl); .) }
|
|
|
- 832 [ "EXPORT" [ "QUALIFIED" | "UNQUALIFIED" ] (. (* definition-module export
|
|
|
- 833 list: parsed, and the
|
|
|
- 834 names are already exported
|
|
|
- 835 by the module scope *) .)
|
|
|
- 836 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
- 837 (. astSeq := AST.NoNode;
|
|
|
- 838 astTail := AST.NoNode; .)
|
|
|
- 839 { ConstBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
- 840 astSeq, astTail, astDecl); .)
|
|
|
- 841 | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
|
|
|
- 842 astSeq, astTail, astDecl); .)
|
|
|
- 843 | VarBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
- 844 astSeq, astTail, astDecl); .)
|
|
|
- 845 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 846 (. (* a heading only: record it so
|
|
|
- 847 Lower can replay it *)
|
|
|
- 848 astProc := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 849 AST.SetOp(astProc, 0);
|
|
|
- 850 AST.SetChild(astProc, 0,
|
|
|
- 851 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 852 AstAppend(AST.NkDeclSeq,
|
|
|
- 853 astSeq, astTail, astProc);
|
|
|
- 854 Lower.NoteProcNode(astProc);
|
|
|
- 855 Lower.ScopeLeave;
|
|
|
- 856 SymTab.CloseProc;
|
|
|
- 857 QbeGen.AbortFunc; .) }
|
|
|
- 858 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
- 859 AST.SetChild(astUnit, 0,
|
|
|
- 860 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 861 AST.SetChild(astUnit, 1, astSeq);
|
|
|
- 862 AST.SetChild(astUnit, 3, astImp);
|
|
|
- 863 astDecl := AST.NoNode;
|
|
|
- 864 astStmt := AST.NoNode; .)
|
|
|
- 865 "END"
|
|
|
- 866 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 867 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 868 SemError(202) END;
|
|
|
- 869 SymTab.EndUnit; .)
|
|
|
- 870 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
- 871 (. CopyNm(m1, refInst);
|
|
|
- 872 CopyNm(g, refGen);
|
|
|
- 873 refSeen := TRUE; refIsDef := TRUE;
|
|
|
- 874 astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
- 875 AST.SetChild(astUnit, 0,
|
|
|
- 876 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 877 astDecl := AST.NoNode;
|
|
|
- 878 astStmt := AST.NoNode; .)
|
|
|
- 879 "END"
|
|
|
- 880 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 881 SemError(202) END;
|
|
|
- 882 SymTab.EndUnit; .) ) .
|
|
|
- 883 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
- 884 g: SymTab.Name;
|
|
|
- 885 k: CARDINAL;
|
|
|
- 886 rp: CARDINAL;
|
|
|
- 887 rpOk: BOOLEAN;
|
|
|
- 888 rErrs: INTEGER;
|
|
|
- 889 rDecl, rStmt: AST.Node;
|
|
|
- 890 rnm: SymTab.Name;
|
|
|
- 891 rSym, rErr: CARDINAL;
|
|
|
- 892 fname: SymTab.Name;
|
|
|
- 893 unres: BOOLEAN;
|
|
|
- 894 astNode: AST.Node; .)
|
|
|
- 895 = (. refN := 0; refSeen := FALSE; .)
|
|
|
- 896 "IMPLEMENTATION" "MODULE"
|
|
|
- 897 [ "FOR" string ] (* ISO foreign module: FOR "C" *)
|
|
|
- 898 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
- 899 IF instActive THEN
|
|
|
- 900 IF NOT SymTab.Reenter(m1,
|
|
|
- 901 SymTab.UnitImpl) THEN
|
|
|
- 902 SemError(201) END
|
|
|
- 903 ELSIF NOT SymTab.BeginImpl(m1) THEN
|
|
|
- 904 SemError(201) END;
|
|
|
- 905 astStmt := AST.NoNode;
|
|
|
- 906 astDecl := AST.NoNode;
|
|
|
- 907 astImp := AST.NoNode;
|
|
|
- 908 astImpTail := AST.NoNode;
|
|
|
- 909 nPendVar := 0;
|
|
|
- 910 CopyNm(m1, unitName);
|
|
|
- 911 unitWasGen := isGen AND NOT instActive;
|
|
|
- 912 unitWasDef := FALSE;
|
|
|
- 913 QbeGen.SetModule(m1); .)
|
|
|
- 914 [ GenericFormals ]
|
|
|
- 915 ( ";"
|
|
|
- 916 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 917 astImp, astImpTail, astDecl); .) }
|
|
|
- 918 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 919 [ "BEGIN" (. FlushPend;
|
|
|
- 920 k := 0;
|
|
|
- 921 WHILE k < SymTab.FwdPending() DO
|
|
|
- 922 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 923 IF unres THEN SemError(201) END;
|
|
|
- 924 INC(k)
|
|
|
- 925 END;
|
|
|
- 926 SymTab.FwdClear;
|
|
|
- 927
|
|
|
- 928 nLab := 0; nGot := 0; .)
|
|
|
- 929 [ StatSeq ] ]
|
|
|
- 930 (. IF twoPhaseParse THEN
|
|
|
- 931 rSym := sym; rErr := errDist;
|
|
|
- 932 rDecl := astDecl; rStmt := astStmt;
|
|
|
- 933 M2S.PushPos;
|
|
|
- 934 repassing := TRUE;
|
|
|
- 935 rp := 0;
|
|
|
- 936 WHILE rp < nSpans DO
|
|
|
- 937 k := 0;
|
|
|
- 938 WHILE (k <= HIGH(rnm))
|
|
|
- 939 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
- 940 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
- 941 END;
|
|
|
- 942 rnm[k] := CHR(0);
|
|
|
- 943 M2S.SeekTo(spanStart[rp]);
|
|
|
- 944 Adv;
|
|
|
- 945 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
- 946 IF NOT rpOk THEN
|
|
|
- 947 FileIO.WriteString(FileIO.StdOut,
|
|
|
- 948 "twophase reenter failed");
|
|
|
- 949 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 950 END;
|
|
|
- 951 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
- 952 QbeGen.BeginFunc("");
|
|
|
- 953 Block(rnm);
|
|
|
- 954 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
- 955 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
- 956 Lower.ScopeLeave;
|
|
|
- 957 SymTab.CloseProc;
|
|
|
- 958 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
- 959 INC(rp)
|
|
|
- 960 END;
|
|
|
- 961 SymTab.OrderCheckOff; rErrs := M2S.errors;
|
|
|
- 962 repassing := FALSE;
|
|
|
- 963 M2S.PopPos;
|
|
|
- 964 sym := rSym; errDist := rErr;
|
|
|
- 965 M2S.errors := rErrs;
|
|
|
- 966
|
|
|
- 967 astDecl := rDecl; astStmt := rStmt
|
|
|
- 968 END; .)
|
|
|
- 969 "END"
|
|
|
- 970 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 971 FlushPend;
|
|
|
- 972 k := 0;
|
|
|
- 973 WHILE k < SymTab.FwdPending() DO
|
|
|
- 974 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 975 IF unres THEN SemError(201) END;
|
|
|
- 976 INC(k)
|
|
|
- 977 END;
|
|
|
- 978 SymTab.FwdClear;
|
|
|
- 979
|
|
|
- 980 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 981 AST.SetChild(astNode, 0,
|
|
|
- 982 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 983 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 984 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 985 AST.SetChild(astNode, 3, astImp);
|
|
|
- 986 astUnit := astNode;
|
|
|
- 987 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 988 SemError(202) END;
|
|
|
- 989 CheckGotos;
|
|
|
- 990 SymTab.EndUnit; .)
|
|
|
- 991 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
- 992 (. CopyNm(m1, refInst);
|
|
|
- 993 CopyNm(g, refGen);
|
|
|
- 994 refSeen := TRUE; refIsDef := FALSE;
|
|
|
- 995 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 996 AST.SetChild(astNode, 0,
|
|
|
- 997 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 998 astDecl := AST.NoNode;
|
|
|
- 999 astStmt := AST.NoNode; .)
|
|
|
- 1000 { Import (. (* refinement unit import *) .) }
|
|
|
- 1001 "END"
|
|
|
- 1002 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 1003 SemError(202) END;
|
|
|
- 1004 SymTab.EndUnit; .) ) .
|
|
|
- 1005 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 1006 k: CARDINAL;
|
|
|
- 1007 rp: CARDINAL;
|
|
|
- 1008 rpOk: BOOLEAN;
|
|
|
- 1009 rErrs: INTEGER;
|
|
|
- 1010 rDecl, rStmt: AST.Node;
|
|
|
- 1011 rnm: SymTab.Name;
|
|
|
- 1012 rSym, rErr: CARDINAL;
|
|
|
- 1013 fname: SymTab.Name;
|
|
|
- 1014 unres: BOOLEAN;
|
|
|
- 1015 astNode: AST.Node; .)
|
|
|
- 1016 = "MODULE"
|
|
|
- 1017 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
- 1018 SemError(200) END;
|
|
|
- 1019 astStmt := AST.NoNode;
|
|
|
- 1020 astDecl := AST.NoNode;
|
|
|
- 1021 astImp := AST.NoNode;
|
|
|
- 1022 astImpTail := AST.NoNode;
|
|
|
- 1023 nPendVar := 0;
|
|
|
- 1024 QbeGen.SetModule(m1); .)
|
|
|
- 1025 [ Priority ]
|
|
|
- 1026 ";"
|
|
|
- 1027 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1028 astImp, astImpTail, astDecl); .) }
|
|
|
- 1029 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 1030 [ "BEGIN" (. FlushPend;
|
|
|
- 1031 k := 0;
|
|
|
- 1032 WHILE k < SymTab.FwdPending() DO
|
|
|
- 1033 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 1034 IF unres THEN SemError(201) END;
|
|
|
- 1035 INC(k)
|
|
|
- 1036 END;
|
|
|
- 1037 SymTab.FwdClear;
|
|
|
- 1038
|
|
|
- 1039 nLab := 0; nGot := 0; .)
|
|
|
- 1040 [ StatSeq ] ]
|
|
|
- 1041 (. IF twoPhaseParse THEN
|
|
|
- 1042 rSym := sym; rErr := errDist;
|
|
|
- 1043 rDecl := astDecl; rStmt := astStmt;
|
|
|
- 1044 M2S.PushPos;
|
|
|
- 1045 repassing := TRUE;
|
|
|
- 1046 rp := 0;
|
|
|
- 1047 WHILE rp < nSpans DO
|
|
|
- 1048 k := 0;
|
|
|
- 1049 WHILE (k <= HIGH(rnm))
|
|
|
- 1050 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
- 1051 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
- 1052 END;
|
|
|
- 1053 rnm[k] := CHR(0);
|
|
|
- 1054 M2S.SeekTo(spanStart[rp]);
|
|
|
- 1055 Adv;
|
|
|
- 1056 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
- 1057 IF NOT rpOk THEN
|
|
|
- 1058 FileIO.WriteString(FileIO.StdOut,
|
|
|
- 1059 "twophase reenter failed");
|
|
|
- 1060 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 1061 END;
|
|
|
- 1062 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
- 1063 QbeGen.BeginFunc("");
|
|
|
- 1064 Block(rnm);
|
|
|
- 1065 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
- 1066 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
- 1067 Lower.ScopeLeave;
|
|
|
- 1068 SymTab.CloseProc;
|
|
|
- 1069 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
- 1070 INC(rp)
|
|
|
- 1071 END;
|
|
|
- 1072 SymTab.OrderCheckOff; rErrs := M2S.errors;
|
|
|
- 1073 repassing := FALSE;
|
|
|
- 1074 M2S.PopPos;
|
|
|
- 1075 sym := rSym; errDist := rErr;
|
|
|
- 1076 M2S.errors := rErrs;
|
|
|
- 1077
|
|
|
- 1078 astDecl := rDecl; astStmt := rStmt
|
|
|
- 1079 END; .)
|
|
|
- 1080 "END"
|
|
|
- 1081 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 1082 FlushPend;
|
|
|
- 1083 k := 0;
|
|
|
- 1084 WHILE k < SymTab.FwdPending() DO
|
|
|
- 1085 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 1086 IF unres THEN SemError(201) END;
|
|
|
- 1087 INC(k)
|
|
|
- 1088 END;
|
|
|
- 1089 SymTab.FwdClear;
|
|
|
- 1090
|
|
|
- 1091 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 1092 SemError(202) END;
|
|
|
- 1093 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 1094 AST.SetChild(astNode, 0,
|
|
|
- 1095 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 1096 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 1097 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 1098 AST.SetChild(astNode, 3, astImp);
|
|
|
- 1099 astUnit := astNode;
|
|
|
- 1100 CheckGotos;
|
|
|
- 1101 SymTab.EndUnit; .) .
|
|
|
- 1102 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1103 = (. astSeq := AST.NoNode;
|
|
|
- 1104 astTail := AST.NoNode; .)
|
|
|
- 1105 { (. astDecl := AST.NoNode; .)
|
|
|
- 1106 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
- 1107 | NestedModule ";" | ClassItem ";" )
|
|
|
- 1108 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1109 astSeq, astTail, astDecl); .) }
|
|
|
- 1110 (. astDecl := astSeq; .) .
|
|
|
- 1111 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
- 1112 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
- 1113 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
- 1114 scope at END. *)
|
|
|
- 1115 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 1116 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
- 1117 expCount, k: CARDINAL;
|
|
|
- 1118 astNode, nImp, nImpTail:
|
|
|
- 1119 AST.Node; .)
|
|
|
- 1120 = "MODULE"
|
|
|
- 1121 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
- 1122 SymTab.KindModule) THEN
|
|
|
- 1123 SemError(200) END;
|
|
|
- 1124 SymTab.PushScope;
|
|
|
- 1125 expCount := 0;
|
|
|
- 1126 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 1127 AST.SetChild(astNode, 0,
|
|
|
- 1128 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 1129 astStmt := AST.NoNode;
|
|
|
- 1130 astDecl := AST.NoNode;
|
|
|
- 1131 nImp := AST.NoNode;
|
|
|
- 1132 nImpTail := AST.NoNode; .)
|
|
|
- 1133 [ Priority ]
|
|
|
- 1134 ";"
|
|
|
- 1135 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1136 nImp, nImpTail, astDecl); .) }
|
|
|
- 1137 [ "EXPORT" [ "QUALIFIED" | "UNQUALIFIED" ]
|
|
|
- 1138 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
- 1139 { "," GetIdent<expNames[expCount]>
|
|
|
- 1140 (. INC(expCount); .) }
|
|
|
- 1141 ";" ]
|
|
|
- 1142 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 1143 [ "BEGIN" (. astStmt := AST.NoNode;
|
|
|
- 1144 .)
|
|
|
- 1145 [ StatSeq ] ]
|
|
|
- 1146 "END"
|
|
|
- 1147 GetIdent<m2> (. AST.SetChild(astNode, 1, astDecl);
|
|
|
- 1148 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 1149 AST.SetChild(astNode, 3, nImp);
|
|
|
- 1150 astDecl := astNode;
|
|
|
- 1151 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 1152 SemError(202) END;
|
|
|
- 1153 k := 0;
|
|
|
- 1154 WHILE k < expCount DO
|
|
|
- 1155 SymTab.ExportUp(expNames[k]);
|
|
|
- 1156 INC(k)
|
|
|
- 1157 END;
|
|
|
- 1158 SymTab.PopScope; .) .
|
|
|
- 1159 Priority
|
|
|
- 1160 = "[" integer "]" (. SemError(230); .) .
|
|
|
- 1161 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
- 1162 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
- 1163 materializes on first use (Design). *)
|
|
|
- 1164 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
- 1165 import lines don't fail); a known module's missing export is
|
|
|
- 1166 201. *)
|
|
|
- 1167 Import (. VAR n: SymTab.Name;
|
|
|
- 1168 astImport: AST.Node; .)
|
|
|
- 1169 = "FROM"
|
|
|
- 1170 GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
|
|
|
- 1171 AST.SetChild(astImport, 0,
|
|
|
- 1172 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1173 "IMPORT"
|
|
|
- 1174 ImpList<n, astImport> ";" (. astDecl := astImport; .)
|
|
|
- 1175 | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
|
|
|
- 1176 ImpModList<astImport> ";" (. astDecl := astImport; .) .
|
|
|
- 1177 ImpList<mod: SymTab.Name; node: AST.Node>
|
|
|
- 1178 (. VAR n: SymTab.Name; .)
|
|
|
- 1179 = ImpName<mod, node>
|
|
|
- 1180 { "," ImpName<mod, node> } .
|
|
|
- 1181 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
- 1182 accepted and ignored: the built-in applies regardless. *)
|
|
|
- 1183 ImpName<mod: SymTab.Name; node: AST.Node>
|
|
|
- 1184 (. VAR n: SymTab.Name; .)
|
|
|
- 1185 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 1186 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1187 IF SymTab.Equal(mod, "libc") THEN
|
|
|
- 1188 (* intrinsic C library:
|
|
|
- 1189 permissive external *)
|
|
|
- 1190 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
- 1191 SemError(201) END;
|
|
|
- 1192 Lower.NoteCProc(n)
|
|
|
- 1193 ELSIF SymTab.ModKnown(mod)
|
|
|
- 1194 AND NOT SymTab.Equal(mod,
|
|
|
- 1195 "SYSTEM") THEN
|
|
|
- 1196 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
- 1197 SemError(201)
|
|
|
- 1198 ELSE Lower.NoteImportedProc(n)
|
|
|
- 1199 END
|
|
|
- 1200 END; .)
|
|
|
- 1201 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
- 1202 | "CHR" | "ORD" | "VAL" | "ABS" | "CAP"
|
|
|
- 1203 | "ODD" | "TRUNC" | "FLOAT"
|
|
|
- 1204 | "UCHR" | "CHR8" | "UORD"
|
|
|
- 1205 | "INC" | "DEC"
|
|
|
- 1206 | "SHIFT" | "ROTATE" | "CAST" | "CONVERT" | "MIN" | "MAX"
|
|
|
- 1207 | "INCL" | "EXCL" | "NEW" | "DISPOSE" | "LOC" ) .
|
|
|
- 1208 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
- 1209 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 1210 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1211 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 1212 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
- 1213 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
- 1214 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
- 1215 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
- 1216 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
- 1217 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
- 1218 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1219 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
- 1220 astSeq := AST.NoNode;
|
|
|
- 1221 astTail := AST.NoNode; .)
|
|
|
- 1222 { (. astDecl := AST.NoNode; .)
|
|
|
- 1223 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
- 1224 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1225 astSeq, astTail, astDecl); .) }
|
|
|
- 1226 (. SymTab.EndTypeBlock;
|
|
|
- 1227 astDecl := astSeq; .) .
|
|
|
- 1228 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
- 1229 t, op: SymTab.TypeIndex;
|
|
|
- 1230 astNode: AST.Node; .)
|
|
|
- 1231 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
- 1232 IF op = SymTab.InvalidType THEN
|
|
|
- 1233 IF NOT SymTab.Enter(n,
|
|
|
- 1234 SymTab.KindType) THEN
|
|
|
- 1235 SemError(200) END
|
|
|
- 1236 END; .)
|
|
|
- 1237 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
- 1238 AST.SetChild(astNode, 0,
|
|
|
- 1239 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1240 AST.SetTy(astNode, t);
|
|
|
- 1241 astDecl := astNode;
|
|
|
- 1242 IF op # SymTab.InvalidType THEN
|
|
|
- 1243 SymTab.SetTarget(op, t)
|
|
|
- 1244 ELSE SymTab.SetSymType(n, t)
|
|
|
- 1245 END;
|
|
|
- 1246 IF SymTab.EnterEnumLits(t) > 0 THEN END; .)
|
|
|
- 1247 | (. IF op # SymTab.InvalidType THEN
|
|
|
- 1248 (* stays opaque *)
|
|
|
- 1249 ELSIF NOT isDef THEN
|
|
|
- 1250 SemError(231)
|
|
|
- 1251 ELSE SymTab.SetSymType(n,
|
|
|
- 1252 SymTab.NewAlias()) END; .) ) .
|
|
|
- 1253 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 1254 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
- 1255 | Subrange<t>
|
|
|
- 1256 | Enum<t>
|
|
|
- 1257 | ArrayType<t, allowOpen>
|
|
|
- 1258 | SetType<t>
|
|
|
- 1259 | RecordType<t>
|
|
|
- 1260 | PointerType<t>
|
|
|
- 1261 | ProcType<t> .
|
|
|
- 1262 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
- 1263 = "POINTER" "TO" (. allowFwdType := TRUE; .)
|
|
|
- 1264 Type<base, FALSE> (. allowFwdType := FALSE;
|
|
|
- 1265 t := SymTab.NewPtr(base); .) .
|
|
|
- 1266 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
- 1267 are code pointers; params are collected into the descriptor. *)
|
|
|
- 1268 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
- 1269 isV: BOOLEAN; .)
|
|
|
- 1270 = ( "PROCEDURE" | "PROC" ) (. allowFwdType := FALSE;
|
|
|
- 1271 res := SymTab.InvalidType;
|
|
|
- 1272 t := SymTab.NewProcType(res); .)
|
|
|
- 1273 [ "(" [ ProcTypeSection<t>
|
|
|
- 1274 { (";" | ",") ProcTypeSection<t> } ] ")" ]
|
|
|
- 1275 [ ":" ( TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .)
|
|
|
- 1276 | "PROC" (. (* PROC as a result type: the
|
|
|
- 1277 pervasive procedure value
|
|
|
- 1278 type (ISO/PIM) *)
|
|
|
- 1279 SymTab.SetProcTypeRes(t,
|
|
|
- 1280 SymTab.AddrType()); .) ) ] .
|
|
|
- 1281 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
- 1282 isV: BOOLEAN;
|
|
|
- 1283 cnt, k: CARDINAL;
|
|
|
- 1284 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
- 1285 = (. isV := FALSE; cnt := 0; .)
|
|
|
- 1286 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1287 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
- 1288 { "," ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
- 1289 | (. (* a comma followed by a type
|
|
|
- 1290 (possibly VAR) ends the name
|
|
|
- 1291 list: the collected names
|
|
|
- 1292 were types, not names *)
|
|
|
- 1293 k := 0;
|
|
|
- 1294 WHILE k < cnt DO
|
|
|
- 1295 SymTab.ProcTypeAdd(t, isV,
|
|
|
- 1296 SymTab.SymType(names[k]));
|
|
|
- 1297 INC(k)
|
|
|
- 1298 END;
|
|
|
- 1299 cnt := 0; .)
|
|
|
- 1300 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1301 Type<pt, TRUE> (. SymTab.ProcTypeAdd(t, isV, pt); .) ) }
|
|
|
- 1302 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
- 1303 WHILE k < cnt DO
|
|
|
- 1304 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 1305 INC(k)
|
|
|
- 1306 END; .)
|
|
|
- 1307 | (. (* type-only parameter list:
|
|
|
- 1308 each collected name is a
|
|
|
- 1309 type (CHAR, a declared type,
|
|
|
- 1310 ... or the GNU shorthand) *)
|
|
|
- 1311 k := 0;
|
|
|
- 1312 WHILE k < cnt DO
|
|
|
- 1313 IF IsTypeName(names[k]) THEN
|
|
|
- 1314 pt := SymTab.SymType(names[k])
|
|
|
- 1315 ELSE SemError(201);
|
|
|
- 1316 pt := SymTab.InvalidType
|
|
|
- 1317 END;
|
|
|
- 1318 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 1319 INC(k)
|
|
|
- 1320 END; .) )
|
|
|
- 1321 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
- 1322 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
- 1323 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
- 1324 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
- 1325 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
- 1326 out. The PIM/ISO multi-index form repeats the bracket group
|
|
|
- 1327 ("ARRAY [lo..hi], [lo..hi] OF T"); the bounds of every group
|
|
|
- 1328 nest in the same inside-out order as the comma list. Bounds are
|
|
|
- 1329 folded literals (int/char); anything else 230. Bare-type indices
|
|
|
- 1330 ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
- 1331 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 1332 (. VAR elem: SymTab.TypeIndex;
|
|
|
- 1333 eb: SymTab.Name;
|
|
|
- 1334 ok: BOOLEAN;
|
|
|
- 1335 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
- 1336 nb, k: CARDINAL;
|
|
|
- 1337 idx: SymTab.TypeIndex;
|
|
|
- 1338 ilo, ihi: INTEGER; .)
|
|
|
- 1339 = "ARRAY" (. allowFwdType := FALSE; .)
|
|
|
- 1340 ( "OF"
|
|
|
- 1341 Type<elem, FALSE> (. LexName(eb); (* the element ident *)
|
|
|
- 1342 IF NOT allowOpen THEN
|
|
|
- 1343 SemError(230) END;
|
|
|
- 1344 t := SymTab.NewOpenArray(elem);
|
|
|
- 1345 IF SymTab.Equal(eb, "BYTE") THEN
|
|
|
- 1346 SymTab.MarkByteBuf(t) END; .)
|
|
|
- 1347 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
- 1348 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
- 1349 type's ordinal bounds give the
|
|
|
- 1350 [lo..hi] pair *)
|
|
|
- 1351 IF SymTab.TypeBounds(idx, ilo,
|
|
|
- 1352 ihi)
|
|
|
- 1353 THEN t := SymTab.NewArrayB(elem,
|
|
|
- 1354 ilo, ihi)
|
|
|
- 1355 ELSE SemError(230);
|
|
|
- 1356 t := SymTab.InvalidType
|
|
|
- 1357 END; .)
|
|
|
- 1358 | "[" (. SymTab.BoundBegin; ok := TRUE;
|
|
|
- 1359 nb := 0; .)
|
|
|
- 1360 BoundPair<ok>
|
|
|
- 1361 { "," BoundPair<ok> }
|
|
|
- 1362 "]" (. (* snapshot this bracket group
|
|
|
- 1363 before the element type, which
|
|
|
- 1364 reuses the bound buffer for a
|
|
|
- 1365 nested ARRAY *)
|
|
|
- 1366 IF nb + SymTab.BoundCount() >
|
|
|
- 1367 HIGH(bnds) + 1 THEN
|
|
|
- 1368 SemError(230); ok := FALSE
|
|
|
- 1369 ELSE
|
|
|
- 1370 k := 0;
|
|
|
- 1371 WHILE k < SymTab.BoundCount() DO
|
|
|
- 1372 bnds[nb] := SymTab.BoundLo(k);
|
|
|
- 1373 bndh[nb] := SymTab.BoundHi(k);
|
|
|
- 1374 INC(k); INC(nb)
|
|
|
- 1375 END
|
|
|
- 1376 END; .)
|
|
|
- 1377 { "," "[" (. SymTab.BoundBegin; .)
|
|
|
- 1378 BoundPair<ok>
|
|
|
- 1379 { "," BoundPair<ok> }
|
|
|
- 1380 "]" (. IF nb + SymTab.BoundCount() >
|
|
|
- 1381 HIGH(bnds) + 1 THEN
|
|
|
- 1382 SemError(230); ok := FALSE
|
|
|
- 1383 ELSE
|
|
|
- 1384 k := 0;
|
|
|
- 1385 WHILE k < SymTab.BoundCount() DO
|
|
|
- 1386 bnds[nb] := SymTab.BoundLo(k);
|
|
|
- 1387 bndh[nb] := SymTab.BoundHi(k);
|
|
|
- 1388 INC(k); INC(nb)
|
|
|
- 1389 END
|
|
|
- 1390 END; .) }
|
|
|
- 1391 "OF" Type<elem, FALSE>
|
|
|
- 1392 (. IF ok THEN
|
|
|
- 1393 k := nb;
|
|
|
- 1394 WHILE k > 0 DO
|
|
|
- 1395 DEC(k);
|
|
|
- 1396 elem := SymTab.NewArrayB(
|
|
|
- 1397 elem, bnds[k], bndh[k])
|
|
|
- 1398 END;
|
|
|
- 1399 t := elem
|
|
|
- 1400 ELSE t := SymTab.InvalidType
|
|
|
- 1401 END; .) ) .
|
|
|
- 1402 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1403 qlo, qhi: QbeGen.QVal;
|
|
|
- 1404 lo, hi: INTEGER;
|
|
|
- 1405 cl, cl2: INTEGER; .)
|
|
|
- 1406 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1407 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1408 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1409 ok := FALSE
|
|
|
- 1410 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
- 1411 cl2 := SymTab.ClassOf(thi);
|
|
|
- 1412 IF ((cl # SymTab.ClInt)
|
|
|
- 1413 AND (cl # SymTab.ClChar)
|
|
|
- 1414 AND (cl # SymTab.ClBool)
|
|
|
- 1415 AND (cl # SymTab.ClEnum)
|
|
|
- 1416 AND (cl # SymTab.ClByte)
|
|
|
- 1417 AND (cl # SymTab.ClSByte))
|
|
|
- 1418 OR ((cl2 # SymTab.ClInt)
|
|
|
- 1419 AND (cl2 # SymTab.ClChar)
|
|
|
- 1420 AND (cl2 # SymTab.ClBool)
|
|
|
- 1421 AND (cl2 # SymTab.ClEnum)
|
|
|
- 1422 AND (cl2 # SymTab.ClByte)
|
|
|
- 1423 AND (cl2 # SymTab.ClSByte)) THEN
|
|
|
- 1424 SemError(230); ok := FALSE
|
|
|
- 1425 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1426 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1427 OR (lo > hi) THEN
|
|
|
- 1428 SemError(230); ok := FALSE
|
|
|
- 1429 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
- 1430 SemError(230); ok := FALSE
|
|
|
- 1431 END;
|
|
|
- 1432 END; .) .
|
|
|
- 1433 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
- 1434 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
- 1435 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
- 1436 comparison across suitable bases are lenient (masks over min
|
|
|
- 1437 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
- 1438 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
- 1439 blo, bhi, bspan: INTEGER;
|
|
|
- 1440 bcls: INTEGER; .)
|
|
|
- 1441 = "SET" (. allowFwdType := FALSE; .)
|
|
|
- 1442 "OF" Type<base, FALSE>
|
|
|
- 1443 (. IF base = SymTab.InvalidType THEN
|
|
|
- 1444 t := SymTab.InvalidType
|
|
|
- 1445 ELSIF SymTab.Unresolved(base) THEN
|
|
|
- 1446 (* an opaque/formal base: defer
|
|
|
- 1447 the span check until the
|
|
|
- 1448 base is completed *)
|
|
|
- 1449 t := SymTab.NewSet(base)
|
|
|
- 1450 ELSE bcls :=
|
|
|
- 1451 SymTab.ClassOf(base);
|
|
|
- 1452 (* a subrange keeps its own
|
|
|
- 1453 span even when its base is
|
|
|
- 1454 CHAR/BOOLEAN/an enum *)
|
|
|
- 1455 IF SymTab.SubBounds(base,
|
|
|
- 1456 blo, bhi) THEN
|
|
|
- 1457 bspan := bhi - blo + 1
|
|
|
- 1458 ELSIF bcls = SymTab.ClBool THEN
|
|
|
- 1459 blo := 0; bspan := 2
|
|
|
- 1460 ELSIF bcls = SymTab.ClChar THEN
|
|
|
- 1461 blo := 0; bspan := 256
|
|
|
- 1462 ELSIF bcls = SymTab.ClByte THEN
|
|
|
- 1463 blo := 0; bspan := 256
|
|
|
- 1464 ELSIF bcls = SymTab.ClSByte THEN
|
|
|
- 1465 blo := -128; bspan := 256
|
|
|
- 1466 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
- 1467 blo := 0;
|
|
|
- 1468 bspan := VAL(INTEGER,
|
|
|
- 1469 SymTab.EnumCount(base))
|
|
|
- 1470 ELSE bspan := 0 END;
|
|
|
- 1471 IF (bspan <= 0)
|
|
|
- 1472 OR (bspan > 65536) THEN
|
|
|
- 1473 SemError(230);
|
|
|
- 1474 t := SymTab.InvalidType
|
|
|
- 1475 ELSE t := SymTab.NewSet(base)
|
|
|
- 1476 END
|
|
|
- 1477 END; .) .
|
|
|
- 1478 (* Records: flat blobs; array fields are pointers to static
|
|
|
- 1479 descriptors (locked amendment), nested records inline. Field
|
|
|
- 1480 offsets static and declaration-ordered. *)
|
|
|
- 1481 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
- 1482 variant part is a `CASE ... END` item; because it starts with the
|
|
|
- 1483 CASE keyword it is unambiguously distinguishable from a field
|
|
|
- 1484 (which starts with an identifier). *)
|
|
|
- 1485 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
- 1486 tagOk: BOOLEAN; .)
|
|
|
- 1487 = "RECORD" (. allowFwdType := FALSE;
|
|
|
- 1488 t := SymTab.NewRecord(); .)
|
|
|
- 1489 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
- 1490 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
- 1491 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
- 1492 = RecField<rec>
|
|
|
- 1493 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 1494 (* A variant part: CASE [tag] : Type OF variants. gm2 extensions:
|
|
|
- 1495 an untagged inner CASE (no tag field), empty arms and ELSE arms. *)
|
|
|
- 1496 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
- 1497 tagN: SymTab.Name;
|
|
|
- 1498 tagged: BOOLEAN; .)
|
|
|
- 1499 = "CASE" (. SymTab.ResetFields(rec);
|
|
|
- 1500 tagged := FALSE; .)
|
|
|
- 1501 [ GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1502 tagN) THEN
|
|
|
- 1503 SemError(200) END;
|
|
|
- 1504 tagged := TRUE; .) ]
|
|
|
- 1505 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
- 1506 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
- 1507 SemError(224)
|
|
|
- 1508 END;
|
|
|
- 1509 IF tagged THEN
|
|
|
- 1510 SymTab.FixPendingF(rec, tagT);
|
|
|
- 1511 SymTab.SetVariantTag(rec, tagN)
|
|
|
- 1512 END; .)
|
|
|
- 1513 "OF"
|
|
|
- 1514 RecFieldList<rec>
|
|
|
- 1515 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
- 1516 RecFieldList<rec> }
|
|
|
- 1517 [ "ELSE" ]
|
|
|
- 1518 "END" .
|
|
|
- 1519 (* A variant branch: `labels : fields` (fields and their trailing ";"
|
|
|
- 1520 optional, gm2), `ELSE`, or empty (the extra "|" separators gm2
|
|
|
- 1521 tolerates). A branch may itself contain a nested variant CASE. *)
|
|
|
- 1522 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
- 1523 lv1, lv2: QbeGen.QVal; .)
|
|
|
- 1524 = [ ( VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ]
|
|
|
- 1525 { "," VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] }
|
|
|
- 1526 ":"
|
|
|
- 1527 [ ArmField<rec> { ";" [ ArmField<rec> ] } ]
|
|
|
- 1528 | "ELSE" ) ] .
|
|
|
- 1529 ArmField<rec: SymTab.TypeIndex>
|
|
|
- 1530 = RecField<rec>
|
|
|
- 1531 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 1532 (* Variant case label: a constant (or a constant range). Values are
|
|
|
- 1533 not interpreted (the layout overlays regardless). *)
|
|
|
- 1534 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 1535 (. VAR lname: SymTab.Name; .)
|
|
|
- 1536 = ( ident (. LexName(lname);
|
|
|
- 1537 QbeGen.CopyOp("0", q);
|
|
|
- 1538 t := SymTab.IntType(); .)
|
|
|
- 1539 | integer (. LexString(lname);
|
|
|
- 1540 QbeGen.CopyOp("0", q);
|
|
|
- 1541 t := SymTab.IntType(); .)
|
|
|
- 1542 | charConst (. LexString(lname);
|
|
|
- 1543 QbeGen.CopyOp("0", q);
|
|
|
- 1544 t := SymTab.CharType(); .) ) .
|
|
|
- 1545 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1546 t2: SymTab.TypeIndex; .)
|
|
|
- 1547 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
- 1548 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
- 1549 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1550 n) THEN
|
|
|
- 1551 SemError(200) END; .)
|
|
|
- 1552 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1553 n) THEN
|
|
|
- 1554 SemError(200) END; .) } .
|
|
|
- 1555 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
- 1556 k: INTEGER;
|
|
|
- 1557 dotted: BOOLEAN; .)
|
|
|
- 1558 = GetIdent<n> (. dotted := FALSE;
|
|
|
- 1559 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 1560 (* declaration before use: an
|
|
|
- 1561 undeclared type is 201,
|
|
|
- 1562 except as a POINTER's base
|
|
|
- 1563 (allowFwdType) *)
|
|
|
- 1564 k := -1;
|
|
|
- 1565 IF allowFwdType THEN
|
|
|
- 1566 t := SymTab.ForwardType(n)
|
|
|
- 1567 ELSE t := SymTab.InvalidType
|
|
|
- 1568 END;
|
|
|
- 1569 IF t = SymTab.InvalidType THEN
|
|
|
- 1570 SemError(201)
|
|
|
- 1571 END
|
|
|
- 1572 ELSE k := SymTab.SymKind(n);
|
|
|
- 1573 IF (k = SymTab.KindType)
|
|
|
- 1574 OR (k = SymTab.KindPredef) THEN
|
|
|
- 1575 t := SymTab.SymType(n)
|
|
|
- 1576 ELSE t := SymTab.InvalidType
|
|
|
- 1577 END
|
|
|
- 1578 END; .)
|
|
|
- 1579 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
- 1580 IF k = SymTab.KindModule THEN
|
|
|
- 1581 t := SymTab.QualType(n, qid);
|
|
|
+ 778 AND (SymTab.SymKind(nm) = SymTab.KindProc) THEN
|
|
|
+ 779 aKind := 2; at := SymTab.SymType(nm);
|
|
|
+ 780 IF NOT SymTab.SymMod(nm, amod) THEN
|
|
|
+ 781 amod[0] := CHR(0) END
|
|
|
+ 782 ELSIF SymTab.Lookup(nm)
|
|
|
+ 783 AND (SymTab.SymKind(nm) = SymTab.KindConst) THEN
|
|
|
+ 784 isV := TRUE; aKind := 1; at := SymTab.SymType(nm);
|
|
|
+ 785 IF NOT SymTab.GetSymVal(nm, s) THEN s[0] := CHR(0) END;
|
|
|
+ 786 CopyNm(s, nm)
|
|
|
+ 787 ELSE SemError(201)
|
|
|
+ 788 END; .) )
|
|
|
+ 789 (. IF refN <= HIGH(refActual) THEN
|
|
|
+ 790 IF aKind = 0 THEN
|
|
|
+ 791 IF isV THEN refKind[refN] := 1
|
|
|
+ 792 ELSE refKind[refN] := 0 END
|
|
|
+ 793 ELSE refKind[refN] := aKind END;
|
|
|
+ 794 refActual[refN] := at;
|
|
|
+ 795 k := 0;
|
|
|
+ 796 WHILE (k <= HIGH(refVal[refN])) AND (nm[k] # CHR(0)) DO
|
|
|
+ 797 refVal[refN][k] := nm[k]; INC(k) END;
|
|
|
+ 798 refVal[refN][k] := CHR(0);
|
|
|
+ 799 k := 0;
|
|
|
+ 800 WHILE (k <= HIGH(refMod[refN])) AND (amod[k] # CHR(0)) DO
|
|
|
+ 801 refMod[refN][k] := amod[k]; INC(k) END;
|
|
|
+ 802 refMod[refN][k] := CHR(0);
|
|
|
+ 803 INC(refN)
|
|
|
+ 804 END; .) .
|
|
|
+ 805 Unit
|
|
|
+ 806 = (. isGen := FALSE;
|
|
|
+ 807 allowDefer := FALSE;
|
|
|
+ 808 allowFwdType := FALSE;
|
|
|
+ 809 repassing := FALSE; .)
|
|
|
+ 810 [ "GENERIC" (. isGen := TRUE; .) ]
|
|
|
+ 811 ( DefUnit | ImplUnit | ProgModule ) .
|
|
|
+ 812 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
+ 813 and one program (last) into one image. Units share the symbol
|
|
|
+ 814 table; imports materialize exported names. *)
|
|
|
+ 815 DefUnit (. VAR m1, m2, pn: SymTab.Name;
|
|
|
+ 816 g: SymTab.Name;
|
|
|
+ 817 astSeq, astTail, astProc: AST.Node; .)
|
|
|
+ 818 = (. refN := 0; refSeen := FALSE; .)
|
|
|
+ 819 "DEFINITION" "MODULE"
|
|
|
+ 820 [ "FOR" string ] (* ISO foreign module: FOR "C" *)
|
|
|
+ 821 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
+ 822 IF instActive THEN
|
|
|
+ 823 IF NOT SymTab.Reenter(m1,
|
|
|
+ 824 SymTab.UnitDef) THEN
|
|
|
+ 825 SemError(200) END
|
|
|
+ 826 ELSIF NOT SymTab.BeginDef(m1) THEN
|
|
|
+ 827 SemError(200) END;
|
|
|
+ 828 QbeGen.SetModule(m1);
|
|
|
+ 829 CopyNm(m1, unitName);
|
|
|
+ 830 unitWasGen := isGen
|
|
|
+ 831 AND NOT instActive;
|
|
|
+ 832 unitWasDef := TRUE; .)
|
|
|
+ 833 [ GenericFormals ]
|
|
|
+ 834 ( ";"
|
|
|
+ 835 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 836 astImp, astImpTail, astDecl); .) }
|
|
|
+ 837 [ "EXPORT" [ "QUALIFIED" | "UNQUALIFIED" ] (. (* definition-module export
|
|
|
+ 838 list: parsed, and the
|
|
|
+ 839 names are already exported
|
|
|
+ 840 by the module scope *) .)
|
|
|
+ 841 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
+ 842 (. astSeq := AST.NoNode;
|
|
|
+ 843 astTail := AST.NoNode; .)
|
|
|
+ 844 { ConstBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 845 astSeq, astTail, astDecl); .)
|
|
|
+ 846 | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 847 astSeq, astTail, astDecl); .)
|
|
|
+ 848 | VarBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 849 astSeq, astTail, astDecl); .)
|
|
|
+ 850 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 851 (. (* a heading only: record it so
|
|
|
+ 852 Lower can replay it *)
|
|
|
+ 853 astProc := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 854 AST.SetOp(astProc, 0);
|
|
|
+ 855 AST.SetChild(astProc, 0,
|
|
|
+ 856 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 857 AstAppend(AST.NkDeclSeq,
|
|
|
+ 858 astSeq, astTail, astProc);
|
|
|
+ 859 Lower.NoteProcNode(astProc);
|
|
|
+ 860 Lower.ScopeLeave;
|
|
|
+ 861 SymTab.CloseProc;
|
|
|
+ 862 QbeGen.AbortFunc; .) }
|
|
|
+ 863 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 864 AST.SetChild(astUnit, 0,
|
|
|
+ 865 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 866 AST.SetChild(astUnit, 1, astSeq);
|
|
|
+ 867 AST.SetChild(astUnit, 3, astImp);
|
|
|
+ 868 astDecl := AST.NoNode;
|
|
|
+ 869 astStmt := AST.NoNode; .)
|
|
|
+ 870 "END"
|
|
|
+ 871 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 872 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 873 SemError(202) END;
|
|
|
+ 874 SymTab.EndUnit; .)
|
|
|
+ 875 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
+ 876 (. CopyNm(m1, refInst);
|
|
|
+ 877 CopyNm(g, refGen);
|
|
|
+ 878 refSeen := TRUE; refIsDef := TRUE;
|
|
|
+ 879 astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 880 AST.SetChild(astUnit, 0,
|
|
|
+ 881 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 882 astDecl := AST.NoNode;
|
|
|
+ 883 astStmt := AST.NoNode; .)
|
|
|
+ 884 "END"
|
|
|
+ 885 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 886 SemError(202) END;
|
|
|
+ 887 SymTab.EndUnit; .) ) .
|
|
|
+ 888 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
+ 889 g: SymTab.Name;
|
|
|
+ 890 k: CARDINAL;
|
|
|
+ 891 rp: CARDINAL;
|
|
|
+ 892 rpOk: BOOLEAN;
|
|
|
+ 893 rErrs: INTEGER;
|
|
|
+ 894 rDecl, rStmt: AST.Node;
|
|
|
+ 895 rnm: SymTab.Name;
|
|
|
+ 896 rSym, rErr: CARDINAL;
|
|
|
+ 897 fname: SymTab.Name;
|
|
|
+ 898 unres: BOOLEAN;
|
|
|
+ 899 astNode: AST.Node; .)
|
|
|
+ 900 = (. refN := 0; refSeen := FALSE; .)
|
|
|
+ 901 "IMPLEMENTATION" "MODULE"
|
|
|
+ 902 [ "FOR" string ] (* ISO foreign module: FOR "C" *)
|
|
|
+ 903 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
+ 904 IF instActive THEN
|
|
|
+ 905 IF NOT SymTab.Reenter(m1,
|
|
|
+ 906 SymTab.UnitImpl) THEN
|
|
|
+ 907 SemError(201) END
|
|
|
+ 908 ELSIF NOT SymTab.BeginImpl(m1) THEN
|
|
|
+ 909 SemError(201) END;
|
|
|
+ 910 astStmt := AST.NoNode;
|
|
|
+ 911 astDecl := AST.NoNode;
|
|
|
+ 912 astImp := AST.NoNode;
|
|
|
+ 913 astImpTail := AST.NoNode;
|
|
|
+ 914 nPendVar := 0;
|
|
|
+ 915 CopyNm(m1, unitName);
|
|
|
+ 916 unitWasGen := isGen AND NOT instActive;
|
|
|
+ 917 unitWasDef := FALSE;
|
|
|
+ 918 QbeGen.SetModule(m1); .)
|
|
|
+ 919 [ GenericFormals ]
|
|
|
+ 920 ( ";"
|
|
|
+ 921 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 922 astImp, astImpTail, astDecl); .) }
|
|
|
+ 923 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 924 [ "BEGIN" (. FlushPend;
|
|
|
+ 925 k := 0;
|
|
|
+ 926 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 927 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 928 IF unres THEN SemError(201) END;
|
|
|
+ 929 INC(k)
|
|
|
+ 930 END;
|
|
|
+ 931 SymTab.FwdClear;
|
|
|
+ 932
|
|
|
+ 933 nLab := 0; nGot := 0; .)
|
|
|
+ 934 [ StatSeq ] ]
|
|
|
+ 935 (. IF twoPhaseParse THEN
|
|
|
+ 936 rSym := sym; rErr := errDist;
|
|
|
+ 937 rDecl := astDecl; rStmt := astStmt;
|
|
|
+ 938 M2S.PushPos;
|
|
|
+ 939 repassing := TRUE;
|
|
|
+ 940 rp := 0;
|
|
|
+ 941 WHILE rp < nSpans DO
|
|
|
+ 942 k := 0;
|
|
|
+ 943 WHILE (k <= HIGH(rnm))
|
|
|
+ 944 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
+ 945 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
+ 946 END;
|
|
|
+ 947 rnm[k] := CHR(0);
|
|
|
+ 948 M2S.SeekTo(spanStart[rp]);
|
|
|
+ 949 Adv;
|
|
|
+ 950 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
+ 951 IF NOT rpOk THEN
|
|
|
+ 952 FileIO.WriteString(FileIO.StdOut,
|
|
|
+ 953 "twophase reenter failed");
|
|
|
+ 954 FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ 955 END;
|
|
|
+ 956 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
+ 957 QbeGen.BeginFunc("");
|
|
|
+ 958 Block(rnm);
|
|
|
+ 959 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
+ 960 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
+ 961 Lower.ScopeLeave;
|
|
|
+ 962 SymTab.CloseProc;
|
|
|
+ 963 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
+ 964 INC(rp)
|
|
|
+ 965 END;
|
|
|
+ 966 SymTab.OrderCheckOff; rErrs := M2S.errors;
|
|
|
+ 967 repassing := FALSE;
|
|
|
+ 968 M2S.PopPos;
|
|
|
+ 969 sym := rSym; errDist := rErr;
|
|
|
+ 970 M2S.errors := rErrs;
|
|
|
+ 971
|
|
|
+ 972 astDecl := rDecl; astStmt := rStmt
|
|
|
+ 973 END; .)
|
|
|
+ 974 "END"
|
|
|
+ 975 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 976 FlushPend;
|
|
|
+ 977 k := 0;
|
|
|
+ 978 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 979 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 980 IF unres THEN SemError(201) END;
|
|
|
+ 981 INC(k)
|
|
|
+ 982 END;
|
|
|
+ 983 SymTab.FwdClear;
|
|
|
+ 984
|
|
|
+ 985 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 986 AST.SetChild(astNode, 0,
|
|
|
+ 987 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 988 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 989 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 990 AST.SetChild(astNode, 3, astImp);
|
|
|
+ 991 astUnit := astNode;
|
|
|
+ 992 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 993 SemError(202) END;
|
|
|
+ 994 CheckGotos;
|
|
|
+ 995 SymTab.EndUnit; .)
|
|
|
+ 996 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
+ 997 (. CopyNm(m1, refInst);
|
|
|
+ 998 CopyNm(g, refGen);
|
|
|
+ 999 refSeen := TRUE; refIsDef := FALSE;
|
|
|
+ 1000 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 1001 AST.SetChild(astNode, 0,
|
|
|
+ 1002 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 1003 astDecl := AST.NoNode;
|
|
|
+ 1004 astStmt := AST.NoNode; .)
|
|
|
+ 1005 { Import (. (* refinement unit import *) .) }
|
|
|
+ 1006 "END"
|
|
|
+ 1007 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 1008 SemError(202) END;
|
|
|
+ 1009 SymTab.EndUnit; .) ) .
|
|
|
+ 1010 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 1011 k: CARDINAL;
|
|
|
+ 1012 rp: CARDINAL;
|
|
|
+ 1013 rpOk: BOOLEAN;
|
|
|
+ 1014 rErrs: INTEGER;
|
|
|
+ 1015 rDecl, rStmt: AST.Node;
|
|
|
+ 1016 rnm: SymTab.Name;
|
|
|
+ 1017 rSym, rErr: CARDINAL;
|
|
|
+ 1018 fname: SymTab.Name;
|
|
|
+ 1019 unres: BOOLEAN;
|
|
|
+ 1020 astNode: AST.Node; .)
|
|
|
+ 1021 = "MODULE"
|
|
|
+ 1022 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
+ 1023 SemError(200) END;
|
|
|
+ 1024 astStmt := AST.NoNode;
|
|
|
+ 1025 astDecl := AST.NoNode;
|
|
|
+ 1026 astImp := AST.NoNode;
|
|
|
+ 1027 astImpTail := AST.NoNode;
|
|
|
+ 1028 nPendVar := 0;
|
|
|
+ 1029 QbeGen.SetModule(m1); .)
|
|
|
+ 1030 [ Priority ]
|
|
|
+ 1031 ";"
|
|
|
+ 1032 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1033 astImp, astImpTail, astDecl); .) }
|
|
|
+ 1034 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 1035 [ "BEGIN" (. FlushPend;
|
|
|
+ 1036 k := 0;
|
|
|
+ 1037 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 1038 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 1039 IF unres THEN SemError(201) END;
|
|
|
+ 1040 INC(k)
|
|
|
+ 1041 END;
|
|
|
+ 1042 SymTab.FwdClear;
|
|
|
+ 1043
|
|
|
+ 1044 nLab := 0; nGot := 0; .)
|
|
|
+ 1045 [ StatSeq ] ]
|
|
|
+ 1046 (. IF twoPhaseParse THEN
|
|
|
+ 1047 rSym := sym; rErr := errDist;
|
|
|
+ 1048 rDecl := astDecl; rStmt := astStmt;
|
|
|
+ 1049 M2S.PushPos;
|
|
|
+ 1050 repassing := TRUE;
|
|
|
+ 1051 rp := 0;
|
|
|
+ 1052 WHILE rp < nSpans DO
|
|
|
+ 1053 k := 0;
|
|
|
+ 1054 WHILE (k <= HIGH(rnm))
|
|
|
+ 1055 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
+ 1056 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
+ 1057 END;
|
|
|
+ 1058 rnm[k] := CHR(0);
|
|
|
+ 1059 M2S.SeekTo(spanStart[rp]);
|
|
|
+ 1060 Adv;
|
|
|
+ 1061 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
+ 1062 IF NOT rpOk THEN
|
|
|
+ 1063 FileIO.WriteString(FileIO.StdOut,
|
|
|
+ 1064 "twophase reenter failed");
|
|
|
+ 1065 FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ 1066 END;
|
|
|
+ 1067 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
+ 1068 QbeGen.BeginFunc("");
|
|
|
+ 1069 Block(rnm);
|
|
|
+ 1070 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
+ 1071 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
+ 1072 Lower.ScopeLeave;
|
|
|
+ 1073 SymTab.CloseProc;
|
|
|
+ 1074 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
+ 1075 INC(rp)
|
|
|
+ 1076 END;
|
|
|
+ 1077 SymTab.OrderCheckOff; rErrs := M2S.errors;
|
|
|
+ 1078 repassing := FALSE;
|
|
|
+ 1079 M2S.PopPos;
|
|
|
+ 1080 sym := rSym; errDist := rErr;
|
|
|
+ 1081 M2S.errors := rErrs;
|
|
|
+ 1082
|
|
|
+ 1083 astDecl := rDecl; astStmt := rStmt
|
|
|
+ 1084 END; .)
|
|
|
+ 1085 "END"
|
|
|
+ 1086 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 1087 FlushPend;
|
|
|
+ 1088 k := 0;
|
|
|
+ 1089 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 1090 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 1091 IF unres THEN SemError(201) END;
|
|
|
+ 1092 INC(k)
|
|
|
+ 1093 END;
|
|
|
+ 1094 SymTab.FwdClear;
|
|
|
+ 1095
|
|
|
+ 1096 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 1097 SemError(202) END;
|
|
|
+ 1098 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 1099 AST.SetChild(astNode, 0,
|
|
|
+ 1100 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 1101 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 1102 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 1103 AST.SetChild(astNode, 3, astImp);
|
|
|
+ 1104 astUnit := astNode;
|
|
|
+ 1105 CheckGotos;
|
|
|
+ 1106 SymTab.EndUnit; .) .
|
|
|
+ 1107 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1108 = (. astSeq := AST.NoNode;
|
|
|
+ 1109 astTail := AST.NoNode; .)
|
|
|
+ 1110 { (. astDecl := AST.NoNode; .)
|
|
|
+ 1111 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
+ 1112 | NestedModule ";" | ClassItem ";" )
|
|
|
+ 1113 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1114 astSeq, astTail, astDecl); .) }
|
|
|
+ 1115 (. astDecl := astSeq; .) .
|
|
|
+ 1116 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
+ 1117 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
+ 1118 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
+ 1119 scope at END. *)
|
|
|
+ 1120 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 1121 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
+ 1122 expCount, k: CARDINAL;
|
|
|
+ 1123 astNode, nImp, nImpTail:
|
|
|
+ 1124 AST.Node; .)
|
|
|
+ 1125 = "MODULE"
|
|
|
+ 1126 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
+ 1127 SymTab.KindModule) THEN
|
|
|
+ 1128 SemError(200) END;
|
|
|
+ 1129 SymTab.PushScope;
|
|
|
+ 1130 expCount := 0;
|
|
|
+ 1131 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 1132 AST.SetChild(astNode, 0,
|
|
|
+ 1133 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 1134 astStmt := AST.NoNode;
|
|
|
+ 1135 astDecl := AST.NoNode;
|
|
|
+ 1136 nImp := AST.NoNode;
|
|
|
+ 1137 nImpTail := AST.NoNode; .)
|
|
|
+ 1138 [ Priority ]
|
|
|
+ 1139 ";"
|
|
|
+ 1140 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1141 nImp, nImpTail, astDecl); .) }
|
|
|
+ 1142 [ "EXPORT" [ "QUALIFIED" | "UNQUALIFIED" ]
|
|
|
+ 1143 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
+ 1144 { "," GetIdent<expNames[expCount]>
|
|
|
+ 1145 (. INC(expCount); .) }
|
|
|
+ 1146 ";" ]
|
|
|
+ 1147 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 1148 [ "BEGIN" (. astStmt := AST.NoNode;
|
|
|
+ 1149 .)
|
|
|
+ 1150 [ StatSeq ] ]
|
|
|
+ 1151 "END"
|
|
|
+ 1152 GetIdent<m2> (. AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 1153 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 1154 AST.SetChild(astNode, 3, nImp);
|
|
|
+ 1155 astDecl := astNode;
|
|
|
+ 1156 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 1157 SemError(202) END;
|
|
|
+ 1158 k := 0;
|
|
|
+ 1159 WHILE k < expCount DO
|
|
|
+ 1160 SymTab.ExportUp(expNames[k]);
|
|
|
+ 1161 INC(k)
|
|
|
+ 1162 END;
|
|
|
+ 1163 SymTab.PopScope; .) .
|
|
|
+ 1164 Priority
|
|
|
+ 1165 = "[" integer "]" (. SemError(230); .) .
|
|
|
+ 1166 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
+ 1167 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
+ 1168 materializes on first use (Design). *)
|
|
|
+ 1169 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
+ 1170 import lines don't fail); a known module's missing export is
|
|
|
+ 1171 201. *)
|
|
|
+ 1172 Import (. VAR n: SymTab.Name;
|
|
|
+ 1173 astImport: AST.Node; .)
|
|
|
+ 1174 = "FROM"
|
|
|
+ 1175 GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
|
|
|
+ 1176 AST.SetChild(astImport, 0,
|
|
|
+ 1177 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1178 "IMPORT"
|
|
|
+ 1179 ImpList<n, astImport> ";" (. astDecl := astImport; .)
|
|
|
+ 1180 | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
|
|
|
+ 1181 ImpModList<astImport> ";" (. astDecl := astImport; .) .
|
|
|
+ 1182 ImpList<mod: SymTab.Name; node: AST.Node>
|
|
|
+ 1183 (. VAR n: SymTab.Name; .)
|
|
|
+ 1184 = ImpName<mod, node>
|
|
|
+ 1185 { "," ImpName<mod, node> } .
|
|
|
+ 1186 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
+ 1187 accepted and ignored: the built-in applies regardless. *)
|
|
|
+ 1188 ImpName<mod: SymTab.Name; node: AST.Node>
|
|
|
+ 1189 (. VAR n: SymTab.Name; .)
|
|
|
+ 1190 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 1191 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1192 IF SymTab.Equal(mod, "libc") THEN
|
|
|
+ 1193 (* intrinsic C library:
|
|
|
+ 1194 permissive external *)
|
|
|
+ 1195 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
+ 1196 SemError(201) END;
|
|
|
+ 1197 Lower.NoteCProc(n)
|
|
|
+ 1198 ELSIF SymTab.ModKnown(mod)
|
|
|
+ 1199 AND NOT SymTab.Equal(mod,
|
|
|
+ 1200 "SYSTEM") THEN
|
|
|
+ 1201 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
+ 1202 SemError(201)
|
|
|
+ 1203 ELSE Lower.NoteImportedProc(n)
|
|
|
+ 1204 END
|
|
|
+ 1205 END; .)
|
|
|
+ 1206 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
+ 1207 | "CHR" | "ORD" | "VAL" | "ABS" | "CAP"
|
|
|
+ 1208 | "ODD" | "TRUNC" | "FLOAT"
|
|
|
+ 1209 | "UCHR" | "CHR8" | "UORD"
|
|
|
+ 1210 | "INC" | "DEC"
|
|
|
+ 1211 | "SHIFT" | "ROTATE" | "CAST" | "CONVERT" | "MIN" | "MAX"
|
|
|
+ 1212 | "INCL" | "EXCL" | "NEW" | "DISPOSE" | "LOC" ) .
|
|
|
+ 1213 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
+ 1214 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 1215 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1216 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 1217 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
+ 1218 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
+ 1219 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
+ 1220 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
+ 1221 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
+ 1222 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
+ 1223 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1224 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
+ 1225 astSeq := AST.NoNode;
|
|
|
+ 1226 astTail := AST.NoNode; .)
|
|
|
+ 1227 { (. astDecl := AST.NoNode; .)
|
|
|
+ 1228 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
+ 1229 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1230 astSeq, astTail, astDecl); .) }
|
|
|
+ 1231 (. SymTab.EndTypeBlock;
|
|
|
+ 1232 astDecl := astSeq; .) .
|
|
|
+ 1233 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
+ 1234 t, op: SymTab.TypeIndex;
|
|
|
+ 1235 astNode: AST.Node; .)
|
|
|
+ 1236 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
+ 1237 IF op = SymTab.InvalidType THEN
|
|
|
+ 1238 IF NOT SymTab.Enter(n,
|
|
|
+ 1239 SymTab.KindType) THEN
|
|
|
+ 1240 SemError(200) END
|
|
|
+ 1241 END; .)
|
|
|
+ 1242 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
+ 1243 AST.SetChild(astNode, 0,
|
|
|
+ 1244 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1245 AST.SetTy(astNode, t);
|
|
|
+ 1246 astDecl := astNode;
|
|
|
+ 1247 IF op # SymTab.InvalidType THEN
|
|
|
+ 1248 SymTab.SetTarget(op, t)
|
|
|
+ 1249 ELSE SymTab.SetSymType(n, t)
|
|
|
+ 1250 END;
|
|
|
+ 1251 IF SymTab.EnterEnumLits(t) > 0 THEN END; .)
|
|
|
+ 1252 | (. IF op # SymTab.InvalidType THEN
|
|
|
+ 1253 (* stays opaque *)
|
|
|
+ 1254 ELSIF NOT isDef THEN
|
|
|
+ 1255 SemError(231)
|
|
|
+ 1256 ELSE SymTab.SetSymType(n,
|
|
|
+ 1257 SymTab.NewAlias()) END; .) ) .
|
|
|
+ 1258 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 1259 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
+ 1260 | Subrange<t>
|
|
|
+ 1261 | Enum<t>
|
|
|
+ 1262 | ArrayType<t, allowOpen>
|
|
|
+ 1263 | SetType<t>
|
|
|
+ 1264 | RecordType<t>
|
|
|
+ 1265 | PointerType<t>
|
|
|
+ 1266 | ProcType<t> .
|
|
|
+ 1267 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
+ 1268 = "POINTER" "TO" (. allowFwdType := TRUE; .)
|
|
|
+ 1269 Type<base, FALSE> (. allowFwdType := FALSE;
|
|
|
+ 1270 t := SymTab.NewPtr(base); .) .
|
|
|
+ 1271 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
+ 1272 are code pointers; params are collected into the descriptor. *)
|
|
|
+ 1273 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
+ 1274 isV: BOOLEAN; .)
|
|
|
+ 1275 = ( "PROCEDURE" | "PROC" ) (. allowFwdType := FALSE;
|
|
|
+ 1276 res := SymTab.InvalidType;
|
|
|
+ 1277 t := SymTab.NewProcType(res); .)
|
|
|
+ 1278 [ "(" [ ProcTypeSection<t>
|
|
|
+ 1279 { (";" | ",") ProcTypeSection<t> } ] ")" ]
|
|
|
+ 1280 [ ":" ( TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .)
|
|
|
+ 1281 | "PROC" (. (* PROC as a result type: the
|
|
|
+ 1282 pervasive procedure value
|
|
|
+ 1283 type (ISO/PIM) *)
|
|
|
+ 1284 SymTab.SetProcTypeRes(t,
|
|
|
+ 1285 SymTab.AddrType()); .) ) ] .
|
|
|
+ 1286 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
+ 1287 isV: BOOLEAN;
|
|
|
+ 1288 cnt, k: CARDINAL;
|
|
|
+ 1289 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
+ 1290 = (. isV := FALSE; cnt := 0; .)
|
|
|
+ 1291 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1292 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
+ 1293 { "," ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
+ 1294 | (. (* a comma followed by a type
|
|
|
+ 1295 (possibly VAR) ends the name
|
|
|
+ 1296 list: the collected names
|
|
|
+ 1297 were types, not names *)
|
|
|
+ 1298 k := 0;
|
|
|
+ 1299 WHILE k < cnt DO
|
|
|
+ 1300 SymTab.ProcTypeAdd(t, isV,
|
|
|
+ 1301 SymTab.SymType(names[k]));
|
|
|
+ 1302 INC(k)
|
|
|
+ 1303 END;
|
|
|
+ 1304 cnt := 0; .)
|
|
|
+ 1305 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1306 Type<pt, TRUE> (. SymTab.ProcTypeAdd(t, isV, pt); .) ) }
|
|
|
+ 1307 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
+ 1308 WHILE k < cnt DO
|
|
|
+ 1309 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 1310 INC(k)
|
|
|
+ 1311 END; .)
|
|
|
+ 1312 | (. (* type-only parameter list:
|
|
|
+ 1313 each collected name is a
|
|
|
+ 1314 type (CHAR, a declared type,
|
|
|
+ 1315 ... or the GNU shorthand) *)
|
|
|
+ 1316 k := 0;
|
|
|
+ 1317 WHILE k < cnt DO
|
|
|
+ 1318 IF IsTypeName(names[k]) THEN
|
|
|
+ 1319 pt := SymTab.SymType(names[k])
|
|
|
+ 1320 ELSE SemError(201);
|
|
|
+ 1321 pt := SymTab.InvalidType
|
|
|
+ 1322 END;
|
|
|
+ 1323 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 1324 INC(k)
|
|
|
+ 1325 END; .) )
|
|
|
+ 1326 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
+ 1327 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
+ 1328 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
+ 1329 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
+ 1330 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
+ 1331 out. The PIM/ISO multi-index form repeats the bracket group
|
|
|
+ 1332 ("ARRAY [lo..hi], [lo..hi] OF T"); the bounds of every group
|
|
|
+ 1333 nest in the same inside-out order as the comma list. Bounds are
|
|
|
+ 1334 folded literals (int/char); anything else 230. Bare-type indices
|
|
|
+ 1335 ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
+ 1336 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 1337 (. VAR elem: SymTab.TypeIndex;
|
|
|
+ 1338 eb: SymTab.Name;
|
|
|
+ 1339 ok: BOOLEAN;
|
|
|
+ 1340 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
+ 1341 nb, k: CARDINAL;
|
|
|
+ 1342 idx: SymTab.TypeIndex;
|
|
|
+ 1343 ilo, ihi: INTEGER; .)
|
|
|
+ 1344 = "ARRAY" (. allowFwdType := FALSE; .)
|
|
|
+ 1345 ( "OF"
|
|
|
+ 1346 Type<elem, FALSE> (. LexName(eb); (* the element ident *)
|
|
|
+ 1347 IF NOT allowOpen THEN
|
|
|
+ 1348 SemError(230) END;
|
|
|
+ 1349 t := SymTab.NewOpenArray(elem);
|
|
|
+ 1350 IF SymTab.Equal(eb, "BYTE") THEN
|
|
|
+ 1351 SymTab.MarkByteBuf(t) END; .)
|
|
|
+ 1352 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
+ 1353 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
+ 1354 type's ordinal bounds give the
|
|
|
+ 1355 [lo..hi] pair *)
|
|
|
+ 1356 IF SymTab.TypeBounds(idx, ilo,
|
|
|
+ 1357 ihi)
|
|
|
+ 1358 THEN t := SymTab.NewArrayB(elem,
|
|
|
+ 1359 ilo, ihi)
|
|
|
+ 1360 ELSE SemError(230);
|
|
|
+ 1361 t := SymTab.InvalidType
|
|
|
+ 1362 END; .)
|
|
|
+ 1363 | "[" (. SymTab.BoundBegin; ok := TRUE;
|
|
|
+ 1364 nb := 0; .)
|
|
|
+ 1365 BoundPair<ok>
|
|
|
+ 1366 { "," BoundPair<ok> }
|
|
|
+ 1367 "]" (. (* snapshot this bracket group
|
|
|
+ 1368 before the element type, which
|
|
|
+ 1369 reuses the bound buffer for a
|
|
|
+ 1370 nested ARRAY *)
|
|
|
+ 1371 IF nb + SymTab.BoundCount() >
|
|
|
+ 1372 HIGH(bnds) + 1 THEN
|
|
|
+ 1373 SemError(230); ok := FALSE
|
|
|
+ 1374 ELSE
|
|
|
+ 1375 k := 0;
|
|
|
+ 1376 WHILE k < SymTab.BoundCount() DO
|
|
|
+ 1377 bnds[nb] := SymTab.BoundLo(k);
|
|
|
+ 1378 bndh[nb] := SymTab.BoundHi(k);
|
|
|
+ 1379 INC(k); INC(nb)
|
|
|
+ 1380 END
|
|
|
+ 1381 END; .)
|
|
|
+ 1382 { "," "[" (. SymTab.BoundBegin; .)
|
|
|
+ 1383 BoundPair<ok>
|
|
|
+ 1384 { "," BoundPair<ok> }
|
|
|
+ 1385 "]" (. IF nb + SymTab.BoundCount() >
|
|
|
+ 1386 HIGH(bnds) + 1 THEN
|
|
|
+ 1387 SemError(230); ok := FALSE
|
|
|
+ 1388 ELSE
|
|
|
+ 1389 k := 0;
|
|
|
+ 1390 WHILE k < SymTab.BoundCount() DO
|
|
|
+ 1391 bnds[nb] := SymTab.BoundLo(k);
|
|
|
+ 1392 bndh[nb] := SymTab.BoundHi(k);
|
|
|
+ 1393 INC(k); INC(nb)
|
|
|
+ 1394 END
|
|
|
+ 1395 END; .) }
|
|
|
+ 1396 "OF" Type<elem, FALSE>
|
|
|
+ 1397 (. IF ok THEN
|
|
|
+ 1398 k := nb;
|
|
|
+ 1399 WHILE k > 0 DO
|
|
|
+ 1400 DEC(k);
|
|
|
+ 1401 elem := SymTab.NewArrayB(
|
|
|
+ 1402 elem, bnds[k], bndh[k])
|
|
|
+ 1403 END;
|
|
|
+ 1404 t := elem
|
|
|
+ 1405 ELSE t := SymTab.InvalidType
|
|
|
+ 1406 END; .) ) .
|
|
|
+ 1407 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1408 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1409 lo, hi: INTEGER;
|
|
|
+ 1410 cl, cl2: INTEGER; .)
|
|
|
+ 1411 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1412 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1413 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1414 ok := FALSE
|
|
|
+ 1415 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
+ 1416 cl2 := SymTab.ClassOf(thi);
|
|
|
+ 1417 IF ((cl # SymTab.ClInt)
|
|
|
+ 1418 AND (cl # SymTab.ClChar)
|
|
|
+ 1419 AND (cl # SymTab.ClBool)
|
|
|
+ 1420 AND (cl # SymTab.ClEnum)
|
|
|
+ 1421 AND (cl # SymTab.ClByte)
|
|
|
+ 1422 AND (cl # SymTab.ClSByte)
|
|
|
+ 1423 AND (cl # SymTab.ClWord16)
|
|
|
+ 1424 AND (cl # SymTab.ClSWord16))
|
|
|
+ 1425 OR ((cl2 # SymTab.ClInt)
|
|
|
+ 1426 AND (cl2 # SymTab.ClChar)
|
|
|
+ 1427 AND (cl2 # SymTab.ClBool)
|
|
|
+ 1428 AND (cl2 # SymTab.ClEnum)
|
|
|
+ 1429 AND (cl2 # SymTab.ClByte)
|
|
|
+ 1430 AND (cl2 # SymTab.ClSByte)
|
|
|
+ 1431 AND (cl2 # SymTab.ClWord16)
|
|
|
+ 1432 AND (cl2 # SymTab.ClSWord16)) THEN
|
|
|
+ 1433 SemError(230); ok := FALSE
|
|
|
+ 1434 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1435 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1436 OR (lo > hi) THEN
|
|
|
+ 1437 SemError(230); ok := FALSE
|
|
|
+ 1438 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
+ 1439 SemError(230); ok := FALSE
|
|
|
+ 1440 END;
|
|
|
+ 1441 END; .) .
|
|
|
+ 1442 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
+ 1443 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
+ 1444 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
+ 1445 comparison across suitable bases are lenient (masks over min
|
|
|
+ 1446 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
+ 1447 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
+ 1448 blo, bhi, bspan: INTEGER;
|
|
|
+ 1449 bcls: INTEGER; .)
|
|
|
+ 1450 = "SET" (. allowFwdType := FALSE; .)
|
|
|
+ 1451 "OF" Type<base, FALSE>
|
|
|
+ 1452 (. IF base = SymTab.InvalidType THEN
|
|
|
+ 1453 t := SymTab.InvalidType
|
|
|
+ 1454 ELSIF SymTab.Unresolved(base) THEN
|
|
|
+ 1455 (* an opaque/formal base: defer
|
|
|
+ 1456 the span check until the
|
|
|
+ 1457 base is completed *)
|
|
|
+ 1458 t := SymTab.NewSet(base)
|
|
|
+ 1459 ELSE bcls :=
|
|
|
+ 1460 SymTab.ClassOf(base);
|
|
|
+ 1461 (* a subrange keeps its own
|
|
|
+ 1462 span even when its base is
|
|
|
+ 1463 CHAR/BOOLEAN/an enum *)
|
|
|
+ 1464 IF SymTab.SubBounds(base,
|
|
|
+ 1465 blo, bhi) THEN
|
|
|
+ 1466 bspan := bhi - blo + 1
|
|
|
+ 1467 ELSIF bcls = SymTab.ClBool THEN
|
|
|
+ 1468 blo := 0; bspan := 2
|
|
|
+ 1469 ELSIF bcls = SymTab.ClChar THEN
|
|
|
+ 1470 blo := 0; bspan := 256
|
|
|
+ 1471 ELSIF bcls = SymTab.ClByte THEN
|
|
|
+ 1472 blo := 0; bspan := 256
|
|
|
+ 1473 ELSIF bcls = SymTab.ClSByte THEN
|
|
|
+ 1474 blo := -128; bspan := 256
|
|
|
+ 1475 ELSIF bcls = SymTab.ClWord16 THEN
|
|
|
+ 1476 blo := 0; bspan := 65536
|
|
|
+ 1477 ELSIF bcls = SymTab.ClSWord16 THEN
|
|
|
+ 1478 blo := -32768; bspan := 65536
|
|
|
+ 1479 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
+ 1480 blo := 0;
|
|
|
+ 1481 bspan := VAL(INTEGER,
|
|
|
+ 1482 SymTab.EnumCount(base))
|
|
|
+ 1483 ELSE bspan := 0 END;
|
|
|
+ 1484 IF (bspan <= 0)
|
|
|
+ 1485 OR (bspan > 65536) THEN
|
|
|
+ 1486 SemError(230);
|
|
|
+ 1487 t := SymTab.InvalidType
|
|
|
+ 1488 ELSE t := SymTab.NewSet(base)
|
|
|
+ 1489 END
|
|
|
+ 1490 END; .) .
|
|
|
+ 1491 (* Records: flat blobs; array fields are pointers to static
|
|
|
+ 1492 descriptors (locked amendment), nested records inline. Field
|
|
|
+ 1493 offsets static and declaration-ordered. *)
|
|
|
+ 1494 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
+ 1495 variant part is a `CASE ... END` item; because it starts with the
|
|
|
+ 1496 CASE keyword it is unambiguously distinguishable from a field
|
|
|
+ 1497 (which starts with an identifier). *)
|
|
|
+ 1498 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 1499 tagOk: BOOLEAN; .)
|
|
|
+ 1500 = "RECORD" (. allowFwdType := FALSE;
|
|
|
+ 1501 t := SymTab.NewRecord(); .)
|
|
|
+ 1502 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
+ 1503 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
+ 1504 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
+ 1505 = RecField<rec>
|
|
|
+ 1506 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 1507 (* A variant part: CASE [tag] : Type OF variants. gm2 extensions:
|
|
|
+ 1508 an untagged inner CASE (no tag field), empty arms and ELSE arms. *)
|
|
|
+ 1509 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
+ 1510 tagN: SymTab.Name;
|
|
|
+ 1511 tagged: BOOLEAN; .)
|
|
|
+ 1512 = "CASE" (. SymTab.ResetFields(rec);
|
|
|
+ 1513 tagged := FALSE; .)
|
|
|
+ 1514 [ GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1515 tagN) THEN
|
|
|
+ 1516 SemError(200) END;
|
|
|
+ 1517 tagged := TRUE; .) ]
|
|
|
+ 1518 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
+ 1519 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
+ 1520 SemError(224)
|
|
|
+ 1521 END;
|
|
|
+ 1522 IF tagged THEN
|
|
|
+ 1523 SymTab.FixPendingF(rec, tagT);
|
|
|
+ 1524 SymTab.SetVariantTag(rec, tagN)
|
|
|
+ 1525 END; .)
|
|
|
+ 1526 "OF"
|
|
|
+ 1527 RecFieldList<rec>
|
|
|
+ 1528 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
+ 1529 RecFieldList<rec> }
|
|
|
+ 1530 [ "ELSE" ]
|
|
|
+ 1531 "END" .
|
|
|
+ 1532 (* A variant branch: `labels : fields` (fields and their trailing ";"
|
|
|
+ 1533 optional, gm2), `ELSE`, or empty (the extra "|" separators gm2
|
|
|
+ 1534 tolerates). A branch may itself contain a nested variant CASE. *)
|
|
|
+ 1535 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
+ 1536 lv1, lv2: QbeGen.QVal; .)
|
|
|
+ 1537 = [ ( VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ]
|
|
|
+ 1538 { "," VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] }
|
|
|
+ 1539 ":"
|
|
|
+ 1540 [ ArmField<rec> { ";" [ ArmField<rec> ] } ]
|
|
|
+ 1541 | "ELSE" ) ] .
|
|
|
+ 1542 ArmField<rec: SymTab.TypeIndex>
|
|
|
+ 1543 = RecField<rec>
|
|
|
+ 1544 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 1545 (* Variant case label: a constant (or a constant range). Values are
|
|
|
+ 1546 not interpreted (the layout overlays regardless). *)
|
|
|
+ 1547 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 1548 (. VAR lname: SymTab.Name; .)
|
|
|
+ 1549 = ( ident (. LexName(lname);
|
|
|
+ 1550 QbeGen.CopyOp("0", q);
|
|
|
+ 1551 t := SymTab.IntType(); .)
|
|
|
+ 1552 | integer (. LexString(lname);
|
|
|
+ 1553 QbeGen.CopyOp("0", q);
|
|
|
+ 1554 t := SymTab.IntType(); .)
|
|
|
+ 1555 | charConst (. LexString(lname);
|
|
|
+ 1556 QbeGen.CopyOp("0", q);
|
|
|
+ 1557 t := SymTab.CharType(); .) ) .
|
|
|
+ 1558 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1559 t2: SymTab.TypeIndex; .)
|
|
|
+ 1560 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
+ 1561 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
+ 1562 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1563 n) THEN
|
|
|
+ 1564 SemError(200) END; .)
|
|
|
+ 1565 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1566 n) THEN
|
|
|
+ 1567 SemError(200) END; .) } .
|
|
|
+ 1568 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
+ 1569 k: INTEGER;
|
|
|
+ 1570 dotted: BOOLEAN; .)
|
|
|
+ 1571 = GetIdent<n> (. dotted := FALSE;
|
|
|
+ 1572 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 1573 (* declaration before use: an
|
|
|
+ 1574 undeclared type is 201,
|
|
|
+ 1575 except as a POINTER's base
|
|
|
+ 1576 (allowFwdType) *)
|
|
|
+ 1577 k := -1;
|
|
|
+ 1578 IF allowFwdType THEN
|
|
|
+ 1579 t := SymTab.ForwardType(n)
|
|
|
+ 1580 ELSE t := SymTab.InvalidType
|
|
|
+ 1581 END;
|
|
|
1582 IF t = SymTab.InvalidType THEN
|
|
|
1583 SemError(201)
|
|
|
1584 END
|
|
|
- 1585 ELSE SemError(221);
|
|
|
- 1586 t := SymTab.InvalidType
|
|
|
- 1587 END; .) ]
|
|
|
- 1588 (. IF NOT dotted THEN
|
|
|
- 1589 IF (k = SymTab.KindModule)
|
|
|
- 1590 OR ((k # SymTab.KindType)
|
|
|
- 1591 AND (k # SymTab.KindPredef)
|
|
|
- 1592 AND (k # SymTab.KindImport)
|
|
|
- 1593 AND (k # -1)) THEN
|
|
|
- 1594 SemError(221)
|
|
|
- 1595 END
|
|
|
- 1596 END; .) .
|
|
|
- 1597 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1598 qlo, qhi: QbeGen.QVal;
|
|
|
- 1599 lo, hi: INTEGER; .)
|
|
|
- 1600 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1601 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1602 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1603 t := SymTab.InvalidType
|
|
|
- 1604 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
- 1605 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
- 1606 SemError(230);
|
|
|
- 1607 t := SymTab.InvalidType
|
|
|
- 1608 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1609 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1610 OR (lo > hi) THEN
|
|
|
- 1611 SemError(230);
|
|
|
- 1612 t := SymTab.InvalidType
|
|
|
- 1613 ELSE IF SymTab.SameType(tlo, thi) THEN
|
|
|
- 1614 (* keep the base type: ['A'..'Z']
|
|
|
- 1615 is character, [red..blue]
|
|
|
- 1616 that enumeration *)
|
|
|
- 1617 t := SymTab.NewSubB(lo, hi, tlo)
|
|
|
- 1618 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
- 1619 END
|
|
|
- 1620 END; .)
|
|
|
- 1621 "]" .
|
|
|
- 1622 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1623 ord: INTEGER;
|
|
|
- 1624 qv: QbeGen.QVal; .)
|
|
|
- 1625 = "(" (. t := SymTab.NewEnum();
|
|
|
- 1626 ord := 0; .)
|
|
|
- 1627 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1628 SymTab.KindConst) THEN
|
|
|
- 1629 SemError(200) END;
|
|
|
- 1630 SymTab.SetSymType(n, t);
|
|
|
- 1631 QbeGen.IntStr(ord, qv);
|
|
|
- 1632 SymTab.SetSymVal(n, qv);
|
|
|
- 1633 SymTab.NoteEnumLit(t, n);
|
|
|
- 1634 Lower.NoteVar(n,
|
|
|
- 1635 SymTab.KindConst, t);
|
|
|
- 1636 Lower.NoteConstVal(qv);
|
|
|
- 1637 INC(ord); .)
|
|
|
- 1638 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1639 SymTab.KindConst) THEN
|
|
|
- 1640 SemError(200) END;
|
|
|
- 1641 SymTab.SetSymType(n, t);
|
|
|
- 1642 QbeGen.IntStr(ord, qv);
|
|
|
- 1643 SymTab.SetSymVal(n, qv);
|
|
|
- 1644 SymTab.NoteEnumLit(t, n);
|
|
|
- 1645 Lower.NoteVar(n,
|
|
|
- 1646 SymTab.KindConst, t);
|
|
|
- 1647 Lower.NoteConstVal(qv);
|
|
|
- 1648 INC(ord); .) }
|
|
|
- 1649 ")" (. SymTab.SetEnumCount(t,
|
|
|
- 1650 VAL(CARDINAL, ord)); .) .
|
|
|
- 1651 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
- 1652 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
- 1653 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
- 1654 class/impl block. Methods end with ";" per the Table example
|
|
|
- 1655 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
- 1656 (* Single CLASS item in both loops: separating declaration from
|
|
|
- 1657 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
- 1658 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
- 1659 The second token decides after CLASS is consumed. A misplaced
|
|
|
- 1660 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
- 1661 whole unit ends 230 until lowering). *)
|
|
|
- 1662 ClassItem
|
|
|
- 1663 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
- 1664 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
- 1665 ct: SymTab.TypeIndex; .)
|
|
|
- 1666 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
- 1667 SymTab.KindType) THEN
|
|
|
- 1668 SemError(200) END;
|
|
|
- 1669 ct := SymTab.NewClass();
|
|
|
- 1670 SymTab.SetSymType(cn, ct);
|
|
|
- 1671 SymTab.PushClassScope(ct);
|
|
|
- 1672 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1673 AST.SetChild(astCls, 0,
|
|
|
- 1674 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1675 astClsP := AST.NoNode;
|
|
|
- 1676 astClsPTail := AST.NoNode;
|
|
|
- 1677 astClsF := AST.NoNode;
|
|
|
- 1678 astClsFTail := AST.NoNode;
|
|
|
- 1679 astClsM := AST.NoNode;
|
|
|
- 1680 astClsMTail := AST.NoNode; .)
|
|
|
- 1681 [ Parents<ct> ]
|
|
|
- 1682 ";"
|
|
|
- 1683 { ClassField<ct> ";" }
|
|
|
- 1684 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 1685 (. Lower.ScopeLeave;
|
|
|
- 1686 SymTab.CloseProc;
|
|
|
- 1687 QbeGen.AbortFunc; .) }
|
|
|
- 1688 "END"
|
|
|
- 1689 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1690 SemError(202) END;
|
|
|
- 1691 SymTab.LayoutClass(ct);
|
|
|
- 1692 SymTab.PopScope;
|
|
|
- 1693 AST.SetChild(astCls, 1, astClsP);
|
|
|
- 1694 AST.SetChild(astCls, 2, astClsF);
|
|
|
- 1695 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1696 astDecl := astCls; .) .
|
|
|
- 1697 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
- 1698 = "(" Parent1<ct>
|
|
|
- 1699 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
- 1700 ")" .
|
|
|
- 1701 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
- 1702 pt: SymTab.TypeIndex; .)
|
|
|
- 1703 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
- 1704 SemError(201)
|
|
|
- 1705 ELSE pt := SymTab.SymType(p);
|
|
|
- 1706 IF SymTab.ClassOf(pt) #
|
|
|
- 1707 SymTab.ClClass THEN
|
|
|
- 1708 SemError(230)
|
|
|
- 1709 ELSE SymTab.SetParent(ct, pt)
|
|
|
- 1710 END
|
|
|
- 1711 END;
|
|
|
- 1712 AstAppend(AST.NkFieldDecl,
|
|
|
- 1713 astClsP, astClsPTail,
|
|
|
- 1714 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
- 1715 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
- 1716 t: SymTab.TypeIndex;
|
|
|
- 1717 astNode: AST.Node; .)
|
|
|
- 1718 = GetIdent<n>
|
|
|
- 1719 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
- 1720 SymTab.KindConst) THEN
|
|
|
- 1721 SemError(200) END;
|
|
|
- 1722 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1723 AST.SetChild(astNode, 0,
|
|
|
- 1724 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1725 AST.SetChild(astNode, 1,
|
|
|
- 1726 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
- 1727 AstAppend(AST.NkFieldDecl,
|
|
|
- 1728 astClsF, astClsFTail, astNode);
|
|
|
- 1729 IF SymTab.Lookup(rhs) THEN
|
|
|
- 1730 SymTab.SetSymType(n,
|
|
|
- 1731 SymTab.SymType(rhs))
|
|
|
- 1732 END; .)
|
|
|
- 1733 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1734 n) THEN
|
|
|
- 1735 SemError(200) END;
|
|
|
- 1736 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1737 AST.SetChild(astNode, 0,
|
|
|
- 1738 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1739 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1740 n) THEN
|
|
|
- 1741 SemError(200) END;
|
|
|
- 1742 AST.SetChild(astNode,
|
|
|
- 1743 AST.NChild(astNode),
|
|
|
- 1744 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
- 1745 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
- 1746 AST.SetTy(astNode, t);
|
|
|
- 1747 AstAppend(AST.NkFieldDecl,
|
|
|
- 1748 astClsF, astClsFTail, astNode); .) ) .
|
|
|
- 1749 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
- 1750 (. VAR wantVirt: BOOLEAN; .)
|
|
|
- 1751 = (. wantVirt := FALSE; .)
|
|
|
- 1752 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
- 1753 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
- 1754 SymTab.MarkVirtual END;
|
|
|
- 1755 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 1756 AST.SetChild(astMethod, 0,
|
|
|
- 1757 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 1758 IF wantVirt THEN
|
|
|
- 1759 AST.SetOp(astMethod, 3)
|
|
|
- 1760 ELSE AST.SetOp(astMethod, 0)
|
|
|
- 1761 END;
|
|
|
- 1762 AstAppend(AST.NkFieldDecl,
|
|
|
- 1763 astClsM, astClsMTail, astMethod); .) .
|
|
|
- 1764 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
- 1765 ct: SymTab.TypeIndex; .)
|
|
|
- 1766 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
- 1767 SemError(201);
|
|
|
- 1768 ct := SymTab.InvalidType
|
|
|
- 1769 ELSE ct := SymTab.SymType(cn);
|
|
|
- 1770 IF SymTab.ClassOf(ct) #
|
|
|
- 1771 SymTab.ClClass THEN
|
|
|
- 1772 SemError(230);
|
|
|
- 1773 ct := SymTab.InvalidType
|
|
|
- 1774 END
|
|
|
- 1775 END;
|
|
|
- 1776 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1777 AST.SetOp(astCls, 1);
|
|
|
- 1778 AST.SetChild(astCls, 0,
|
|
|
- 1779 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1780 astClsM := AST.NoNode;
|
|
|
- 1781 astClsMTail := AST.NoNode;
|
|
|
- 1782 astStmt := AST.NoNode;
|
|
|
- 1783 IF ct #
|
|
|
- 1784 SymTab.InvalidType THEN
|
|
|
- 1785 IF NOT SymTab.PushClassMembers(
|
|
|
- 1786 ct) THEN
|
|
|
- 1787 SemError(230) END;
|
|
|
- 1788 SymTab.PushImplClass(ct)
|
|
|
- 1789 END; .)
|
|
|
- 1790 ";" { MethodImpl<ct> ";" }
|
|
|
- 1791 (. astStmt := AST.NoNode; .)
|
|
|
- 1792 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
- 1793 .)
|
|
|
- 1794 [ StatSeq ] ]
|
|
|
- 1795 "END"
|
|
|
- 1796 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1797 SemError(202) END;
|
|
|
- 1798 SymTab.PopImplClass;
|
|
|
- 1799 SymTab.PopScope;
|
|
|
- 1800 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
- 1801 AST.SetChild(astCls, 2, astStmt);
|
|
|
- 1802 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1803 astDecl := astCls; .) .
|
|
|
- 1804 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
- 1805 thisQ: QbeGen.QVal;
|
|
|
- 1806 methRes: SymTab.TypeIndex; .)
|
|
|
- 1807 = MethodHeading<pn, ct> ";"
|
|
|
- 1808 (. IF (ct #
|
|
|
- 1809 SymTab.InvalidType)
|
|
|
- 1810 AND NOT SymTab.MethodExists(ct,
|
|
|
- 1811 pn) THEN
|
|
|
- 1812 SemError(201) END; .)
|
|
|
- 1813 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
- 1814 SymTab.MarkFwd;
|
|
|
- 1815 QbeGen.AbortFunc;
|
|
|
- 1816 Lower.ScopeLeave;
|
|
|
- 1817 SymTab.CloseProc; .)
|
|
|
- 1818 | (.
|
|
|
- 1819 (* bind the receiver: bare
|
|
|
- 1820 field names resolve
|
|
|
- 1821 against THIS *)
|
|
|
- 1822 QbeGen.CopyOp("@", thisQ);
|
|
|
- 1823 QbeGen.PushWith(thisQ); .)
|
|
|
- 1824 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
- 1825 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
- 1826 QbeGen.PopWith;
|
|
|
- 1827 methRes := SymTab.CurRes();
|
|
|
- 1828 Lower.ScopeLeave;
|
|
|
- 1829 SymTab.CloseProc;
|
|
|
- 1830 QbeGen.EndFunc(methRes); .) ) .
|
|
|
- 1831 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1832 = "CONST" (. astSeq := AST.NoNode;
|
|
|
- 1833 astTail := AST.NoNode; .)
|
|
|
- 1834 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1835 astSeq, astTail, astDecl); .) }
|
|
|
- 1836 (. astDecl := astSeq; .) .
|
|
|
- 1837 ConstDecl (. VAR n: SymTab.Name;
|
|
|
- 1838 t: SymTab.TypeIndex;
|
|
|
- 1839 qv: QbeGen.QVal;
|
|
|
- 1840 cls: INTEGER;
|
|
|
- 1841 mk: ARRAY [0 .. 15] OF CARDINAL;
|
|
|
- 1842 mw: CARDINAL;
|
|
|
- 1843 mlo: INTEGER;
|
|
|
- 1844 astNode: AST.Node; .)
|
|
|
- 1845 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1846 SymTab.KindConst) THEN
|
|
|
- 1847 SemError(200) END; .)
|
|
|
- 1848 "="
|
|
|
- 1849 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1850 AST.SetChild(astNode, 0,
|
|
|
- 1851 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1852 AST.SetChild(astNode, 1, astCur);
|
|
|
- 1853 AST.SetTy(astNode, t);
|
|
|
- 1854 astDecl := astNode;
|
|
|
- 1855 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
- 1856 Lower.NoteConstVal(qv);
|
|
|
- 1857 SymTab.SetSymType(n, t);
|
|
|
- 1858 cls := SymTab.ClassOf(t);
|
|
|
- 1859 IF cls = SymTab.ClSet THEN
|
|
|
- 1860 (* a SET CONST needs static
|
|
|
- 1861 data: fold its mask now
|
|
|
- 1862 (the grammar sees the
|
|
|
- 1863 element values) and let
|
|
|
- 1864 Lower re-emit it *)
|
|
|
- 1865 IF Lower.SetConstMaskOf(
|
|
|
- 1866 AST.Child(astNode, 1),
|
|
|
- 1867 mk, mw, mlo) THEN
|
|
|
- 1868 Lower.NoteSetMask(n, mk, mw,
|
|
|
- 1869 mlo);
|
|
|
- 1870 SymTab.SetSymVal(n, qv)
|
|
|
- 1871 ELSE
|
|
|
- 1872 SemError(230)
|
|
|
- 1873 END
|
|
|
- 1874 ELSIF (cls = SymTab.ClArray)
|
|
|
- 1875 OR (cls = SymTab.ClRecord)
|
|
|
- 1876 OR (cls = SymTab.ClClass)
|
|
|
- 1877 OR (cls = SymTab.ClStr)
|
|
|
- 1878 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 1879 (* an aggregate/string
|
|
|
- 1880 constant: qv is its
|
|
|
- 1881 descriptor address; no
|
|
|
- 1882 scalar data *)
|
|
|
- 1883 SymTab.SetSymVal(n, qv)
|
|
|
- 1884 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
- 1885 SemError(230)
|
|
|
- 1886 ELSE
|
|
|
- 1887 SymTab.SetSymVal(n, qv);
|
|
|
- 1888 END; .) .
|
|
|
- 1889 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1890 = "VAR" (. astSeq := AST.NoNode;
|
|
|
- 1891 astTail := AST.NoNode; .)
|
|
|
- 1892 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1893 astSeq, astTail, astDecl); .) }
|
|
|
- 1894 (. astDecl := astSeq; .) .
|
|
|
- 1895 VarDecl (. VAR nm: SymTab.Name;
|
|
|
- 1896 t: SymTab.TypeIndex;
|
|
|
- 1897 i: CARDINAL;
|
|
|
- 1898 cls: INTEGER;
|
|
|
- 1899 astNode, astTail: AST.Node; .)
|
|
|
- 1900 = VarIdents ":"
|
|
|
- 1901 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1902 astTail := astNode;
|
|
|
- 1903 i := 0;
|
|
|
- 1904 WHILE i < SymTab.PendCount() DO
|
|
|
- 1905 SymTab.PendName(i, nm);
|
|
|
- 1906 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
- 1907 (* chunked: a VAR list can
|
|
|
- 1908 exceed AST.MaxChild *)
|
|
|
- 1909 AstAppend(AST.NkBlock,
|
|
|
- 1910 astNode, astTail,
|
|
|
- 1911 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
- 1912 INC(i)
|
|
|
- 1913 END;
|
|
|
- 1914 AST.SetTy(astNode, t);
|
|
|
- 1915 astDecl := astNode;
|
|
|
- 1916 cls := SymTab.ClassOf(t);
|
|
|
- 1917 IF (t # SymTab.InvalidType)
|
|
|
- 1918 AND NOT SymTab.IsUnresolved(t)
|
|
|
- 1919 AND (cls # SymTab.ClInt)
|
|
|
- 1920 AND (cls # SymTab.ClBool)
|
|
|
- 1921 AND (cls # SymTab.ClChar)
|
|
|
- 1922 AND (cls # SymTab.ClReal)
|
|
|
- 1923 AND (cls # SymTab.ClArray)
|
|
|
- 1924 AND (cls # SymTab.ClSet)
|
|
|
- 1925 AND (cls # SymTab.ClRecord)
|
|
|
- 1926 AND (cls # SymTab.ClPtr)
|
|
|
- 1927 AND (cls # SymTab.ClLong)
|
|
|
- 1928 AND (cls # SymTab.ClProc)
|
|
|
- 1929 AND (cls # SymTab.ClUChar)
|
|
|
- 1930 AND (cls # SymTab.ClUStr)
|
|
|
- 1931 AND (cls # SymTab.ClEnum)
|
|
|
- 1932 AND (cls # SymTab.ClByte)
|
|
|
- 1933 AND (cls # SymTab.ClSByte)
|
|
|
- 1934 AND (cls # SymTab.ClClass) THEN
|
|
|
- 1935 SemError(230) END;
|
|
|
- 1936 IF QbeGen.LocFull() THEN
|
|
|
- 1937 SemError(233) END;
|
|
|
- 1938 i := 0;
|
|
|
- 1939 IF SymTab.IsUnresolved(t)
|
|
|
- 1940 AND NOT SymTab.InProc() THEN
|
|
|
- 1941 (* a forward-typed global:
|
|
|
- 1942 defer emission until the
|
|
|
- 1943 TYPE block completes *)
|
|
|
- 1944 AST.SetOp(astNode, 1);
|
|
|
- 1945 WHILE i < SymTab.PendCount() DO
|
|
|
- 1946 SymTab.PendName(i, nm);
|
|
|
- 1947 IF nPendVar <=
|
|
|
- 1948 HIGH(pendVarName) THEN
|
|
|
- 1949 pendVarName[nPendVar] := nm;
|
|
|
- 1950 pendVarT[nPendVar] := t;
|
|
|
- 1951 INC(nPendVar)
|
|
|
- 1952 END;
|
|
|
- 1953 INC(i)
|
|
|
- 1954 END
|
|
|
- 1955 ELSE
|
|
|
- 1956 WHILE i < SymTab.PendCount() DO
|
|
|
- 1957 SymTab.PendName(i, nm);
|
|
|
- 1958 INC(i)
|
|
|
- 1959 END
|
|
|
- 1960 END;
|
|
|
- 1961 (* a plain VAR list, not a
|
|
|
- 1962 heading: the signature
|
|
|
- 1963 result is discarded *)
|
|
|
- 1964 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 1965 END; .) .
|
|
|
- 1966 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
- 1967 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 1968 SymTab.KindVar) THEN
|
|
|
- 1969 SemError(200) END; .)
|
|
|
- 1970 { ","
|
|
|
- 1971 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 1972 SymTab.KindVar) THEN
|
|
|
- 1973 SemError(200) END; .) } .
|
|
|
- 1974 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
- 1975 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 1976 SemError(200) END; .)
|
|
|
- 1977 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 1978 SemError(200) END; .) } .
|
|
|
- 1979 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
- 1980 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
- 1981 FORWARD marks; the body heading re-enters (signature compare
|
|
|
- 1982 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
- 1983 (* gm2 declaration pragmas: __BUILTIN__ (definition module) and
|
|
|
- 1984 __ATTRIBUTE__ __BUILTIN__ (( name )) (implementation). They
|
|
|
- 1985 annotate C built-ins; V3 parses and ignores them. *)
|
|
|
- 1986 ProcPragma
|
|
|
- 1987 = "__BUILTIN__"
|
|
|
- 1988 | "__ATTRIBUTE__" [ "__BUILTIN__" ] [ "(" "(" ident ")" ")" ] .
|
|
|
- 1989
|
|
|
- 1990 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
- 1991 (. VAR t: SymTab.TypeIndex;
|
|
|
- 1992 mg: QbeGen.QVal; .)
|
|
|
- 1993 = "PROCEDURE"
|
|
|
- 1994 [ ProcPragma ]
|
|
|
- 1995 GetIdent<pn> (. IF methCls #
|
|
|
- 1996 SymTab.InvalidType THEN
|
|
|
- 1997 (* a method: resume the
|
|
|
- 1998 declared symbol (reuse
|
|
|
- 1999 its uid) *)
|
|
|
- 2000 IF NOT SymTab.ResumeMethod(
|
|
|
- 2001 methCls, pn) THEN
|
|
|
- 2002 SemError(200) END
|
|
|
- 2003 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
- 2004 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
- 2005 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
- 2006 SemError(200) END
|
|
|
- 2007 END
|
|
|
- 2008 END;
|
|
|
- 2009 Lower.ScopeEnter;
|
|
|
- 2010 Lower.NoteProc(pn,
|
|
|
- 2011 SymTab.ProcUid(pn),
|
|
|
- 2012 SymTab.InvalidType,
|
|
|
- 2013 SymTab.ProcDepthOf(pn),
|
|
|
- 2014 FALSE);
|
|
|
- 2015 QbeGen.BeginFunc("");
|
|
|
- 2016 IF methCls #
|
|
|
- 2017 SymTab.InvalidType THEN
|
|
|
- 2018 (* hidden THIS receiver:
|
|
|
- 2019 a VAR param of the
|
|
|
- 2020 class type, pushed as
|
|
|
- 2021 the WITH base *)
|
|
|
- 2022 IF NOT SymTab.EnterThisParam(
|
|
|
- 2023 methCls) THEN
|
|
|
- 2024 SemError(200) END;
|
|
|
- 2025 IF NOT QbeGen.FuncParam(
|
|
|
- 2026 "THIS", TRUE,
|
|
|
- 2027 methCls) THEN
|
|
|
- 2028 SemError(233) END
|
|
|
- 2029 END; .)
|
|
|
- 2030 [ FormalParams ]
|
|
|
- 2031 [ ":" ( TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
- 2032 SemError(235) END;
|
|
|
- 2033 Lower.SetProcRes(t); .)
|
|
|
- 2034 | "PROC" (. (* PROC result: the procedure
|
|
|
- 2035 value type *)
|
|
|
- 2036 IF NOT SymTab.SetProcRes(
|
|
|
- 2037 SymTab.AddrType()) THEN
|
|
|
- 2038 SemError(235) END;
|
|
|
- 2039 Lower.SetProcRes(
|
|
|
- 2040 SymTab.AddrType()); .) ) ] .
|
|
|
- 2041 FormalParams
|
|
|
- 2042 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
- 2043 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
- 2044 nm: SymTab.Name;
|
|
|
- 2045 i: CARDINAL;
|
|
|
- 2046 isV: BOOLEAN; .)
|
|
|
- 2047 = (. isV := FALSE; .)
|
|
|
- 2048 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 2049 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
- 2050 WHILE i < SymTab.PendCount() DO
|
|
|
- 2051 SymTab.PendName(i, nm);
|
|
|
- 2052 Lower.NoteParam(nm, t, isV);
|
|
|
- 2053 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
- 2054 (* value open arrays are
|
|
|
- 2055 passed as descriptor
|
|
|
- 2056 addresses (no copy):
|
|
|
- 2057 same representation as
|
|
|
- 2058 VAR formals *)
|
|
|
- 2059 IF NOT QbeGen.FuncParam(nm,
|
|
|
- 2060 isV
|
|
|
- 2061 OR SymTab.IsOpenArray(t),
|
|
|
- 2062 t) THEN
|
|
|
- 2063 SemError(233) END;
|
|
|
- 2064 INC(i)
|
|
|
- 2065 END;
|
|
|
- 2066 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 2067 SemError(235) END; .) .
|
|
|
- 2068 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
- 2069 static link gives them their parent's frame. Methods keep
|
|
|
- 2070 parse-now/230-later. *)
|
|
|
- 2071 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
- 2072 astNode: AST.Node; .)
|
|
|
- 2073 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 2074 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 2075 AST.SetOp(astNode, 0);
|
|
|
- 2076 AST.SetChild(astNode, 0,
|
|
|
- 2077 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 2078 Lower.NoteProcNode(astNode); .)
|
|
|
- 2079 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
- 2080 astDecl := astNode;
|
|
|
- 2081 Lower.ScopeLeave;
|
|
|
- 2082 SymTab.MarkFwd;
|
|
|
- 2083 SymTab.CloseProc;
|
|
|
- 2084 QbeGen.AbortFunc; .)
|
|
|
- 2085 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
- 2086 astDecl := astNode;
|
|
|
- 2087 Lower.MarkProcExternal;
|
|
|
- 2088 Lower.ScopeLeave;
|
|
|
- 2089 SymTab.MarkExternal("");
|
|
|
- 2090 SymTab.CloseProc;
|
|
|
- 2091 QbeGen.AbortFunc; .)
|
|
|
- 2092 |
|
|
|
- 2093 (. allowDefer := TRUE; deferredBody := FALSE;
|
|
|
- 2094 curProcNode := astNode; .)
|
|
|
- 2095 Block<pn> (. IF deferredBody THEN
|
|
|
- 2096 (* body skipped: close like
|
|
|
- 2097 FORWARD (no body node) *)
|
|
|
- 2098 astDecl := astNode;
|
|
|
- 2099 Lower.ScopeLeave;
|
|
|
- 2100 SymTab.CloseProc;
|
|
|
- 2101 QbeGen.AbortFunc
|
|
|
- 2102 ELSE
|
|
|
- 2103 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2104 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
- 2105 astDecl := astNode;
|
|
|
- 2106 Lower.ScopeLeave;
|
|
|
- 2107 SymTab.CloseProc;
|
|
|
- 2108 QbeGen.EndFunc(
|
|
|
- 2109 SymTab.ProcRes(pn))
|
|
|
- 2110 END; .) ) .
|
|
|
- 2111 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN; .)
|
|
|
- 2112 = (. dfr := FALSE;
|
|
|
- 2113 IF allowDefer AND twoPhaseParse
|
|
|
- 2114 AND NOT repassing THEN
|
|
|
- 2115 dfr := DeferSkip(pn)
|
|
|
- 2116 END;
|
|
|
- 2117 allowDefer := FALSE;
|
|
|
- 2118 .)
|
|
|
- 2119 DeclSeq (. astBlkDecls := astDecl;
|
|
|
- 2120 astStmt := AST.NoNode;
|
|
|
- 2121 nLab := 0; nGot := 0; .)
|
|
|
- 2122 [ "BEGIN" (. (* an empty body is still a
|
|
|
- 2123 body: mark it so Lower
|
|
|
- 2124 does not read it as a
|
|
|
- 2125 definition heading *)
|
|
|
- 2126 IF NOT dfr THEN
|
|
|
- 2127 IF astStmt = AST.NoNode THEN
|
|
|
- 2128 astStmt :=
|
|
|
- 2129 AST.MakeNode(AST.NkBlock)
|
|
|
- 2130 END
|
|
|
- 2131 END; .)
|
|
|
- 2132 [ StatSeq ] ]
|
|
|
- 2133 "END"
|
|
|
- 2134 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
- 2135 SemError(202) END;
|
|
|
- 2136 CheckGotos; .) .
|
|
|
- 2137 (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
|
|
|
- 2138 level body once the unit's declarations are complete. Inlined at
|
|
|
- 2139 both call sites because a stand-alone epsilon production is
|
|
|
- 2140 "unreachable" to Coco/R (referenced only from actions). *)
|
|
|
- 2141 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 2142 = (. astSeq := AST.NoNode;
|
|
|
- 2143 astTail := AST.NoNode; .)
|
|
|
- 2144 Statement (. AstAppend(AST.NkBlock,
|
|
|
- 2145 astSeq, astTail, astStmt); .)
|
|
|
- 2146 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
- 2147 astSeq, astTail, astStmt); .) ] }
|
|
|
- 2148 (. astStmt := astSeq; .) .
|
|
|
- 2149 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
- 2150 are accepted: the statement after ';' is optional. *)
|
|
|
- 2151 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
- 2152 = (. astStmt := AST.NoNode; .)
|
|
|
- 2153 ( AssOrCall
|
|
|
- 2154 | IfStat
|
|
|
- 2155 | WhileStat
|
|
|
- 2156 | RepeatStat
|
|
|
- 2157 | LoopStat
|
|
|
- 2158 | ForStat
|
|
|
- 2159 | CaseStat
|
|
|
- 2160 | WithStat
|
|
|
- 2161 | ReturnStat
|
|
|
- 2162 | HaltStat
|
|
|
- 2163 | NewStat
|
|
|
- 2164 | DisposeStat
|
|
|
- 2165 | IncDecStat
|
|
|
- 2166 | InclExclStat
|
|
|
- 2167 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
- 2168 SemError(230) END;
|
|
|
- 2169 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
- 2170 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
- 2171 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
- 2172 AST.SetChild(astStmt, 0,
|
|
|
- 2173 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
- 2174 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
- 2175 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
- 2176 dk: INTEGER;
|
|
|
- 2177 qd, qe: QbeGen.QVal;
|
|
|
- 2178 qn: SymTab.Name;
|
|
|
- 2179 sfx, isInc: BOOLEAN;
|
|
|
- 2180 astNode, astD: AST.Node; .)
|
|
|
- 2181 = ( "INCL" (. isInc := TRUE; .)
|
|
|
- 2182 | "EXCL" (. isInc := FALSE; .) )
|
|
|
- 2183 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
- 2184 Expr<et2, qe> ")"
|
|
|
- 2185 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2186 IF isInc THEN
|
|
|
- 2187 AST.SetChild(astNode, 0,
|
|
|
- 2188 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
- 2189 ELSE AST.SetChild(astNode, 0,
|
|
|
- 2190 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
- 2191 END;
|
|
|
- 2192 IF astD # AST.NoNode THEN
|
|
|
- 2193 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2194 IF astCur # AST.NoNode THEN
|
|
|
- 2195 AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 2196 astStmt := astNode; .)
|
|
|
- 2197 (. IF (at # SymTab.InvalidType)
|
|
|
- 2198 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
- 2199 SemError(222)
|
|
|
- 2200 END; .) .
|
|
|
- 2201 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
- 2202 integer designator. *)
|
|
|
- 2203 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
- 2204 dk: INTEGER;
|
|
|
- 2205 qd, qv, qn2, qstep:
|
|
|
- 2206 QbeGen.QVal;
|
|
|
- 2207 qn: SymTab.Name;
|
|
|
- 2208 sfx, isInc: BOOLEAN;
|
|
|
- 2209 astNode, astD, astStep:
|
|
|
- 2210 AST.Node; .)
|
|
|
- 2211 = (. isInc := TRUE; .)
|
|
|
- 2212 ( "INC" (. isInc := TRUE; .)
|
|
|
- 2213 | "DEC" (. isInc := FALSE; .) )
|
|
|
- 2214 "(" (. astStep := AST.NoNode; .)
|
|
|
- 2215 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
- 2216 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
- 2217 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2218 IF isInc THEN
|
|
|
- 2219 AST.SetChild(astNode, 0,
|
|
|
- 2220 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
- 2221 ELSE AST.SetChild(astNode, 0,
|
|
|
- 2222 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
- 2223 END;
|
|
|
- 2224 IF astD # AST.NoNode THEN
|
|
|
- 2225 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2226 IF astStep # AST.NoNode THEN
|
|
|
- 2227 AST.SetChild(astNode, 2, astStep) END;
|
|
|
- 2228 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2229 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2230 AND (dk # SymTab.KindParam)
|
|
|
- 2231 AND (dk # SymTab.KindField) THEN
|
|
|
- 2232 SemError(210)
|
|
|
- 2233 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
- 2234 SemError(211)
|
|
|
- 2235 END; .) .
|
|
|
- 2236 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
- 2237 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
- 2238 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
- 2239 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2240 dk: INTEGER;
|
|
|
- 2241 qd, qm: QbeGen.QVal;
|
|
|
- 2242 qn: SymTab.Name;
|
|
|
- 2243 sfx: BOOLEAN;
|
|
|
- 2244 bt: SymTab.TypeIndex;
|
|
|
- 2245 astNode, astD: AST.Node; .)
|
|
|
- 2246 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 2247 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2248 AST.SetChild(astNode, 0,
|
|
|
- 2249 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
- 2250 IF astD # AST.NoNode THEN
|
|
|
- 2251 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2252 astStmt := astNode; .)
|
|
|
- 2253 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2254 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2255 AND (dk # SymTab.KindParam)
|
|
|
- 2256 AND (dk # SymTab.KindField) THEN
|
|
|
- 2257 SemError(210)
|
|
|
- 2258 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 2259 SymTab.ClPtr THEN
|
|
|
- 2260 SemError(219)
|
|
|
- 2261 END; .) .
|
|
|
- 2262 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2263 dk: INTEGER;
|
|
|
- 2264 qd, qv: QbeGen.QVal;
|
|
|
- 2265 qn: SymTab.Name;
|
|
|
- 2266 sfx: BOOLEAN;
|
|
|
- 2267 astNode, astD: AST.Node; .)
|
|
|
- 2268 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 2269 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2270 AST.SetChild(astNode, 0,
|
|
|
- 2271 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
- 2272 IF astD # AST.NoNode THEN
|
|
|
- 2273 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2274 astStmt := astNode; .)
|
|
|
- 2275 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2276 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2277 AND (dk # SymTab.KindParam)
|
|
|
- 2278 AND (dk # SymTab.KindField) THEN
|
|
|
- 2279 SemError(210)
|
|
|
- 2280 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 2281 SymTab.ClPtr THEN
|
|
|
- 2282 SemError(219)
|
|
|
- 2283 END; .) .
|
|
|
- 2284 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
- 2285 address; field designators resolve through both stacks. *)
|
|
|
- 2286 WithStat (. VAR nW: CARDINAL;
|
|
|
- 2287 astNode: AST.Node; .)
|
|
|
- 2288 = "WITH" (. nW := 0;
|
|
|
- 2289 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
- 2290 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
- 2291 "DO" (. astStmt := AST.NoNode; .)
|
|
|
- 2292 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
- 2293 AST.NChild(astNode), astStmt);
|
|
|
- 2294 astStmt := astNode;
|
|
|
- 2295 WHILE nW > 0 DO
|
|
|
- 2296 SymTab.PopScope;
|
|
|
- 2297 QbeGen.PopWith;
|
|
|
- 2298 DEC(nW)
|
|
|
- 2299 END; .) .
|
|
|
- 2300 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
- 2301 (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2302 dk: INTEGER;
|
|
|
- 2303 qd, qe: QbeGen.QVal;
|
|
|
- 2304 qn: SymTab.Name;
|
|
|
- 2305 sfx: BOOLEAN; .)
|
|
|
- 2306 = Design<dt, dk, qd, qn, sfx>
|
|
|
- 2307 (. IF astCur # AST.NoNode THEN
|
|
|
- 2308 AST.SetChild(wnode,
|
|
|
- 2309 AST.NChild(wnode), astCur) END;
|
|
|
- 2310 IF dt = SymTab.InvalidType THEN
|
|
|
- 2311 ELSIF (SymTab.ClassOf(dt) #
|
|
|
- 2312 SymTab.ClRecord)
|
|
|
- 2313 AND (SymTab.ClassOf(dt) #
|
|
|
- 2314 SymTab.ClClass) THEN
|
|
|
- 2315 SemError(215)
|
|
|
- 2316 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
- 2317 QbeGen.PushWith(qd);
|
|
|
- 2318 INC(nW)
|
|
|
- 2319 END; .) .
|
|
|
- 2320 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
- 2321 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
- 2322 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
- 2323 dk: INTEGER;
|
|
|
- 2324 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
- 2325 qn: SymTab.Name;
|
|
|
- 2326 ct2, res0: SymTab.TypeIndex;
|
|
|
- 2327 q2, mg0: QbeGen.QVal;
|
|
|
- 2328 isR, conv, wconv: BOOLEAN;
|
|
|
- 2329 called, sfx: BOOLEAN;
|
|
|
- 2330 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
- 2331 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
- 2332 = GetIdent<n>
|
|
|
- 2333 ( ":" (. NoteLabel(n);
|
|
|
- 2334 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
- 2335 AST.SetChild(astNode, 0,
|
|
|
- 2336 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 2337 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
- 2338 AST.SetChild(astLab, 0, astNode); .)
|
|
|
- 2339 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
- 2340 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
- 2341 astStmt := astLab; .)
|
|
|
- 2342 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
- 2343 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
- 2344 ( ":="
|
|
|
- 2345 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 2346 AST.NkAssign, 0, astLhs, astCur);
|
|
|
- 2347 IF (dt # SymTab.InvalidType)
|
|
|
- 2348 AND (dk # SymTab.KindVar)
|
|
|
- 2349 AND (dk # SymTab.KindParam)
|
|
|
- 2350 AND (dk # SymTab.KindField) THEN
|
|
|
- 2351 SemError(210)
|
|
|
- 2352 ELSIF NOT SymTab.Assignable(et,
|
|
|
- 2353 dt) THEN
|
|
|
- 2354 SemError(210)
|
|
|
- 2355 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 2356 AND (SymTab.ClassOf(dt) =
|
|
|
- 2357 SymTab.ClClass) THEN
|
|
|
- 2358 SemError(230) END;
|
|
|
- 2359 isR := (dt #
|
|
|
- 2360 SymTab.InvalidType)
|
|
|
- 2361 AND (SymTab.ClassOf(dt)
|
|
|
- 2362 = SymTab.ClReal);
|
|
|
- 2363 conv := isR
|
|
|
- 2364 AND SymTab.IsIntFamily(et);
|
|
|
- 2365 wconv := (dt #
|
|
|
- 2366 SymTab.InvalidType)
|
|
|
- 2367 AND SymTab.IsLongFamily(dt)
|
|
|
- 2368 AND SymTab.IsIntFamily(et);
|
|
|
- 2369 IF ((dk = SymTab.KindVar)
|
|
|
- 2370 OR (dk = SymTab.KindParam)
|
|
|
- 2371 OR (dk = SymTab.KindField))
|
|
|
- 2372 AND (dt # SymTab.InvalidType)
|
|
|
- 2373 AND (et # SymTab.InvalidType)
|
|
|
- 2374 AND (SymTab.ClassOf(dt) #
|
|
|
- 2375 SymTab.ClClass) THEN
|
|
|
- 2376 END; .)
|
|
|
- 2377 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
- 2378 (. astRes := AstCallNode(astLhs);
|
|
|
- 2379 sfx := FALSE; .)
|
|
|
- 2380 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
- 2381 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 2382 AST.NkAssign, 0, astRes, astCur);
|
|
|
- 2383 IF NOT sfx THEN
|
|
|
- 2384 SemError(233)
|
|
|
- 2385 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
- 2386 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
- 2387 SemError(210)
|
|
|
- 2388 END; .)
|
|
|
- 2389 | (. (* discarding the result of a
|
|
|
- 2390 foreign C varargs call
|
|
|
- 2391 (printf/snprintf) is accepted;
|
|
|
- 2392 an ordinary Modula-2 function
|
|
|
- 2393 used as a statement stays 233 *)
|
|
|
- 2394 IF (ct2 # SymTab.InvalidType)
|
|
|
- 2395 AND NOT SymTab.Varargs(qn) THEN
|
|
|
- 2396 SemError(233) END;
|
|
|
- 2397 astStmt := astRes; .) )
|
|
|
- 2398 | (* bare `P;`: proper parameterless
|
|
|
- 2399 procedure call; anything else
|
|
|
- 2400 here is 233 (was a bare syntax
|
|
|
- 2401 error before 4.2) *)
|
|
|
- 2402 (. astStmt := AstCallNode(astLhs);
|
|
|
- 2403 IF (dk = SymTab.KindProc)
|
|
|
- 2404 AND NOT sfx THEN
|
|
|
- 2405 res0 := SymTab.ProcRes(qn);
|
|
|
- 2406 IF res0 #
|
|
|
- 2407 SymTab.InvalidType THEN
|
|
|
- 2408 SemError(233)
|
|
|
- 2409 ELSIF SymTab.ProcNPar(qn) #
|
|
|
- 2410 0 THEN
|
|
|
- 2411 SemError(233)
|
|
|
- 2412 END
|
|
|
- 2413 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 2414 AND (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
|
|
|
- 2415 IF SymTab.ProcTypeRes(dt) #
|
|
|
- 2416 SymTab.InvalidType THEN
|
|
|
- 2417 SemError(233)
|
|
|
- 2418 ELSIF SymTab.ProcTypeNPar(dt) #
|
|
|
- 2419 0 THEN
|
|
|
- 2420 SemError(233)
|
|
|
- 2421 END
|
|
|
- 2422 ELSE SemError(233)
|
|
|
- 2423 END; .) ) ) .
|
|
|
- 2424 (* Actual-parameter list shared by statement and expression calls.
|
|
|
- 2425 want selects CallEnd's result handling; t/q carry the call
|
|
|
- 2426 value (statement calls discard). Arity/type failures are 233;
|
|
|
- 2427 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
- 2428 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
- 2429 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
- 2430 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 2431 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
- 2432 vs: INTEGER;
|
|
|
- 2433 res: SymTab.TypeIndex;
|
|
|
- 2434 mg: QbeGen.QVal;
|
|
|
- 2435 ok, ind, isMeth, va, isConv: BOOLEAN; .)
|
|
|
- 2436 = "(" (. called := TRUE;
|
|
|
- 2437 ok := TRUE;
|
|
|
- 2438 ind := FALSE;
|
|
|
- 2439 isConv := FALSE;
|
|
|
- 2440 isMeth := methCls #
|
|
|
- 2441 SymTab.InvalidType;
|
|
|
- 2442 IF isMeth THEN
|
|
|
- 2443 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
- 2444 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
- 2445 res := SymTab.ProcRes(pn)
|
|
|
- 2446 ELSIF (SymTab.SymKind(pn) = SymTab.KindType)
|
|
|
- 2447 OR (SymTab.SymKind(pn) = SymTab.KindPredef) THEN
|
|
|
- 2448 (* ISO type conversion T(x):
|
|
|
- 2449 one value, result is T *)
|
|
|
- 2450 isConv := TRUE;
|
|
|
- 2451 res := SymTab.SymType(pn)
|
|
|
- 2452 ELSIF (pt # SymTab.InvalidType)
|
|
|
- 2453 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
- 2454 ind := TRUE;
|
|
|
- 2455 res := SymTab.ProcTypeRes(pt)
|
|
|
- 2456 ELSE SemError(233);
|
|
|
- 2457 ok := FALSE;
|
|
|
- 2458 res := SymTab.InvalidType
|
|
|
- 2459 END;
|
|
|
- 2460 i := 0; .)
|
|
|
- 2461 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
- 2462 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
- 2463 ")" (. IF ok THEN
|
|
|
- 2464 IF isConv THEN
|
|
|
- 2465 (* a conversion takes
|
|
|
- 2466 exactly one value *)
|
|
|
- 2467 IF i # 1 THEN
|
|
|
- 2468 SemError(233); ok := FALSE
|
|
|
- 2469 END
|
|
|
- 2470 ELSE
|
|
|
- 2471 IF isMeth THEN
|
|
|
- 2472 np := SymTab.ClassMethodNPar(
|
|
|
- 2473 methCls, pn)
|
|
|
- 2474 ELSIF ind THEN
|
|
|
- 2475 np := SymTab.ProcTypeNPar(pt)
|
|
|
- 2476 ELSE np := SymTab.ProcNPar(pn)
|
|
|
- 2477 END;
|
|
|
- 2478 va := (NOT isMeth) AND (NOT ind)
|
|
|
- 2479 AND (SymTab.SymKind(pn) =
|
|
|
- 2480 SymTab.KindProc)
|
|
|
- 2481 AND SymTab.Varargs(pn);
|
|
|
- 2482 IF (i # np) AND NOT va THEN
|
|
|
+ 1585 ELSE k := SymTab.SymKind(n);
|
|
|
+ 1586 IF (k = SymTab.KindType)
|
|
|
+ 1587 OR (k = SymTab.KindPredef) THEN
|
|
|
+ 1588 t := SymTab.SymType(n)
|
|
|
+ 1589 ELSE t := SymTab.InvalidType
|
|
|
+ 1590 END
|
|
|
+ 1591 END; .)
|
|
|
+ 1592 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
+ 1593 IF k = SymTab.KindModule THEN
|
|
|
+ 1594 t := SymTab.QualType(n, qid);
|
|
|
+ 1595 IF t = SymTab.InvalidType THEN
|
|
|
+ 1596 SemError(201)
|
|
|
+ 1597 END
|
|
|
+ 1598 ELSE SemError(221);
|
|
|
+ 1599 t := SymTab.InvalidType
|
|
|
+ 1600 END; .) ]
|
|
|
+ 1601 (. IF NOT dotted THEN
|
|
|
+ 1602 IF (k = SymTab.KindModule)
|
|
|
+ 1603 OR ((k # SymTab.KindType)
|
|
|
+ 1604 AND (k # SymTab.KindPredef)
|
|
|
+ 1605 AND (k # SymTab.KindImport)
|
|
|
+ 1606 AND (k # -1)) THEN
|
|
|
+ 1607 SemError(221)
|
|
|
+ 1608 END
|
|
|
+ 1609 END; .) .
|
|
|
+ 1610 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1611 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1612 lo, hi: INTEGER; .)
|
|
|
+ 1613 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1614 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1615 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1616 t := SymTab.InvalidType
|
|
|
+ 1617 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
+ 1618 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
+ 1619 SemError(230);
|
|
|
+ 1620 t := SymTab.InvalidType
|
|
|
+ 1621 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1622 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1623 OR (lo > hi) THEN
|
|
|
+ 1624 SemError(230);
|
|
|
+ 1625 t := SymTab.InvalidType
|
|
|
+ 1626 ELSE IF SymTab.SameType(tlo, thi) THEN
|
|
|
+ 1627 (* keep the base type: ['A'..'Z']
|
|
|
+ 1628 is character, [red..blue]
|
|
|
+ 1629 that enumeration *)
|
|
|
+ 1630 t := SymTab.NewSubB(lo, hi, tlo)
|
|
|
+ 1631 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
+ 1632 END
|
|
|
+ 1633 END; .)
|
|
|
+ 1634 "]" .
|
|
|
+ 1635 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1636 ord: INTEGER;
|
|
|
+ 1637 qv: QbeGen.QVal; .)
|
|
|
+ 1638 = "(" (. t := SymTab.NewEnum();
|
|
|
+ 1639 ord := 0; .)
|
|
|
+ 1640 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1641 SymTab.KindConst) THEN
|
|
|
+ 1642 SemError(200) END;
|
|
|
+ 1643 SymTab.SetSymType(n, t);
|
|
|
+ 1644 QbeGen.IntStr(ord, qv);
|
|
|
+ 1645 SymTab.SetSymVal(n, qv);
|
|
|
+ 1646 SymTab.NoteEnumLit(t, n);
|
|
|
+ 1647 Lower.NoteVar(n,
|
|
|
+ 1648 SymTab.KindConst, t);
|
|
|
+ 1649 Lower.NoteConstVal(qv);
|
|
|
+ 1650 INC(ord); .)
|
|
|
+ 1651 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1652 SymTab.KindConst) THEN
|
|
|
+ 1653 SemError(200) END;
|
|
|
+ 1654 SymTab.SetSymType(n, t);
|
|
|
+ 1655 QbeGen.IntStr(ord, qv);
|
|
|
+ 1656 SymTab.SetSymVal(n, qv);
|
|
|
+ 1657 SymTab.NoteEnumLit(t, n);
|
|
|
+ 1658 Lower.NoteVar(n,
|
|
|
+ 1659 SymTab.KindConst, t);
|
|
|
+ 1660 Lower.NoteConstVal(qv);
|
|
|
+ 1661 INC(ord); .) }
|
|
|
+ 1662 ")" (. SymTab.SetEnumCount(t,
|
|
|
+ 1663 VAL(CARDINAL, ord)); .) .
|
|
|
+ 1664 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
+ 1665 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
+ 1666 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
+ 1667 class/impl block. Methods end with ";" per the Table example
|
|
|
+ 1668 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
+ 1669 (* Single CLASS item in both loops: separating declaration from
|
|
|
+ 1670 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
+ 1671 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
+ 1672 The second token decides after CLASS is consumed. A misplaced
|
|
|
+ 1673 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
+ 1674 whole unit ends 230 until lowering). *)
|
|
|
+ 1675 ClassItem
|
|
|
+ 1676 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
+ 1677 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
+ 1678 ct: SymTab.TypeIndex; .)
|
|
|
+ 1679 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
+ 1680 SymTab.KindType) THEN
|
|
|
+ 1681 SemError(200) END;
|
|
|
+ 1682 ct := SymTab.NewClass();
|
|
|
+ 1683 SymTab.SetSymType(cn, ct);
|
|
|
+ 1684 SymTab.PushClassScope(ct);
|
|
|
+ 1685 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1686 AST.SetChild(astCls, 0,
|
|
|
+ 1687 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1688 astClsP := AST.NoNode;
|
|
|
+ 1689 astClsPTail := AST.NoNode;
|
|
|
+ 1690 astClsF := AST.NoNode;
|
|
|
+ 1691 astClsFTail := AST.NoNode;
|
|
|
+ 1692 astClsM := AST.NoNode;
|
|
|
+ 1693 astClsMTail := AST.NoNode; .)
|
|
|
+ 1694 [ Parents<ct> ]
|
|
|
+ 1695 ";"
|
|
|
+ 1696 { ClassField<ct> ";" }
|
|
|
+ 1697 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 1698 (. Lower.ScopeLeave;
|
|
|
+ 1699 SymTab.CloseProc;
|
|
|
+ 1700 QbeGen.AbortFunc; .) }
|
|
|
+ 1701 "END"
|
|
|
+ 1702 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1703 SemError(202) END;
|
|
|
+ 1704 SymTab.LayoutClass(ct);
|
|
|
+ 1705 SymTab.PopScope;
|
|
|
+ 1706 AST.SetChild(astCls, 1, astClsP);
|
|
|
+ 1707 AST.SetChild(astCls, 2, astClsF);
|
|
|
+ 1708 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1709 astDecl := astCls; .) .
|
|
|
+ 1710 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
+ 1711 = "(" Parent1<ct>
|
|
|
+ 1712 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
+ 1713 ")" .
|
|
|
+ 1714 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
+ 1715 pt: SymTab.TypeIndex; .)
|
|
|
+ 1716 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
+ 1717 SemError(201)
|
|
|
+ 1718 ELSE pt := SymTab.SymType(p);
|
|
|
+ 1719 IF SymTab.ClassOf(pt) #
|
|
|
+ 1720 SymTab.ClClass THEN
|
|
|
+ 1721 SemError(230)
|
|
|
+ 1722 ELSE SymTab.SetParent(ct, pt)
|
|
|
+ 1723 END
|
|
|
+ 1724 END;
|
|
|
+ 1725 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1726 astClsP, astClsPTail,
|
|
|
+ 1727 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
+ 1728 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
+ 1729 t: SymTab.TypeIndex;
|
|
|
+ 1730 astNode: AST.Node; .)
|
|
|
+ 1731 = GetIdent<n>
|
|
|
+ 1732 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1733 SymTab.KindConst) THEN
|
|
|
+ 1734 SemError(200) END;
|
|
|
+ 1735 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1736 AST.SetChild(astNode, 0,
|
|
|
+ 1737 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1738 AST.SetChild(astNode, 1,
|
|
|
+ 1739 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
+ 1740 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1741 astClsF, astClsFTail, astNode);
|
|
|
+ 1742 IF SymTab.Lookup(rhs) THEN
|
|
|
+ 1743 SymTab.SetSymType(n,
|
|
|
+ 1744 SymTab.SymType(rhs))
|
|
|
+ 1745 END; .)
|
|
|
+ 1746 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1747 n) THEN
|
|
|
+ 1748 SemError(200) END;
|
|
|
+ 1749 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1750 AST.SetChild(astNode, 0,
|
|
|
+ 1751 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1752 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1753 n) THEN
|
|
|
+ 1754 SemError(200) END;
|
|
|
+ 1755 AST.SetChild(astNode,
|
|
|
+ 1756 AST.NChild(astNode),
|
|
|
+ 1757 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
+ 1758 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
+ 1759 AST.SetTy(astNode, t);
|
|
|
+ 1760 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1761 astClsF, astClsFTail, astNode); .) ) .
|
|
|
+ 1762 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
+ 1763 (. VAR wantVirt: BOOLEAN; .)
|
|
|
+ 1764 = (. wantVirt := FALSE; .)
|
|
|
+ 1765 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
+ 1766 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
+ 1767 SymTab.MarkVirtual END;
|
|
|
+ 1768 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 1769 AST.SetChild(astMethod, 0,
|
|
|
+ 1770 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 1771 IF wantVirt THEN
|
|
|
+ 1772 AST.SetOp(astMethod, 3)
|
|
|
+ 1773 ELSE AST.SetOp(astMethod, 0)
|
|
|
+ 1774 END;
|
|
|
+ 1775 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1776 astClsM, astClsMTail, astMethod); .) .
|
|
|
+ 1777 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
+ 1778 ct: SymTab.TypeIndex; .)
|
|
|
+ 1779 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
+ 1780 SemError(201);
|
|
|
+ 1781 ct := SymTab.InvalidType
|
|
|
+ 1782 ELSE ct := SymTab.SymType(cn);
|
|
|
+ 1783 IF SymTab.ClassOf(ct) #
|
|
|
+ 1784 SymTab.ClClass THEN
|
|
|
+ 1785 SemError(230);
|
|
|
+ 1786 ct := SymTab.InvalidType
|
|
|
+ 1787 END
|
|
|
+ 1788 END;
|
|
|
+ 1789 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1790 AST.SetOp(astCls, 1);
|
|
|
+ 1791 AST.SetChild(astCls, 0,
|
|
|
+ 1792 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1793 astClsM := AST.NoNode;
|
|
|
+ 1794 astClsMTail := AST.NoNode;
|
|
|
+ 1795 astStmt := AST.NoNode;
|
|
|
+ 1796 IF ct #
|
|
|
+ 1797 SymTab.InvalidType THEN
|
|
|
+ 1798 IF NOT SymTab.PushClassMembers(
|
|
|
+ 1799 ct) THEN
|
|
|
+ 1800 SemError(230) END;
|
|
|
+ 1801 SymTab.PushImplClass(ct)
|
|
|
+ 1802 END; .)
|
|
|
+ 1803 ";" { MethodImpl<ct> ";" }
|
|
|
+ 1804 (. astStmt := AST.NoNode; .)
|
|
|
+ 1805 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
+ 1806 .)
|
|
|
+ 1807 [ StatSeq ] ]
|
|
|
+ 1808 "END"
|
|
|
+ 1809 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1810 SemError(202) END;
|
|
|
+ 1811 SymTab.PopImplClass;
|
|
|
+ 1812 SymTab.PopScope;
|
|
|
+ 1813 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
+ 1814 AST.SetChild(astCls, 2, astStmt);
|
|
|
+ 1815 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1816 astDecl := astCls; .) .
|
|
|
+ 1817 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
+ 1818 thisQ: QbeGen.QVal;
|
|
|
+ 1819 methRes: SymTab.TypeIndex; .)
|
|
|
+ 1820 = MethodHeading<pn, ct> ";"
|
|
|
+ 1821 (. IF (ct #
|
|
|
+ 1822 SymTab.InvalidType)
|
|
|
+ 1823 AND NOT SymTab.MethodExists(ct,
|
|
|
+ 1824 pn) THEN
|
|
|
+ 1825 SemError(201) END; .)
|
|
|
+ 1826 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
+ 1827 SymTab.MarkFwd;
|
|
|
+ 1828 QbeGen.AbortFunc;
|
|
|
+ 1829 Lower.ScopeLeave;
|
|
|
+ 1830 SymTab.CloseProc; .)
|
|
|
+ 1831 | (.
|
|
|
+ 1832 (* bind the receiver: bare
|
|
|
+ 1833 field names resolve
|
|
|
+ 1834 against THIS *)
|
|
|
+ 1835 QbeGen.CopyOp("@", thisQ);
|
|
|
+ 1836 QbeGen.PushWith(thisQ); .)
|
|
|
+ 1837 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
+ 1838 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
+ 1839 QbeGen.PopWith;
|
|
|
+ 1840 methRes := SymTab.CurRes();
|
|
|
+ 1841 Lower.ScopeLeave;
|
|
|
+ 1842 SymTab.CloseProc;
|
|
|
+ 1843 QbeGen.EndFunc(methRes); .) ) .
|
|
|
+ 1844 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1845 = "CONST" (. astSeq := AST.NoNode;
|
|
|
+ 1846 astTail := AST.NoNode; .)
|
|
|
+ 1847 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1848 astSeq, astTail, astDecl); .) }
|
|
|
+ 1849 (. astDecl := astSeq; .) .
|
|
|
+ 1850 ConstDecl (. VAR n: SymTab.Name;
|
|
|
+ 1851 t: SymTab.TypeIndex;
|
|
|
+ 1852 qv: QbeGen.QVal;
|
|
|
+ 1853 cls: INTEGER;
|
|
|
+ 1854 mk: ARRAY [0 .. 15] OF CARDINAL;
|
|
|
+ 1855 mw: CARDINAL;
|
|
|
+ 1856 mlo: INTEGER;
|
|
|
+ 1857 astNode: AST.Node; .)
|
|
|
+ 1858 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1859 SymTab.KindConst) THEN
|
|
|
+ 1860 SemError(200) END; .)
|
|
|
+ 1861 "="
|
|
|
+ 1862 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1863 AST.SetChild(astNode, 0,
|
|
|
+ 1864 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1865 AST.SetChild(astNode, 1, astCur);
|
|
|
+ 1866 AST.SetTy(astNode, t);
|
|
|
+ 1867 astDecl := astNode;
|
|
|
+ 1868 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
+ 1869 Lower.NoteConstVal(qv);
|
|
|
+ 1870 SymTab.SetSymType(n, t);
|
|
|
+ 1871 cls := SymTab.ClassOf(t);
|
|
|
+ 1872 IF cls = SymTab.ClSet THEN
|
|
|
+ 1873 (* a SET CONST needs static
|
|
|
+ 1874 data: fold its mask now
|
|
|
+ 1875 (the grammar sees the
|
|
|
+ 1876 element values) and let
|
|
|
+ 1877 Lower re-emit it *)
|
|
|
+ 1878 IF Lower.SetConstMaskOf(
|
|
|
+ 1879 AST.Child(astNode, 1),
|
|
|
+ 1880 mk, mw, mlo) THEN
|
|
|
+ 1881 Lower.NoteSetMask(n, mk, mw,
|
|
|
+ 1882 mlo);
|
|
|
+ 1883 SymTab.SetSymVal(n, qv)
|
|
|
+ 1884 ELSE
|
|
|
+ 1885 SemError(230)
|
|
|
+ 1886 END
|
|
|
+ 1887 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 1888 OR (cls = SymTab.ClRecord)
|
|
|
+ 1889 OR (cls = SymTab.ClClass)
|
|
|
+ 1890 OR (cls = SymTab.ClStr)
|
|
|
+ 1891 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 1892 (* an aggregate/string
|
|
|
+ 1893 constant: qv is its
|
|
|
+ 1894 descriptor address; no
|
|
|
+ 1895 scalar data *)
|
|
|
+ 1896 SymTab.SetSymVal(n, qv)
|
|
|
+ 1897 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
+ 1898 SemError(230)
|
|
|
+ 1899 ELSE
|
|
|
+ 1900 SymTab.SetSymVal(n, qv);
|
|
|
+ 1901 END; .) .
|
|
|
+ 1902 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1903 = "VAR" (. astSeq := AST.NoNode;
|
|
|
+ 1904 astTail := AST.NoNode; .)
|
|
|
+ 1905 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1906 astSeq, astTail, astDecl); .) }
|
|
|
+ 1907 (. astDecl := astSeq; .) .
|
|
|
+ 1908 VarDecl (. VAR nm: SymTab.Name;
|
|
|
+ 1909 t: SymTab.TypeIndex;
|
|
|
+ 1910 i: CARDINAL;
|
|
|
+ 1911 cls: INTEGER;
|
|
|
+ 1912 astNode, astTail: AST.Node; .)
|
|
|
+ 1913 = VarIdents ":"
|
|
|
+ 1914 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1915 astTail := astNode;
|
|
|
+ 1916 i := 0;
|
|
|
+ 1917 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1918 SymTab.PendName(i, nm);
|
|
|
+ 1919 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
+ 1920 (* chunked: a VAR list can
|
|
|
+ 1921 exceed AST.MaxChild *)
|
|
|
+ 1922 AstAppend(AST.NkBlock,
|
|
|
+ 1923 astNode, astTail,
|
|
|
+ 1924 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
+ 1925 INC(i)
|
|
|
+ 1926 END;
|
|
|
+ 1927 AST.SetTy(astNode, t);
|
|
|
+ 1928 astDecl := astNode;
|
|
|
+ 1929 cls := SymTab.ClassOf(t);
|
|
|
+ 1930 IF (t # SymTab.InvalidType)
|
|
|
+ 1931 AND NOT SymTab.IsUnresolved(t)
|
|
|
+ 1932 AND (cls # SymTab.ClInt)
|
|
|
+ 1933 AND (cls # SymTab.ClBool)
|
|
|
+ 1934 AND (cls # SymTab.ClChar)
|
|
|
+ 1935 AND (cls # SymTab.ClReal)
|
|
|
+ 1936 AND (cls # SymTab.ClArray)
|
|
|
+ 1937 AND (cls # SymTab.ClSet)
|
|
|
+ 1938 AND (cls # SymTab.ClRecord)
|
|
|
+ 1939 AND (cls # SymTab.ClPtr)
|
|
|
+ 1940 AND (cls # SymTab.ClLong)
|
|
|
+ 1941 AND (cls # SymTab.ClProc)
|
|
|
+ 1942 AND (cls # SymTab.ClUChar)
|
|
|
+ 1943 AND (cls # SymTab.ClUStr)
|
|
|
+ 1944 AND (cls # SymTab.ClEnum)
|
|
|
+ 1945 AND (cls # SymTab.ClByte)
|
|
|
+ 1946 AND (cls # SymTab.ClSByte)
|
|
|
+ 1947 AND (cls # SymTab.ClWord16)
|
|
|
+ 1948 AND (cls # SymTab.ClSWord16)
|
|
|
+ 1949 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 1950 SemError(230) END;
|
|
|
+ 1951 IF QbeGen.LocFull() THEN
|
|
|
+ 1952 SemError(233) END;
|
|
|
+ 1953 i := 0;
|
|
|
+ 1954 IF SymTab.IsUnresolved(t)
|
|
|
+ 1955 AND NOT SymTab.InProc() THEN
|
|
|
+ 1956 (* a forward-typed global:
|
|
|
+ 1957 defer emission until the
|
|
|
+ 1958 TYPE block completes *)
|
|
|
+ 1959 AST.SetOp(astNode, 1);
|
|
|
+ 1960 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1961 SymTab.PendName(i, nm);
|
|
|
+ 1962 IF nPendVar <=
|
|
|
+ 1963 HIGH(pendVarName) THEN
|
|
|
+ 1964 pendVarName[nPendVar] := nm;
|
|
|
+ 1965 pendVarT[nPendVar] := t;
|
|
|
+ 1966 INC(nPendVar)
|
|
|
+ 1967 END;
|
|
|
+ 1968 INC(i)
|
|
|
+ 1969 END
|
|
|
+ 1970 ELSE
|
|
|
+ 1971 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1972 SymTab.PendName(i, nm);
|
|
|
+ 1973 INC(i)
|
|
|
+ 1974 END
|
|
|
+ 1975 END;
|
|
|
+ 1976 (* a plain VAR list, not a
|
|
|
+ 1977 heading: the signature
|
|
|
+ 1978 result is discarded *)
|
|
|
+ 1979 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 1980 END; .) .
|
|
|
+ 1981 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
+ 1982 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 1983 SymTab.KindVar) THEN
|
|
|
+ 1984 SemError(200) END; .)
|
|
|
+ 1985 { ","
|
|
|
+ 1986 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 1987 SymTab.KindVar) THEN
|
|
|
+ 1988 SemError(200) END; .) } .
|
|
|
+ 1989 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
+ 1990 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 1991 SemError(200) END; .)
|
|
|
+ 1992 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 1993 SemError(200) END; .) } .
|
|
|
+ 1994 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
+ 1995 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
+ 1996 FORWARD marks; the body heading re-enters (signature compare
|
|
|
+ 1997 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
+ 1998 (* gm2 declaration pragmas: __BUILTIN__ (definition module) and
|
|
|
+ 1999 __ATTRIBUTE__ __BUILTIN__ (( name )) (implementation). They
|
|
|
+ 2000 annotate C built-ins; V3 parses and ignores them. *)
|
|
|
+ 2001 ProcPragma
|
|
|
+ 2002 = "__BUILTIN__"
|
|
|
+ 2003 | "__ATTRIBUTE__" [ "__BUILTIN__" ] [ "(" "(" ident ")" ")" ] .
|
|
|
+ 2004
|
|
|
+ 2005 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
+ 2006 (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2007 mg: QbeGen.QVal; .)
|
|
|
+ 2008 = "PROCEDURE"
|
|
|
+ 2009 [ ProcPragma ]
|
|
|
+ 2010 GetIdent<pn> (. IF methCls #
|
|
|
+ 2011 SymTab.InvalidType THEN
|
|
|
+ 2012 (* a method: resume the
|
|
|
+ 2013 declared symbol (reuse
|
|
|
+ 2014 its uid) *)
|
|
|
+ 2015 IF NOT SymTab.ResumeMethod(
|
|
|
+ 2016 methCls, pn) THEN
|
|
|
+ 2017 SemError(200) END
|
|
|
+ 2018 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
+ 2019 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
+ 2020 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
+ 2021 SemError(200) END
|
|
|
+ 2022 END
|
|
|
+ 2023 END;
|
|
|
+ 2024 Lower.ScopeEnter;
|
|
|
+ 2025 Lower.NoteProc(pn,
|
|
|
+ 2026 SymTab.ProcUid(pn),
|
|
|
+ 2027 SymTab.InvalidType,
|
|
|
+ 2028 SymTab.ProcDepthOf(pn),
|
|
|
+ 2029 FALSE);
|
|
|
+ 2030 QbeGen.BeginFunc("");
|
|
|
+ 2031 IF methCls #
|
|
|
+ 2032 SymTab.InvalidType THEN
|
|
|
+ 2033 (* hidden THIS receiver:
|
|
|
+ 2034 a VAR param of the
|
|
|
+ 2035 class type, pushed as
|
|
|
+ 2036 the WITH base *)
|
|
|
+ 2037 IF NOT SymTab.EnterThisParam(
|
|
|
+ 2038 methCls) THEN
|
|
|
+ 2039 SemError(200) END;
|
|
|
+ 2040 IF NOT QbeGen.FuncParam(
|
|
|
+ 2041 "THIS", TRUE,
|
|
|
+ 2042 methCls) THEN
|
|
|
+ 2043 SemError(233) END
|
|
|
+ 2044 END; .)
|
|
|
+ 2045 [ FormalParams ]
|
|
|
+ 2046 [ ":" ( TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
+ 2047 SemError(235) END;
|
|
|
+ 2048 Lower.SetProcRes(t); .)
|
|
|
+ 2049 | "PROC" (. (* PROC result: the procedure
|
|
|
+ 2050 value type *)
|
|
|
+ 2051 IF NOT SymTab.SetProcRes(
|
|
|
+ 2052 SymTab.AddrType()) THEN
|
|
|
+ 2053 SemError(235) END;
|
|
|
+ 2054 Lower.SetProcRes(
|
|
|
+ 2055 SymTab.AddrType()); .) ) ] .
|
|
|
+ 2056 FormalParams
|
|
|
+ 2057 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
+ 2058 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2059 nm: SymTab.Name;
|
|
|
+ 2060 i: CARDINAL;
|
|
|
+ 2061 isV: BOOLEAN; .)
|
|
|
+ 2062 = (. isV := FALSE; .)
|
|
|
+ 2063 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 2064 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
+ 2065 WHILE i < SymTab.PendCount() DO
|
|
|
+ 2066 SymTab.PendName(i, nm);
|
|
|
+ 2067 Lower.NoteParam(nm, t, isV);
|
|
|
+ 2068 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
+ 2069 (* value open arrays are
|
|
|
+ 2070 passed as descriptor
|
|
|
+ 2071 addresses (no copy):
|
|
|
+ 2072 same representation as
|
|
|
+ 2073 VAR formals *)
|
|
|
+ 2074 IF NOT QbeGen.FuncParam(nm,
|
|
|
+ 2075 isV
|
|
|
+ 2076 OR SymTab.IsOpenArray(t),
|
|
|
+ 2077 t) THEN
|
|
|
+ 2078 SemError(233) END;
|
|
|
+ 2079 INC(i)
|
|
|
+ 2080 END;
|
|
|
+ 2081 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 2082 SemError(235) END; .) .
|
|
|
+ 2083 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
+ 2084 static link gives them their parent's frame. Methods keep
|
|
|
+ 2085 parse-now/230-later. *)
|
|
|
+ 2086 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
+ 2087 astNode: AST.Node; .)
|
|
|
+ 2088 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 2089 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 2090 AST.SetOp(astNode, 0);
|
|
|
+ 2091 AST.SetChild(astNode, 0,
|
|
|
+ 2092 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 2093 Lower.NoteProcNode(astNode); .)
|
|
|
+ 2094 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
+ 2095 astDecl := astNode;
|
|
|
+ 2096 Lower.ScopeLeave;
|
|
|
+ 2097 SymTab.MarkFwd;
|
|
|
+ 2098 SymTab.CloseProc;
|
|
|
+ 2099 QbeGen.AbortFunc; .)
|
|
|
+ 2100 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
+ 2101 astDecl := astNode;
|
|
|
+ 2102 Lower.MarkProcExternal;
|
|
|
+ 2103 Lower.ScopeLeave;
|
|
|
+ 2104 SymTab.MarkExternal("");
|
|
|
+ 2105 SymTab.CloseProc;
|
|
|
+ 2106 QbeGen.AbortFunc; .)
|
|
|
+ 2107 |
|
|
|
+ 2108 (. allowDefer := TRUE; deferredBody := FALSE;
|
|
|
+ 2109 curProcNode := astNode; .)
|
|
|
+ 2110 Block<pn> (. IF deferredBody THEN
|
|
|
+ 2111 (* body skipped: close like
|
|
|
+ 2112 FORWARD (no body node) *)
|
|
|
+ 2113 astDecl := astNode;
|
|
|
+ 2114 Lower.ScopeLeave;
|
|
|
+ 2115 SymTab.CloseProc;
|
|
|
+ 2116 QbeGen.AbortFunc
|
|
|
+ 2117 ELSE
|
|
|
+ 2118 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2119 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
+ 2120 astDecl := astNode;
|
|
|
+ 2121 Lower.ScopeLeave;
|
|
|
+ 2122 SymTab.CloseProc;
|
|
|
+ 2123 QbeGen.EndFunc(
|
|
|
+ 2124 SymTab.ProcRes(pn))
|
|
|
+ 2125 END; .) ) .
|
|
|
+ 2126 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN; .)
|
|
|
+ 2127 = (. dfr := FALSE;
|
|
|
+ 2128 IF allowDefer AND twoPhaseParse
|
|
|
+ 2129 AND NOT repassing THEN
|
|
|
+ 2130 dfr := DeferSkip(pn)
|
|
|
+ 2131 END;
|
|
|
+ 2132 allowDefer := FALSE;
|
|
|
+ 2133 .)
|
|
|
+ 2134 DeclSeq (. astBlkDecls := astDecl;
|
|
|
+ 2135 astStmt := AST.NoNode;
|
|
|
+ 2136 nLab := 0; nGot := 0; .)
|
|
|
+ 2137 [ "BEGIN" (. (* an empty body is still a
|
|
|
+ 2138 body: mark it so Lower
|
|
|
+ 2139 does not read it as a
|
|
|
+ 2140 definition heading *)
|
|
|
+ 2141 IF NOT dfr THEN
|
|
|
+ 2142 IF astStmt = AST.NoNode THEN
|
|
|
+ 2143 astStmt :=
|
|
|
+ 2144 AST.MakeNode(AST.NkBlock)
|
|
|
+ 2145 END
|
|
|
+ 2146 END; .)
|
|
|
+ 2147 [ StatSeq ] ]
|
|
|
+ 2148 "END"
|
|
|
+ 2149 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
+ 2150 SemError(202) END;
|
|
|
+ 2151 CheckGotos; .) .
|
|
|
+ 2152 (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
|
|
|
+ 2153 level body once the unit's declarations are complete. Inlined at
|
|
|
+ 2154 both call sites because a stand-alone epsilon production is
|
|
|
+ 2155 "unreachable" to Coco/R (referenced only from actions). *)
|
|
|
+ 2156 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 2157 = (. astSeq := AST.NoNode;
|
|
|
+ 2158 astTail := AST.NoNode; .)
|
|
|
+ 2159 Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 2160 astSeq, astTail, astStmt); .)
|
|
|
+ 2161 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 2162 astSeq, astTail, astStmt); .) ] }
|
|
|
+ 2163 (. astStmt := astSeq; .) .
|
|
|
+ 2164 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
+ 2165 are accepted: the statement after ';' is optional. *)
|
|
|
+ 2166 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
+ 2167 = (. astStmt := AST.NoNode; .)
|
|
|
+ 2168 ( AssOrCall
|
|
|
+ 2169 | IfStat
|
|
|
+ 2170 | WhileStat
|
|
|
+ 2171 | RepeatStat
|
|
|
+ 2172 | LoopStat
|
|
|
+ 2173 | ForStat
|
|
|
+ 2174 | CaseStat
|
|
|
+ 2175 | WithStat
|
|
|
+ 2176 | ReturnStat
|
|
|
+ 2177 | HaltStat
|
|
|
+ 2178 | NewStat
|
|
|
+ 2179 | DisposeStat
|
|
|
+ 2180 | IncDecStat
|
|
|
+ 2181 | InclExclStat
|
|
|
+ 2182 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
+ 2183 SemError(230) END;
|
|
|
+ 2184 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
+ 2185 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
+ 2186 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
+ 2187 AST.SetChild(astStmt, 0,
|
|
|
+ 2188 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
+ 2189 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
+ 2190 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
+ 2191 dk: INTEGER;
|
|
|
+ 2192 qd, qe: QbeGen.QVal;
|
|
|
+ 2193 qn: SymTab.Name;
|
|
|
+ 2194 sfx, isInc: BOOLEAN;
|
|
|
+ 2195 astNode, astD: AST.Node; .)
|
|
|
+ 2196 = ( "INCL" (. isInc := TRUE; .)
|
|
|
+ 2197 | "EXCL" (. isInc := FALSE; .) )
|
|
|
+ 2198 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
+ 2199 Expr<et2, qe> ")"
|
|
|
+ 2200 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2201 IF isInc THEN
|
|
|
+ 2202 AST.SetChild(astNode, 0,
|
|
|
+ 2203 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
+ 2204 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 2205 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
+ 2206 END;
|
|
|
+ 2207 IF astD # AST.NoNode THEN
|
|
|
+ 2208 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2209 IF astCur # AST.NoNode THEN
|
|
|
+ 2210 AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 2211 astStmt := astNode; .)
|
|
|
+ 2212 (. IF (at # SymTab.InvalidType)
|
|
|
+ 2213 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
+ 2214 SemError(222)
|
|
|
+ 2215 END; .) .
|
|
|
+ 2216 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
+ 2217 integer designator. *)
|
|
|
+ 2218 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
+ 2219 dk: INTEGER;
|
|
|
+ 2220 qd, qv, qn2, qstep:
|
|
|
+ 2221 QbeGen.QVal;
|
|
|
+ 2222 qn: SymTab.Name;
|
|
|
+ 2223 sfx, isInc: BOOLEAN;
|
|
|
+ 2224 astNode, astD, astStep:
|
|
|
+ 2225 AST.Node; .)
|
|
|
+ 2226 = (. isInc := TRUE; .)
|
|
|
+ 2227 ( "INC" (. isInc := TRUE; .)
|
|
|
+ 2228 | "DEC" (. isInc := FALSE; .) )
|
|
|
+ 2229 "(" (. astStep := AST.NoNode; .)
|
|
|
+ 2230 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
+ 2231 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
+ 2232 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2233 IF isInc THEN
|
|
|
+ 2234 AST.SetChild(astNode, 0,
|
|
|
+ 2235 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
+ 2236 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 2237 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
+ 2238 END;
|
|
|
+ 2239 IF astD # AST.NoNode THEN
|
|
|
+ 2240 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2241 IF astStep # AST.NoNode THEN
|
|
|
+ 2242 AST.SetChild(astNode, 2, astStep) END;
|
|
|
+ 2243 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2244 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2245 AND (dk # SymTab.KindParam)
|
|
|
+ 2246 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2247 SemError(210)
|
|
|
+ 2248 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
+ 2249 SemError(211)
|
|
|
+ 2250 END; .) .
|
|
|
+ 2251 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
+ 2252 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
+ 2253 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
+ 2254 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2255 dk: INTEGER;
|
|
|
+ 2256 qd, qm: QbeGen.QVal;
|
|
|
+ 2257 qn: SymTab.Name;
|
|
|
+ 2258 sfx: BOOLEAN;
|
|
|
+ 2259 bt: SymTab.TypeIndex;
|
|
|
+ 2260 astNode, astD: AST.Node; .)
|
|
|
+ 2261 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 2262 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2263 AST.SetChild(astNode, 0,
|
|
|
+ 2264 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
+ 2265 IF astD # AST.NoNode THEN
|
|
|
+ 2266 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2267 astStmt := astNode; .)
|
|
|
+ 2268 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2269 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2270 AND (dk # SymTab.KindParam)
|
|
|
+ 2271 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2272 SemError(210)
|
|
|
+ 2273 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 2274 SymTab.ClPtr THEN
|
|
|
+ 2275 SemError(219)
|
|
|
+ 2276 END; .) .
|
|
|
+ 2277 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2278 dk: INTEGER;
|
|
|
+ 2279 qd, qv: QbeGen.QVal;
|
|
|
+ 2280 qn: SymTab.Name;
|
|
|
+ 2281 sfx: BOOLEAN;
|
|
|
+ 2282 astNode, astD: AST.Node; .)
|
|
|
+ 2283 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 2284 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2285 AST.SetChild(astNode, 0,
|
|
|
+ 2286 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
+ 2287 IF astD # AST.NoNode THEN
|
|
|
+ 2288 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2289 astStmt := astNode; .)
|
|
|
+ 2290 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2291 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2292 AND (dk # SymTab.KindParam)
|
|
|
+ 2293 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2294 SemError(210)
|
|
|
+ 2295 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 2296 SymTab.ClPtr THEN
|
|
|
+ 2297 SemError(219)
|
|
|
+ 2298 END; .) .
|
|
|
+ 2299 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
+ 2300 address; field designators resolve through both stacks. *)
|
|
|
+ 2301 WithStat (. VAR nW: CARDINAL;
|
|
|
+ 2302 astNode: AST.Node; .)
|
|
|
+ 2303 = "WITH" (. nW := 0;
|
|
|
+ 2304 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
+ 2305 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
+ 2306 "DO" (. astStmt := AST.NoNode; .)
|
|
|
+ 2307 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
+ 2308 AST.NChild(astNode), astStmt);
|
|
|
+ 2309 astStmt := astNode;
|
|
|
+ 2310 WHILE nW > 0 DO
|
|
|
+ 2311 SymTab.PopScope;
|
|
|
+ 2312 QbeGen.PopWith;
|
|
|
+ 2313 DEC(nW)
|
|
|
+ 2314 END; .) .
|
|
|
+ 2315 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
+ 2316 (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2317 dk: INTEGER;
|
|
|
+ 2318 qd, qe: QbeGen.QVal;
|
|
|
+ 2319 qn: SymTab.Name;
|
|
|
+ 2320 sfx: BOOLEAN; .)
|
|
|
+ 2321 = Design<dt, dk, qd, qn, sfx>
|
|
|
+ 2322 (. IF astCur # AST.NoNode THEN
|
|
|
+ 2323 AST.SetChild(wnode,
|
|
|
+ 2324 AST.NChild(wnode), astCur) END;
|
|
|
+ 2325 IF dt = SymTab.InvalidType THEN
|
|
|
+ 2326 ELSIF (SymTab.ClassOf(dt) #
|
|
|
+ 2327 SymTab.ClRecord)
|
|
|
+ 2328 AND (SymTab.ClassOf(dt) #
|
|
|
+ 2329 SymTab.ClClass) THEN
|
|
|
+ 2330 SemError(215)
|
|
|
+ 2331 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
+ 2332 QbeGen.PushWith(qd);
|
|
|
+ 2333 INC(nW)
|
|
|
+ 2334 END; .) .
|
|
|
+ 2335 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
+ 2336 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
+ 2337 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
+ 2338 dk: INTEGER;
|
|
|
+ 2339 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
+ 2340 qn: SymTab.Name;
|
|
|
+ 2341 ct2, res0: SymTab.TypeIndex;
|
|
|
+ 2342 q2, mg0: QbeGen.QVal;
|
|
|
+ 2343 isR, conv, wconv: BOOLEAN;
|
|
|
+ 2344 called, sfx: BOOLEAN;
|
|
|
+ 2345 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
+ 2346 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
+ 2347 = GetIdent<n>
|
|
|
+ 2348 ( ":" (. NoteLabel(n);
|
|
|
+ 2349 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
+ 2350 AST.SetChild(astNode, 0,
|
|
|
+ 2351 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 2352 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
+ 2353 AST.SetChild(astLab, 0, astNode); .)
|
|
|
+ 2354 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
+ 2355 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
+ 2356 astStmt := astLab; .)
|
|
|
+ 2357 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
+ 2358 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
+ 2359 ( ":="
|
|
|
+ 2360 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 2361 AST.NkAssign, 0, astLhs, astCur);
|
|
|
+ 2362 IF (dt # SymTab.InvalidType)
|
|
|
+ 2363 AND (dk # SymTab.KindVar)
|
|
|
+ 2364 AND (dk # SymTab.KindParam)
|
|
|
+ 2365 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2366 SemError(210)
|
|
|
+ 2367 ELSIF NOT SymTab.Assignable(et,
|
|
|
+ 2368 dt) THEN
|
|
|
+ 2369 SemError(210)
|
|
|
+ 2370 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 2371 AND (SymTab.ClassOf(dt) =
|
|
|
+ 2372 SymTab.ClClass) THEN
|
|
|
+ 2373 SemError(230) END;
|
|
|
+ 2374 isR := (dt #
|
|
|
+ 2375 SymTab.InvalidType)
|
|
|
+ 2376 AND (SymTab.ClassOf(dt)
|
|
|
+ 2377 = SymTab.ClReal);
|
|
|
+ 2378 conv := isR
|
|
|
+ 2379 AND SymTab.IsIntFamily(et);
|
|
|
+ 2380 wconv := (dt #
|
|
|
+ 2381 SymTab.InvalidType)
|
|
|
+ 2382 AND SymTab.IsLongFamily(dt)
|
|
|
+ 2383 AND SymTab.IsIntFamily(et);
|
|
|
+ 2384 IF ((dk = SymTab.KindVar)
|
|
|
+ 2385 OR (dk = SymTab.KindParam)
|
|
|
+ 2386 OR (dk = SymTab.KindField))
|
|
|
+ 2387 AND (dt # SymTab.InvalidType)
|
|
|
+ 2388 AND (et # SymTab.InvalidType)
|
|
|
+ 2389 AND (SymTab.ClassOf(dt) #
|
|
|
+ 2390 SymTab.ClClass) THEN
|
|
|
+ 2391 END; .)
|
|
|
+ 2392 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
+ 2393 (. astRes := AstCallNode(astLhs);
|
|
|
+ 2394 sfx := FALSE; .)
|
|
|
+ 2395 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
+ 2396 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 2397 AST.NkAssign, 0, astRes, astCur);
|
|
|
+ 2398 IF NOT sfx THEN
|
|
|
+ 2399 SemError(233)
|
|
|
+ 2400 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
+ 2401 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
+ 2402 SemError(210)
|
|
|
+ 2403 END; .)
|
|
|
+ 2404 | (. (* discarding the result of a
|
|
|
+ 2405 foreign C varargs call
|
|
|
+ 2406 (printf/snprintf) is accepted;
|
|
|
+ 2407 an ordinary Modula-2 function
|
|
|
+ 2408 used as a statement stays 233 *)
|
|
|
+ 2409 IF (ct2 # SymTab.InvalidType)
|
|
|
+ 2410 AND NOT SymTab.Varargs(qn) THEN
|
|
|
+ 2411 SemError(233) END;
|
|
|
+ 2412 astStmt := astRes; .) )
|
|
|
+ 2413 | (* bare `P;`: proper parameterless
|
|
|
+ 2414 procedure call; anything else
|
|
|
+ 2415 here is 233 (was a bare syntax
|
|
|
+ 2416 error before 4.2) *)
|
|
|
+ 2417 (. astStmt := AstCallNode(astLhs);
|
|
|
+ 2418 IF (dk = SymTab.KindProc)
|
|
|
+ 2419 AND NOT sfx THEN
|
|
|
+ 2420 res0 := SymTab.ProcRes(qn);
|
|
|
+ 2421 IF res0 #
|
|
|
+ 2422 SymTab.InvalidType THEN
|
|
|
+ 2423 SemError(233)
|
|
|
+ 2424 ELSIF SymTab.ProcNPar(qn) #
|
|
|
+ 2425 0 THEN
|
|
|
+ 2426 SemError(233)
|
|
|
+ 2427 END
|
|
|
+ 2428 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 2429 AND (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
|
|
|
+ 2430 IF SymTab.ProcTypeRes(dt) #
|
|
|
+ 2431 SymTab.InvalidType THEN
|
|
|
+ 2432 SemError(233)
|
|
|
+ 2433 ELSIF SymTab.ProcTypeNPar(dt) #
|
|
|
+ 2434 0 THEN
|
|
|
+ 2435 SemError(233)
|
|
|
+ 2436 END
|
|
|
+ 2437 ELSE SemError(233)
|
|
|
+ 2438 END; .) ) ) .
|
|
|
+ 2439 (* Actual-parameter list shared by statement and expression calls.
|
|
|
+ 2440 want selects CallEnd's result handling; t/q carry the call
|
|
|
+ 2441 value (statement calls discard). Arity/type failures are 233;
|
|
|
+ 2442 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
+ 2443 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
+ 2444 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
+ 2445 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 2446 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
+ 2447 vs: INTEGER;
|
|
|
+ 2448 res: SymTab.TypeIndex;
|
|
|
+ 2449 mg: QbeGen.QVal;
|
|
|
+ 2450 ok, ind, isMeth, va, isConv: BOOLEAN; .)
|
|
|
+ 2451 = "(" (. called := TRUE;
|
|
|
+ 2452 ok := TRUE;
|
|
|
+ 2453 ind := FALSE;
|
|
|
+ 2454 isConv := FALSE;
|
|
|
+ 2455 isMeth := methCls #
|
|
|
+ 2456 SymTab.InvalidType;
|
|
|
+ 2457 IF isMeth THEN
|
|
|
+ 2458 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
+ 2459 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
+ 2460 res := SymTab.ProcRes(pn)
|
|
|
+ 2461 ELSIF (SymTab.SymKind(pn) = SymTab.KindType)
|
|
|
+ 2462 OR (SymTab.SymKind(pn) = SymTab.KindPredef) THEN
|
|
|
+ 2463 (* ISO type conversion T(x):
|
|
|
+ 2464 one value, result is T *)
|
|
|
+ 2465 isConv := TRUE;
|
|
|
+ 2466 res := SymTab.SymType(pn)
|
|
|
+ 2467 ELSIF (pt # SymTab.InvalidType)
|
|
|
+ 2468 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
+ 2469 ind := TRUE;
|
|
|
+ 2470 res := SymTab.ProcTypeRes(pt)
|
|
|
+ 2471 ELSE SemError(233);
|
|
|
+ 2472 ok := FALSE;
|
|
|
+ 2473 res := SymTab.InvalidType
|
|
|
+ 2474 END;
|
|
|
+ 2475 i := 0; .)
|
|
|
+ 2476 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
+ 2477 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
+ 2478 ")" (. IF ok THEN
|
|
|
+ 2479 IF isConv THEN
|
|
|
+ 2480 (* a conversion takes
|
|
|
+ 2481 exactly one value *)
|
|
|
+ 2482 IF i # 1 THEN
|
|
|
2483 SemError(233); ok := FALSE
|
|
|
2484 END
|
|
|
- 2485 END
|
|
|
- 2486 END;
|
|
|
- 2487 IF NOT ok THEN
|
|
|
- 2488 t := SymTab.InvalidType;
|
|
|
- 2489 QbeGen.CopyOp("0", q)
|
|
|
- 2490 ELSIF want THEN
|
|
|
- 2491 IF res =
|
|
|
- 2492 SymTab.InvalidType THEN
|
|
|
- 2493 IF NOT soft THEN SemError(233) END;
|
|
|
- 2494 t := SymTab.InvalidType;
|
|
|
- 2495 QbeGen.CopyOp("0", q)
|
|
|
- 2496 ELSE t := res;
|
|
|
- 2497 QbeGen.CopyOp("@", q)
|
|
|
- 2498 END
|
|
|
- 2499 ELSE
|
|
|
- 2500 (* a function call used as
|
|
|
- 2501 a statement: allowed for
|
|
|
- 2502 a foreign C varargs proc
|
|
|
- 2503 (printf/snprintf), whose
|
|
|
- 2504 result is conventionally
|
|
|
- 2505 discarded; ordinary
|
|
|
- 2506 Modula-2 functions keep
|
|
|
- 2507 the 233 diagnostic *)
|
|
|
- 2508 IF (res # SymTab.InvalidType)
|
|
|
- 2509 AND NOT va THEN
|
|
|
- 2510 SemError(233)
|
|
|
- 2511 END;
|
|
|
- 2512 t := SymTab.InvalidType;
|
|
|
- 2513 QbeGen.CopyOp("0", q);
|
|
|
- 2514 END; .) .
|
|
|
- 2515 (* One actual: VAR formals take recorded designator addresses
|
|
|
- 2516 (233 otherwise); value formals take converted expressions. *)
|
|
|
- 2517 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
- 2518 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
- 2519 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
- 2520 qe, qa, qt: QbeGen.QVal;
|
|
|
- 2521 isV, conv, va: BOOLEAN;
|
|
|
- 2522 cl: CHAR;
|
|
|
- 2523 savedN, aj: CARDINAL;
|
|
|
- 2524 savedArgs: ARRAY [0 .. 31]
|
|
|
- 2525 OF AST.Node;
|
|
|
- 2526 astActual: AST.Node; .)
|
|
|
- 2527 = (. (* Parsing the actual can clobber
|
|
|
- 2528 the enclosing call's argument
|
|
|
- 2529 list (Factor resets astNArgs),
|
|
|
- 2530 so save/restore it. *)
|
|
|
- 2531 savedN := astNArgs; aj := 0;
|
|
|
- 2532 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 2533 savedArgs[aj] := astArgs[aj];
|
|
|
- 2534 INC(aj)
|
|
|
- 2535 END; .)
|
|
|
- 2536 Expr<at, qe> (. QbeGen.CopyOp(qe, convQ); convT := at;
|
|
|
- 2537 astActual := astCur;
|
|
|
- 2538 astNArgs := savedN; aj := 0;
|
|
|
- 2539 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 2540 astArgs[aj] := savedArgs[aj];
|
|
|
- 2541 INC(aj)
|
|
|
- 2542 END;
|
|
|
- 2543 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
- 2544 astArgs[astNArgs] := astCur;
|
|
|
- 2545 INC(astNArgs)
|
|
|
- 2546 ELSE SemError(230)
|
|
|
- 2547 (* > 32 actuals: impl limit *)
|
|
|
- 2548 END;
|
|
|
- 2549 va := (NOT ind)
|
|
|
- 2550 AND (methCls =
|
|
|
- 2551 SymTab.InvalidType)
|
|
|
- 2552 AND (SymTab.SymKind(pn) =
|
|
|
- 2553 SymTab.KindProc)
|
|
|
- 2554 AND SymTab.Varargs(pn);
|
|
|
- 2555 IF ind THEN
|
|
|
- 2556 ft :=
|
|
|
- 2557 SymTab.ProcTypeParamType(pt,
|
|
|
- 2558 i);
|
|
|
- 2559 isV :=
|
|
|
- 2560 SymTab.ProcTypeParamIsVar(pt,
|
|
|
- 2561 i)
|
|
|
- 2562 ELSIF methCls #
|
|
|
- 2563 SymTab.InvalidType THEN
|
|
|
- 2564 ft :=
|
|
|
- 2565 SymTab.ClassMethodParamType(
|
|
|
- 2566 methCls, pn, i);
|
|
|
- 2567 isV :=
|
|
|
- 2568 SymTab.ClassMethodParamIsVar(
|
|
|
- 2569 methCls, pn, i)
|
|
|
- 2570 ELSE
|
|
|
- 2571 ft := SymTab.ParamType(pn, i);
|
|
|
- 2572 isV := SymTab.ParamIsVar(pn, i)
|
|
|
- 2573 END;
|
|
|
- 2574 IF (at = SymTab.InvalidType) THEN
|
|
|
- 2575 ELSIF ft = SymTab.InvalidType THEN
|
|
|
- 2576 ELSIF isV THEN
|
|
|
- 2577 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 2578 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 2579 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 2580 AND QbeGen.IsImm(qe) THEN
|
|
|
- 2581 ELSIF (AST.Kind(astActual) #
|
|
|
- 2582 AST.NkDesignator)
|
|
|
- 2583 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
- 2584 SemError(233)
|
|
|
- 2585 ELSIF NOT SymTab.VarParamOk(at, ft)
|
|
|
- 2586 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
- 2587 SemError(233)
|
|
|
- 2588 END
|
|
|
- 2589 ELSE
|
|
|
- 2590 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 2591 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 2592 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 2593 AND QbeGen.IsImm(qe) THEN
|
|
|
- 2594 ELSIF NOT SymTab.Assignable(at, ft)
|
|
|
- 2595 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
- 2596 SemError(233)
|
|
|
- 2597 END
|
|
|
- 2598 END; .) .
|
|
|
- 2599 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2600 q: QbeGen.QVal;
|
|
|
- 2601 hasElse: BOOLEAN;
|
|
|
- 2602 astCond, astIf, astLast,
|
|
|
- 2603 astNode: AST.Node; .)
|
|
|
- 2604 = "IF" (. hasElse := FALSE; .)
|
|
|
- 2605 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 2606 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2607 SemError(214) END; .)
|
|
|
- 2608 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 2609 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2610 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2611 astIf := astNode;
|
|
|
- 2612 astLast := astNode; .)
|
|
|
- 2613 { "ELSIF"
|
|
|
- 2614 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 2615 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2616 SemError(214) END; .)
|
|
|
- 2617 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 2618 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2619 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2620 AST.SetChild(astLast, 2, astNode);
|
|
|
- 2621 astLast := astNode; .) }
|
|
|
- 2622 [ "ELSE" (. hasElse := TRUE;
|
|
|
- 2623 astStmt := AST.NoNode; .)
|
|
|
- 2624 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
- 2625 "END" (. astStmt := astIf; .) .
|
|
|
- 2626 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2627 q: QbeGen.QVal;
|
|
|
- 2628 astCond, astNode: AST.Node; .)
|
|
|
- 2629 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
- 2630 Expr<t, q> (. astCond := astCur;
|
|
|
- 2631 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2632 SemError(214) END; .)
|
|
|
- 2633 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
- 2634 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2635 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2636 astStmt := astNode; .)
|
|
|
- 2637 "END" .
|
|
|
- 2638 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2639 q: QbeGen.QVal;
|
|
|
- 2640 astCond, astBody, astNode:
|
|
|
- 2641 AST.Node; .)
|
|
|
- 2642 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
- 2643 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
- 2644 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
- 2645 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
- 2646 AST.SetChild(astNode, 0, astBody);
|
|
|
- 2647 AST.SetChild(astNode, 1, astCond);
|
|
|
- 2648 astStmt := astNode;
|
|
|
- 2649 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2650 SemError(214) END; .) .
|
|
|
- 2651 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
- 2652 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
- 2653 QbeGen.NewLabel(lEnd);
|
|
|
- 2654 QbeGen.PushLoop(lEnd); .)
|
|
|
- 2655 [ StatSeq ]
|
|
|
- 2656 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
- 2657 AST.SetChild(astNode, 0, astStmt);
|
|
|
- 2658 astStmt := astNode;
|
|
|
- 2659 QbeGen.PopLoop; .) .
|
|
|
- 2660 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
- 2661 Runtime direction would need a compare-select; the literal
|
|
|
- 2662 sign picks cslew/csegew at "DO" time. *)
|
|
|
- 2663 ForStat (. VAR lv: SymTab.Name;
|
|
|
- 2664 tlo, thi, tby:
|
|
|
- 2665 SymTab.TypeIndex;
|
|
|
- 2666 qlo, qhi, qby, qt, qk, qb:
|
|
|
- 2667 QbeGen.QVal;
|
|
|
- 2668 lTop, lBody, lEnd:
|
|
|
- 2669 QbeGen.QVal;
|
|
|
- 2670 by: INTEGER;
|
|
|
- 2671 ok: BOOLEAN;
|
|
|
- 2672 astVar, astLo, astHi, astBy,
|
|
|
- 2673 astNode: AST.Node; .)
|
|
|
- 2674 = "FOR" (. by := 1; .)
|
|
|
- 2675 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
- 2676 astStmt := AST.NoNode;
|
|
|
- 2677 astBy := AST.NoNode;
|
|
|
- 2678 ok := SymTab.Lookup(lv);
|
|
|
- 2679 IF NOT ok THEN
|
|
|
- 2680 SemError(201)
|
|
|
- 2681 ELSIF (SymTab.SymKind(lv) #
|
|
|
- 2682 SymTab.KindVar)
|
|
|
- 2683 AND (SymTab.SymKind(lv) #
|
|
|
- 2684 SymTab.KindParam) THEN
|
|
|
- 2685 SemError(220); ok := FALSE
|
|
|
- 2686 ELSIF NOT SymTab.IsOrdinal(
|
|
|
- 2687 SymTab.SymType(lv)) THEN
|
|
|
- 2688 SemError(220); ok := FALSE
|
|
|
- 2689 END; .)
|
|
|
- 2690 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
- 2691 IF NOT SymTab.Assignable(tlo,
|
|
|
- 2692 SymTab.SymType(lv)) THEN
|
|
|
- 2693 SemError(220); ok := FALSE
|
|
|
- 2694 END; .)
|
|
|
- 2695 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
- 2696 IF NOT SymTab.Assignable(thi,
|
|
|
- 2697 SymTab.SymType(lv)) THEN
|
|
|
- 2698 SemError(220); ok := FALSE
|
|
|
- 2699 END; .)
|
|
|
- 2700 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
- 2701 IF (tby #
|
|
|
- 2702 SymTab.InvalidType)
|
|
|
- 2703 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
- 2704 SemError(220); ok := FALSE
|
|
|
- 2705 END;
|
|
|
- 2706 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
- 2707 SemError(230); by := 1
|
|
|
- 2708 ELSIF by = 0 THEN
|
|
|
- 2709 SemError(220); by := 1
|
|
|
- 2710 END; .) ]
|
|
|
- 2711 "DO"
|
|
|
- 2712 [ StatSeq ]
|
|
|
- 2713 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
- 2714 AST.SetChild(astNode, 0, astVar);
|
|
|
- 2715 AST.SetChild(astNode, 1, astLo);
|
|
|
- 2716 AST.SetChild(astNode, 2, astHi);
|
|
|
- 2717 AST.SetChild(astNode, 3, astBy);
|
|
|
- 2718 AST.SetChild(astNode, 4, astStmt);
|
|
|
- 2719 astStmt := astNode;
|
|
|
- 2720 .) .
|
|
|
- 2721 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
- 2722 qsel, lEnd: QbeGen.QVal;
|
|
|
- 2723 arm, astNode, astArms,
|
|
|
- 2724 astArmsTail: AST.Node; .)
|
|
|
- 2725 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
- 2726 AST.SetChild(astNode, 0, astCur);
|
|
|
- 2727 astArms := AST.NoNode;
|
|
|
- 2728 astArmsTail := AST.NoNode;
|
|
|
- 2729 .)
|
|
|
- 2730 "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
- 2731 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
- 2732 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
- 2733 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
- 2734 AST.SetOp(arm, 1);
|
|
|
- 2735 AST.SetChild(arm, 0, astStmt);
|
|
|
- 2736 AstAppend(AST.NkBlock,
|
|
|
- 2737 astArms, astArmsTail, arm); .) ]
|
|
|
- 2738 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
- 2739 astStmt := astNode;
|
|
|
- 2740 .) .
|
|
|
- 2741 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
- 2742 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
- 2743 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
- 2744 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
- 2745 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2746 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
- 2747 (. VAR arm: AST.Node; .)
|
|
|
- 2748 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
- 2749 CaseLabel<tsel, qsel, arm>
|
|
|
- 2750 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
- 2751 ":" (. astStmt := AST.NoNode; .)
|
|
|
- 2752 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
- 2753 astStmt);
|
|
|
- 2754 AstAppend(AST.NkBlock,
|
|
|
- 2755 arms, armsTail, arm);
|
|
|
- 2756 .) .
|
|
|
- 2757 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2758 arm: AST.Node>
|
|
|
- 2759 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
- 2760 q2, q3, qc, qd, qe:
|
|
|
- 2761 QbeGen.QVal;
|
|
|
- 2762 astLab: AST.Node;
|
|
|
- 2763 lNext: QbeGen.QVal; .)
|
|
|
- 2764 = Expr<t2, q2> (. astLab := astCur;
|
|
|
- 2765 IF SymTab.IsEmptyStr(t2)
|
|
|
- 2766 AND (SymTab.ClassOf(tsel) =
|
|
|
- 2767 SymTab.ClChar) THEN
|
|
|
- 2768 (* ISO: '' as a CASE label
|
|
|
- 2769 is the terminator *)
|
|
|
- 2770 QbeGen.CopyOp("0", q2);
|
|
|
- 2771 t2 := SymTab.CharType()
|
|
|
- 2772 END;
|
|
|
- 2773 IF (t2 #
|
|
|
- 2774 SymTab.InvalidType)
|
|
|
- 2775 AND (tsel #
|
|
|
- 2776 SymTab.InvalidType)
|
|
|
- 2777 AND NOT SymTab.EqCheck(t2,
|
|
|
- 2778 tsel) THEN
|
|
|
- 2779 SemError(213) END;
|
|
|
- 2780 (* set labels are not immediates:
|
|
|
- 2781 the CASE chain uses CmpSet *)
|
|
|
- 2782 IF (SymTab.ClassOf(t2) # SymTab.ClSet)
|
|
|
- 2783 AND NOT QbeGen.IsImm(q2) THEN
|
|
|
- 2784 SemError(230)
|
|
|
- 2785 END; .)
|
|
|
- 2786 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
- 2787 AST.NkSubrange, 0, astLab, astCur);
|
|
|
- 2788 IF SymTab.IsEmptyStr(t3)
|
|
|
- 2789 AND (SymTab.ClassOf(tsel) =
|
|
|
- 2790 SymTab.ClChar) THEN
|
|
|
- 2791 QbeGen.CopyOp("0", q3);
|
|
|
- 2792 t3 := SymTab.CharType()
|
|
|
- 2793 END;
|
|
|
- 2794 IF (t3 #
|
|
|
- 2795 SymTab.InvalidType)
|
|
|
- 2796 AND (tsel #
|
|
|
- 2797 SymTab.InvalidType)
|
|
|
- 2798 AND NOT SymTab.EqCheck(t3,
|
|
|
- 2799 tsel) THEN
|
|
|
- 2800 SemError(213) END;
|
|
|
- 2801 IF (SymTab.ClassOf(t3) # SymTab.ClSet)
|
|
|
- 2802 AND NOT QbeGen.IsImm(q3) THEN
|
|
|
- 2803 SemError(230)
|
|
|
- 2804 END; .) ]
|
|
|
- 2805 (. AST.SetChild(arm,
|
|
|
- 2806 AST.NChild(arm), astLab); .) .
|
|
|
- 2807 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2808 q, qt: QbeGen.QVal;
|
|
|
- 2809 res: SymTab.TypeIndex;
|
|
|
- 2810 hadE, conv: BOOLEAN;
|
|
|
- 2811 astVal, astNode: AST.Node; .)
|
|
|
- 2812 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
- 2813 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
- 2814 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
- 2815 IF hadE THEN
|
|
|
- 2816 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2817 END;
|
|
|
- 2818 astStmt := astNode;
|
|
|
- 2819 conv := FALSE;
|
|
|
- 2820 IF NOT SymTab.InProc() THEN
|
|
|
- 2821 SemError(232)
|
|
|
- 2822 ELSE res := SymTab.CurRes();
|
|
|
- 2823 IF NOT hadE THEN
|
|
|
- 2824 IF res #
|
|
|
- 2825 SymTab.InvalidType THEN
|
|
|
- 2826 SemError(232)
|
|
|
- 2827 END
|
|
|
- 2828 ELSIF (res =
|
|
|
- 2829 SymTab.InvalidType)
|
|
|
- 2830 OR (t #
|
|
|
- 2831 SymTab.InvalidType)
|
|
|
- 2832 AND NOT SymTab.Assignable(t,
|
|
|
- 2833 res) THEN
|
|
|
- 2834 SemError(232)
|
|
|
- 2835 END
|
|
|
- 2836 END; .) .
|
|
|
- 2837 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2838 q: QbeGen.QVal;
|
|
|
- 2839 astVal, astNode: AST.Node; .)
|
|
|
- 2840 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
- 2841 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
- 2842 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
- 2843 IF astVal # AST.NoNode THEN
|
|
|
- 2844 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2845 END;
|
|
|
- 2846 astStmt := astNode;
|
|
|
- 2847 .) .
|
|
|
- 2848 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
- 2849 Each index descends one level (bounds-checked, trap on breach);
|
|
|
- 2850 nested levels reload the inner descriptor address. q ends as the
|
|
|
- 2851 value (scalars), the descriptor address (plain arrays), or the
|
|
|
- 2852 element address (indexed); sfx marks the indexed form. *)
|
|
|
- 2853 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2854 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2855 (. VAR n: SymTab.Name; .)
|
|
|
- 2856 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
- 2857 (* The part of Design after the identifier: resolve it and walk the
|
|
|
- 2858 selectors. Split out so a statement can decide between a label
|
|
|
- 2859 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
- 2860 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2861 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2862 (. VAR fn, mal: SymTab.Name;
|
|
|
- 2863 cls: INTEGER;
|
|
|
- 2864 ic: SymTab.TypeIndex;
|
|
|
- 2865 curT, it, eT, bt:
|
|
|
- 2866 SymTab.TypeIndex;
|
|
|
- 2867 iq, ql, qlo, qhi, qe:
|
|
|
- 2868 QbeGen.QVal;
|
|
|
- 2869 lo, hi: INTEGER;
|
|
|
- 2870 fo: INTEGER;
|
|
|
- 2871 isOpen: BOOLEAN;
|
|
|
- 2872 qb, cv: QbeGen.QVal;
|
|
|
- 2873 r: BOOLEAN;
|
|
|
- 2874 astDes, astSel: AST.Node; .)
|
|
|
- 2875 = (. methCls := SymTab.InvalidType;
|
|
|
- 2876 QbeGen.CopyOp(n, qn);
|
|
|
- 2877 sfx := FALSE;
|
|
|
- 2878 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 2879 (* a bare method name inside
|
|
|
- 2880 a CLASS IMPLEMENTATION
|
|
|
- 2881 is a sibling call on
|
|
|
- 2882 THIS *)
|
|
|
- 2883 ic := SymTab.CurImplClass();
|
|
|
- 2884 IF (ic #
|
|
|
- 2885 SymTab.InvalidType)
|
|
|
- 2886 AND SymTab.MethodExists(ic, n) THEN
|
|
|
- 2887 sfx := FALSE;
|
|
|
- 2888 QbeGen.CopyOp("@", q);
|
|
|
- 2889 methCls := ic;
|
|
|
- 2890 k := SymTab.KindProc;
|
|
|
- 2891 t := SymTab.InvalidType
|
|
|
- 2892 ELSIF SymTab.InProc() THEN
|
|
|
- 2893 (* not declared anywhere
|
|
|
- 2894 in scope: with bodies
|
|
|
- 2895 parsed at unit end this
|
|
|
- 2896 is a genuine 201 (a
|
|
|
- 2897 nested-local forward is
|
|
|
- 2898 no longer tolerated). *)
|
|
|
- 2899 SemError(201);
|
|
|
- 2900 t := SymTab.InvalidType;
|
|
|
- 2901 k := -1;
|
|
|
- 2902 QbeGen.CopyOp("0", q)
|
|
|
- 2903 ELSE
|
|
|
- 2904 SemError(201);
|
|
|
- 2905 t :=
|
|
|
- 2906 SymTab.InvalidType;
|
|
|
- 2907 k := -1;
|
|
|
- 2908 QbeGen.CopyOp("0", q)
|
|
|
- 2909 END
|
|
|
- 2910 ELSE
|
|
|
- 2911 t := SymTab.SymType(n);
|
|
|
- 2912 k := SymTab.SymKind(n);
|
|
|
- 2913 IF k = SymTab.KindConst THEN
|
|
|
- 2914 IF SymTab.Equal(n,
|
|
|
- 2915 "TRUE") THEN
|
|
|
- 2916 t := SymTab.BoolType();
|
|
|
- 2917 QbeGen.CopyOp("1", q)
|
|
|
- 2918 ELSIF SymTab.Equal(n,
|
|
|
- 2919 "FALSE") THEN
|
|
|
- 2920 t := SymTab.BoolType();
|
|
|
- 2921 QbeGen.CopyOp("0", q)
|
|
|
- 2922 ELSIF SymTab.Equal(n,
|
|
|
- 2923 "NIL") THEN
|
|
|
- 2924 QbeGen.CopyOp("0", q)
|
|
|
- 2925 ELSE
|
|
|
- 2926 cls :=
|
|
|
- 2927 SymTab.ClassOf(t);
|
|
|
- 2928 IF (t #
|
|
|
- 2929 SymTab.InvalidType)
|
|
|
- 2930 AND ((cls = SymTab.ClInt)
|
|
|
- 2931 OR (cls
|
|
|
- 2932 = SymTab.ClChar)
|
|
|
- 2933 OR (cls
|
|
|
- 2934 = SymTab.ClEnum)
|
|
|
- 2935 OR (cls
|
|
|
- 2936 = SymTab.ClReal)
|
|
|
- 2937 OR (cls
|
|
|
- 2938 = SymTab.ClLong)
|
|
|
- 2939 OR (cls
|
|
|
- 2940 = SymTab.ClNil)
|
|
|
- 2941 OR (cls = SymTab.ClByte)
|
|
|
- 2942 OR (cls = SymTab.ClSByte)
|
|
|
- 2943 OR (cls = SymTab.ClBool)) THEN
|
|
|
- 2944 IF cls = SymTab.ClNil THEN
|
|
|
- 2945 QbeGen.CopyOp("0", q)
|
|
|
- 2946 ELSIF ((cls
|
|
|
- 2947 = SymTab.ClInt)
|
|
|
- 2948 OR (cls
|
|
|
- 2949 = SymTab.ClChar)
|
|
|
- 2950 OR (cls
|
|
|
- 2951 = SymTab.ClEnum)
|
|
|
- 2952 OR (cls
|
|
|
- 2953 = SymTab.ClLong)
|
|
|
- 2954 OR (cls = SymTab.ClByte)
|
|
|
- 2955 OR (cls = SymTab.ClSByte)
|
|
|
- 2956 OR (cls = SymTab.ClBool))
|
|
|
- 2957 AND SymTab.GetSymVal(n, cv)
|
|
|
- 2958 AND QbeGen.IsImm(cv) THEN
|
|
|
- 2959 QbeGen.CopyOp(cv, q)
|
|
|
- 2960 ELSE
|
|
|
- 2961 QbeGen.LoadVar(n,
|
|
|
- 2962 cls = SymTab.ClReal,
|
|
|
- 2963 q)
|
|
|
- 2964 END
|
|
|
- 2965 ELSIF (cls = SymTab.ClArray)
|
|
|
- 2966 OR (cls = SymTab.ClRecord)
|
|
|
- 2967 OR (cls = SymTab.ClClass)
|
|
|
- 2968 OR (cls = SymTab.ClStr)
|
|
|
- 2969 OR (cls = SymTab.ClUStr)
|
|
|
- 2970 OR (cls = SymTab.ClSet) THEN
|
|
|
- 2971 (* aggregate constant:
|
|
|
- 2972 its value IS the
|
|
|
- 2973 descriptor address *)
|
|
|
- 2974 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
- 2975 QbeGen.CopyOp(cv, q)
|
|
|
- 2976 ELSE
|
|
|
- 2977 QbeGen.CopyOp("0", q)
|
|
|
- 2978 END
|
|
|
- 2979 ELSE
|
|
|
- 2980 IF t #
|
|
|
- 2981 SymTab.InvalidType THEN
|
|
|
- 2982 SemError(230)
|
|
|
- 2983 END;
|
|
|
- 2984 QbeGen.CopyOp("0", q)
|
|
|
- 2985 END
|
|
|
- 2986 END
|
|
|
- 2987 ELSIF (k = SymTab.KindVar)
|
|
|
- 2988 OR (k = SymTab.KindParam) THEN
|
|
|
- 2989 cls := SymTab.ClassOf(t);
|
|
|
- 2990 IF (cls # SymTab.ClInt)
|
|
|
- 2991 AND (cls # SymTab.ClBool)
|
|
|
- 2992 AND (cls # SymTab.ClChar)
|
|
|
- 2993 AND (cls # SymTab.ClUChar)
|
|
|
- 2994 AND (cls # SymTab.ClEnum)
|
|
|
- 2995 AND (cls # SymTab.ClReal)
|
|
|
- 2996 AND (cls # SymTab.ClPtr)
|
|
|
- 2997 AND (cls # SymTab.ClProc)
|
|
|
- 2998 AND (cls # SymTab.ClLong)
|
|
|
- 2999 AND (cls # SymTab.ClArray)
|
|
|
- 3000 AND (cls # SymTab.ClSet)
|
|
|
- 3001 AND (cls # SymTab.ClRecord)
|
|
|
- 3002 AND (cls # SymTab.ClUStr)
|
|
|
- 3003 AND (cls # SymTab.ClByte)
|
|
|
- 3004 AND (cls # SymTab.ClSByte)
|
|
|
- 3005 AND (cls # SymTab.ClClass) THEN
|
|
|
- 3006 SemError(230);
|
|
|
- 3007 QbeGen.CopyOp("0", q)
|
|
|
- 3008 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3009 END
|
|
|
- 3010 ELSE QbeGen.CopyOp("0", q);
|
|
|
- 3011 IF k = SymTab.KindImport THEN
|
|
|
- 3012 SemError(230)
|
|
|
- 3013 ELSIF k =
|
|
|
- 3014 SymTab.KindProc THEN
|
|
|
- 3015 (* bare procedure name:
|
|
|
- 3016 a following ArgList
|
|
|
- 3017 makes it a call;
|
|
|
- 3018 otherwise Fact
|
|
|
- 3019 reports 230 *)
|
|
|
- 3020 ELSE
|
|
|
- 3021 IF k = SymTab.KindField THEN
|
|
|
- 3022 IF QbeGen.TopWith(qb) THEN
|
|
|
- 3023 sfx := TRUE
|
|
|
- 3024 ELSE SemError(230);
|
|
|
- 3025 QbeGen.CopyOp("0", q)
|
|
|
- 3026 END
|
|
|
- 3027 END
|
|
|
- 3028 END
|
|
|
- 3029 END
|
|
|
- 3030 END; .)
|
|
|
- 3031 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
- 3032 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 3033 { "[" Expr<it, iq>
|
|
|
- 3034 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 3035 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 3036 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3037 SymTab.ClArray THEN
|
|
|
- 3038 SemError(217);
|
|
|
- 3039 t := SymTab.InvalidType
|
|
|
- 3040 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 3041 AND (SymTab.ClassOf(it) #
|
|
|
- 3042 SymTab.ClChar)
|
|
|
- 3043 AND (SymTab.ClassOf(it) #
|
|
|
- 3044 SymTab.ClEnum)
|
|
|
- 3045 AND (SymTab.ClassOf(it) #
|
|
|
- 3046 SymTab.ClBool) THEN
|
|
|
- 3047 SemError(218);
|
|
|
- 3048 t := SymTab.InvalidType
|
|
|
- 3049 ELSE
|
|
|
- 3050 eT := SymTab.ArrayElem(t);
|
|
|
- 3051 t := eT; sfx := TRUE
|
|
|
- 3052 END; .)
|
|
|
- 3053 { "," Expr<it, iq>
|
|
|
- 3054 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 3055 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 3056 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3057 SymTab.ClArray THEN
|
|
|
- 3058 SemError(217);
|
|
|
- 3059 t := SymTab.InvalidType
|
|
|
- 3060 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 3061 AND (SymTab.ClassOf(it) #
|
|
|
- 3062 SymTab.ClChar)
|
|
|
- 3063 AND (SymTab.ClassOf(it) #
|
|
|
- 3064 SymTab.ClEnum)
|
|
|
- 3065 AND (SymTab.ClassOf(it) #
|
|
|
- 3066 SymTab.ClBool) THEN
|
|
|
- 3067 SemError(218);
|
|
|
- 3068 t := SymTab.InvalidType
|
|
|
- 3069 ELSE
|
|
|
- 3070 eT := SymTab.ArrayElem(t);
|
|
|
- 3071 t := eT; sfx := TRUE
|
|
|
- 3072 END; .) }
|
|
|
- 3073 "]"
|
|
|
- 3074 | "." GetIdent<fn>
|
|
|
- 3075 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3076 AST.SetOp(astSel, AST.SelField);
|
|
|
- 3077 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
- 3078 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
- 3079 (* qualified L.x: materialize
|
|
|
- 3080 the export, then load it *)
|
|
|
- 3081 IF NOT SymTab.MaterializeAlias(n,
|
|
|
- 3082 fn, mal) THEN
|
|
|
- 3083 SemError(201);
|
|
|
- 3084 t := SymTab.InvalidType;
|
|
|
- 3085 QbeGen.CopyOp("0", q)
|
|
|
- 3086 ELSE
|
|
|
- 3087 QbeGen.CopyOp(mal, qn);
|
|
|
- 3088 t := SymTab.SymType(mal);
|
|
|
- 3089 k := SymTab.SymKind(mal);
|
|
|
- 3090 sfx := FALSE;
|
|
|
- 3091 IF k = SymTab.KindProc THEN
|
|
|
- 3092 (* call: ArgList supplies
|
|
|
- 3093 the value *)
|
|
|
- 3094 QbeGen.CopyOp("0", q)
|
|
|
- 3095 ELSIF k = SymTab.KindConst THEN
|
|
|
- 3096 IF SymTab.GetSymVal(mal,
|
|
|
- 3097 cv)
|
|
|
- 3098 THEN QbeGen.CopyOp(cv, q)
|
|
|
- 3099 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3100 END
|
|
|
- 3101 END
|
|
|
- 3102 END
|
|
|
- 3103 ELSIF t = SymTab.InvalidType THEN
|
|
|
- 3104 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3105 SymTab.ClRecord)
|
|
|
- 3106 AND (SymTab.ClassOf(t) #
|
|
|
- 3107 SymTab.ClClass) THEN
|
|
|
- 3108 SemError(215);
|
|
|
- 3109 t := SymTab.InvalidType
|
|
|
- 3110 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 3111 SymTab.ClClass)
|
|
|
- 3112 AND SymTab.MethodExists(t, fn) THEN
|
|
|
- 3113 (* obj.Method: bind the
|
|
|
- 3114 method and pass obj as
|
|
|
- 3115 the hidden receiver; q
|
|
|
- 3116 already holds the
|
|
|
- 3117 object's address *)
|
|
|
- 3118 QbeGen.CopyOp(fn, n);
|
|
|
- 3119 QbeGen.CopyOp(fn, qn);
|
|
|
- 3120 methCls := t;
|
|
|
- 3121 k := SymTab.KindProc;
|
|
|
- 3122 t := SymTab.InvalidType
|
|
|
- 3123 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 3124 fn) THEN
|
|
|
- 3125 SemError(216);
|
|
|
- 3126 t := SymTab.InvalidType
|
|
|
- 3127 ELSE
|
|
|
- 3128 t := SymTab.FieldType(t, fn);
|
|
|
- 3129 sfx := TRUE
|
|
|
- 3130 END; .)
|
|
|
- 3131 | "^"
|
|
|
- 3132 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3133 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 3134 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 3135 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3136 SymTab.ClPtr THEN
|
|
|
- 3137 SemError(219);
|
|
|
- 3138 t := SymTab.InvalidType
|
|
|
- 3139 ELSE
|
|
|
- 3140 bt := SymTab.PtrBase(t);
|
|
|
- 3141 IF bt = SymTab.InvalidType THEN
|
|
|
- 3142 ELSE
|
|
|
- 3143 t := bt;
|
|
|
- 3144 sfx := TRUE
|
|
|
- 3145 END
|
|
|
- 3146 END; .) } (. astCur := astDes; .) .
|
|
|
- 3147 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
- 3148 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
- 3149 (a value, or a descriptor address for aggregates); each component
|
|
|
- 3150 descends one level exactly like the Design components. *)
|
|
|
- 3151 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 3152 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
- 3153 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
- 3154 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
- 3155 iq, ql, qlo, qhi, qe, qb:
|
|
|
- 3156 QbeGen.QVal;
|
|
|
- 3157 lo, hi, fo: INTEGER;
|
|
|
- 3158 isOpen: BOOLEAN;
|
|
|
- 3159 fname: SymTab.Name;
|
|
|
- 3160 astWrap, astSel: AST.Node; .)
|
|
|
- 3161 = "[" Expr<it, iq>
|
|
|
- 3162 (. isM := FALSE;
|
|
|
- 3163 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3164 astWrap := AST.MakeNode(
|
|
|
- 3165 AST.NkDesignator);
|
|
|
- 3166 AST.SetChild(astWrap, 0, node);
|
|
|
- 3167 node := astWrap
|
|
|
- 3168 END;
|
|
|
- 3169 AST.SetChild(node, AST.NChild(node),
|
|
|
- 3170 AST.MakeUn(AST.NkSelector,
|
|
|
- 3171 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 3172 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3173 SymTab.ClArray THEN
|
|
|
- 3174 SemError(217);
|
|
|
- 3175 t := SymTab.InvalidType
|
|
|
- 3176 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 3177 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
- 3178 AND (SymTab.ClassOf(it) # SymTab.ClEnum)
|
|
|
- 3179 AND (SymTab.ClassOf(it) # SymTab.ClBool) THEN
|
|
|
- 3180 SemError(218);
|
|
|
- 3181 t := SymTab.InvalidType
|
|
|
- 3182 ELSE
|
|
|
- 3183 eT := SymTab.ArrayElem(t);
|
|
|
- 3184 t := eT; sfx := TRUE
|
|
|
- 3185 END; .)
|
|
|
- 3186 "]"
|
|
|
- 3187 | "." GetIdent<fname>
|
|
|
- 3188 (. isM := FALSE;
|
|
|
- 3189 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3190 astWrap := AST.MakeNode(
|
|
|
- 3191 AST.NkDesignator);
|
|
|
- 3192 AST.SetChild(astWrap, 0, node);
|
|
|
- 3193 node := astWrap
|
|
|
- 3194 END;
|
|
|
- 3195 AST.SetChild(node, AST.NChild(node),
|
|
|
- 3196 AST.MakeUn(AST.NkSelector,
|
|
|
- 3197 AST.SelField,
|
|
|
- 3198 AST.MakeLeaf(AST.NkIdent,
|
|
|
- 3199 fname))); IF t = SymTab.InvalidType THEN
|
|
|
- 3200 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3201 SymTab.ClRecord)
|
|
|
- 3202 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 3203 SemError(215);
|
|
|
- 3204 t := SymTab.InvalidType
|
|
|
- 3205 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 3206 SymTab.ClClass)
|
|
|
- 3207 AND SymTab.MethodExists(t, fname) THEN
|
|
|
- 3208 (* a method on the call result:
|
|
|
- 3209 a following ArgList makes
|
|
|
- 3210 the call *)
|
|
|
- 3211 mname := fname;
|
|
|
- 3212 methCls := t; isM := TRUE;
|
|
|
- 3213 t := SymTab.InvalidType
|
|
|
- 3214 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 3215 fname) THEN
|
|
|
- 3216 SemError(216);
|
|
|
- 3217 t := SymTab.InvalidType
|
|
|
- 3218 ELSE
|
|
|
- 3219 t := SymTab.FieldType(t, fname);
|
|
|
- 3220 sfx := TRUE
|
|
|
- 3221 END; .)
|
|
|
- 3222 | "^" (. isM := FALSE;
|
|
|
- 3223 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3224 astWrap := AST.MakeNode(
|
|
|
- 3225 AST.NkDesignator);
|
|
|
- 3226 AST.SetChild(astWrap, 0, node);
|
|
|
- 3227 node := astWrap
|
|
|
- 3228 END;
|
|
|
- 3229 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3230 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 3231 AST.SetChild(node,
|
|
|
- 3232 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 3233 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3234 SymTab.ClPtr THEN
|
|
|
- 3235 SemError(219);
|
|
|
- 3236 t := SymTab.InvalidType
|
|
|
- 3237 ELSE
|
|
|
- 3238 bt := SymTab.PtrBase(t);
|
|
|
- 3239 IF bt # SymTab.InvalidType THEN
|
|
|
- 3240 t := bt; sfx := TRUE
|
|
|
- 3241 END
|
|
|
- 3242 END; .) .
|
|
|
- 3243 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3244 (. VAR t2: SymTab.TypeIndex;
|
|
|
- 3245 op: INTEGER;
|
|
|
- 3246 q2, qt, wl: QbeGen.QVal;
|
|
|
- 3247 astA, astB: AST.Node;
|
|
|
- 3248 astOp: INTEGER;
|
|
|
- 3249 astMade: BOOLEAN;
|
|
|
- 3250 isR: BOOLEAN; .)
|
|
|
- 3251 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
- 3252 [ Rel<op> SimExpr<t2, q2>
|
|
|
- 3253 (. astB := astCur; astMade := TRUE;
|
|
|
- 3254 astOp := AST.OpEq;
|
|
|
- 3255 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
- 3256 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
- 3257 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
- 3258 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
- 3259 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
- 3260 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
- 3261 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
- 3262 END;
|
|
|
- 3263 IF op = SymTab.OpIn THEN
|
|
|
- 3264 IF SymTab.InCheck(t, t2) THEN
|
|
|
- 3265 IF (t = SymTab.InvalidType)
|
|
|
- 3266 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 3267 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 3268 ELSE
|
|
|
- 3269 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3270 END
|
|
|
- 3271 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
- 3272 QbeGen.CopyOp("0", q)
|
|
|
- 3273 END
|
|
|
- 3274 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
- 3275 IF (t = SymTab.InvalidType)
|
|
|
- 3276 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 3277 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 3278 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
- 3279 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
- 3280 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
- 3281 AND (op # SymTab.OpNeq2) THEN
|
|
|
- 3282 SemError(213); t := SymTab.InvalidType;
|
|
|
- 3283 QbeGen.CopyOp("0", q)
|
|
|
- 3284 ELSE
|
|
|
- 3285 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3286 END
|
|
|
- 3287 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3288 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3289 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3290 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
- 3291 QbeGen.StrEq(op, q, q2, qt);
|
|
|
- 3292 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 3293 ELSIF SymTab.IsLongFamily(t)
|
|
|
- 3294 OR SymTab.IsLongFamily(t2) THEN
|
|
|
- 3295 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3296 ELSE
|
|
|
- 3297 t := SymTab.BoolType();
|
|
|
- 3298 QbeGen.CopyOp("@", q)
|
|
|
- 3299 END
|
|
|
- 3300 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
- 3301 QbeGen.CopyOp("0", q)
|
|
|
- 3302 END;
|
|
|
- 3303 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
- 3304 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
- 3305 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3306 Rel<VAR op: INTEGER>
|
|
|
- 3307 = "=" (. op := SymTab.OpEq; .)
|
|
|
- 3308 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
- 3309 | "<" (. op := SymTab.OpLt; .)
|
|
|
- 3310 | "<=" (. op := SymTab.OpLe; .)
|
|
|
- 3311 | ">" (. op := SymTab.OpGt; .)
|
|
|
- 3312 | ">=" (. op := SymTab.OpGe; .)
|
|
|
- 3313 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
- 3314 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3315 (. VAR t2, res2, lt, rt:
|
|
|
- 3316 SymTab.TypeIndex;
|
|
|
- 3317 op: INTEGER;
|
|
|
- 3318 q2, qt, wq, qf, q2a, q2b:
|
|
|
- 3319 QbeGen.QVal;
|
|
|
- 3320 neg, isR, isL, folded:
|
|
|
- 3321 BOOLEAN;
|
|
|
- 3322 fok: BOOLEAN;
|
|
|
- 3323 lw, rw, mw: CARDINAL;
|
|
|
- 3324 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 3325 astA, astB: AST.Node;
|
|
|
- 3326 astSign, astOp: INTEGER; .)
|
|
|
- 3327 = (. neg := FALSE; astSign := 0; .)
|
|
|
- 3328 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
- 3329 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
- 3330 Term<t, q> (. astA := astCur;
|
|
|
- 3331 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
- 3332 QbeGen.NegFold(q, q)
|
|
|
- 3333 END;
|
|
|
- 3334 IF astSign < 0 THEN
|
|
|
- 3335 astCur := AST.MakeUn(
|
|
|
- 3336 AST.NkUnary, AST.OpSub, astA);
|
|
|
- 3337 astA := astCur
|
|
|
- 3338 END; .)
|
|
|
- 3339 { AddOp<op>
|
|
|
- 3340 Term<t2, q2> (. astB := astCur; .)
|
|
|
- 3341 (. astOp := AST.OpAdd;
|
|
|
- 3342 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
- 3343 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
- 3344 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 3345 astCur := astA;
|
|
|
- 3346 IF op = SymTab.OpOr THEN
|
|
|
- 3347 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
- 3348 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 3349 t := SymTab.BoolType()
|
|
|
- 3350 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 3351 IF t # SymTab.InvalidType THEN
|
|
|
- 3352 QbeGen.CopyOp("@", q)
|
|
|
- 3353 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3354 END
|
|
|
- 3355 ELSIF (op = SymTab.OpAdd)
|
|
|
- 3356 AND (SymTab.UStrCompat(t, t2)
|
|
|
- 3357 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 3358 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
- 3359 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
- 3360 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
- 3361 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 3362 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
- 3363 (* UString concatenation: a UCHAR operand becomes a
|
|
|
- 3364 1-codepoint UString; the result is a descriptor in the
|
|
|
- 3365 shim's concat buffer. Work on copies so neither
|
|
|
- 3366 operand is clobbered. *)
|
|
|
- 3367 t := SymTab.NewUStr();
|
|
|
- 3368 QbeGen.CopyOp("@", q)
|
|
|
- 3369 ELSIF (op = SymTab.OpAdd)
|
|
|
- 3370 AND (SymTab.StrCompat(t, t2)
|
|
|
- 3371 OR (SymTab.IsStrType(t)
|
|
|
- 3372 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
- 3373 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 3374 AND SymTab.IsStrType(t2))) THEN
|
|
|
- 3375 (* string concatenation; a CHAR operand becomes a
|
|
|
- 3376 1-character string literal. When both operands are
|
|
|
- 3377 constants, fold to a single string literal so a
|
|
|
- 3378 constructor element stays compile-time. *)
|
|
|
- 3379 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
- 3380 qt, fok);
|
|
|
- 3381 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
- 3382 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3383 END;
|
|
|
- 3384 t := SymTab.NewStr()
|
|
|
- 3385 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 3386 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3387 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3388 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 3389 mw := lw;
|
|
|
- 3390 IF rw > mw THEN mw := rw END;
|
|
|
- 3391 t := SymTab.NewSet(
|
|
|
- 3392 SymTab.NewSubR(0,
|
|
|
- 3393 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 3394 QbeGen.CopyOp("@", q)
|
|
|
- 3395 ELSE
|
|
|
- 3396 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
- 3397 lt := t; rt := t2; t := res2
|
|
|
- 3398 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 3399 IF t # SymTab.InvalidType THEN
|
|
|
- 3400 isL := SymTab.IsLongFamily(t);
|
|
|
- 3401 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 3402 folded := FALSE;
|
|
|
- 3403 IF (NOT isL) AND (NOT isR)
|
|
|
- 3404 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 3405 IF op = SymTab.OpAdd THEN
|
|
|
- 3406 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
- 3407 ELSE
|
|
|
- 3408 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
- 3409 END
|
|
|
- 3410 END;
|
|
|
- 3411 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 3412 ELSE
|
|
|
- 3413 QbeGen.CopyOp("@", q)
|
|
|
- 3414 END
|
|
|
- 3415 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3416 END
|
|
|
- 3417 END; .) }
|
|
|
- 3418 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3419 AddOp<VAR op: INTEGER>
|
|
|
- 3420 = "+" (. op := SymTab.OpAdd; .)
|
|
|
- 3421 | "-" (. op := SymTab.OpSub; .)
|
|
|
- 3422 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
- 3423 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3424 (. VAR t2, res2, lt, rt:
|
|
|
- 3425 SymTab.TypeIndex;
|
|
|
- 3426 op: INTEGER;
|
|
|
- 3427 q2, qt, wq, qf:
|
|
|
- 3428 QbeGen.QVal;
|
|
|
- 3429 isR, isL, folded: BOOLEAN;
|
|
|
- 3430 lw, rw, mw: CARDINAL;
|
|
|
- 3431 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 3432 astA, astB: AST.Node;
|
|
|
- 3433 astOp: INTEGER; .)
|
|
|
- 3434 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
- 3435 Fact<t2, q2> (. astB := astCur; .)
|
|
|
- 3436 (. astOp := AST.OpMul;
|
|
|
- 3437 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
- 3438 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
- 3439 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
- 3440 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
- 3441 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 3442 astCur := astA;
|
|
|
- 3443 IF op = SymTab.OpAnd THEN
|
|
|
- 3444 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
- 3445 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 3446 t := SymTab.BoolType()
|
|
|
- 3447 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 3448 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
- 3449 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3450 END
|
|
|
- 3451 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 3452 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3453 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3454 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 3455 mw := lw;
|
|
|
- 3456 IF rw > mw THEN mw := rw END;
|
|
|
- 3457 t := SymTab.NewSet(
|
|
|
- 3458 SymTab.NewSubR(0,
|
|
|
- 3459 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 3460 QbeGen.CopyOp("@", q)
|
|
|
- 3461 ELSE
|
|
|
- 3462 IF SymTab.ArithCheck(t, t2,
|
|
|
- 3463 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
- 3464 res2) THEN
|
|
|
- 3465 lt := t; rt := t2; t := res2
|
|
|
- 3466 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 3467 IF t # SymTab.InvalidType THEN
|
|
|
- 3468 isL := SymTab.IsLongFamily(t);
|
|
|
- 3469 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 3470 folded := FALSE;
|
|
|
- 3471 IF (NOT isL) AND (NOT isR)
|
|
|
- 3472 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 3473 IF op = SymTab.OpTimes THEN
|
|
|
- 3474 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
- 3475 ELSIF op = SymTab.OpDiv THEN
|
|
|
- 3476 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
- 3477 ELSIF op = SymTab.OpMod THEN
|
|
|
- 3478 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
- 3479 END
|
|
|
- 3480 END;
|
|
|
- 3481 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 3482 ELSE
|
|
|
- 3483 QbeGen.CopyOp("@", q)
|
|
|
- 3484 END
|
|
|
- 3485 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3486 END
|
|
|
- 3487 END; .) }
|
|
|
- 3488 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3489 MulOp<VAR op: INTEGER>
|
|
|
- 3490 = "*" (. op := SymTab.OpTimes; .)
|
|
|
- 3491 | "/" (. op := SymTab.OpSlash; .)
|
|
|
- 3492 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
- 3493 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
- 3494 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
- 3495 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3496 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
- 3497 et, dt, t2, st, ct2, et2:
|
|
|
- 3498 SymTab.TypeIndex;
|
|
|
- 3499 dk: INTEGER;
|
|
|
- 3500 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
- 3501 QbeGen.QVal;
|
|
|
- 3502 qn, vn: SymTab.Name;
|
|
|
- 3503 vt: SymTab.TypeIndex;
|
|
|
- 3504 c1, c2: INTEGER;
|
|
|
- 3505 lo, hi: INTEGER;
|
|
|
- 3506 isMax: BOOLEAN;
|
|
|
- 3507 called, isHigh, sfx, isCh,
|
|
|
- 3508 isU, uok, isStr: BOOLEAN;
|
|
|
- 3509 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
- 3510 astD: AST.Node;
|
|
|
- 3511 astCall: BOOLEAN;
|
|
|
- 3512 astNode, astNot: AST.Node;
|
|
|
- 3513 j: CARDINAL;
|
|
|
- 3514 astArg2: AST.Node;
|
|
|
- 3515 astBrace: AST.Node;
|
|
|
- 3516 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
- 3517 isConvF: BOOLEAN;
|
|
|
- 3518 fi, fj: CARDINAL; .)
|
|
|
- 3519 = (. astIsLit := FALSE; .)
|
|
|
- 3520 ( "__LINE__" (. QbeGen.IntStr(M2S.line, q);
|
|
|
- 3521 astIsLit := TRUE;
|
|
|
- 3522 astCur := AST.MakeLeaf(
|
|
|
- 3523 AST.NkIntLit, q);
|
|
|
- 3524 t := SymTab.IntType(); .)
|
|
|
- 3525 | "__FILE__" (. (* fold to the quoted file name *)
|
|
|
- 3526 s[0] := '"'; fi := 1; fj := 0;
|
|
|
- 3527 WHILE (M2S.fileName[fj] # CHR(0))
|
|
|
- 3528 AND (fi < HIGH(s)) DO
|
|
|
- 3529 s[fi] := M2S.fileName[fj];
|
|
|
- 3530 INC(fi); INC(fj)
|
|
|
- 3531 END;
|
|
|
- 3532 s[fi] := '"';
|
|
|
- 3533 s[fi + 1] := CHR(0);
|
|
|
- 3534 astIsLit := TRUE;
|
|
|
- 3535 astCur := AST.MakeLeaf(
|
|
|
- 3536 AST.NkStrLit, s);
|
|
|
- 3537 t := SymTab.NewStr();
|
|
|
- 3538 QbeGen.DeclStr(s, q); .)
|
|
|
- 3539 | integer (. LexString(s);
|
|
|
- 3540 QbeGen.NormInt(s, q); astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s);
|
|
|
- 3541 t := SymTab.IntType(); .)
|
|
|
- 3542 | charConst (. LexString(s);
|
|
|
- 3543 QbeGen.NormLit(s, q, isCh);
|
|
|
- 3544 astIsLit := TRUE;
|
|
|
- 3545 astCur := AST.MakeLeaf(
|
|
|
- 3546 AST.NkCharLit, s);
|
|
|
- 3547 t := SymTab.CharType(); .)
|
|
|
- 3548 | real (. LexString(s);
|
|
|
- 3549 QbeGen.NormReal(s, q);
|
|
|
- 3550 astIsLit := TRUE;
|
|
|
- 3551 astCur := AST.MakeLeaf(
|
|
|
- 3552 AST.NkRealLit, s);
|
|
|
- 3553 t := SymTab.RealType(); .)
|
|
|
- 3554 | string (. LexString(s);
|
|
|
+ 2485 ELSE
|
|
|
+ 2486 IF isMeth THEN
|
|
|
+ 2487 np := SymTab.ClassMethodNPar(
|
|
|
+ 2488 methCls, pn)
|
|
|
+ 2489 ELSIF ind THEN
|
|
|
+ 2490 np := SymTab.ProcTypeNPar(pt)
|
|
|
+ 2491 ELSE np := SymTab.ProcNPar(pn)
|
|
|
+ 2492 END;
|
|
|
+ 2493 va := (NOT isMeth) AND (NOT ind)
|
|
|
+ 2494 AND (SymTab.SymKind(pn) =
|
|
|
+ 2495 SymTab.KindProc)
|
|
|
+ 2496 AND SymTab.Varargs(pn);
|
|
|
+ 2497 IF (i # np) AND NOT va THEN
|
|
|
+ 2498 SemError(233); ok := FALSE
|
|
|
+ 2499 END
|
|
|
+ 2500 END
|
|
|
+ 2501 END;
|
|
|
+ 2502 IF NOT ok THEN
|
|
|
+ 2503 t := SymTab.InvalidType;
|
|
|
+ 2504 QbeGen.CopyOp("0", q)
|
|
|
+ 2505 ELSIF want THEN
|
|
|
+ 2506 IF res =
|
|
|
+ 2507 SymTab.InvalidType THEN
|
|
|
+ 2508 IF NOT soft THEN SemError(233) END;
|
|
|
+ 2509 t := SymTab.InvalidType;
|
|
|
+ 2510 QbeGen.CopyOp("0", q)
|
|
|
+ 2511 ELSE t := res;
|
|
|
+ 2512 QbeGen.CopyOp("@", q)
|
|
|
+ 2513 END
|
|
|
+ 2514 ELSE
|
|
|
+ 2515 (* a function call used as
|
|
|
+ 2516 a statement: allowed for
|
|
|
+ 2517 a foreign C varargs proc
|
|
|
+ 2518 (printf/snprintf), whose
|
|
|
+ 2519 result is conventionally
|
|
|
+ 2520 discarded; ordinary
|
|
|
+ 2521 Modula-2 functions keep
|
|
|
+ 2522 the 233 diagnostic *)
|
|
|
+ 2523 IF (res # SymTab.InvalidType)
|
|
|
+ 2524 AND NOT va THEN
|
|
|
+ 2525 SemError(233)
|
|
|
+ 2526 END;
|
|
|
+ 2527 t := SymTab.InvalidType;
|
|
|
+ 2528 QbeGen.CopyOp("0", q);
|
|
|
+ 2529 END; .) .
|
|
|
+ 2530 (* One actual: VAR formals take recorded designator addresses
|
|
|
+ 2531 (233 otherwise); value formals take converted expressions. *)
|
|
|
+ 2532 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
+ 2533 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
+ 2534 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
+ 2535 qe, qa, qt: QbeGen.QVal;
|
|
|
+ 2536 isV, conv, va: BOOLEAN;
|
|
|
+ 2537 cl: CHAR;
|
|
|
+ 2538 savedN, aj: CARDINAL;
|
|
|
+ 2539 savedArgs: ARRAY [0 .. 31]
|
|
|
+ 2540 OF AST.Node;
|
|
|
+ 2541 astActual: AST.Node; .)
|
|
|
+ 2542 = (. (* Parsing the actual can clobber
|
|
|
+ 2543 the enclosing call's argument
|
|
|
+ 2544 list (Factor resets astNArgs),
|
|
|
+ 2545 so save/restore it. *)
|
|
|
+ 2546 savedN := astNArgs; aj := 0;
|
|
|
+ 2547 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 2548 savedArgs[aj] := astArgs[aj];
|
|
|
+ 2549 INC(aj)
|
|
|
+ 2550 END; .)
|
|
|
+ 2551 Expr<at, qe> (. QbeGen.CopyOp(qe, convQ); convT := at;
|
|
|
+ 2552 astActual := astCur;
|
|
|
+ 2553 astNArgs := savedN; aj := 0;
|
|
|
+ 2554 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 2555 astArgs[aj] := savedArgs[aj];
|
|
|
+ 2556 INC(aj)
|
|
|
+ 2557 END;
|
|
|
+ 2558 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
+ 2559 astArgs[astNArgs] := astCur;
|
|
|
+ 2560 INC(astNArgs)
|
|
|
+ 2561 ELSE SemError(230)
|
|
|
+ 2562 (* > 32 actuals: impl limit *)
|
|
|
+ 2563 END;
|
|
|
+ 2564 va := (NOT ind)
|
|
|
+ 2565 AND (methCls =
|
|
|
+ 2566 SymTab.InvalidType)
|
|
|
+ 2567 AND (SymTab.SymKind(pn) =
|
|
|
+ 2568 SymTab.KindProc)
|
|
|
+ 2569 AND SymTab.Varargs(pn);
|
|
|
+ 2570 IF ind THEN
|
|
|
+ 2571 ft :=
|
|
|
+ 2572 SymTab.ProcTypeParamType(pt,
|
|
|
+ 2573 i);
|
|
|
+ 2574 isV :=
|
|
|
+ 2575 SymTab.ProcTypeParamIsVar(pt,
|
|
|
+ 2576 i)
|
|
|
+ 2577 ELSIF methCls #
|
|
|
+ 2578 SymTab.InvalidType THEN
|
|
|
+ 2579 ft :=
|
|
|
+ 2580 SymTab.ClassMethodParamType(
|
|
|
+ 2581 methCls, pn, i);
|
|
|
+ 2582 isV :=
|
|
|
+ 2583 SymTab.ClassMethodParamIsVar(
|
|
|
+ 2584 methCls, pn, i)
|
|
|
+ 2585 ELSE
|
|
|
+ 2586 ft := SymTab.ParamType(pn, i);
|
|
|
+ 2587 isV := SymTab.ParamIsVar(pn, i)
|
|
|
+ 2588 END;
|
|
|
+ 2589 IF (at = SymTab.InvalidType) THEN
|
|
|
+ 2590 ELSIF ft = SymTab.InvalidType THEN
|
|
|
+ 2591 ELSIF isV THEN
|
|
|
+ 2592 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 2593 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 2594 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 2595 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 2596 ELSIF (AST.Kind(astActual) #
|
|
|
+ 2597 AST.NkDesignator)
|
|
|
+ 2598 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
+ 2599 SemError(233)
|
|
|
+ 2600 ELSIF NOT SymTab.VarParamOk(at, ft)
|
|
|
+ 2601 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
+ 2602 SemError(233)
|
|
|
+ 2603 END
|
|
|
+ 2604 ELSE
|
|
|
+ 2605 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 2606 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 2607 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 2608 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 2609 ELSIF NOT SymTab.Assignable(at, ft)
|
|
|
+ 2610 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
+ 2611 SemError(233)
|
|
|
+ 2612 END
|
|
|
+ 2613 END; .) .
|
|
|
+ 2614 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2615 q: QbeGen.QVal;
|
|
|
+ 2616 hasElse: BOOLEAN;
|
|
|
+ 2617 astCond, astIf, astLast,
|
|
|
+ 2618 astNode: AST.Node; .)
|
|
|
+ 2619 = "IF" (. hasElse := FALSE; .)
|
|
|
+ 2620 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2621 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2622 SemError(214) END; .)
|
|
|
+ 2623 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2624 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2625 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2626 astIf := astNode;
|
|
|
+ 2627 astLast := astNode; .)
|
|
|
+ 2628 { "ELSIF"
|
|
|
+ 2629 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2630 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2631 SemError(214) END; .)
|
|
|
+ 2632 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2633 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2634 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2635 AST.SetChild(astLast, 2, astNode);
|
|
|
+ 2636 astLast := astNode; .) }
|
|
|
+ 2637 [ "ELSE" (. hasElse := TRUE;
|
|
|
+ 2638 astStmt := AST.NoNode; .)
|
|
|
+ 2639 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
+ 2640 "END" (. astStmt := astIf; .) .
|
|
|
+ 2641 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2642 q: QbeGen.QVal;
|
|
|
+ 2643 astCond, astNode: AST.Node; .)
|
|
|
+ 2644 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2645 Expr<t, q> (. astCond := astCur;
|
|
|
+ 2646 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2647 SemError(214) END; .)
|
|
|
+ 2648 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
+ 2649 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2650 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2651 astStmt := astNode; .)
|
|
|
+ 2652 "END" .
|
|
|
+ 2653 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2654 q: QbeGen.QVal;
|
|
|
+ 2655 astCond, astBody, astNode:
|
|
|
+ 2656 AST.Node; .)
|
|
|
+ 2657 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
+ 2658 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
+ 2659 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
+ 2660 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
+ 2661 AST.SetChild(astNode, 0, astBody);
|
|
|
+ 2662 AST.SetChild(astNode, 1, astCond);
|
|
|
+ 2663 astStmt := astNode;
|
|
|
+ 2664 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2665 SemError(214) END; .) .
|
|
|
+ 2666 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
+ 2667 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
+ 2668 QbeGen.NewLabel(lEnd);
|
|
|
+ 2669 QbeGen.PushLoop(lEnd); .)
|
|
|
+ 2670 [ StatSeq ]
|
|
|
+ 2671 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
+ 2672 AST.SetChild(astNode, 0, astStmt);
|
|
|
+ 2673 astStmt := astNode;
|
|
|
+ 2674 QbeGen.PopLoop; .) .
|
|
|
+ 2675 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
+ 2676 Runtime direction would need a compare-select; the literal
|
|
|
+ 2677 sign picks cslew/csegew at "DO" time. *)
|
|
|
+ 2678 ForStat (. VAR lv: SymTab.Name;
|
|
|
+ 2679 tlo, thi, tby:
|
|
|
+ 2680 SymTab.TypeIndex;
|
|
|
+ 2681 qlo, qhi, qby, qt, qk, qb:
|
|
|
+ 2682 QbeGen.QVal;
|
|
|
+ 2683 lTop, lBody, lEnd:
|
|
|
+ 2684 QbeGen.QVal;
|
|
|
+ 2685 by: INTEGER;
|
|
|
+ 2686 ok: BOOLEAN;
|
|
|
+ 2687 astVar, astLo, astHi, astBy,
|
|
|
+ 2688 astNode: AST.Node; .)
|
|
|
+ 2689 = "FOR" (. by := 1; .)
|
|
|
+ 2690 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
+ 2691 astStmt := AST.NoNode;
|
|
|
+ 2692 astBy := AST.NoNode;
|
|
|
+ 2693 ok := SymTab.Lookup(lv);
|
|
|
+ 2694 IF NOT ok THEN
|
|
|
+ 2695 SemError(201)
|
|
|
+ 2696 ELSIF (SymTab.SymKind(lv) #
|
|
|
+ 2697 SymTab.KindVar)
|
|
|
+ 2698 AND (SymTab.SymKind(lv) #
|
|
|
+ 2699 SymTab.KindParam) THEN
|
|
|
+ 2700 SemError(220); ok := FALSE
|
|
|
+ 2701 ELSIF NOT SymTab.IsOrdinal(
|
|
|
+ 2702 SymTab.SymType(lv)) THEN
|
|
|
+ 2703 SemError(220); ok := FALSE
|
|
|
+ 2704 END; .)
|
|
|
+ 2705 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
+ 2706 IF NOT SymTab.Assignable(tlo,
|
|
|
+ 2707 SymTab.SymType(lv)) THEN
|
|
|
+ 2708 SemError(220); ok := FALSE
|
|
|
+ 2709 END; .)
|
|
|
+ 2710 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
+ 2711 IF NOT SymTab.Assignable(thi,
|
|
|
+ 2712 SymTab.SymType(lv)) THEN
|
|
|
+ 2713 SemError(220); ok := FALSE
|
|
|
+ 2714 END; .)
|
|
|
+ 2715 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
+ 2716 IF (tby #
|
|
|
+ 2717 SymTab.InvalidType)
|
|
|
+ 2718 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
+ 2719 SemError(220); ok := FALSE
|
|
|
+ 2720 END;
|
|
|
+ 2721 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
+ 2722 SemError(230); by := 1
|
|
|
+ 2723 ELSIF by = 0 THEN
|
|
|
+ 2724 SemError(220); by := 1
|
|
|
+ 2725 END; .) ]
|
|
|
+ 2726 "DO"
|
|
|
+ 2727 [ StatSeq ]
|
|
|
+ 2728 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
+ 2729 AST.SetChild(astNode, 0, astVar);
|
|
|
+ 2730 AST.SetChild(astNode, 1, astLo);
|
|
|
+ 2731 AST.SetChild(astNode, 2, astHi);
|
|
|
+ 2732 AST.SetChild(astNode, 3, astBy);
|
|
|
+ 2733 AST.SetChild(astNode, 4, astStmt);
|
|
|
+ 2734 astStmt := astNode;
|
|
|
+ 2735 .) .
|
|
|
+ 2736 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
+ 2737 qsel, lEnd: QbeGen.QVal;
|
|
|
+ 2738 arm, astNode, astArms,
|
|
|
+ 2739 astArmsTail: AST.Node; .)
|
|
|
+ 2740 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
+ 2741 AST.SetChild(astNode, 0, astCur);
|
|
|
+ 2742 astArms := AST.NoNode;
|
|
|
+ 2743 astArmsTail := AST.NoNode;
|
|
|
+ 2744 .)
|
|
|
+ 2745 "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
+ 2746 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
+ 2747 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2748 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
+ 2749 AST.SetOp(arm, 1);
|
|
|
+ 2750 AST.SetChild(arm, 0, astStmt);
|
|
|
+ 2751 AstAppend(AST.NkBlock,
|
|
|
+ 2752 astArms, astArmsTail, arm); .) ]
|
|
|
+ 2753 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
+ 2754 astStmt := astNode;
|
|
|
+ 2755 .) .
|
|
|
+ 2756 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
+ 2757 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
+ 2758 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
+ 2759 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
+ 2760 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2761 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
+ 2762 (. VAR arm: AST.Node; .)
|
|
|
+ 2763 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
+ 2764 CaseLabel<tsel, qsel, arm>
|
|
|
+ 2765 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
+ 2766 ":" (. astStmt := AST.NoNode; .)
|
|
|
+ 2767 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
+ 2768 astStmt);
|
|
|
+ 2769 AstAppend(AST.NkBlock,
|
|
|
+ 2770 arms, armsTail, arm);
|
|
|
+ 2771 .) .
|
|
|
+ 2772 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2773 arm: AST.Node>
|
|
|
+ 2774 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
+ 2775 q2, q3, qc, qd, qe:
|
|
|
+ 2776 QbeGen.QVal;
|
|
|
+ 2777 astLab: AST.Node;
|
|
|
+ 2778 lNext: QbeGen.QVal; .)
|
|
|
+ 2779 = Expr<t2, q2> (. astLab := astCur;
|
|
|
+ 2780 IF SymTab.IsEmptyStr(t2)
|
|
|
+ 2781 AND (SymTab.ClassOf(tsel) =
|
|
|
+ 2782 SymTab.ClChar) THEN
|
|
|
+ 2783 (* ISO: '' as a CASE label
|
|
|
+ 2784 is the terminator *)
|
|
|
+ 2785 QbeGen.CopyOp("0", q2);
|
|
|
+ 2786 t2 := SymTab.CharType()
|
|
|
+ 2787 END;
|
|
|
+ 2788 IF (t2 #
|
|
|
+ 2789 SymTab.InvalidType)
|
|
|
+ 2790 AND (tsel #
|
|
|
+ 2791 SymTab.InvalidType)
|
|
|
+ 2792 AND NOT SymTab.EqCheck(t2,
|
|
|
+ 2793 tsel) THEN
|
|
|
+ 2794 SemError(213) END;
|
|
|
+ 2795 (* set labels are not immediates:
|
|
|
+ 2796 the CASE chain uses CmpSet *)
|
|
|
+ 2797 IF (SymTab.ClassOf(t2) # SymTab.ClSet)
|
|
|
+ 2798 AND NOT QbeGen.IsImm(q2) THEN
|
|
|
+ 2799 SemError(230)
|
|
|
+ 2800 END; .)
|
|
|
+ 2801 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
+ 2802 AST.NkSubrange, 0, astLab, astCur);
|
|
|
+ 2803 IF SymTab.IsEmptyStr(t3)
|
|
|
+ 2804 AND (SymTab.ClassOf(tsel) =
|
|
|
+ 2805 SymTab.ClChar) THEN
|
|
|
+ 2806 QbeGen.CopyOp("0", q3);
|
|
|
+ 2807 t3 := SymTab.CharType()
|
|
|
+ 2808 END;
|
|
|
+ 2809 IF (t3 #
|
|
|
+ 2810 SymTab.InvalidType)
|
|
|
+ 2811 AND (tsel #
|
|
|
+ 2812 SymTab.InvalidType)
|
|
|
+ 2813 AND NOT SymTab.EqCheck(t3,
|
|
|
+ 2814 tsel) THEN
|
|
|
+ 2815 SemError(213) END;
|
|
|
+ 2816 IF (SymTab.ClassOf(t3) # SymTab.ClSet)
|
|
|
+ 2817 AND NOT QbeGen.IsImm(q3) THEN
|
|
|
+ 2818 SemError(230)
|
|
|
+ 2819 END; .) ]
|
|
|
+ 2820 (. AST.SetChild(arm,
|
|
|
+ 2821 AST.NChild(arm), astLab); .) .
|
|
|
+ 2822 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2823 q, qt: QbeGen.QVal;
|
|
|
+ 2824 res: SymTab.TypeIndex;
|
|
|
+ 2825 hadE, conv: BOOLEAN;
|
|
|
+ 2826 astVal, astNode: AST.Node; .)
|
|
|
+ 2827 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
+ 2828 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
+ 2829 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
+ 2830 IF hadE THEN
|
|
|
+ 2831 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2832 END;
|
|
|
+ 2833 astStmt := astNode;
|
|
|
+ 2834 conv := FALSE;
|
|
|
+ 2835 IF NOT SymTab.InProc() THEN
|
|
|
+ 2836 SemError(232)
|
|
|
+ 2837 ELSE res := SymTab.CurRes();
|
|
|
+ 2838 IF NOT hadE THEN
|
|
|
+ 2839 IF res #
|
|
|
+ 2840 SymTab.InvalidType THEN
|
|
|
+ 2841 SemError(232)
|
|
|
+ 2842 END
|
|
|
+ 2843 ELSIF (res =
|
|
|
+ 2844 SymTab.InvalidType)
|
|
|
+ 2845 OR (t #
|
|
|
+ 2846 SymTab.InvalidType)
|
|
|
+ 2847 AND NOT SymTab.Assignable(t,
|
|
|
+ 2848 res) THEN
|
|
|
+ 2849 SemError(232)
|
|
|
+ 2850 END
|
|
|
+ 2851 END; .) .
|
|
|
+ 2852 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2853 q: QbeGen.QVal;
|
|
|
+ 2854 astVal, astNode: AST.Node; .)
|
|
|
+ 2855 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
+ 2856 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
+ 2857 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
+ 2858 IF astVal # AST.NoNode THEN
|
|
|
+ 2859 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2860 END;
|
|
|
+ 2861 astStmt := astNode;
|
|
|
+ 2862 .) .
|
|
|
+ 2863 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
+ 2864 Each index descends one level (bounds-checked, trap on breach);
|
|
|
+ 2865 nested levels reload the inner descriptor address. q ends as the
|
|
|
+ 2866 value (scalars), the descriptor address (plain arrays), or the
|
|
|
+ 2867 element address (indexed); sfx marks the indexed form. *)
|
|
|
+ 2868 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2869 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2870 (. VAR n: SymTab.Name; .)
|
|
|
+ 2871 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
+ 2872 (* The part of Design after the identifier: resolve it and walk the
|
|
|
+ 2873 selectors. Split out so a statement can decide between a label
|
|
|
+ 2874 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
+ 2875 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2876 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2877 (. VAR fn, mal: SymTab.Name;
|
|
|
+ 2878 cls: INTEGER;
|
|
|
+ 2879 ic: SymTab.TypeIndex;
|
|
|
+ 2880 curT, it, eT, bt:
|
|
|
+ 2881 SymTab.TypeIndex;
|
|
|
+ 2882 iq, ql, qlo, qhi, qe:
|
|
|
+ 2883 QbeGen.QVal;
|
|
|
+ 2884 lo, hi: INTEGER;
|
|
|
+ 2885 fo: INTEGER;
|
|
|
+ 2886 isOpen: BOOLEAN;
|
|
|
+ 2887 qb, cv: QbeGen.QVal;
|
|
|
+ 2888 r: BOOLEAN;
|
|
|
+ 2889 astDes, astSel: AST.Node; .)
|
|
|
+ 2890 = (. methCls := SymTab.InvalidType;
|
|
|
+ 2891 QbeGen.CopyOp(n, qn);
|
|
|
+ 2892 sfx := FALSE;
|
|
|
+ 2893 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 2894 (* a bare method name inside
|
|
|
+ 2895 a CLASS IMPLEMENTATION
|
|
|
+ 2896 is a sibling call on
|
|
|
+ 2897 THIS *)
|
|
|
+ 2898 ic := SymTab.CurImplClass();
|
|
|
+ 2899 IF (ic #
|
|
|
+ 2900 SymTab.InvalidType)
|
|
|
+ 2901 AND SymTab.MethodExists(ic, n) THEN
|
|
|
+ 2902 sfx := FALSE;
|
|
|
+ 2903 QbeGen.CopyOp("@", q);
|
|
|
+ 2904 methCls := ic;
|
|
|
+ 2905 k := SymTab.KindProc;
|
|
|
+ 2906 t := SymTab.InvalidType
|
|
|
+ 2907 ELSIF SymTab.InProc() THEN
|
|
|
+ 2908 (* not declared anywhere
|
|
|
+ 2909 in scope: with bodies
|
|
|
+ 2910 parsed at unit end this
|
|
|
+ 2911 is a genuine 201 (a
|
|
|
+ 2912 nested-local forward is
|
|
|
+ 2913 no longer tolerated). *)
|
|
|
+ 2914 SemError(201);
|
|
|
+ 2915 t := SymTab.InvalidType;
|
|
|
+ 2916 k := -1;
|
|
|
+ 2917 QbeGen.CopyOp("0", q)
|
|
|
+ 2918 ELSE
|
|
|
+ 2919 SemError(201);
|
|
|
+ 2920 t :=
|
|
|
+ 2921 SymTab.InvalidType;
|
|
|
+ 2922 k := -1;
|
|
|
+ 2923 QbeGen.CopyOp("0", q)
|
|
|
+ 2924 END
|
|
|
+ 2925 ELSE
|
|
|
+ 2926 t := SymTab.SymType(n);
|
|
|
+ 2927 k := SymTab.SymKind(n);
|
|
|
+ 2928 IF k = SymTab.KindConst THEN
|
|
|
+ 2929 IF SymTab.Equal(n,
|
|
|
+ 2930 "TRUE") THEN
|
|
|
+ 2931 t := SymTab.BoolType();
|
|
|
+ 2932 QbeGen.CopyOp("1", q)
|
|
|
+ 2933 ELSIF SymTab.Equal(n,
|
|
|
+ 2934 "FALSE") THEN
|
|
|
+ 2935 t := SymTab.BoolType();
|
|
|
+ 2936 QbeGen.CopyOp("0", q)
|
|
|
+ 2937 ELSIF SymTab.Equal(n,
|
|
|
+ 2938 "NIL") THEN
|
|
|
+ 2939 QbeGen.CopyOp("0", q)
|
|
|
+ 2940 ELSE
|
|
|
+ 2941 cls :=
|
|
|
+ 2942 SymTab.ClassOf(t);
|
|
|
+ 2943 IF (t #
|
|
|
+ 2944 SymTab.InvalidType)
|
|
|
+ 2945 AND ((cls = SymTab.ClInt)
|
|
|
+ 2946 OR (cls
|
|
|
+ 2947 = SymTab.ClChar)
|
|
|
+ 2948 OR (cls
|
|
|
+ 2949 = SymTab.ClEnum)
|
|
|
+ 2950 OR (cls
|
|
|
+ 2951 = SymTab.ClReal)
|
|
|
+ 2952 OR (cls
|
|
|
+ 2953 = SymTab.ClLong)
|
|
|
+ 2954 OR (cls
|
|
|
+ 2955 = SymTab.ClNil)
|
|
|
+ 2956 OR (cls = SymTab.ClByte)
|
|
|
+ 2957 OR (cls = SymTab.ClSByte)
|
|
|
+ 2958 OR (cls = SymTab.ClWord16)
|
|
|
+ 2959 OR (cls = SymTab.ClSWord16)
|
|
|
+ 2960 OR (cls = SymTab.ClBool)) THEN
|
|
|
+ 2961 IF cls = SymTab.ClNil THEN
|
|
|
+ 2962 QbeGen.CopyOp("0", q)
|
|
|
+ 2963 ELSIF ((cls
|
|
|
+ 2964 = SymTab.ClInt)
|
|
|
+ 2965 OR (cls
|
|
|
+ 2966 = SymTab.ClChar)
|
|
|
+ 2967 OR (cls
|
|
|
+ 2968 = SymTab.ClEnum)
|
|
|
+ 2969 OR (cls
|
|
|
+ 2970 = SymTab.ClLong)
|
|
|
+ 2971 OR (cls = SymTab.ClByte)
|
|
|
+ 2972 OR (cls = SymTab.ClSByte)
|
|
|
+ 2973 OR (cls = SymTab.ClWord16)
|
|
|
+ 2974 OR (cls = SymTab.ClSWord16)
|
|
|
+ 2975 OR (cls = SymTab.ClBool))
|
|
|
+ 2976 AND SymTab.GetSymVal(n, cv)
|
|
|
+ 2977 AND QbeGen.IsImm(cv) THEN
|
|
|
+ 2978 QbeGen.CopyOp(cv, q)
|
|
|
+ 2979 ELSE
|
|
|
+ 2980 QbeGen.LoadVar(n,
|
|
|
+ 2981 cls = SymTab.ClReal,
|
|
|
+ 2982 q)
|
|
|
+ 2983 END
|
|
|
+ 2984 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 2985 OR (cls = SymTab.ClRecord)
|
|
|
+ 2986 OR (cls = SymTab.ClClass)
|
|
|
+ 2987 OR (cls = SymTab.ClStr)
|
|
|
+ 2988 OR (cls = SymTab.ClUStr)
|
|
|
+ 2989 OR (cls = SymTab.ClSet) THEN
|
|
|
+ 2990 (* aggregate constant:
|
|
|
+ 2991 its value IS the
|
|
|
+ 2992 descriptor address *)
|
|
|
+ 2993 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
+ 2994 QbeGen.CopyOp(cv, q)
|
|
|
+ 2995 ELSE
|
|
|
+ 2996 QbeGen.CopyOp("0", q)
|
|
|
+ 2997 END
|
|
|
+ 2998 ELSE
|
|
|
+ 2999 IF t #
|
|
|
+ 3000 SymTab.InvalidType THEN
|
|
|
+ 3001 SemError(230)
|
|
|
+ 3002 END;
|
|
|
+ 3003 QbeGen.CopyOp("0", q)
|
|
|
+ 3004 END
|
|
|
+ 3005 END
|
|
|
+ 3006 ELSIF (k = SymTab.KindVar)
|
|
|
+ 3007 OR (k = SymTab.KindParam) THEN
|
|
|
+ 3008 cls := SymTab.ClassOf(t);
|
|
|
+ 3009 IF (cls # SymTab.ClInt)
|
|
|
+ 3010 AND (cls # SymTab.ClBool)
|
|
|
+ 3011 AND (cls # SymTab.ClChar)
|
|
|
+ 3012 AND (cls # SymTab.ClUChar)
|
|
|
+ 3013 AND (cls # SymTab.ClEnum)
|
|
|
+ 3014 AND (cls # SymTab.ClReal)
|
|
|
+ 3015 AND (cls # SymTab.ClPtr)
|
|
|
+ 3016 AND (cls # SymTab.ClProc)
|
|
|
+ 3017 AND (cls # SymTab.ClLong)
|
|
|
+ 3018 AND (cls # SymTab.ClArray)
|
|
|
+ 3019 AND (cls # SymTab.ClSet)
|
|
|
+ 3020 AND (cls # SymTab.ClRecord)
|
|
|
+ 3021 AND (cls # SymTab.ClUStr)
|
|
|
+ 3022 AND (cls # SymTab.ClByte)
|
|
|
+ 3023 AND (cls # SymTab.ClSByte)
|
|
|
+ 3024 AND (cls # SymTab.ClWord16)
|
|
|
+ 3025 AND (cls # SymTab.ClSWord16)
|
|
|
+ 3026 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 3027 SemError(230);
|
|
|
+ 3028 QbeGen.CopyOp("0", q)
|
|
|
+ 3029 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3030 END
|
|
|
+ 3031 ELSE QbeGen.CopyOp("0", q);
|
|
|
+ 3032 IF k = SymTab.KindImport THEN
|
|
|
+ 3033 SemError(230)
|
|
|
+ 3034 ELSIF k =
|
|
|
+ 3035 SymTab.KindProc THEN
|
|
|
+ 3036 (* bare procedure name:
|
|
|
+ 3037 a following ArgList
|
|
|
+ 3038 makes it a call;
|
|
|
+ 3039 otherwise Fact
|
|
|
+ 3040 reports 230 *)
|
|
|
+ 3041 ELSE
|
|
|
+ 3042 IF k = SymTab.KindField THEN
|
|
|
+ 3043 IF QbeGen.TopWith(qb) THEN
|
|
|
+ 3044 sfx := TRUE
|
|
|
+ 3045 ELSE SemError(230);
|
|
|
+ 3046 QbeGen.CopyOp("0", q)
|
|
|
+ 3047 END
|
|
|
+ 3048 END
|
|
|
+ 3049 END
|
|
|
+ 3050 END
|
|
|
+ 3051 END; .)
|
|
|
+ 3052 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
+ 3053 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 3054 { "[" Expr<it, iq>
|
|
|
+ 3055 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 3056 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 3057 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3058 SymTab.ClArray THEN
|
|
|
+ 3059 SemError(217);
|
|
|
+ 3060 t := SymTab.InvalidType
|
|
|
+ 3061 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 3062 AND (SymTab.ClassOf(it) #
|
|
|
+ 3063 SymTab.ClChar)
|
|
|
+ 3064 AND (SymTab.ClassOf(it) #
|
|
|
+ 3065 SymTab.ClEnum)
|
|
|
+ 3066 AND (SymTab.ClassOf(it) #
|
|
|
+ 3067 SymTab.ClBool) THEN
|
|
|
+ 3068 SemError(218);
|
|
|
+ 3069 t := SymTab.InvalidType
|
|
|
+ 3070 ELSE
|
|
|
+ 3071 eT := SymTab.ArrayElem(t);
|
|
|
+ 3072 t := eT; sfx := TRUE
|
|
|
+ 3073 END; .)
|
|
|
+ 3074 { "," Expr<it, iq>
|
|
|
+ 3075 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 3076 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 3077 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3078 SymTab.ClArray THEN
|
|
|
+ 3079 SemError(217);
|
|
|
+ 3080 t := SymTab.InvalidType
|
|
|
+ 3081 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 3082 AND (SymTab.ClassOf(it) #
|
|
|
+ 3083 SymTab.ClChar)
|
|
|
+ 3084 AND (SymTab.ClassOf(it) #
|
|
|
+ 3085 SymTab.ClEnum)
|
|
|
+ 3086 AND (SymTab.ClassOf(it) #
|
|
|
+ 3087 SymTab.ClBool) THEN
|
|
|
+ 3088 SemError(218);
|
|
|
+ 3089 t := SymTab.InvalidType
|
|
|
+ 3090 ELSE
|
|
|
+ 3091 eT := SymTab.ArrayElem(t);
|
|
|
+ 3092 t := eT; sfx := TRUE
|
|
|
+ 3093 END; .) }
|
|
|
+ 3094 "]"
|
|
|
+ 3095 | "." GetIdent<fn>
|
|
|
+ 3096 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3097 AST.SetOp(astSel, AST.SelField);
|
|
|
+ 3098 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
+ 3099 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
+ 3100 (* qualified L.x: materialize
|
|
|
+ 3101 the export, then load it *)
|
|
|
+ 3102 IF NOT SymTab.MaterializeAlias(n,
|
|
|
+ 3103 fn, mal) THEN
|
|
|
+ 3104 SemError(201);
|
|
|
+ 3105 t := SymTab.InvalidType;
|
|
|
+ 3106 QbeGen.CopyOp("0", q)
|
|
|
+ 3107 ELSE
|
|
|
+ 3108 QbeGen.CopyOp(mal, qn);
|
|
|
+ 3109 t := SymTab.SymType(mal);
|
|
|
+ 3110 k := SymTab.SymKind(mal);
|
|
|
+ 3111 sfx := FALSE;
|
|
|
+ 3112 IF k = SymTab.KindProc THEN
|
|
|
+ 3113 (* call: ArgList supplies
|
|
|
+ 3114 the value *)
|
|
|
+ 3115 QbeGen.CopyOp("0", q)
|
|
|
+ 3116 ELSIF k = SymTab.KindConst THEN
|
|
|
+ 3117 IF SymTab.GetSymVal(mal,
|
|
|
+ 3118 cv)
|
|
|
+ 3119 THEN QbeGen.CopyOp(cv, q)
|
|
|
+ 3120 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3121 END
|
|
|
+ 3122 END
|
|
|
+ 3123 END
|
|
|
+ 3124 ELSIF t = SymTab.InvalidType THEN
|
|
|
+ 3125 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3126 SymTab.ClRecord)
|
|
|
+ 3127 AND (SymTab.ClassOf(t) #
|
|
|
+ 3128 SymTab.ClClass) THEN
|
|
|
+ 3129 SemError(215);
|
|
|
+ 3130 t := SymTab.InvalidType
|
|
|
+ 3131 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 3132 SymTab.ClClass)
|
|
|
+ 3133 AND SymTab.MethodExists(t, fn) THEN
|
|
|
+ 3134 (* obj.Method: bind the
|
|
|
+ 3135 method and pass obj as
|
|
|
+ 3136 the hidden receiver; q
|
|
|
+ 3137 already holds the
|
|
|
+ 3138 object's address *)
|
|
|
+ 3139 QbeGen.CopyOp(fn, n);
|
|
|
+ 3140 QbeGen.CopyOp(fn, qn);
|
|
|
+ 3141 methCls := t;
|
|
|
+ 3142 k := SymTab.KindProc;
|
|
|
+ 3143 t := SymTab.InvalidType
|
|
|
+ 3144 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 3145 fn) THEN
|
|
|
+ 3146 SemError(216);
|
|
|
+ 3147 t := SymTab.InvalidType
|
|
|
+ 3148 ELSE
|
|
|
+ 3149 t := SymTab.FieldType(t, fn);
|
|
|
+ 3150 sfx := TRUE
|
|
|
+ 3151 END; .)
|
|
|
+ 3152 | "^"
|
|
|
+ 3153 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3154 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 3155 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 3156 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3157 SymTab.ClPtr THEN
|
|
|
+ 3158 SemError(219);
|
|
|
+ 3159 t := SymTab.InvalidType
|
|
|
+ 3160 ELSE
|
|
|
+ 3161 bt := SymTab.PtrBase(t);
|
|
|
+ 3162 IF bt = SymTab.InvalidType THEN
|
|
|
+ 3163 ELSE
|
|
|
+ 3164 t := bt;
|
|
|
+ 3165 sfx := TRUE
|
|
|
+ 3166 END
|
|
|
+ 3167 END; .) } (. astCur := astDes; .) .
|
|
|
+ 3168 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
+ 3169 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
+ 3170 (a value, or a descriptor address for aggregates); each component
|
|
|
+ 3171 descends one level exactly like the Design components. *)
|
|
|
+ 3172 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 3173 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
+ 3174 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
+ 3175 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
+ 3176 iq, ql, qlo, qhi, qe, qb:
|
|
|
+ 3177 QbeGen.QVal;
|
|
|
+ 3178 lo, hi, fo: INTEGER;
|
|
|
+ 3179 isOpen: BOOLEAN;
|
|
|
+ 3180 fname: SymTab.Name;
|
|
|
+ 3181 astWrap, astSel: AST.Node; .)
|
|
|
+ 3182 = "[" Expr<it, iq>
|
|
|
+ 3183 (. isM := FALSE;
|
|
|
+ 3184 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3185 astWrap := AST.MakeNode(
|
|
|
+ 3186 AST.NkDesignator);
|
|
|
+ 3187 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3188 node := astWrap
|
|
|
+ 3189 END;
|
|
|
+ 3190 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 3191 AST.MakeUn(AST.NkSelector,
|
|
|
+ 3192 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 3193 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3194 SymTab.ClArray THEN
|
|
|
+ 3195 SemError(217);
|
|
|
+ 3196 t := SymTab.InvalidType
|
|
|
+ 3197 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 3198 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
+ 3199 AND (SymTab.ClassOf(it) # SymTab.ClEnum)
|
|
|
+ 3200 AND (SymTab.ClassOf(it) # SymTab.ClBool) THEN
|
|
|
+ 3201 SemError(218);
|
|
|
+ 3202 t := SymTab.InvalidType
|
|
|
+ 3203 ELSE
|
|
|
+ 3204 eT := SymTab.ArrayElem(t);
|
|
|
+ 3205 t := eT; sfx := TRUE
|
|
|
+ 3206 END; .)
|
|
|
+ 3207 "]"
|
|
|
+ 3208 | "." GetIdent<fname>
|
|
|
+ 3209 (. isM := FALSE;
|
|
|
+ 3210 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3211 astWrap := AST.MakeNode(
|
|
|
+ 3212 AST.NkDesignator);
|
|
|
+ 3213 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3214 node := astWrap
|
|
|
+ 3215 END;
|
|
|
+ 3216 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 3217 AST.MakeUn(AST.NkSelector,
|
|
|
+ 3218 AST.SelField,
|
|
|
+ 3219 AST.MakeLeaf(AST.NkIdent,
|
|
|
+ 3220 fname))); IF t = SymTab.InvalidType THEN
|
|
|
+ 3221 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3222 SymTab.ClRecord)
|
|
|
+ 3223 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 3224 SemError(215);
|
|
|
+ 3225 t := SymTab.InvalidType
|
|
|
+ 3226 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 3227 SymTab.ClClass)
|
|
|
+ 3228 AND SymTab.MethodExists(t, fname) THEN
|
|
|
+ 3229 (* a method on the call result:
|
|
|
+ 3230 a following ArgList makes
|
|
|
+ 3231 the call *)
|
|
|
+ 3232 mname := fname;
|
|
|
+ 3233 methCls := t; isM := TRUE;
|
|
|
+ 3234 t := SymTab.InvalidType
|
|
|
+ 3235 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 3236 fname) THEN
|
|
|
+ 3237 SemError(216);
|
|
|
+ 3238 t := SymTab.InvalidType
|
|
|
+ 3239 ELSE
|
|
|
+ 3240 t := SymTab.FieldType(t, fname);
|
|
|
+ 3241 sfx := TRUE
|
|
|
+ 3242 END; .)
|
|
|
+ 3243 | "^" (. isM := FALSE;
|
|
|
+ 3244 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3245 astWrap := AST.MakeNode(
|
|
|
+ 3246 AST.NkDesignator);
|
|
|
+ 3247 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3248 node := astWrap
|
|
|
+ 3249 END;
|
|
|
+ 3250 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3251 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 3252 AST.SetChild(node,
|
|
|
+ 3253 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 3254 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3255 SymTab.ClPtr THEN
|
|
|
+ 3256 SemError(219);
|
|
|
+ 3257 t := SymTab.InvalidType
|
|
|
+ 3258 ELSE
|
|
|
+ 3259 bt := SymTab.PtrBase(t);
|
|
|
+ 3260 IF bt # SymTab.InvalidType THEN
|
|
|
+ 3261 t := bt; sfx := TRUE
|
|
|
+ 3262 END
|
|
|
+ 3263 END; .) .
|
|
|
+ 3264 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3265 (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 3266 op: INTEGER;
|
|
|
+ 3267 q2, qt, wl: QbeGen.QVal;
|
|
|
+ 3268 astA, astB: AST.Node;
|
|
|
+ 3269 astOp: INTEGER;
|
|
|
+ 3270 astMade: BOOLEAN;
|
|
|
+ 3271 isR: BOOLEAN; .)
|
|
|
+ 3272 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
+ 3273 [ Rel<op> SimExpr<t2, q2>
|
|
|
+ 3274 (. astB := astCur; astMade := TRUE;
|
|
|
+ 3275 astOp := AST.OpEq;
|
|
|
+ 3276 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
+ 3277 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
+ 3278 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
+ 3279 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
+ 3280 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
+ 3281 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
+ 3282 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
+ 3283 END;
|
|
|
+ 3284 IF op = SymTab.OpIn THEN
|
|
|
+ 3285 IF SymTab.InCheck(t, t2) THEN
|
|
|
+ 3286 IF (t = SymTab.InvalidType)
|
|
|
+ 3287 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 3288 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 3289 ELSE
|
|
|
+ 3290 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3291 END
|
|
|
+ 3292 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
+ 3293 QbeGen.CopyOp("0", q)
|
|
|
+ 3294 END
|
|
|
+ 3295 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
+ 3296 IF (t = SymTab.InvalidType)
|
|
|
+ 3297 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 3298 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 3299 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
+ 3300 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
+ 3301 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
+ 3302 AND (op # SymTab.OpNeq2) THEN
|
|
|
+ 3303 SemError(213); t := SymTab.InvalidType;
|
|
|
+ 3304 QbeGen.CopyOp("0", q)
|
|
|
+ 3305 ELSE
|
|
|
+ 3306 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3307 END
|
|
|
+ 3308 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3309 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3310 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3311 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
+ 3312 QbeGen.StrEq(op, q, q2, qt);
|
|
|
+ 3313 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 3314 ELSIF SymTab.IsLongFamily(t)
|
|
|
+ 3315 OR SymTab.IsLongFamily(t2) THEN
|
|
|
+ 3316 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3317 ELSE
|
|
|
+ 3318 t := SymTab.BoolType();
|
|
|
+ 3319 QbeGen.CopyOp("@", q)
|
|
|
+ 3320 END
|
|
|
+ 3321 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
+ 3322 QbeGen.CopyOp("0", q)
|
|
|
+ 3323 END;
|
|
|
+ 3324 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
+ 3325 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
+ 3326 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3327 Rel<VAR op: INTEGER>
|
|
|
+ 3328 = "=" (. op := SymTab.OpEq; .)
|
|
|
+ 3329 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
+ 3330 | "<" (. op := SymTab.OpLt; .)
|
|
|
+ 3331 | "<=" (. op := SymTab.OpLe; .)
|
|
|
+ 3332 | ">" (. op := SymTab.OpGt; .)
|
|
|
+ 3333 | ">=" (. op := SymTab.OpGe; .)
|
|
|
+ 3334 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
+ 3335 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3336 (. VAR t2, res2, lt, rt:
|
|
|
+ 3337 SymTab.TypeIndex;
|
|
|
+ 3338 op: INTEGER;
|
|
|
+ 3339 q2, qt, wq, qf, q2a, q2b:
|
|
|
+ 3340 QbeGen.QVal;
|
|
|
+ 3341 neg, isR, isL, folded:
|
|
|
+ 3342 BOOLEAN;
|
|
|
+ 3343 fok: BOOLEAN;
|
|
|
+ 3344 lw, rw, mw: CARDINAL;
|
|
|
+ 3345 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 3346 astA, astB: AST.Node;
|
|
|
+ 3347 astSign, astOp: INTEGER; .)
|
|
|
+ 3348 = (. neg := FALSE; astSign := 0; .)
|
|
|
+ 3349 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
+ 3350 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
+ 3351 Term<t, q> (. astA := astCur;
|
|
|
+ 3352 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
+ 3353 QbeGen.NegFold(q, q)
|
|
|
+ 3354 END;
|
|
|
+ 3355 IF astSign < 0 THEN
|
|
|
+ 3356 astCur := AST.MakeUn(
|
|
|
+ 3357 AST.NkUnary, AST.OpSub, astA);
|
|
|
+ 3358 astA := astCur
|
|
|
+ 3359 END; .)
|
|
|
+ 3360 { AddOp<op>
|
|
|
+ 3361 Term<t2, q2> (. astB := astCur; .)
|
|
|
+ 3362 (. astOp := AST.OpAdd;
|
|
|
+ 3363 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
+ 3364 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
+ 3365 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 3366 astCur := astA;
|
|
|
+ 3367 IF op = SymTab.OpOr THEN
|
|
|
+ 3368 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
+ 3369 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 3370 t := SymTab.BoolType()
|
|
|
+ 3371 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 3372 IF t # SymTab.InvalidType THEN
|
|
|
+ 3373 QbeGen.CopyOp("@", q)
|
|
|
+ 3374 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3375 END
|
|
|
+ 3376 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 3377 AND (SymTab.UStrCompat(t, t2)
|
|
|
+ 3378 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 3379 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
+ 3380 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
+ 3381 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
+ 3382 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 3383 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
+ 3384 (* UString concatenation: a UCHAR operand becomes a
|
|
|
+ 3385 1-codepoint UString; the result is a descriptor in the
|
|
|
+ 3386 shim's concat buffer. Work on copies so neither
|
|
|
+ 3387 operand is clobbered. *)
|
|
|
+ 3388 t := SymTab.NewUStr();
|
|
|
+ 3389 QbeGen.CopyOp("@", q)
|
|
|
+ 3390 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 3391 AND (SymTab.StrCompat(t, t2)
|
|
|
+ 3392 OR (SymTab.IsStrType(t)
|
|
|
+ 3393 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
+ 3394 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 3395 AND SymTab.IsStrType(t2))) THEN
|
|
|
+ 3396 (* string concatenation; a CHAR operand becomes a
|
|
|
+ 3397 1-character string literal. When both operands are
|
|
|
+ 3398 constants, fold to a single string literal so a
|
|
|
+ 3399 constructor element stays compile-time. *)
|
|
|
+ 3400 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
+ 3401 qt, fok);
|
|
|
+ 3402 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
+ 3403 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3404 END;
|
|
|
+ 3405 t := SymTab.NewStr()
|
|
|
+ 3406 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 3407 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3408 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3409 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 3410 mw := lw;
|
|
|
+ 3411 IF rw > mw THEN mw := rw END;
|
|
|
+ 3412 t := SymTab.NewSet(
|
|
|
+ 3413 SymTab.NewSubR(0,
|
|
|
+ 3414 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 3415 QbeGen.CopyOp("@", q)
|
|
|
+ 3416 ELSE
|
|
|
+ 3417 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
+ 3418 lt := t; rt := t2; t := res2
|
|
|
+ 3419 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 3420 IF t # SymTab.InvalidType THEN
|
|
|
+ 3421 isL := SymTab.IsLongFamily(t);
|
|
|
+ 3422 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 3423 folded := FALSE;
|
|
|
+ 3424 IF (NOT isL) AND (NOT isR)
|
|
|
+ 3425 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 3426 IF op = SymTab.OpAdd THEN
|
|
|
+ 3427 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
+ 3428 ELSE
|
|
|
+ 3429 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
+ 3430 END
|
|
|
+ 3431 END;
|
|
|
+ 3432 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 3433 ELSE
|
|
|
+ 3434 QbeGen.CopyOp("@", q)
|
|
|
+ 3435 END
|
|
|
+ 3436 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3437 END
|
|
|
+ 3438 END; .) }
|
|
|
+ 3439 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3440 AddOp<VAR op: INTEGER>
|
|
|
+ 3441 = "+" (. op := SymTab.OpAdd; .)
|
|
|
+ 3442 | "-" (. op := SymTab.OpSub; .)
|
|
|
+ 3443 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
+ 3444 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3445 (. VAR t2, res2, lt, rt:
|
|
|
+ 3446 SymTab.TypeIndex;
|
|
|
+ 3447 op: INTEGER;
|
|
|
+ 3448 q2, qt, wq, qf:
|
|
|
+ 3449 QbeGen.QVal;
|
|
|
+ 3450 isR, isL, folded: BOOLEAN;
|
|
|
+ 3451 lw, rw, mw: CARDINAL;
|
|
|
+ 3452 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 3453 astA, astB: AST.Node;
|
|
|
+ 3454 astOp: INTEGER; .)
|
|
|
+ 3455 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
+ 3456 Fact<t2, q2> (. astB := astCur; .)
|
|
|
+ 3457 (. astOp := AST.OpMul;
|
|
|
+ 3458 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
+ 3459 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
+ 3460 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
+ 3461 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
+ 3462 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 3463 astCur := astA;
|
|
|
+ 3464 IF op = SymTab.OpAnd THEN
|
|
|
+ 3465 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
+ 3466 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 3467 t := SymTab.BoolType()
|
|
|
+ 3468 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 3469 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
+ 3470 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3471 END
|
|
|
+ 3472 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 3473 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3474 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3475 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 3476 mw := lw;
|
|
|
+ 3477 IF rw > mw THEN mw := rw END;
|
|
|
+ 3478 t := SymTab.NewSet(
|
|
|
+ 3479 SymTab.NewSubR(0,
|
|
|
+ 3480 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 3481 QbeGen.CopyOp("@", q)
|
|
|
+ 3482 ELSE
|
|
|
+ 3483 IF SymTab.ArithCheck(t, t2,
|
|
|
+ 3484 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
+ 3485 res2) THEN
|
|
|
+ 3486 lt := t; rt := t2; t := res2
|
|
|
+ 3487 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 3488 IF t # SymTab.InvalidType THEN
|
|
|
+ 3489 isL := SymTab.IsLongFamily(t);
|
|
|
+ 3490 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 3491 folded := FALSE;
|
|
|
+ 3492 IF (NOT isL) AND (NOT isR)
|
|
|
+ 3493 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 3494 IF op = SymTab.OpTimes THEN
|
|
|
+ 3495 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
+ 3496 ELSIF op = SymTab.OpDiv THEN
|
|
|
+ 3497 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
+ 3498 ELSIF op = SymTab.OpMod THEN
|
|
|
+ 3499 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
+ 3500 END
|
|
|
+ 3501 END;
|
|
|
+ 3502 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 3503 ELSE
|
|
|
+ 3504 QbeGen.CopyOp("@", q)
|
|
|
+ 3505 END
|
|
|
+ 3506 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3507 END
|
|
|
+ 3508 END; .) }
|
|
|
+ 3509 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3510 MulOp<VAR op: INTEGER>
|
|
|
+ 3511 = "*" (. op := SymTab.OpTimes; .)
|
|
|
+ 3512 | "/" (. op := SymTab.OpSlash; .)
|
|
|
+ 3513 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
+ 3514 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
+ 3515 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
+ 3516 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3517 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ 3518 et, dt, t2, st, ct2, et2:
|
|
|
+ 3519 SymTab.TypeIndex;
|
|
|
+ 3520 dk: INTEGER;
|
|
|
+ 3521 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
+ 3522 QbeGen.QVal;
|
|
|
+ 3523 qn, vn: SymTab.Name;
|
|
|
+ 3524 vt: SymTab.TypeIndex;
|
|
|
+ 3525 c1, c2: INTEGER;
|
|
|
+ 3526 lo, hi: INTEGER;
|
|
|
+ 3527 isMax: BOOLEAN;
|
|
|
+ 3528 called, isHigh, sfx, isCh,
|
|
|
+ 3529 isU, uok, isStr: BOOLEAN;
|
|
|
+ 3530 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
+ 3531 astD: AST.Node;
|
|
|
+ 3532 astCall: BOOLEAN;
|
|
|
+ 3533 astNode, astNot: AST.Node;
|
|
|
+ 3534 j: CARDINAL;
|
|
|
+ 3535 astArg2: AST.Node;
|
|
|
+ 3536 astBrace: AST.Node;
|
|
|
+ 3537 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
+ 3538 isConvF: BOOLEAN;
|
|
|
+ 3539 fi, fj: CARDINAL; .)
|
|
|
+ 3540 = (. astIsLit := FALSE; .)
|
|
|
+ 3541 ( "__LINE__" (. QbeGen.IntStr(M2S.line, q);
|
|
|
+ 3542 astIsLit := TRUE;
|
|
|
+ 3543 astCur := AST.MakeLeaf(
|
|
|
+ 3544 AST.NkIntLit, q);
|
|
|
+ 3545 t := SymTab.IntType(); .)
|
|
|
+ 3546 | "__FILE__" (. (* fold to the quoted file name *)
|
|
|
+ 3547 s[0] := '"'; fi := 1; fj := 0;
|
|
|
+ 3548 WHILE (M2S.fileName[fj] # CHR(0))
|
|
|
+ 3549 AND (fi < HIGH(s)) DO
|
|
|
+ 3550 s[fi] := M2S.fileName[fj];
|
|
|
+ 3551 INC(fi); INC(fj)
|
|
|
+ 3552 END;
|
|
|
+ 3553 s[fi] := '"';
|
|
|
+ 3554 s[fi + 1] := CHR(0);
|
|
|
3555 astIsLit := TRUE;
|
|
|
3556 astCur := AST.MakeLeaf(
|
|
|
3557 AST.NkStrLit, s);
|
|
|
- 3558 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3559 t := SymTab.CharType();
|
|
|
- 3560 QbeGen.IntStr(
|
|
|
- 3561 QbeGen.CharVal(s), q)
|
|
|
- 3562 ELSIF SymTab.StrLen(s) = 2 THEN
|
|
|
- 3563 (* empty string: a string value
|
|
|
- 3564 for arrays, 0 for CHAR *)
|
|
|
- 3565 t := SymTab.NewEmptyStr();
|
|
|
- 3566 QbeGen.DeclStr(s, q)
|
|
|
- 3567 ELSE t := SymTab.NewStr();
|
|
|
- 3568 QbeGen.DeclStr(s, q);
|
|
|
- 3569 (* a literal's value IS its
|
|
|
- 3570 static descriptor address *)
|
|
|
- 3571 END; .)
|
|
|
- 3572 | ustring (. LexString(s);
|
|
|
- 3573 astIsLit := TRUE;
|
|
|
- 3574 astCur := AST.MakeLeaf(
|
|
|
- 3575 AST.NkStrLit, s);
|
|
|
- 3576 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
- 3577 uok);
|
|
|
- 3578 IF NOT uok THEN
|
|
|
- 3579 SemError(234);
|
|
|
- 3580 t := SymTab.InvalidType
|
|
|
- 3581 ELSIF isU THEN
|
|
|
- 3582 t := SymTab.UCharType();
|
|
|
- 3583 QbeGen.IntStr(ucp, q)
|
|
|
- 3584 ELSE
|
|
|
- 3585 t := SymTab.NewUStr();
|
|
|
- 3586 END; .)
|
|
|
- 3587 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
- 3588 astNArgs := 0; called := FALSE;
|
|
|
- 3589 t := dt;
|
|
|
- 3590 IF dk = SymTab.KindConst THEN
|
|
|
- 3591 QbeGen.CopyOp(qd, q)
|
|
|
- 3592 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3593 END; .)
|
|
|
- 3594 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
- 3595 astBrace := astCur; .) ]
|
|
|
- 3596 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 3597 (. astCall := TRUE;
|
|
|
- 3598 IF (SymTab.SymKind(qn) = SymTab.KindType)
|
|
|
- 3599 OR (SymTab.SymKind(qn) = SymTab.KindPredef) THEN
|
|
|
- 3600 (* T(x): emit as the VAL builtin so Lower's
|
|
|
- 3601 conversion rules apply unchanged *)
|
|
|
- 3602 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3603 AST.SetChild(astNode, 0,
|
|
|
- 3604 AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3605 AST.SetChild(astNode, 1,
|
|
|
- 3606 AST.MakeLeaf(AST.NkIdent, qn));
|
|
|
- 3607 IF astNArgs = 1 THEN
|
|
|
- 3608 AST.SetChild(astNode, 2, astArgs[0])
|
|
|
- 3609 END;
|
|
|
- 3610 isConvF := TRUE
|
|
|
- 3611 ELSE astNode := AstCallNode(astD)
|
|
|
- 3612 END;
|
|
|
- 3613 astRes := astNode;
|
|
|
- 3614 t := ct2;
|
|
|
- 3615 QbeGen.CopyOp(q2, q);
|
|
|
- 3616 IF isConvF AND QbeGen.IsImm(convQ)
|
|
|
- 3617 AND OrdClass(convT) AND OrdClass(ct2) THEN
|
|
|
- 3618 QbeGen.CopyOp(convQ, q)
|
|
|
- 3619 END;
|
|
|
- 3620 sfx := FALSE; .)
|
|
|
- 3621 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
- 3622 [ (. astNArgs := 0; .)
|
|
|
- 3623 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 3624 (. astNode := AstCallNode(astRes);
|
|
|
- 3625 astRes := astNode;
|
|
|
- 3626 t := ct2;
|
|
|
- 3627 QbeGen.CopyOp(q2, q);
|
|
|
- 3628 sfx := FALSE; .) ] }
|
|
|
- 3629 (. IF sfx THEN
|
|
|
- 3630 IF t = SymTab.InvalidType THEN
|
|
|
- 3631 QbeGen.CopyOp("0", q)
|
|
|
- 3632 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3633 SymTab.ClRecord)
|
|
|
- 3634 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
- 3635 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
- 3636 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 3637 QbeGen.CopyOp("@", q)
|
|
|
- 3638 END
|
|
|
- 3639 END; .) ]
|
|
|
- 3640 (. IF called THEN
|
|
|
- 3641 astCur := astRes
|
|
|
- 3642 ELSIF astCall THEN
|
|
|
- 3643 astCur := astBrace
|
|
|
- 3644 ELSE astCur := astD
|
|
|
- 3645 END;
|
|
|
- 3646 astIsLit := TRUE;
|
|
|
- 3647 IF NOT called
|
|
|
- 3648 AND (dk = SymTab.KindProc) THEN
|
|
|
- 3649 (* bare zero-arg function
|
|
|
- 3650 call (parentheses may be
|
|
|
- 3651 omitted); a proper or
|
|
|
- 3652 parameterised proc here
|
|
|
- 3653 is 230 *)
|
|
|
- 3654 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
- 3655 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
- 3656 t := SymTab.ProcRes(qn);
|
|
|
- 3657 QbeGen.CopyOp("@", q);
|
|
|
- 3658 astCur := AST.MakeNode(AST.NkCall);
|
|
|
- 3659 AST.SetChild(astCur, 0, astD)
|
|
|
- 3660 ELSE
|
|
|
- 3661 t := SymTab.ProcTypeOf(qn);
|
|
|
- 3662 QbeGen.CopyOp("@", q)
|
|
|
- 3663 END
|
|
|
- 3664 END; .)
|
|
|
- 3665 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
- 3666 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
- 3667 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
- 3668 isU := FALSE; .)
|
|
|
- 3669 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3670 isStr := TRUE;
|
|
|
- 3671 isU := FALSE;
|
|
|
- 3672 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3673 dt := SymTab.CharType();
|
|
|
- 3674 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
- 3675 qd)
|
|
|
- 3676 ELSE
|
|
|
- 3677 dt := SymTab.NewStr();
|
|
|
- 3678 QbeGen.DeclStr(s, qd);
|
|
|
- 3679 END;
|
|
|
- 3680 dk := -1;
|
|
|
- 3681 qn[0] := CHR(0); .)
|
|
|
- 3682 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3683 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
- 3684 uok);
|
|
|
- 3685 isStr := FALSE;
|
|
|
- 3686 IF NOT uok THEN
|
|
|
- 3687 SemError(234);
|
|
|
- 3688 dt := SymTab.InvalidType
|
|
|
- 3689 ELSIF isU THEN
|
|
|
- 3690 (* one codepoint: a UCHAR;
|
|
|
- 3691 LEN is 1, HIGH is 0 *)
|
|
|
- 3692 dt := SymTab.UCharType();
|
|
|
- 3693 QbeGen.IntStr(ucp, qd)
|
|
|
- 3694 ELSE
|
|
|
- 3695 dt := SymTab.NewUStr();
|
|
|
- 3696 END;
|
|
|
- 3697 dk := -1;
|
|
|
- 3698 qn[0] := CHR(0); .) )
|
|
|
- 3699 ")"
|
|
|
- 3700 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3701 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
- 3702 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
- 3703 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3704 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
- 3705 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3706 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3707 IF (dt # SymTab.InvalidType)
|
|
|
- 3708 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
- 3709 (* UString: the count is
|
|
|
- 3710 the descriptor header *)
|
|
|
- 3711 t := SymTab.IntType();
|
|
|
- 3712 QbeGen.CopyOp("@", q)
|
|
|
- 3713 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 3714 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
- 3715 (* single UCHAR codepoint *)
|
|
|
- 3716 IF isHigh THEN
|
|
|
- 3717 QbeGen.CopyOp("0", qr)
|
|
|
- 3718 ELSE
|
|
|
- 3719 QbeGen.CopyOp("1", qr)
|
|
|
- 3720 END;
|
|
|
- 3721 t := SymTab.IntType();
|
|
|
- 3722 QbeGen.CopyOp(qr, q)
|
|
|
- 3723 ELSIF isStr THEN
|
|
|
- 3724 (* fold: content length at
|
|
|
- 3725 compile time *)
|
|
|
- 3726 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3727 c1 := 1
|
|
|
- 3728 ELSE
|
|
|
- 3729 c1 :=
|
|
|
- 3730 SymTab.StrLen(s) - 2
|
|
|
- 3731 END;
|
|
|
- 3732 IF isHigh THEN
|
|
|
- 3733 DEC(c1)
|
|
|
- 3734 END;
|
|
|
- 3735 QbeGen.IntStr(c1, qr);
|
|
|
- 3736 t := SymTab.IntType();
|
|
|
- 3737 QbeGen.CopyOp(qr, q)
|
|
|
- 3738 ELSIF dt = SymTab.InvalidType THEN
|
|
|
- 3739 t := SymTab.InvalidType;
|
|
|
- 3740 QbeGen.CopyOp("0", q)
|
|
|
- 3741 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 3742 SymTab.ClArray THEN
|
|
|
- 3743 SemError(217);
|
|
|
- 3744 t := SymTab.InvalidType;
|
|
|
- 3745 QbeGen.CopyOp("0", q)
|
|
|
- 3746 ELSE
|
|
|
- 3747 IF SymTab.IsOpenArray(dt) THEN
|
|
|
- 3748 t := SymTab.IntType();
|
|
|
- 3749 QbeGen.CopyOp("@", q)
|
|
|
- 3750 ELSE
|
|
|
- 3751 IF isHigh THEN
|
|
|
- 3752 QbeGen.IntStr(
|
|
|
- 3753 SymTab.ArrayHi(dt), qr)
|
|
|
- 3754 ELSE
|
|
|
- 3755 QbeGen.IntStr(VAL(
|
|
|
- 3756 INTEGER,
|
|
|
- 3757 SymTab.ArrayLen(dt)),
|
|
|
- 3758 qr)
|
|
|
- 3759 END;
|
|
|
- 3760 t := SymTab.IntType();
|
|
|
- 3761 QbeGen.CopyOp(qr, q)
|
|
|
- 3762 END
|
|
|
- 3763 END; .)
|
|
|
- 3764 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3765 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3766 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
- 3767 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3768 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3769 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3770 t := SymTab.InvalidType;
|
|
|
- 3771 QbeGen.CopyOp("0", q)
|
|
|
- 3772 ELSE
|
|
|
- 3773 QbeGen.IntStr(VAL(INTEGER,
|
|
|
- 3774 SymTab.ObjectSize(dt)), q);
|
|
|
- 3775 t := SymTab.IntType()
|
|
|
- 3776 END; .)
|
|
|
- 3777 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
- 3778 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
- 3779 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
- 3780 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3781 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3782 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
- 3783 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3784 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
- 3785 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3786 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3787 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3788 (* set shift/rotate: isMax
|
|
|
- 3789 doubles as "rotate" *)
|
|
|
- 3790 IF (et # SymTab.InvalidType)
|
|
|
- 3791 AND (SymTab.ClassOf(et) =
|
|
|
- 3792 SymTab.ClSet) THEN
|
|
|
- 3793 t := et;
|
|
|
- 3794 QbeGen.CopyOp("@", q)
|
|
|
- 3795 ELSE SemError(230);
|
|
|
- 3796 t := SymTab.InvalidType;
|
|
|
- 3797 QbeGen.CopyOp("0", q)
|
|
|
- 3798 END; .)
|
|
|
- 3799 | ( "MIN" (. isMax := FALSE; .)
|
|
|
- 3800 | "MAX" (. isMax := TRUE; .) )
|
|
|
- 3801 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3802 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3803 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3804 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
- 3805 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3806 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
- 3807 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3558 t := SymTab.NewStr();
|
|
|
+ 3559 QbeGen.DeclStr(s, q); .)
|
|
|
+ 3560 | integer (. LexString(s);
|
|
|
+ 3561 QbeGen.NormInt(s, q); astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s);
|
|
|
+ 3562 t := SymTab.IntType(); .)
|
|
|
+ 3563 | charConst (. LexString(s);
|
|
|
+ 3564 QbeGen.NormLit(s, q, isCh);
|
|
|
+ 3565 astIsLit := TRUE;
|
|
|
+ 3566 astCur := AST.MakeLeaf(
|
|
|
+ 3567 AST.NkCharLit, s);
|
|
|
+ 3568 t := SymTab.CharType(); .)
|
|
|
+ 3569 | real (. LexString(s);
|
|
|
+ 3570 QbeGen.NormReal(s, q);
|
|
|
+ 3571 astIsLit := TRUE;
|
|
|
+ 3572 astCur := AST.MakeLeaf(
|
|
|
+ 3573 AST.NkRealLit, s);
|
|
|
+ 3574 t := SymTab.RealType(); .)
|
|
|
+ 3575 | string (. LexString(s);
|
|
|
+ 3576 astIsLit := TRUE;
|
|
|
+ 3577 astCur := AST.MakeLeaf(
|
|
|
+ 3578 AST.NkStrLit, s);
|
|
|
+ 3579 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3580 t := SymTab.CharType();
|
|
|
+ 3581 QbeGen.IntStr(
|
|
|
+ 3582 QbeGen.CharVal(s), q)
|
|
|
+ 3583 ELSIF SymTab.StrLen(s) = 2 THEN
|
|
|
+ 3584 (* empty string: a string value
|
|
|
+ 3585 for arrays, 0 for CHAR *)
|
|
|
+ 3586 t := SymTab.NewEmptyStr();
|
|
|
+ 3587 QbeGen.DeclStr(s, q)
|
|
|
+ 3588 ELSE t := SymTab.NewStr();
|
|
|
+ 3589 QbeGen.DeclStr(s, q);
|
|
|
+ 3590 (* a literal's value IS its
|
|
|
+ 3591 static descriptor address *)
|
|
|
+ 3592 END; .)
|
|
|
+ 3593 | ustring (. LexString(s);
|
|
|
+ 3594 astIsLit := TRUE;
|
|
|
+ 3595 astCur := AST.MakeLeaf(
|
|
|
+ 3596 AST.NkStrLit, s);
|
|
|
+ 3597 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
+ 3598 uok);
|
|
|
+ 3599 IF NOT uok THEN
|
|
|
+ 3600 SemError(234);
|
|
|
+ 3601 t := SymTab.InvalidType
|
|
|
+ 3602 ELSIF isU THEN
|
|
|
+ 3603 t := SymTab.UCharType();
|
|
|
+ 3604 QbeGen.IntStr(ucp, q)
|
|
|
+ 3605 ELSE
|
|
|
+ 3606 t := SymTab.NewUStr();
|
|
|
+ 3607 END; .)
|
|
|
+ 3608 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
+ 3609 astNArgs := 0; called := FALSE;
|
|
|
+ 3610 t := dt;
|
|
|
+ 3611 IF dk = SymTab.KindConst THEN
|
|
|
+ 3612 QbeGen.CopyOp(qd, q)
|
|
|
+ 3613 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3614 END; .)
|
|
|
+ 3615 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
+ 3616 astBrace := astCur; .) ]
|
|
|
+ 3617 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3618 (. astCall := TRUE;
|
|
|
+ 3619 IF (SymTab.SymKind(qn) = SymTab.KindType)
|
|
|
+ 3620 OR (SymTab.SymKind(qn) = SymTab.KindPredef) THEN
|
|
|
+ 3621 (* T(x): emit as the VAL builtin so Lower's
|
|
|
+ 3622 conversion rules apply unchanged *)
|
|
|
+ 3623 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3624 AST.SetChild(astNode, 0,
|
|
|
+ 3625 AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3626 AST.SetChild(astNode, 1,
|
|
|
+ 3627 AST.MakeLeaf(AST.NkIdent, qn));
|
|
|
+ 3628 IF astNArgs = 1 THEN
|
|
|
+ 3629 AST.SetChild(astNode, 2, astArgs[0])
|
|
|
+ 3630 END;
|
|
|
+ 3631 isConvF := TRUE
|
|
|
+ 3632 ELSE astNode := AstCallNode(astD)
|
|
|
+ 3633 END;
|
|
|
+ 3634 astRes := astNode;
|
|
|
+ 3635 t := ct2;
|
|
|
+ 3636 QbeGen.CopyOp(q2, q);
|
|
|
+ 3637 IF isConvF AND QbeGen.IsImm(convQ)
|
|
|
+ 3638 AND OrdClass(convT) AND OrdClass(ct2) THEN
|
|
|
+ 3639 QbeGen.CopyOp(convQ, q)
|
|
|
+ 3640 END;
|
|
|
+ 3641 sfx := FALSE; .)
|
|
|
+ 3642 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
+ 3643 [ (. astNArgs := 0; .)
|
|
|
+ 3644 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3645 (. astNode := AstCallNode(astRes);
|
|
|
+ 3646 astRes := astNode;
|
|
|
+ 3647 t := ct2;
|
|
|
+ 3648 QbeGen.CopyOp(q2, q);
|
|
|
+ 3649 sfx := FALSE; .) ] }
|
|
|
+ 3650 (. IF sfx THEN
|
|
|
+ 3651 IF t = SymTab.InvalidType THEN
|
|
|
+ 3652 QbeGen.CopyOp("0", q)
|
|
|
+ 3653 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3654 SymTab.ClRecord)
|
|
|
+ 3655 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
+ 3656 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
+ 3657 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 3658 QbeGen.CopyOp("@", q)
|
|
|
+ 3659 END
|
|
|
+ 3660 END; .) ]
|
|
|
+ 3661 (. IF called THEN
|
|
|
+ 3662 astCur := astRes
|
|
|
+ 3663 ELSIF astCall THEN
|
|
|
+ 3664 astCur := astBrace
|
|
|
+ 3665 ELSE astCur := astD
|
|
|
+ 3666 END;
|
|
|
+ 3667 astIsLit := TRUE;
|
|
|
+ 3668 IF NOT called
|
|
|
+ 3669 AND (dk = SymTab.KindProc) THEN
|
|
|
+ 3670 (* bare zero-arg function
|
|
|
+ 3671 call (parentheses may be
|
|
|
+ 3672 omitted); a proper or
|
|
|
+ 3673 parameterised proc here
|
|
|
+ 3674 is 230 *)
|
|
|
+ 3675 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
+ 3676 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
+ 3677 t := SymTab.ProcRes(qn);
|
|
|
+ 3678 QbeGen.CopyOp("@", q);
|
|
|
+ 3679 astCur := AST.MakeNode(AST.NkCall);
|
|
|
+ 3680 AST.SetChild(astCur, 0, astD)
|
|
|
+ 3681 ELSE
|
|
|
+ 3682 t := SymTab.ProcTypeOf(qn);
|
|
|
+ 3683 QbeGen.CopyOp("@", q)
|
|
|
+ 3684 END
|
|
|
+ 3685 END; .)
|
|
|
+ 3686 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
+ 3687 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
+ 3688 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
+ 3689 isU := FALSE; .)
|
|
|
+ 3690 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3691 isStr := TRUE;
|
|
|
+ 3692 isU := FALSE;
|
|
|
+ 3693 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3694 dt := SymTab.CharType();
|
|
|
+ 3695 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
+ 3696 qd)
|
|
|
+ 3697 ELSE
|
|
|
+ 3698 dt := SymTab.NewStr();
|
|
|
+ 3699 QbeGen.DeclStr(s, qd);
|
|
|
+ 3700 END;
|
|
|
+ 3701 dk := -1;
|
|
|
+ 3702 qn[0] := CHR(0); .)
|
|
|
+ 3703 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3704 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
+ 3705 uok);
|
|
|
+ 3706 isStr := FALSE;
|
|
|
+ 3707 IF NOT uok THEN
|
|
|
+ 3708 SemError(234);
|
|
|
+ 3709 dt := SymTab.InvalidType
|
|
|
+ 3710 ELSIF isU THEN
|
|
|
+ 3711 (* one codepoint: a UCHAR;
|
|
|
+ 3712 LEN is 1, HIGH is 0 *)
|
|
|
+ 3713 dt := SymTab.UCharType();
|
|
|
+ 3714 QbeGen.IntStr(ucp, qd)
|
|
|
+ 3715 ELSE
|
|
|
+ 3716 dt := SymTab.NewUStr();
|
|
|
+ 3717 END;
|
|
|
+ 3718 dk := -1;
|
|
|
+ 3719 qn[0] := CHR(0); .) )
|
|
|
+ 3720 ")"
|
|
|
+ 3721 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3722 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
+ 3723 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
+ 3724 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3725 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
+ 3726 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3727 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3728 IF (dt # SymTab.InvalidType)
|
|
|
+ 3729 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
+ 3730 (* UString: the count is
|
|
|
+ 3731 the descriptor header *)
|
|
|
+ 3732 t := SymTab.IntType();
|
|
|
+ 3733 QbeGen.CopyOp("@", q)
|
|
|
+ 3734 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 3735 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
+ 3736 (* single UCHAR codepoint *)
|
|
|
+ 3737 IF isHigh THEN
|
|
|
+ 3738 QbeGen.CopyOp("0", qr)
|
|
|
+ 3739 ELSE
|
|
|
+ 3740 QbeGen.CopyOp("1", qr)
|
|
|
+ 3741 END;
|
|
|
+ 3742 t := SymTab.IntType();
|
|
|
+ 3743 QbeGen.CopyOp(qr, q)
|
|
|
+ 3744 ELSIF isStr THEN
|
|
|
+ 3745 (* fold: content length at
|
|
|
+ 3746 compile time *)
|
|
|
+ 3747 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3748 c1 := 1
|
|
|
+ 3749 ELSE
|
|
|
+ 3750 c1 :=
|
|
|
+ 3751 SymTab.StrLen(s) - 2
|
|
|
+ 3752 END;
|
|
|
+ 3753 IF isHigh THEN
|
|
|
+ 3754 DEC(c1)
|
|
|
+ 3755 END;
|
|
|
+ 3756 QbeGen.IntStr(c1, qr);
|
|
|
+ 3757 t := SymTab.IntType();
|
|
|
+ 3758 QbeGen.CopyOp(qr, q)
|
|
|
+ 3759 ELSIF dt = SymTab.InvalidType THEN
|
|
|
+ 3760 t := SymTab.InvalidType;
|
|
|
+ 3761 QbeGen.CopyOp("0", q)
|
|
|
+ 3762 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 3763 SymTab.ClArray THEN
|
|
|
+ 3764 SemError(217);
|
|
|
+ 3765 t := SymTab.InvalidType;
|
|
|
+ 3766 QbeGen.CopyOp("0", q)
|
|
|
+ 3767 ELSE
|
|
|
+ 3768 IF SymTab.IsOpenArray(dt) THEN
|
|
|
+ 3769 t := SymTab.IntType();
|
|
|
+ 3770 QbeGen.CopyOp("@", q)
|
|
|
+ 3771 ELSE
|
|
|
+ 3772 IF isHigh THEN
|
|
|
+ 3773 QbeGen.IntStr(
|
|
|
+ 3774 SymTab.ArrayHi(dt), qr)
|
|
|
+ 3775 ELSE
|
|
|
+ 3776 QbeGen.IntStr(VAL(
|
|
|
+ 3777 INTEGER,
|
|
|
+ 3778 SymTab.ArrayLen(dt)),
|
|
|
+ 3779 qr)
|
|
|
+ 3780 END;
|
|
|
+ 3781 t := SymTab.IntType();
|
|
|
+ 3782 QbeGen.CopyOp(qr, q)
|
|
|
+ 3783 END
|
|
|
+ 3784 END; .)
|
|
|
+ 3785 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3786 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3787 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
+ 3788 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3789 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3790 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3791 t := SymTab.InvalidType;
|
|
|
+ 3792 QbeGen.CopyOp("0", q)
|
|
|
+ 3793 ELSE
|
|
|
+ 3794 QbeGen.IntStr(VAL(INTEGER,
|
|
|
+ 3795 SymTab.ObjectSize(dt)), q);
|
|
|
+ 3796 t := SymTab.IntType()
|
|
|
+ 3797 END; .)
|
|
|
+ 3798 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
+ 3799 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
+ 3800 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
+ 3801 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3802 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3803 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
+ 3804 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3805 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
+ 3806 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3807 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
3808 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3809 IF (dt # SymTab.InvalidType)
|
|
|
- 3810 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
- 3811 (* REAL/LONGREAL: the
|
|
|
- 3812 implementation bounds *)
|
|
|
- 3813 IF isMax THEN
|
|
|
- 3814 QbeGen.NormReal(
|
|
|
- 3815 "3.402823e38", q)
|
|
|
- 3816 ELSE QbeGen.NormReal(
|
|
|
- 3817 "-3.402823e38", q)
|
|
|
- 3818 END;
|
|
|
- 3819 t := SymTab.RealType()
|
|
|
- 3820 ELSIF (dt #
|
|
|
- 3821 SymTab.InvalidType)
|
|
|
- 3822 AND (SymTab.ClassOf(dt) =
|
|
|
- 3823 SymTab.ClLong) THEN
|
|
|
- 3824 IF isMax THEN
|
|
|
- 3825 QbeGen.CopyOp(
|
|
|
- 3826 "9223372036854775807", q)
|
|
|
- 3827 ELSE QbeGen.CopyOp(
|
|
|
- 3828 "-9223372036854775808", q)
|
|
|
- 3829 END;
|
|
|
- 3830 t := SymTab.LongType()
|
|
|
- 3831 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
- 3832 hi) THEN
|
|
|
- 3833 IF isMax THEN
|
|
|
- 3834 QbeGen.IntStr(hi, q)
|
|
|
- 3835 ELSE QbeGen.IntStr(lo, q)
|
|
|
- 3836 END;
|
|
|
- 3837 (* a set's bounds are those
|
|
|
- 3838 of its base type *)
|
|
|
- 3839 IF SymTab.ClassOf(dt) =
|
|
|
- 3840 SymTab.ClSet THEN
|
|
|
- 3841 t := SymTab.SetBase(dt)
|
|
|
- 3842 ELSE t := SymTab.IntType()
|
|
|
- 3843 END
|
|
|
- 3844 ELSE SemError(230);
|
|
|
- 3845 t := SymTab.InvalidType;
|
|
|
- 3846 QbeGen.CopyOp("0", q)
|
|
|
- 3847 END; .)
|
|
|
- 3848 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3849 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3850 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
- 3851 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3852 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3853 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3854 t := SymTab.InvalidType;
|
|
|
- 3855 QbeGen.CopyOp("0", q)
|
|
|
- 3856 ELSE
|
|
|
- 3857 IF sfx
|
|
|
- 3858 OR (dk = SymTab.KindVar)
|
|
|
- 3859 OR (dk = SymTab.KindParam) THEN
|
|
|
- 3860 QbeGen.CopyOp("@", q)
|
|
|
- 3861 ELSE SemError(230);
|
|
|
- 3862 QbeGen.CopyOp("0", q)
|
|
|
- 3863 END;
|
|
|
- 3864 t := SymTab.AddrType()
|
|
|
- 3865 END; .)
|
|
|
- 3866 | "CHR" "(" Expr<et, q> ")"
|
|
|
- 3867 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3868 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
- 3869 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3870 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3871 (. IF (et # SymTab.InvalidType)
|
|
|
- 3872 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3873 SemError(211) END;
|
|
|
- 3874 t := SymTab.CharType(); .)
|
|
|
- 3875 | "ORD" "(" Expr<et, q> ")"
|
|
|
- 3876 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3877 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
- 3878 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3879 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3880 (. IF et # SymTab.InvalidType THEN
|
|
|
- 3881 IF (SymTab.ClassOf(et) #
|
|
|
- 3882 SymTab.ClChar)
|
|
|
- 3883 AND (SymTab.ClassOf(et) #
|
|
|
- 3884 SymTab.ClBool)
|
|
|
- 3885 AND (SymTab.ClassOf(et) #
|
|
|
- 3886 SymTab.ClEnum)
|
|
|
- 3887 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3888 SemError(211) END
|
|
|
- 3889 END;
|
|
|
- 3890 t := SymTab.IntType(); .)
|
|
|
- 3891 | "CAP" "(" Expr<et, q> ")"
|
|
|
- 3892 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3893 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
- 3894 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3895 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3896 (. IF QbeGen.IsImm(q)
|
|
|
- 3897 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 3898 IF (lo >= VAL(INTEGER, ORD("a"))) AND (lo <= VAL(INTEGER, ORD("z"))) THEN lo := lo - 32 END;
|
|
|
- 3899 QbeGen.IntStr(lo, q)
|
|
|
- 3900 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3901 END;
|
|
|
- 3902 t := SymTab.CharType(); .)
|
|
|
- 3903 | "UCHR" "(" Expr<et, q> ")"
|
|
|
- 3904 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3905 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
- 3906 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3907 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3908 (. (* UCHR: the UCHAR constructor.
|
|
|
- 3909 CHAR -> UCHAR (identity);
|
|
|
- 3910 INTEGER familly -> UCHAR
|
|
|
- 3911 (codepoint value). *)
|
|
|
- 3912 IF (et # SymTab.InvalidType)
|
|
|
- 3913 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
- 3914 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3915 SemError(211) END;
|
|
|
- 3916 t := SymTab.UCharType(); .)
|
|
|
- 3917 | "CHR8" "(" Expr<et, q> ")"
|
|
|
- 3918 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3919 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
- 3920 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3921 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3922 (. IF (et # SymTab.InvalidType)
|
|
|
- 3923 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3924 SemError(211) END;
|
|
|
- 3925 t := SymTab.CharType(); .)
|
|
|
- 3926 | "UORD" "(" Expr<et, q> ")"
|
|
|
- 3927 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3928 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
- 3929 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3930 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3931 (. (* UORD(u): the codepoint as a
|
|
|
- 3932 32-bit ordinal (INTEGER),
|
|
|
- 3933 cf. ORD for CHAR. *)
|
|
|
- 3934 IF (et # SymTab.InvalidType)
|
|
|
- 3935 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3809 (* set shift/rotate: isMax
|
|
|
+ 3810 doubles as "rotate" *)
|
|
|
+ 3811 IF (et # SymTab.InvalidType)
|
|
|
+ 3812 AND (SymTab.ClassOf(et) =
|
|
|
+ 3813 SymTab.ClSet) THEN
|
|
|
+ 3814 t := et;
|
|
|
+ 3815 QbeGen.CopyOp("@", q)
|
|
|
+ 3816 ELSE SemError(230);
|
|
|
+ 3817 t := SymTab.InvalidType;
|
|
|
+ 3818 QbeGen.CopyOp("0", q)
|
|
|
+ 3819 END; .)
|
|
|
+ 3820 | ( "MIN" (. isMax := FALSE; .)
|
|
|
+ 3821 | "MAX" (. isMax := TRUE; .) )
|
|
|
+ 3822 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3823 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3824 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3825 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
+ 3826 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3827 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
+ 3828 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3829 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3830 IF (dt # SymTab.InvalidType)
|
|
|
+ 3831 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
+ 3832 (* REAL/LONGREAL: the
|
|
|
+ 3833 implementation bounds *)
|
|
|
+ 3834 IF isMax THEN
|
|
|
+ 3835 QbeGen.NormReal(
|
|
|
+ 3836 "3.402823e38", q)
|
|
|
+ 3837 ELSE QbeGen.NormReal(
|
|
|
+ 3838 "-3.402823e38", q)
|
|
|
+ 3839 END;
|
|
|
+ 3840 t := SymTab.RealType()
|
|
|
+ 3841 ELSIF (dt #
|
|
|
+ 3842 SymTab.InvalidType)
|
|
|
+ 3843 AND (SymTab.ClassOf(dt) =
|
|
|
+ 3844 SymTab.ClLong) THEN
|
|
|
+ 3845 IF isMax THEN
|
|
|
+ 3846 QbeGen.CopyOp(
|
|
|
+ 3847 "9223372036854775807", q)
|
|
|
+ 3848 ELSE QbeGen.CopyOp(
|
|
|
+ 3849 "-9223372036854775808", q)
|
|
|
+ 3850 END;
|
|
|
+ 3851 t := SymTab.LongType()
|
|
|
+ 3852 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
+ 3853 hi) THEN
|
|
|
+ 3854 IF isMax THEN
|
|
|
+ 3855 QbeGen.IntStr(hi, q)
|
|
|
+ 3856 ELSE QbeGen.IntStr(lo, q)
|
|
|
+ 3857 END;
|
|
|
+ 3858 (* a set's bounds are those
|
|
|
+ 3859 of its base type *)
|
|
|
+ 3860 IF SymTab.ClassOf(dt) =
|
|
|
+ 3861 SymTab.ClSet THEN
|
|
|
+ 3862 t := SymTab.SetBase(dt)
|
|
|
+ 3863 ELSE t := SymTab.IntType()
|
|
|
+ 3864 END
|
|
|
+ 3865 ELSE SemError(230);
|
|
|
+ 3866 t := SymTab.InvalidType;
|
|
|
+ 3867 QbeGen.CopyOp("0", q)
|
|
|
+ 3868 END; .)
|
|
|
+ 3869 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3870 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3871 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
+ 3872 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3873 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3874 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3875 t := SymTab.InvalidType;
|
|
|
+ 3876 QbeGen.CopyOp("0", q)
|
|
|
+ 3877 ELSE
|
|
|
+ 3878 IF sfx
|
|
|
+ 3879 OR (dk = SymTab.KindVar)
|
|
|
+ 3880 OR (dk = SymTab.KindParam) THEN
|
|
|
+ 3881 QbeGen.CopyOp("@", q)
|
|
|
+ 3882 ELSE SemError(230);
|
|
|
+ 3883 QbeGen.CopyOp("0", q)
|
|
|
+ 3884 END;
|
|
|
+ 3885 t := SymTab.AddrType()
|
|
|
+ 3886 END; .)
|
|
|
+ 3887 | "CHR" "(" Expr<et, q> ")"
|
|
|
+ 3888 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3889 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
+ 3890 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3891 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3892 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3893 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3894 SemError(211) END;
|
|
|
+ 3895 t := SymTab.CharType(); .)
|
|
|
+ 3896 | "ORD" "(" Expr<et, q> ")"
|
|
|
+ 3897 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3898 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
+ 3899 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3900 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3901 (. IF et # SymTab.InvalidType THEN
|
|
|
+ 3902 IF (SymTab.ClassOf(et) #
|
|
|
+ 3903 SymTab.ClChar)
|
|
|
+ 3904 AND (SymTab.ClassOf(et) #
|
|
|
+ 3905 SymTab.ClBool)
|
|
|
+ 3906 AND (SymTab.ClassOf(et) #
|
|
|
+ 3907 SymTab.ClEnum)
|
|
|
+ 3908 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3909 SemError(211) END
|
|
|
+ 3910 END;
|
|
|
+ 3911 t := SymTab.IntType(); .)
|
|
|
+ 3912 | "CAP" "(" Expr<et, q> ")"
|
|
|
+ 3913 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3914 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
+ 3915 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3916 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3917 (. IF QbeGen.IsImm(q)
|
|
|
+ 3918 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 3919 IF (lo >= VAL(INTEGER, ORD("a"))) AND (lo <= VAL(INTEGER, ORD("z"))) THEN lo := lo - 32 END;
|
|
|
+ 3920 QbeGen.IntStr(lo, q)
|
|
|
+ 3921 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3922 END;
|
|
|
+ 3923 t := SymTab.CharType(); .)
|
|
|
+ 3924 | "UCHR" "(" Expr<et, q> ")"
|
|
|
+ 3925 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3926 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
+ 3927 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3928 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3929 (. (* UCHR: the UCHAR constructor.
|
|
|
+ 3930 CHAR -> UCHAR (identity);
|
|
|
+ 3931 INTEGER familly -> UCHAR
|
|
|
+ 3932 (codepoint value). *)
|
|
|
+ 3933 IF (et # SymTab.InvalidType)
|
|
|
+ 3934 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
+ 3935 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
3936 SemError(211) END;
|
|
|
- 3937 t := SymTab.IntType(); .)
|
|
|
- 3938 | "ABS" "(" Expr<et, q> ")"
|
|
|
+ 3937 t := SymTab.UCharType(); .)
|
|
|
+ 3938 | "CHR8" "(" Expr<et, q> ")"
|
|
|
3939 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3940 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
+ 3940 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
3941 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
3942 astCur := astNode; astIsLit := TRUE; .)
|
|
|
3943 (. IF (et # SymTab.InvalidType)
|
|
|
- 3944 AND NOT SymTab.IsIntFamily(et)
|
|
|
- 3945 AND (SymTab.ClassOf(et) #
|
|
|
- 3946 SymTab.ClReal) THEN
|
|
|
- 3947 SemError(211)
|
|
|
- 3948 ELSIF QbeGen.IsImm(q)
|
|
|
- 3949 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 3950 IF lo < 0 THEN lo := -lo END;
|
|
|
- 3951 QbeGen.IntStr(lo, q)
|
|
|
- 3952 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3953 END;
|
|
|
- 3954 t := et; .)
|
|
|
- 3955 | "ODD" "(" Expr<et, q> ")"
|
|
|
- 3956 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3957 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ODD"));
|
|
|
- 3958 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3959 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3960 (. IF (et # SymTab.InvalidType)
|
|
|
- 3961 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3962 SemError(211) END;
|
|
|
- 3963 t := SymTab.BoolType();
|
|
|
- 3964 IF QbeGen.IsImm(q)
|
|
|
- 3965 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 3966 IF (lo MOD 2) # 0 THEN
|
|
|
- 3967 QbeGen.CopyOp("1", q)
|
|
|
- 3968 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3969 END
|
|
|
- 3970 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3971 END; .)
|
|
|
- 3972 | "TRUNC" "(" Expr<et, q> ")"
|
|
|
- 3973 (. (* TRUNC(x): real -> INTEGER, as the VAL builtin *)
|
|
|
- 3974 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3975 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3976 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "INTEGER"));
|
|
|
- 3977 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3978 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3979 (. t := SymTab.IntType();
|
|
|
- 3980 QbeGen.CopyOp("@", q); .)
|
|
|
- 3981 | "FLOAT" "(" Expr<et, q> ")"
|
|
|
- 3982 (. (* FLOAT(i): integer -> REAL, as the VAL builtin *)
|
|
|
- 3983 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3984 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3985 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "REAL"));
|
|
|
- 3986 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3987 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3988 (. t := SymTab.RealType();
|
|
|
- 3989 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa); QbeGen.CopyOp(qa, q)
|
|
|
- 3990 ELSE QbeGen.CopyOp("@", q) END; .)
|
|
|
- 3991 | ( "VAL" | "CONVERT" | "CAST" ) "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
- 3992 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3993 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3994 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3995 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3996 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3997 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
- 3998 SemError(201);
|
|
|
- 3999 t := SymTab.InvalidType
|
|
|
- 4000 ELSE vt := SymTab.SymType(vn);
|
|
|
- 4001 IF vt = SymTab.InvalidType THEN
|
|
|
- 4002 t := SymTab.InvalidType
|
|
|
- 4003 ELSIF et =
|
|
|
- 4004 SymTab.InvalidType THEN
|
|
|
- 4005 t := vt
|
|
|
- 4006 ELSE
|
|
|
- 4007 c1 := SymTab.ClassOf(et);
|
|
|
- 4008 c2 := SymTab.ClassOf(vt);
|
|
|
- 4009 IF ((c1 = SymTab.ClInt)
|
|
|
- 4010 OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte))
|
|
|
- 4011 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 4012 IF NOT QbeGen.IsImm(q) THEN QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
- 4013 t := vt
|
|
|
- 4014 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 4015 AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
|
|
|
- 4016 OR (c2 = SymTab.ClSByte)) THEN
|
|
|
- 4017 IF NOT (QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo)) THEN QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
- 4018 t := vt
|
|
|
- 4019 ELSIF ((c1 = SymTab.ClInt)
|
|
|
- 4020 OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte))
|
|
|
- 4021 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 4022 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvIR(q, qa) END;
|
|
|
- 4023 QbeGen.CopyOp(qa, q);
|
|
|
- 4024 t := vt
|
|
|
- 4025 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 4026 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 4027 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvLR(q, qa) END;
|
|
|
- 4028 QbeGen.CopyOp(qa, q);
|
|
|
- 4029 t := vt
|
|
|
- 4030 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 4031 AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
|
|
|
- 4032 OR (c2 = SymTab.ClSByte)) THEN
|
|
|
- 4033 QbeGen.ConvRI(q, qa);
|
|
|
- 4034 QbeGen.CopyOp(qa, q);
|
|
|
+ 3944 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3945 SemError(211) END;
|
|
|
+ 3946 t := SymTab.CharType(); .)
|
|
|
+ 3947 | "UORD" "(" Expr<et, q> ")"
|
|
|
+ 3948 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3949 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
+ 3950 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3951 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3952 (. (* UORD(u): the codepoint as a
|
|
|
+ 3953 32-bit ordinal (INTEGER),
|
|
|
+ 3954 cf. ORD for CHAR. *)
|
|
|
+ 3955 IF (et # SymTab.InvalidType)
|
|
|
+ 3956 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3957 SemError(211) END;
|
|
|
+ 3958 t := SymTab.IntType(); .)
|
|
|
+ 3959 | "ABS" "(" Expr<et, q> ")"
|
|
|
+ 3960 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3961 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
+ 3962 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3963 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3964 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3965 AND NOT SymTab.IsIntFamily(et)
|
|
|
+ 3966 AND (SymTab.ClassOf(et) #
|
|
|
+ 3967 SymTab.ClReal) THEN
|
|
|
+ 3968 SemError(211)
|
|
|
+ 3969 ELSIF QbeGen.IsImm(q)
|
|
|
+ 3970 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 3971 IF lo < 0 THEN lo := -lo END;
|
|
|
+ 3972 QbeGen.IntStr(lo, q)
|
|
|
+ 3973 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3974 END;
|
|
|
+ 3975 t := et; .)
|
|
|
+ 3976 | "ODD" "(" Expr<et, q> ")"
|
|
|
+ 3977 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3978 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ODD"));
|
|
|
+ 3979 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3980 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3981 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3982 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3983 SemError(211) END;
|
|
|
+ 3984 t := SymTab.BoolType();
|
|
|
+ 3985 IF QbeGen.IsImm(q)
|
|
|
+ 3986 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 3987 IF (lo MOD 2) # 0 THEN
|
|
|
+ 3988 QbeGen.CopyOp("1", q)
|
|
|
+ 3989 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3990 END
|
|
|
+ 3991 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3992 END; .)
|
|
|
+ 3993 | "TRUNC" "(" Expr<et, q> ")"
|
|
|
+ 3994 (. (* TRUNC(x): real -> INTEGER, as the VAL builtin *)
|
|
|
+ 3995 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3996 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3997 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "INTEGER"));
|
|
|
+ 3998 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3999 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4000 (. t := SymTab.IntType();
|
|
|
+ 4001 QbeGen.CopyOp("@", q); .)
|
|
|
+ 4002 | "FLOAT" "(" Expr<et, q> ")"
|
|
|
+ 4003 (. (* FLOAT(i): integer -> REAL, as the VAL builtin *)
|
|
|
+ 4004 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4005 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 4006 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "REAL"));
|
|
|
+ 4007 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 4008 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4009 (. t := SymTab.RealType();
|
|
|
+ 4010 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa); QbeGen.CopyOp(qa, q)
|
|
|
+ 4011 ELSE QbeGen.CopyOp("@", q) END; .)
|
|
|
+ 4012 | ( "VAL" | "CONVERT" | "CAST" ) "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
+ 4013 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4014 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 4015 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 4016 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 4017 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4018 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
+ 4019 SemError(201);
|
|
|
+ 4020 t := SymTab.InvalidType
|
|
|
+ 4021 ELSE vt := SymTab.SymType(vn);
|
|
|
+ 4022 IF vt = SymTab.InvalidType THEN
|
|
|
+ 4023 t := SymTab.InvalidType
|
|
|
+ 4024 ELSIF et =
|
|
|
+ 4025 SymTab.InvalidType THEN
|
|
|
+ 4026 t := vt
|
|
|
+ 4027 ELSE
|
|
|
+ 4028 c1 := SymTab.ClassOf(et);
|
|
|
+ 4029 c2 := SymTab.ClassOf(vt);
|
|
|
+ 4030 IF ((c1 = SymTab.ClInt)
|
|
|
+ 4031 OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
|
|
|
+ 4032 OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
|
|
|
+ 4033 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 4034 IF NOT QbeGen.IsImm(q) THEN QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
4035 t := vt
|
|
|
- 4036 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 4037 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 4038 QbeGen.ConvRL(q, qa);
|
|
|
- 4039 QbeGen.CopyOp(qa, q);
|
|
|
- 4040 t := vt
|
|
|
- 4041 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 4042 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 4043 t := vt
|
|
|
- 4044 ELSIF ((c1 = SymTab.ClInt)
|
|
|
- 4045 OR (c1 =
|
|
|
- 4046 SymTab.ClChar)
|
|
|
- 4047 OR (c1 =
|
|
|
- 4048 SymTab.ClBool)
|
|
|
- 4049 OR (c1 =
|
|
|
- 4050 SymTab.ClByte)
|
|
|
- 4051 OR (c1 =
|
|
|
- 4052 SymTab.ClSByte)
|
|
|
- 4053 OR (c1 =
|
|
|
- 4054 SymTab.ClEnum))
|
|
|
- 4055 AND ((c2 = SymTab.ClInt)
|
|
|
- 4056 OR (c2 =
|
|
|
- 4057 SymTab.ClChar)
|
|
|
- 4058 OR (c2 =
|
|
|
- 4059 SymTab.ClBool)
|
|
|
- 4060 OR (c2 =
|
|
|
- 4061 SymTab.ClByte)
|
|
|
- 4062 OR (c2 =
|
|
|
- 4063 SymTab.ClSByte)
|
|
|
- 4064 OR (c2 =
|
|
|
- 4065 SymTab.ClEnum)) THEN
|
|
|
- 4066 t := vt
|
|
|
- 4067 ELSIF (c1 = SymTab.ClPtr)
|
|
|
- 4068 AND (c2 = SymTab.ClPtr) THEN
|
|
|
- 4069 t := vt
|
|
|
- 4070 ELSIF ((c1 = SymTab.ClProc)
|
|
|
- 4071 AND (c2 = SymTab.ClProc))
|
|
|
- 4072 OR ((c1 = SymTab.ClProc) AND (c2 = SymTab.ClPtr))
|
|
|
- 4073 OR ((c1 = SymTab.ClPtr) AND (c2 = SymTab.ClProc)) THEN
|
|
|
- 4074 t := vt
|
|
|
- 4075 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 4076 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 4077 t := vt
|
|
|
- 4078 ELSIF ((c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt))
|
|
|
- 4079 OR ((c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet)) THEN
|
|
|
- 4080 (* a set <-> its machine word (BITSET) *)
|
|
|
- 4081 t := vt
|
|
|
- 4082 ELSE SemError(230);
|
|
|
- 4083 t := SymTab.InvalidType
|
|
|
- 4084 END
|
|
|
- 4085 END
|
|
|
- 4086 END; .)
|
|
|
- 4087 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
- 4088 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
- 4089 QbeGen.CopyOp(sq, q); .)
|
|
|
- 4090 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
- 4091 IF SymTab.BoolCheck(t2) THEN
|
|
|
- 4092 t := SymTab.BoolType()
|
|
|
- 4093 ELSE SemError(212);
|
|
|
- 4094 t := SymTab.InvalidType END;
|
|
|
- 4095 IF t # SymTab.InvalidType THEN
|
|
|
- 4096 QbeGen.CopyOp("@", q)
|
|
|
- 4097 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 4098 END;
|
|
|
- 4099 astIsLit := TRUE;
|
|
|
- 4100 astCur := AST.MakeUn(
|
|
|
- 4101 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
- 4102 )
|
|
|
- 4103 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
- 4104 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 4105 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
- 4106 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
- 4107 for computed elements. Ranges always lower via SetRange. *)
|
|
|
- 4108 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 4109 (. VAR astNode: AST.Node; .)
|
|
|
- 4110 = "{" (. t := SymTab.NewSet(
|
|
|
- 4111 SymTab.NewSubR(0, 255));
|
|
|
- 4112 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
- 4113 QbeGen.NewSetTemp(8, q);
|
|
|
- 4114 QbeGen.SetZero(q, 8); .)
|
|
|
- 4115 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
- 4116 "}" (. astCur := astNode; .) .
|
|
|
- 4117 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
- 4118 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
- 4119 declared type sets the width (set) or element type (array). *)
|
|
|
- 4120 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 4121 (. VAR nw: CARDINAL;
|
|
|
- 4122 astNode, astTail: AST.Node;
|
|
|
- 4123 savedCls: INTEGER; .)
|
|
|
- 4124 = "{" (. savedCls := braceCls;
|
|
|
- 4125 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
- 4126 AST.SetTy(astNode, vt);
|
|
|
- 4127 astTail := astNode;
|
|
|
- 4128 IF vt = SymTab.InvalidType THEN
|
|
|
- 4129 braceCls := -1
|
|
|
- 4130 ELSE braceCls :=
|
|
|
- 4131 SymTab.ClassOf(vt)
|
|
|
- 4132 END;
|
|
|
- 4133 IF braceCls = SymTab.ClSet THEN
|
|
|
- 4134 IF vt = SymTab.InvalidType THEN
|
|
|
- 4135 nw := 8
|
|
|
- 4136 ELSE nw := SymTab.SetWords(vt);
|
|
|
- 4137 IF nw = 0 THEN nw := 8 END
|
|
|
- 4138 END;
|
|
|
- 4139 QbeGen.NewSetTemp(nw, q);
|
|
|
- 4140 QbeGen.SetZero(q, nw)
|
|
|
- 4141 ELSIF (braceCls =
|
|
|
- 4142 SymTab.ClArray)
|
|
|
- 4143 OR (braceCls =
|
|
|
- 4144 SymTab.ClRecord)
|
|
|
- 4145 OR (braceCls =
|
|
|
- 4146 SymTab.ClClass) THEN
|
|
|
- 4147 QbeGen.CtorBegin(vt)
|
|
|
- 4148 ELSE
|
|
|
- 4149 IF vt # SymTab.InvalidType THEN
|
|
|
- 4150 SemError(230) END;
|
|
|
- 4151 braceCls := -1
|
|
|
- 4152 END; .)
|
|
|
- 4153 [ BraceElem<vt, q, astNode, astTail>
|
|
|
- 4154 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
- 4155 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
- 4156 OR (braceCls =
|
|
|
- 4157 SymTab.ClRecord)
|
|
|
- 4158 OR (braceCls =
|
|
|
- 4159 SymTab.ClClass) THEN
|
|
|
- 4160 QbeGen.CtorEnd(q)
|
|
|
- 4161 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
- 4162 QbeGen.CopyOp("0", q)
|
|
|
- 4163 END;
|
|
|
- 4164 braceCls := savedCls; .)
|
|
|
- 4165 (. astCur := astNode; .) .
|
|
|
- 4166 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
- 4167 VAR node, tail: AST.Node>
|
|
|
- 4168 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 4169 qe, q2: QbeGen.QVal;
|
|
|
- 4170 v, v2, reps, k: INTEGER;
|
|
|
- 4171 elem: SymTab.TypeIndex;
|
|
|
- 4172 lo: INTEGER;
|
|
|
- 4173 span: CARDINAL;
|
|
|
- 4174 cl, cl2: INTEGER;
|
|
|
- 4175 hasR, hasB: BOOLEAN;
|
|
|
- 4176 astEl: AST.Node; .)
|
|
|
- 4177 = (. hasR := FALSE; hasB := FALSE;
|
|
|
- 4178 reps := 1; .)
|
|
|
- 4179 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 4180 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 4181 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 4182 hasR := TRUE; .) ]
|
|
|
- 4183 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
- 4184 (. IF braceCls = SymTab.ClSet THEN
|
|
|
- 4185 IF hasB THEN SemError(230) END;
|
|
|
- 4186 lo := SymTab.SetBaseLo(vt);
|
|
|
- 4187 span := SymTab.SetCount(vt);
|
|
|
- 4188 IF (et = SymTab.InvalidType)
|
|
|
- 4189 OR (hasR AND (et2 =
|
|
|
- 4190 SymTab.InvalidType)) THEN
|
|
|
- 4191 ELSE cl :=
|
|
|
- 4192 SymTab.ClassOf(et);
|
|
|
- 4193 IF hasR THEN
|
|
|
- 4194 cl2 :=
|
|
|
- 4195 SymTab.ClassOf(et2)
|
|
|
- 4196 ELSE cl2 := SymTab.ClInt
|
|
|
- 4197 END;
|
|
|
- 4198 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 4199 OR (hasR AND NOT
|
|
|
- 4200 SymTab.SetElemClassOk(cl2))
|
|
|
- 4201 THEN
|
|
|
- 4202 SemError(222)
|
|
|
- 4203 ELSIF hasR
|
|
|
- 4204 AND SymTab.ConstInt(qe, v)
|
|
|
- 4205 AND SymTab.ConstInt(q2,
|
|
|
- 4206 v2)
|
|
|
- 4207 AND ((v < lo)
|
|
|
- 4208 OR (v2 < lo)
|
|
|
- 4209 OR (v >= lo +
|
|
|
- 4210 VAL(INTEGER, span))
|
|
|
- 4211 OR (v2 >= lo +
|
|
|
- 4212 VAL(INTEGER, span))
|
|
|
- 4213 OR (v > v2)) THEN
|
|
|
- 4214 SemError(222)
|
|
|
- 4215 ELSIF hasR THEN
|
|
|
- 4216 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 4217 lo, span)
|
|
|
- 4218 ELSIF SymTab.ConstInt(qe,
|
|
|
- 4219 v)
|
|
|
- 4220 AND ((v < lo)
|
|
|
- 4221 OR (v >= lo +
|
|
|
- 4222 VAL(INTEGER,
|
|
|
- 4223 span))) THEN
|
|
|
- 4224 SemError(222)
|
|
|
- 4225 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 4226 lo, span)
|
|
|
- 4227 END
|
|
|
- 4228 END
|
|
|
- 4229 ELSIF (braceCls = SymTab.ClArray)
|
|
|
- 4230 OR (braceCls =
|
|
|
- 4231 SymTab.ClRecord)
|
|
|
- 4232 OR (braceCls =
|
|
|
- 4233 SymTab.ClClass) THEN
|
|
|
- 4234 IF hasR THEN SemError(230) END;
|
|
|
- 4235 reps := 1;
|
|
|
- 4236 IF hasB THEN
|
|
|
- 4237 IF SymTab.ConstInt(q2, v2)
|
|
|
- 4238 AND (v2 >= 1) THEN
|
|
|
- 4239 reps := v2
|
|
|
- 4240 ELSE SemError(230)
|
|
|
- 4241 END
|
|
|
- 4242 END;
|
|
|
- 4243 k := 0;
|
|
|
- 4244 WHILE k < reps DO
|
|
|
- 4245 QbeGen.CtorElem(qe);
|
|
|
- 4246 INC(k)
|
|
|
- 4247 END
|
|
|
- 4248 END; .)
|
|
|
- 4249 (. (* the BY form repeats the
|
|
|
- 4250 element; keep the AST in
|
|
|
- 4251 step with CtorElem *)
|
|
|
- 4252 k := 0;
|
|
|
- 4253 WHILE k < reps DO
|
|
|
- 4254 AstAppend(AST.NkBlock,
|
|
|
- 4255 node, tail, astEl);
|
|
|
- 4256 INC(k)
|
|
|
- 4257 END; .) .
|
|
|
- 4258 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 4259 qe, q2: QbeGen.QVal;
|
|
|
- 4260 v, v2: INTEGER;
|
|
|
- 4261 lo: INTEGER;
|
|
|
- 4262 span: CARDINAL;
|
|
|
- 4263 cl, cl2: INTEGER;
|
|
|
- 4264 hasR: BOOLEAN;
|
|
|
- 4265 astEl: AST.Node; .)
|
|
|
- 4266 = (. hasR := FALSE; .)
|
|
|
- 4267 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 4268 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 4269 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 4270 hasR := TRUE; .) ]
|
|
|
- 4271 (. lo := SymTab.SetBaseLo(st);
|
|
|
- 4272 span := SymTab.SetCount(st);
|
|
|
- 4273 IF (et = SymTab.InvalidType)
|
|
|
- 4274 OR (hasR AND (et2 =
|
|
|
- 4275 SymTab.InvalidType)) THEN
|
|
|
- 4276 ELSE cl :=
|
|
|
- 4277 SymTab.ClassOf(et);
|
|
|
- 4278 IF hasR THEN
|
|
|
- 4279 cl2 :=
|
|
|
- 4280 SymTab.ClassOf(et2)
|
|
|
- 4281 ELSE cl2 := SymTab.ClInt
|
|
|
- 4282 END;
|
|
|
- 4283 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 4284 OR (hasR AND NOT
|
|
|
- 4285 SymTab.SetElemClassOk(cl2))
|
|
|
- 4286 THEN
|
|
|
- 4287 SemError(222)
|
|
|
- 4288 ELSIF hasR
|
|
|
- 4289 AND SymTab.ConstInt(qe, v)
|
|
|
- 4290 AND SymTab.ConstInt(q2,
|
|
|
- 4291 v2)
|
|
|
- 4292 AND ((v < lo)
|
|
|
- 4293 OR (v2 < lo)
|
|
|
- 4294 OR (v >= lo +
|
|
|
- 4295 VAL(INTEGER, span))
|
|
|
- 4296 OR (v2 >= lo +
|
|
|
- 4297 VAL(INTEGER, span))
|
|
|
- 4298 OR (v > v2)) THEN
|
|
|
- 4299 SemError(222)
|
|
|
- 4300 ELSIF hasR THEN
|
|
|
- 4301 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 4302 lo, span)
|
|
|
- 4303 ELSIF SymTab.ConstInt(qe,
|
|
|
- 4304 v)
|
|
|
- 4305 AND ((v < lo)
|
|
|
- 4306 OR (v >= lo +
|
|
|
- 4307 VAL(INTEGER,
|
|
|
- 4308 span))) THEN
|
|
|
- 4309 SemError(222)
|
|
|
- 4310 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 4311 lo, span)
|
|
|
- 4312 END
|
|
|
- 4313 END; .)
|
|
|
- 4314 (. AST.SetChild(node,
|
|
|
- 4315 AST.NChild(node), astEl); .) .
|
|
|
- 4316 GetIdent<VAR n: SymTab.Name>
|
|
|
- 4317 = ident (. LexName(n); .) .
|
|
|
- 4318
|
|
|
- 4319 END M2.
|
|
|
+ 4036 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 4037 AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
|
|
|
+ 4038 OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
|
|
|
+ 4039 OR (c2 = SymTab.ClSWord16)) THEN
|
|
|
+ 4040 IF NOT (QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo)) THEN QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
+ 4041 t := vt
|
|
|
+ 4042 ELSIF ((c1 = SymTab.ClInt)
|
|
|
+ 4043 OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
|
|
|
+ 4044 OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
|
|
|
+ 4045 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 4046 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvIR(q, qa) END;
|
|
|
+ 4047 QbeGen.CopyOp(qa, q);
|
|
|
+ 4048 t := vt
|
|
|
+ 4049 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 4050 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 4051 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvLR(q, qa) END;
|
|
|
+ 4052 QbeGen.CopyOp(qa, q);
|
|
|
+ 4053 t := vt
|
|
|
+ 4054 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 4055 AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
|
|
|
+ 4056 OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
|
|
|
+ 4057 OR (c2 = SymTab.ClSWord16)) THEN
|
|
|
+ 4058 QbeGen.ConvRI(q, qa);
|
|
|
+ 4059 QbeGen.CopyOp(qa, q);
|
|
|
+ 4060 t := vt
|
|
|
+ 4061 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 4062 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 4063 QbeGen.ConvRL(q, qa);
|
|
|
+ 4064 QbeGen.CopyOp(qa, q);
|
|
|
+ 4065 t := vt
|
|
|
+ 4066 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 4067 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 4068 t := vt
|
|
|
+ 4069 ELSIF ((c1 = SymTab.ClInt)
|
|
|
+ 4070 OR (c1 =
|
|
|
+ 4071 SymTab.ClChar)
|
|
|
+ 4072 OR (c1 =
|
|
|
+ 4073 SymTab.ClBool)
|
|
|
+ 4074 OR (c1 =
|
|
|
+ 4075 SymTab.ClByte)
|
|
|
+ 4076 OR (c1 =
|
|
|
+ 4077 SymTab.ClSByte)
|
|
|
+ 4078 OR (c1 =
|
|
|
+ 4079 SymTab.ClWord16)
|
|
|
+ 4080 OR (c1 =
|
|
|
+ 4081 SymTab.ClSWord16)
|
|
|
+ 4082 OR (c1 =
|
|
|
+ 4083 SymTab.ClEnum))
|
|
|
+ 4084 AND ((c2 = SymTab.ClInt)
|
|
|
+ 4085 OR (c2 =
|
|
|
+ 4086 SymTab.ClChar)
|
|
|
+ 4087 OR (c2 =
|
|
|
+ 4088 SymTab.ClBool)
|
|
|
+ 4089 OR (c2 =
|
|
|
+ 4090 SymTab.ClByte)
|
|
|
+ 4091 OR (c2 =
|
|
|
+ 4092 SymTab.ClSByte)
|
|
|
+ 4093 OR (c2 =
|
|
|
+ 4094 SymTab.ClWord16)
|
|
|
+ 4095 OR (c2 =
|
|
|
+ 4096 SymTab.ClSWord16)
|
|
|
+ 4097 OR (c2 =
|
|
|
+ 4098 SymTab.ClEnum)) THEN
|
|
|
+ 4099 t := vt
|
|
|
+ 4100 ELSIF (c1 = SymTab.ClPtr)
|
|
|
+ 4101 AND (c2 = SymTab.ClPtr) THEN
|
|
|
+ 4102 t := vt
|
|
|
+ 4103 ELSIF ((c1 = SymTab.ClProc)
|
|
|
+ 4104 AND (c2 = SymTab.ClProc))
|
|
|
+ 4105 OR ((c1 = SymTab.ClProc) AND (c2 = SymTab.ClPtr))
|
|
|
+ 4106 OR ((c1 = SymTab.ClPtr) AND (c2 = SymTab.ClProc)) THEN
|
|
|
+ 4107 t := vt
|
|
|
+ 4108 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 4109 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 4110 t := vt
|
|
|
+ 4111 ELSIF ((c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt))
|
|
|
+ 4112 OR ((c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet)) THEN
|
|
|
+ 4113 (* a set <-> its machine word (BITSET) *)
|
|
|
+ 4114 t := vt
|
|
|
+ 4115 ELSE SemError(230);
|
|
|
+ 4116 t := SymTab.InvalidType
|
|
|
+ 4117 END
|
|
|
+ 4118 END
|
|
|
+ 4119 END; .)
|
|
|
+ 4120 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
+ 4121 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
+ 4122 QbeGen.CopyOp(sq, q); .)
|
|
|
+ 4123 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
+ 4124 IF SymTab.BoolCheck(t2) THEN
|
|
|
+ 4125 t := SymTab.BoolType()
|
|
|
+ 4126 ELSE SemError(212);
|
|
|
+ 4127 t := SymTab.InvalidType END;
|
|
|
+ 4128 IF t # SymTab.InvalidType THEN
|
|
|
+ 4129 QbeGen.CopyOp("@", q)
|
|
|
+ 4130 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 4131 END;
|
|
|
+ 4132 astIsLit := TRUE;
|
|
|
+ 4133 astCur := AST.MakeUn(
|
|
|
+ 4134 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
+ 4135 )
|
|
|
+ 4136 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
+ 4137 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 4138 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
+ 4139 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
+ 4140 for computed elements. Ranges always lower via SetRange. *)
|
|
|
+ 4141 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 4142 (. VAR astNode: AST.Node; .)
|
|
|
+ 4143 = "{" (. t := SymTab.NewSet(
|
|
|
+ 4144 SymTab.NewSubR(0, 255));
|
|
|
+ 4145 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
+ 4146 QbeGen.NewSetTemp(8, q);
|
|
|
+ 4147 QbeGen.SetZero(q, 8); .)
|
|
|
+ 4148 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
+ 4149 "}" (. astCur := astNode; .) .
|
|
|
+ 4150 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
+ 4151 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
+ 4152 declared type sets the width (set) or element type (array). *)
|
|
|
+ 4153 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 4154 (. VAR nw: CARDINAL;
|
|
|
+ 4155 astNode, astTail: AST.Node;
|
|
|
+ 4156 savedCls: INTEGER; .)
|
|
|
+ 4157 = "{" (. savedCls := braceCls;
|
|
|
+ 4158 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
+ 4159 AST.SetTy(astNode, vt);
|
|
|
+ 4160 astTail := astNode;
|
|
|
+ 4161 IF vt = SymTab.InvalidType THEN
|
|
|
+ 4162 braceCls := -1
|
|
|
+ 4163 ELSE braceCls :=
|
|
|
+ 4164 SymTab.ClassOf(vt)
|
|
|
+ 4165 END;
|
|
|
+ 4166 IF braceCls = SymTab.ClSet THEN
|
|
|
+ 4167 IF vt = SymTab.InvalidType THEN
|
|
|
+ 4168 nw := 8
|
|
|
+ 4169 ELSE nw := SymTab.SetWords(vt);
|
|
|
+ 4170 IF nw = 0 THEN nw := 8 END
|
|
|
+ 4171 END;
|
|
|
+ 4172 QbeGen.NewSetTemp(nw, q);
|
|
|
+ 4173 QbeGen.SetZero(q, nw)
|
|
|
+ 4174 ELSIF (braceCls =
|
|
|
+ 4175 SymTab.ClArray)
|
|
|
+ 4176 OR (braceCls =
|
|
|
+ 4177 SymTab.ClRecord)
|
|
|
+ 4178 OR (braceCls =
|
|
|
+ 4179 SymTab.ClClass) THEN
|
|
|
+ 4180 QbeGen.CtorBegin(vt)
|
|
|
+ 4181 ELSE
|
|
|
+ 4182 IF vt # SymTab.InvalidType THEN
|
|
|
+ 4183 SemError(230) END;
|
|
|
+ 4184 braceCls := -1
|
|
|
+ 4185 END; .)
|
|
|
+ 4186 [ BraceElem<vt, q, astNode, astTail>
|
|
|
+ 4187 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
+ 4188 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
+ 4189 OR (braceCls =
|
|
|
+ 4190 SymTab.ClRecord)
|
|
|
+ 4191 OR (braceCls =
|
|
|
+ 4192 SymTab.ClClass) THEN
|
|
|
+ 4193 QbeGen.CtorEnd(q)
|
|
|
+ 4194 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
+ 4195 QbeGen.CopyOp("0", q)
|
|
|
+ 4196 END;
|
|
|
+ 4197 braceCls := savedCls; .)
|
|
|
+ 4198 (. astCur := astNode; .) .
|
|
|
+ 4199 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
+ 4200 VAR node, tail: AST.Node>
|
|
|
+ 4201 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 4202 qe, q2: QbeGen.QVal;
|
|
|
+ 4203 v, v2, reps, k: INTEGER;
|
|
|
+ 4204 elem: SymTab.TypeIndex;
|
|
|
+ 4205 lo: INTEGER;
|
|
|
+ 4206 span: CARDINAL;
|
|
|
+ 4207 cl, cl2: INTEGER;
|
|
|
+ 4208 hasR, hasB: BOOLEAN;
|
|
|
+ 4209 astEl: AST.Node; .)
|
|
|
+ 4210 = (. hasR := FALSE; hasB := FALSE;
|
|
|
+ 4211 reps := 1; .)
|
|
|
+ 4212 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 4213 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 4214 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 4215 hasR := TRUE; .) ]
|
|
|
+ 4216 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
+ 4217 (. IF braceCls = SymTab.ClSet THEN
|
|
|
+ 4218 IF hasB THEN SemError(230) END;
|
|
|
+ 4219 lo := SymTab.SetBaseLo(vt);
|
|
|
+ 4220 span := SymTab.SetCount(vt);
|
|
|
+ 4221 IF (et = SymTab.InvalidType)
|
|
|
+ 4222 OR (hasR AND (et2 =
|
|
|
+ 4223 SymTab.InvalidType)) THEN
|
|
|
+ 4224 ELSE cl :=
|
|
|
+ 4225 SymTab.ClassOf(et);
|
|
|
+ 4226 IF hasR THEN
|
|
|
+ 4227 cl2 :=
|
|
|
+ 4228 SymTab.ClassOf(et2)
|
|
|
+ 4229 ELSE cl2 := SymTab.ClInt
|
|
|
+ 4230 END;
|
|
|
+ 4231 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 4232 OR (hasR AND NOT
|
|
|
+ 4233 SymTab.SetElemClassOk(cl2))
|
|
|
+ 4234 THEN
|
|
|
+ 4235 SemError(222)
|
|
|
+ 4236 ELSIF hasR
|
|
|
+ 4237 AND SymTab.ConstInt(qe, v)
|
|
|
+ 4238 AND SymTab.ConstInt(q2,
|
|
|
+ 4239 v2)
|
|
|
+ 4240 AND ((v < lo)
|
|
|
+ 4241 OR (v2 < lo)
|
|
|
+ 4242 OR (v >= lo +
|
|
|
+ 4243 VAL(INTEGER, span))
|
|
|
+ 4244 OR (v2 >= lo +
|
|
|
+ 4245 VAL(INTEGER, span))
|
|
|
+ 4246 OR (v > v2)) THEN
|
|
|
+ 4247 SemError(222)
|
|
|
+ 4248 ELSIF hasR THEN
|
|
|
+ 4249 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 4250 lo, span)
|
|
|
+ 4251 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 4252 v)
|
|
|
+ 4253 AND ((v < lo)
|
|
|
+ 4254 OR (v >= lo +
|
|
|
+ 4255 VAL(INTEGER,
|
|
|
+ 4256 span))) THEN
|
|
|
+ 4257 SemError(222)
|
|
|
+ 4258 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 4259 lo, span)
|
|
|
+ 4260 END
|
|
|
+ 4261 END
|
|
|
+ 4262 ELSIF (braceCls = SymTab.ClArray)
|
|
|
+ 4263 OR (braceCls =
|
|
|
+ 4264 SymTab.ClRecord)
|
|
|
+ 4265 OR (braceCls =
|
|
|
+ 4266 SymTab.ClClass) THEN
|
|
|
+ 4267 IF hasR THEN SemError(230) END;
|
|
|
+ 4268 reps := 1;
|
|
|
+ 4269 IF hasB THEN
|
|
|
+ 4270 IF SymTab.ConstInt(q2, v2)
|
|
|
+ 4271 AND (v2 >= 1) THEN
|
|
|
+ 4272 reps := v2
|
|
|
+ 4273 ELSE SemError(230)
|
|
|
+ 4274 END
|
|
|
+ 4275 END;
|
|
|
+ 4276 k := 0;
|
|
|
+ 4277 WHILE k < reps DO
|
|
|
+ 4278 QbeGen.CtorElem(qe);
|
|
|
+ 4279 INC(k)
|
|
|
+ 4280 END
|
|
|
+ 4281 END; .)
|
|
|
+ 4282 (. (* the BY form repeats the
|
|
|
+ 4283 element; keep the AST in
|
|
|
+ 4284 step with CtorElem *)
|
|
|
+ 4285 k := 0;
|
|
|
+ 4286 WHILE k < reps DO
|
|
|
+ 4287 AstAppend(AST.NkBlock,
|
|
|
+ 4288 node, tail, astEl);
|
|
|
+ 4289 INC(k)
|
|
|
+ 4290 END; .) .
|
|
|
+ 4291 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 4292 qe, q2: QbeGen.QVal;
|
|
|
+ 4293 v, v2: INTEGER;
|
|
|
+ 4294 lo: INTEGER;
|
|
|
+ 4295 span: CARDINAL;
|
|
|
+ 4296 cl, cl2: INTEGER;
|
|
|
+ 4297 hasR: BOOLEAN;
|
|
|
+ 4298 astEl: AST.Node; .)
|
|
|
+ 4299 = (. hasR := FALSE; .)
|
|
|
+ 4300 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 4301 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 4302 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 4303 hasR := TRUE; .) ]
|
|
|
+ 4304 (. lo := SymTab.SetBaseLo(st);
|
|
|
+ 4305 span := SymTab.SetCount(st);
|
|
|
+ 4306 IF (et = SymTab.InvalidType)
|
|
|
+ 4307 OR (hasR AND (et2 =
|
|
|
+ 4308 SymTab.InvalidType)) THEN
|
|
|
+ 4309 ELSE cl :=
|
|
|
+ 4310 SymTab.ClassOf(et);
|
|
|
+ 4311 IF hasR THEN
|
|
|
+ 4312 cl2 :=
|
|
|
+ 4313 SymTab.ClassOf(et2)
|
|
|
+ 4314 ELSE cl2 := SymTab.ClInt
|
|
|
+ 4315 END;
|
|
|
+ 4316 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 4317 OR (hasR AND NOT
|
|
|
+ 4318 SymTab.SetElemClassOk(cl2))
|
|
|
+ 4319 THEN
|
|
|
+ 4320 SemError(222)
|
|
|
+ 4321 ELSIF hasR
|
|
|
+ 4322 AND SymTab.ConstInt(qe, v)
|
|
|
+ 4323 AND SymTab.ConstInt(q2,
|
|
|
+ 4324 v2)
|
|
|
+ 4325 AND ((v < lo)
|
|
|
+ 4326 OR (v2 < lo)
|
|
|
+ 4327 OR (v >= lo +
|
|
|
+ 4328 VAL(INTEGER, span))
|
|
|
+ 4329 OR (v2 >= lo +
|
|
|
+ 4330 VAL(INTEGER, span))
|
|
|
+ 4331 OR (v > v2)) THEN
|
|
|
+ 4332 SemError(222)
|
|
|
+ 4333 ELSIF hasR THEN
|
|
|
+ 4334 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 4335 lo, span)
|
|
|
+ 4336 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 4337 v)
|
|
|
+ 4338 AND ((v < lo)
|
|
|
+ 4339 OR (v >= lo +
|
|
|
+ 4340 VAL(INTEGER,
|
|
|
+ 4341 span))) THEN
|
|
|
+ 4342 SemError(222)
|
|
|
+ 4343 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 4344 lo, span)
|
|
|
+ 4345 END
|
|
|
+ 4346 END; .)
|
|
|
+ 4347 (. AST.SetChild(node,
|
|
|
+ 4348 AST.NChild(node), astEl); .) .
|
|
|
+ 4349 GetIdent<VAR n: SymTab.Name>
|
|
|
+ 4350 = ident (. LexName(n); .) .
|
|
|
+ 4351
|
|
|
+ 4352 END M2.
|
|
|
|
|
|
0 errors
|
|
|
|
